#lang scheme/base

;; Scheme macro wrapper that combines 'forth->records' from forth.ss
;; with the target word compiler from comp.ss. This is used for
;; Scheme-style 'begin' forms, both for module and toplevel namespace.

;; Note that this does NOT include bindings for any forth syntax!
;; (i.e. ':'). This is to allow the most flexibility.


 "../comp.ss"   ;; target-compile and wrap/...
  (lib "pretty.ss")

;; Attach semantics to the toplevel forth parser implemented by
;; 'forth->records', which maps forth code (interpreted by possible
;; forth parsing macros available in the compilation time namespace)
;; to a list of dictionary records, and collects toplevel forms using
;; a side-effect on the 'forth-toplevel-forms' parameter.

;; The following macro translates these dictionary records into
;; define-ns forms, and wraps them in a proper begin form. Forth words
;; are represented by 3 entities:

;; - a target label (eventually contains compiled code)
;; - a wrapper macro that compiles a call to the label
;; - postponed code instantiated by 'target-compile'

(define-for-syntax (forth-begin-tx stx init-forms register-code)

  ;; Transform different record types to a (define body) expression.
  (define (record->define/register register! record)
    (syntax-case record ()
      ((name lang loc rep)
       (syntax-case #'lang (macro)
             (syntax-case #'name ()
               ;; Anonymous macros are not really interesting.
               ;; FIXME: maybe detect invariant: macro = identity.
               (#f #`(void))
               ;; Use macros with local exit support.
               (_ #`(redefine!-ns
                     (macro) name
                     (wrap-macro/mexit 'name loc rep)))))
          (syntax-case (generate-temporaries
                        '(label wrapper postponed)) ()
            ((label wrapper postponed)
             ;; collect name of postponed code to be compiled
             (register! #'postponed) 
             (syntax-case #'name ()
               ;; no name? just register postponed code
               (#f #`(define postponed rep))
               ;; else also define the macro wrapper and target code instance
               (_  #`(begin
                         (wrap 'name loc rep))
                       (redefine!-ns (macro) name wrapper)
                       (define-ns    (target) name label)))))))))))
  (define (code->defines code)
    (define words '())
            (lambda (record)
               (lambda (x) (push! words x))
         (target-compile (list #,@words)))))
  ;; Note: forth->records needs to run in the right environment to
  ;; define the RPN syntax!

      ((forth-toplevel-forms init-forms))
    (syntax-case stx ()
      ((_ . code)
       (let* ((defs (with-macro-syntax 
                     (lambda ()
                       (code->defines #'code))))
              (topl (datum->syntax
         #`(begin (begin #,@topl)

(define-syntax (forth-module-begin stx)
  (let ((module-name
          stx 'enclosing-module-name)))
       #,(forth-begin-tx stx
                         '((provide (all-defined-out)))

(define-syntax (forth-begin stx)
  (forth-begin-tx stx '() #'register-code))