#lang scheme/base

;; Handling different languages is done by associating a fresh
;; namespace to each instantiated target code module. Such a namespace
;; is called a ``project''.

;; This module provides some instantiation/sharing help and provides
;; communication between namespaces using 'eval'.

;; (define-syntax-rule (delegated-live-macros: name ...)
;;   (begin
;;     (provide name ...)
;;     (define-syntax-rule (name . args)
;;       (prj-eval `(with-console (lambda () (name . args))))) ...))

(define-syntax-rule (delegated-functions: name ...)
  (begin
    (provide name ...)
    (define (name . args)
      (prj-eval `(apply name ',args))) ...))

;; Special case: to not limit composition, provide macros as
;; functions. This is for constructs that need to be macros in the
;; compiler namespace because they expand to toplevel forms.
(define-syntax-rule (delegated-toplevel: name ...)
  (begin
    (provide name ...)
    (define (name arg)
      (prj-eval `(name ,arg))) ...))


(provide
 make-prj-namespace           ;; create namespace with sharing
 current-prj                  ;; parameter with current prj namespace
;; prj-require                  ;; require into prj namespace
 prj-eval                     ;; evaluate form in prj namespace
 prj                          ;; shortcut macro for multiple quoted forms

 forth-debug       ;; string -> print compiled code

 enter-prj
 
 words!
 console!
 pointers!

 make-prj              
 init-prj)

(delegated-toplevel:

 forth-command      ;; string -> target interaction command
 
 forth-compile      ;; string -> compiled code
 forth-load/compile ;; file -> compiled code
 forth-path         ;; add a search directory for load

 )


(delegated-functions:

 repl

 tfind             ;; lookup target word
 
 prog              ;; program a .hex file using an external programmer like piklab-prog

 with-console
 
 current-console   ;; target's console port + baud rate
 pointers          ;; memory allocation pointers  FIXME: make same as asm's current-pointers
 
 print-code        ;; print it
 kill-code!        ;; delete accumulated code
 
 save-ihex         ;; intel hex output
 save-dict         ;; save base app state
 load-dict         ;; load ..


)

;(delegated-live-macros:
; scat>             ;; scat host<->target interaction
; target>           ;; simulated target-local view of scat>
;
;)



(define make-prj (make-parameter (lambda () (error 'no-prj-registered))))
(define (init-prj)
  (current-prj ((make-prj))))


;; Create a namespace with shared and private module instances.
(define (shared/initial-namespace src-ns shared private)
  (let ((dst-ns (make-base-namespace)))

    ;; See PLT 4.0 guide, section 16.3
    ;; Reflection and Dynamic Evaluation -> Sharing Data and Code Across Namespaces
    (define (load-shared mod)
      (parameterize ((current-namespace src-ns))  ;; make sure it's there
        (dynamic-require mod #f)
        (namespace-require mod))

      (namespace-attach-module src-ns mod dst-ns) ;; get instance from here
      (parameterize ((current-namespace dst-ns))  ;; create bindings
        (namespace-require mod))
      )
    
    (define (load-private mod)
      (parameterize ((current-namespace dst-ns))
        (dynamic-require mod #f)
        (namespace-require mod)))
    
    (for-each load-shared shared)
    (for-each load-private private)

    dst-ns))

;; Create an initialized namespace with structure sharing. Make sure
;; the initial module names are all in canonical form, otherwise the
;; reps won't be shared.

(require scheme/runtime-path)
(define-runtime-path shared "shared.ss")
;; (printf "shared: ~a\n" shared)

(define (make-prj-namespace [initial '()]
                            [src (current-namespace)])
  (shared/initial-namespace
   src
   ;; Data structures are shared, so we can lift code out of the
   ;; namespace. This should include some more code that is common to
   ;; all compilers.
   `(,shared)

   ;; Populate more.
   `(,@initial)))
     


;; To simplify put the current namspace in a parameter.
(define current-prj (make-parameter #f))
(define (prj-eval expr)
  (unless (current-prj) (init-prj)) ;; lazy instantiation
  (parameterize
      ;; Make sure code inside the namespace can use 'eval' for
      ;; reflective operations.
      ((current-namespace (current-prj)))
    (eval expr)))

;; (define (prj-require spec)
;;   (parameterize ((current-namespace (current-prj)))
;;     (namespace-require spec)))


(define-syntax-rule (prj forms ...)
  (prj-eval '(begin forms ...)))


(define (forth-debug str)
  (prj-eval
   `(begin
      (asm-off!)
      (forth-compile ,str)
      (asm-on!))))


;; Loading project files.
(define (words! x)    (prj-eval `(set-target-words! ',x)))
(define (console! x)  (prj-eval `(current-console ',x)))
(define (pointers! x) (prj-eval `(pointers ',x)))


;; Entering/leaving project namespaces.

(define (enter-prj)
  (let ((top (current-namespace)))
    (prj-eval `(define (leave-prj) (current-namespace ,top)))
    (current-namespace (current-prj))))