#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
 scheme/match
 scheme/control
 "../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 meaning of the following token.

 
 ((see w)  ('w tsee))
 ((msee w) ('w msee))
 ((vsee w) ('w vsee))

 ((sea w)  ('w print-tword)) ;; sea = see assembly
 
 ((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))

 )

;; Used to be just read-eval-print-loop, but a prompt is nice to have.
;; Explicit (exit) is necessary to leave scheme mode.
(define (racket) (scheme))
(define (scheme)
  (display "Entering Racket REPL.  CTRL-D to exit.\n")
  (let loop ()
    (prompt
     (with-handlers
         ((void
           (lambda (ex)
             (display "ERROR:\n")
             (display ex)
             (loop))))
       (read-eval-print-loop)))))

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

;; Log interactive state.  Because it's impossible to serialize the
;; the state built up during interactive compilation, we provide a way
;; to log the subset of the evaluations that lead to definitions, so
;; they can be replayed on next start.

(define eval-log-file
  (make-parameter "staapl.log"))

;; The eval-log records scheme expressions because they are validated
;; as proper code.  This thanslates back to Forth syntax.

;; Note that currently we save scheme syntax (= exactly what is passed
;; to `eval') since it's most correct.  I'm not sure if this unparsing
;; actually covers all cases, so right now it is for illustration
;; purpose only.

;; To write out code, postfix needs to be '(forth) to make sure that
;; after every line we switch back to forth mode, which is what the
;; command interpreter does.

(define (format-forth-expr expr [postfix '()])
  (match expr
         ((list-rest 'forth-begin words)
          (let ((ws (append words postfix))) ;; switch back to forth mode
            (apply string-append
                   (for/list ((w ws))
                     (format "~a " w)))))
         (else
          (format "\\ not forth: ~s" expr))))

(define (replay [file (eval-log-file)])
  ;; (printf "replaying definitions from ~a\n" file)
  (with-input-from-file file
    (lambda ()
      (let next ()
        (let ((expr (read)))
          (unless (eof-object? expr)
            (printf "~a\n" (format-forth-expr expr))
            (eval expr)
            (next))))))
  (commit))
      
(define (eval-log expr)
  ;; Eval first in case there is an error
  (eval expr)
  (with-output-to-file
      (eval-log-file)
      (lambda () (write expr) (newline))
      #:exists 'append))

(prefix-parsers
 (target)

 ;; Compile code from console + commit.
 ((inline-code (c ...))  (,(!: (eval-log '(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))
 
 )

;; If any of these words are encountered, one extra word is parsed and
;; the result is passed to the compiler.
(prefix-parsers-wrapped
 (target) declare:
 (variable 2variable load require planet staapl))

;; If any of these words are encountered, the entire line is parsed
;; and passed to the compiler.
(prefix-parsers-wrapped
 (target) compile-line:
 (: macro forth))