#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 staapl-resolve 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)) ;; 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 "load-staapl.ss") (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)]) (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-resolve) "prj/shared.ss")) ;; Populate more. `(,@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!))))