#lang scheme/base

(require
 "../target.ss"
 "../scat.ss"
 "tethered.ss"
 "console.ss"
 "commands.ss"
 (for-syntax
  "../tools-tx.ss"
  "../scat-tx.ss"
  "../forth-tx.ss"
  scheme/base))

(provide (all-defined-out))

;; 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 e)
  (cond
   ((procedure? fn) (fn e))
   ((target-word? fn) ((scat: ',(target-word-address fn) texec/w) e))
   (else (error 'target-interpret))))

(define-syntax (target: stx)
  (define (immediate im e) #`((scat: ' #,im >t) #,e))
  (define (function fn e)  #`(target-interpret #,fn #,e))
  (define (map-id id) (ns-prefixed #'(target) id))

  (with-scat-syntax
   (lambda ()
     (parameterize
         ((rpn-map-identifier map-id)
          (rpn-immediate      immediate)
          (rpn-function       function)
          (rpn-lambda         scat-lambda)
          (rpn-context        with-scat-syntax)) ;; FIXME
       (rpn-compile (stx-cdr stx))))))

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

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

(define-syntax (forth-command stx)
  (syntax-case stx ()
    ((_ str) #`(target> #,@(string->forth-syntax #'str)))))