#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-macros: name ...)
  (begin
    (provide name ...)
    (define-syntax-rule (name . args)
      (prj-eval '(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
 
 make-prj              
 init-prj)

(delegated-toplevel:

 forth-compile      ;; string -> compiled code
 forth-load/compile ;; file -> compiled code
 forth-command      ;; string -> target interaction command

 )

(delegated-functions:

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

 current-console   ;; target's console port + baud rate

 print-code        ;; print it
 save-ihex         ;; intel hex output
 save-dict         ;; word dictionary output
)

(delegated-macros:
 
 live-scat>        ;; scat + connection (host<->target interaction)
 target>           ;; simulated target-local view of live-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.
(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.
   '(staapl/tools
     staapl/scat/rep
     staapl/target/rep)

   ;; Compiled forth code registration is local to the namespace.
   `(staapl/target/incremental
     ,@initial)))


;; To simplify put the current namspace in a parameter.
(define current-prj (make-parameter #f))
(define (prj-eval expr)
  (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!))))