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

(define-syntax-rule (delegated-functions: name ...)
    (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 ...)
    (provide name ...)
    (define (name arg)
      (prj-eval `(name ,arg))) ...))

 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



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



 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

 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)


;; Planet references the universal access mechanism for all staapl
;; code. During packaging, staapl's planet version number will be
;; hardcoded in the source tree. This number is necessary to locate
;; the code for the reflective operations.
(require "")
(define staapl-resolve
  (make-parameter staapl->module-path))

;; 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)])
   ;; 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-resolve) "prj/"))

   ;; Populate more.

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