#lang scheme/base


(provide (all-defined-out))

;; The target: language is used for interaction with a live machine.
;; It provides a simulation of a Forth console.  The target: form
;; produces a scat function.

;; LITERALS are moved to the target parameter stack.
(define-syntax-rule (target-push  im p sub)
  (let ((p ((live: 'im >t) p))) sub))

;; IDENTIFIERS refer to one of
;;   - prefix parsing macros that escape the default semantics (see
;;   - names of on-target binary code.  such will be executed.
;;   - names of composite macros.  such will be expanded and attempted
;;   to be interpreted as code/data.
;;   - scat functions (or automatically lifted scheme functions).

;; Classical Forth doesn't interpret macros at the console, but since
;; Coma Forth is based heavily on macros, interaction would be quite
;; painful without first instantiating some macros as binary code on
;; the target.  Note that this is basicly a hack, and not all macros
;; can be instantiated.

;; If identifiers do not have bound syntax, interpretation is delayed
;; until runtime.  The target: language always runs interactively with
;; an associated toplevel namespace for maximum debugging flexibility.

;; FIXME: this prefers code over data, instead of the first one found.
;; Might need to do it differently?

(define (target-interpret sym)
  (define defined? (make-ns-defined? sym))
   ((target-find-code sym) => (lambda (x) (live: ',x texec/b)))
   ((target-find-data sym) => (lambda (x) (live: ',x >t)))
   ((defined? '(macro))    => (lambda (x) (live: ',x tsim)))
   (else (live-interpret sym))))
(define-syntax-rule (target id)
  (target-interpret 'id))

;; Abstracted out: used in other target-like language parsers.
(define-syntax-rule (target-parse (ns push) code ...)
   (rpn-parse (rpn:-compile
               scat-push    ;; Program quotations are not used in target language,
               scat:        ;; so they escape to scat.
               ) code ...)))
(define-syntax-rule (target: code ...)
  (target-parse ((target)
                code ...))
(define-syntax-rule (target> code ...)
  (void ((target: code ...) (state:stack))))

(define-syntax-rule (forth-command str)
  (forth-lex-string/cps target> str))