#lang scheme/base

(require
 "../target.ss"
 "../scat.ss"
 "../ns.ss"
 "../rpn.ss"
 "../macro.ss"
 "tethered.ss"
 "commands.ss"
 "../forth/forth-lex.ss"
 (for-syntax
  "../ns-tx.ss"
  scheme/base))

(provide target:
         target
         forth-command)

;; The 'target:' language will execute target words, load numbers on
;; the stack and perform macro subsitutions for the parsing words
;; defined in this file.

;; The (target) namespace contains parsing macros and target word
;; structues. The word structures are not executable, so function
;; semantics involves an interpretation step.

(define (target-interpret fn state)
  (cond
   ((procedure? fn) (fn state))
   ((target-word? fn) ((scat: ',(target-word-address fn) texec/w) state))
   (else (error 'target-interpret))))

(define (target-simulated macro)
  (lambda (state)
    (simulate-macro macro)  ;; Viewed as a Scat word, simulation is a target side-effect.
    state))

(define-syntax-rule (target-apply fn p sub) (let ((p (target-interpret fn p))) sub))
(define-syntax-rule (target-push  im p sub) (let ((p ((scat: 'im >t) p))) sub))

;; Here we use abstract namespace resolution to catch undefined target
;; identifiers and implent them with simulated macros.  Note this does
;; not work for transformer bindings.

(define-syntax (target stx)
  (syntax-case stx ()
    ((_ id) (and (identifier? #'id)
                 (not (identifier-binding
                       (ns-prefixed #'(target) #'id))))
     #`(target-simulated (macro id)))
    ((_ form)
     #`(ns (target) form))))


(define-syntax-rule (target: code ...)
  (rpn-parse (rpn:-compile
              (target)
              target-apply
              target-push
              target-apply  ;; can't quote programs on target, so
                            ;; flatten them into execution instead.
              target:
              (rpn-lambda)
              ) code ...))
             
(define-syntax-rule (target> code ...)
  (void ((target: code ...) (state:stack))))

;; (define-syntax-rule (live-scat> code ...) (scat-console (scat: code ...)))

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