#lang scheme/base

;; Live interaction and parsing words.  This fills the gap between
;; target word execution, macro simulation and scat/scheme procedure
;; execution.

;; This module mostly defines scat words that perform host
;; computations based on target data.

(require
 "../tools.ss"
 "../scat.ss"
 "../rpn.ss"
 "../ns.ss"

 "reflection.ss"
 "tethered.ss"
 "../target.ss"
 "../code.ss"
 "rpn-live.ss"
 
 (for-syntax
  "../forth/forth-tx.ss"
  scheme/base))

(provide (all-defined-out))

;; LOWLEVEL PARSERS
;; Pass the rest of the input to a prefix parser.
(ns (target) (define-syntax slurp rpn-slurp))


;; SCAT GLUE CODE
(compositions (scat) live:
              
 ;; target I/O
 (hilo> swap 8 <<< or)
 (>hilo dup 8 <<< swap #xFF and)

 ;; Printing words from the stack.  These scat words are wrapped later
 ;; using 1cmd to take their argument from the target stack.
 (ps        8 sign-extend p)
 (px        byte->string d)
 
 ;; DOUBLE WORD EXTENSIONS
 (_ps       16 sign-extend p)
 (_px       word->string d)
 (_p        p)

 )

;; ARGUMENTS FROM TARGET
(prefix-parsers/meta
 (target) live:
 
 ((_1cmd: w)   (t> t> hilo> w))
 ((1cmd: w)    (t> w)))

;; Change the meaning of a word by prefixing it with another word.
;; Make sure the prefixer removes the word from the stream to not get
;; an expansion loop.
(define-syntax-rule (prefix-parsers-wrapped ns wrap (name ...))
  (prefix-parsers ns ((name) (wrap name)) ...))


(prefix-parsers-wrapped
 (target) 1cmd:
 
 (kb a! f! abd fbd bd p px ps erase-block erase-from-block client target!))

(prefix-parsers-wrapped
 (target) _1cmd:

 (_p _px _ps))


;; Prefix parsers that expand to inline scat code.
(prefix-parsers/meta
 (target) live:

 ;; Words that modify the semantics of the following token.

 ((see w)  ('w tsee))
 ((msee w) ('w msee))
 ((vsee w) ('w vsee))
 
 ((help w)    ('w print-doc))
;; ((load w)    ('w forth-load))
 
 ((start w)   ('w target-find-code tstart/b))
 ((|'| w)     ('w target-find-code  _>t))          ;; FIXME: depend on architecture!
 ((dump w)    ('w target-find-code f! fdump))
 
 ((plot n)    ('n plot))
 ((2plot n)   ('n 2plot))
 
 ;; Memory access is never overridden by target implementation. FIXME:
 ;; why is this?  The 'access-bank functionality can probably be
 ;; implemented as a concatenative macro.
 
 ((@)         (t> access-bank t@ >t))
 ((!)         (t> t> swap access-bank t!))


 ((|.|) (t> p))

 )


(define scheme read-eval-print-loop)

;; Side effect wrapper.
(define-syntax-rule (!: e ...)
  (lambda (state)
    (begin e ...)
    state))

(prefix-parsers
 (target)

 ;; Compile code from console + commit.
 ((inline-code (c ...))  (,(!: (eval '(forth-begin c ...))) commit))

 ;; Switch to compile mode for 2 words.  Instead we might try to run
 ;; the (macro) namespace parser directly?  This won't work for ":" as
 ;; it is not terminated.
 ((declare: parser name)  (inline-code (parser name)))

 ;; Switch to compile mode for the rest of the line.
 ((compile-line:)  (slurp inline-code))

 ;; Interaction with full macro language available: compile code and
 ;; execute it.  The procedure is available as "last" and is
 ;; terminated with "exit" for convenience and robustness.
 ((code/last (c ...))  (inline-code (: last c ... exit) last))
 ((::) (slurp code/last))

 )

(prefix-parsers-wrapped
 (target) declare:
 (variable 2variable load require planet staapl))

(prefix-parsers-wrapped
 (target) compile-line:
 (: macro forth))