#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 ...)
    (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-macro->data              ;; get macro constant value
 prj                          ;; shortcut macro for multiple quoted forms

 forth-debug                  ;; string -> print compiled code




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


;; forth-load/compile just inlines the (forth-begin ..) macro. In
;; order for this to work it needs to be evaluated in the compiler
;; namespace.
(provide forth-load/compile)
(define (forth-load/compile file [top! #f])
  (when top!
    (let ((dir
           (if (boolean? top!)
               (let-values (((base name _) (split-path file))) base)
      (prj-eval `(current-load-relative-directory ,dir))))
  (prj-eval `(forth-load/compile ,file)))



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


 target-words      ;; name reflection
 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 ..




; 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)


;; 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 "")
;; (printf "shared: ~a\n" 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.

   ;; Populate more.

;; 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
      ;; 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)

;; Entering/leaving project namespaces.

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

(define (prj-macro->data sym)
  (with-handlers ((void (lambda _ #f)))
    (prj-eval `(macro->data (macro: ,sym)))))