#lang scheme/base

;; Live interaction and parsing words. This simulates an interactive
;; Forth console that has access to all the host and target
;; functionality.

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

 "reflection.ss"
 "tethered.ss"
 "../target.ss"

 (for-syntax
  scheme/base))

(provide (all-defined-out))


;; All uses of 'eval in the staapl/live/ modules will use the current
;; project namespace, as managed by prj/manager.ss code.  However,
;; live/commands.ss has a link to the manager for delegating
;; meta-namespace operations (like reload/switch/kill/...).

(define manager (make-parameter #f))
(define (manager-eval expr) (eval expr (manager)))
(snarf as-void (scat) ((expr) (manager-eval)))


  
;; Types are handled by prefixes. I.e (+) => (2sim +)
(define-syntax prefix-parser-types
  (syntax-rules ()
    ((_ #t ns type (name ...))
     (prefix-parsers ns ((name) (type name)) ...))
    ((_ ns (type . names) ...)
     (begin (prefix-parser-types #t ns type names) ...))))



;; Namespace = (target)
;; - transformers = prefix parsing words
;; - words = target-word records
;;
;; All functionality comes from Scat.

(primitive-prefix-parsers
 (target) scat:
 ;; Words that modify the semantics of the following symbol.

 ;; FIXME: either >> or 2/ needs 'truncate' for simulation, or
 ;; explicit signed/unsigned conversion.

 ((prj cmd) ('cmd manager-eval))
 
 ((see w)  ('w tsee))
 ((msee w) ('w msee))
 ((vsee w) ('w vsee))
 
 ((help w)    ('w print-doc))
 ((load w)    ('w forth-load))
; ((prj  w)    ("prj/" 'w ->string string-append project))
; ((project w) ('w ->string project))

 ((prog w)    ('w symbol->string piklab-prog))
 
 ((start w)   ('w tfind tstart/w))
 ((|'| w)     ('w tfind _>t))
 ((dump w)    ('w tfind 1 <<< f! fdump))
 
 ((plot n)    ('n plot))
 ((2plot n)   ('n 2plot))
 
 ;; Memory access is never overridden by target
 ;; implementation. FIXME: why is this?
 
 ((@)         (t> access-bank t@ >t))
 ((!)         (t> t> swap access-bank t!))

 ;; Subsitition type prefixes
 
 ((_1cmd w)   (t> t> hilo> w))
 ((1cmd w)    (t> w))
 ((0cmd w)    (w))
 
 ;; FIXME: x >x x>

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




;; target -> target
(prefix-parser-types
 (target)
 
 ;; Some commands will perform host actions, but might take
 ;; arguments from the target stack. To limit surprises this list
 ;; is exhaustive: there are no automaticly delegated (prj:)
 ;; words.
 
 (0cmd  dtc sync
        ts tss tsx _ts _tss _tsx
        pa ppa revert OK


        ;; cold self-reset (RESET instruction) or external reset if
        ;; supported by target interface.
        
        cold  

        scrap pdict pforth
        clear more bin macros words commands install adump fdump
        hub tnop
        revert-macros ;; FIXME: make sure 'empty' does this
        )
 
 (1cmd  ablock fblock kb a! f!
        abd fbd bd
        p px ps        ;; one byte unsigned, hex, signed
        erase-block
        erase-from-block
        client
        )
 (_1cmd _p _px _ps))



;; ;; Entry point for (syntax-only!) live interaction -> prj code
;; ;; transformation.
;; (define (live->prj code)

;;   (define default
;;     (predicates->parsers
;;      (number?  ((n)  (n tlit)))
;;      (symbol?  ((w)  ('w tinterpret)))))
  
;;   (apply-parsers-ns/default
;;    '(live) default code))


;; ;; Append a line to a log of lines.

;; (define (log-line str stack)
;;   (if (or
;;        (null? stack)
;;        (not (equal? str (car stack))))
;;       (cons str stack)
;;       stack))



;; ;; DIRECT
;; (provide vm->native/compile
;;          live/vm->prj)


;; (define (underscore stx)
;;   (->syntax
;;    stx
;;    (string->symbol
;;     (string-append
;;      "_"
;;      (symbol->string (->datum stx))))))


;; (define (vm->native/compile code)

;;   (define default
;;     (predicates->parsers
;;      (symbol?      ((w)       (|'| #,(underscore #'w)
;;                                    |'| _compile macro/default)))
;;      (number?      ((n)       (n _literal)))))

;;   (apply-parsers-ns/default
;;    '(compile-vm) default code))


;; (named-parsers
;;  (compile-vm)
               
;;  (0cmd         ((w)       (w)))
;;  (|:|          ((_ name)  (: #,(underscore #'name) enter)))
;;  (|;|          ((_)       (_exit))))
  
;;   (named-parser-clones (compile-vm)
;;                        (0cmd pa clear))
  


;;   ;; FIXME abstract out ns/default thingy
  
;;   (define (live/vm->prj code)

;;     (define default
;;       (predicates->parsers
;;        (symbol?   ((w)   ('#,(underscore #'w) tf
;;                           _tlit 'dtc tfind texec/w)))
;;        (number?   ((n)   (n _tlit)))))
    
;;     (apply-parsers-ns/default
;;      '(live-vm) default code))
  
  

;;   ;; FIXME: find a way to extend the other live commands.
;;   ;; map these to their '_' counterpart

;;   ;; FIXME: commands that take no args can be simply mapped.
;;   ;;(define (_command? x)  (element-of x '(ts tss tsx cold ping)))

;;   (named-parsers
;;    (live-vm)

;;    (0cmd      ((w)   (w))) ;; just use same as native
;;    (_0cmd     ((w)   (#,(underscore #'w)))) ;; special

;;    (1cmd      ((w)   (_t> #,(underscore #'w)))))

  
;;   (named-parser-clones
;;    (live-vm)
   
;;    (0cmd   commit clear pa ppa cold ping)
;;    (_0cmd  ts tss tsx)
;;    (1cmd   p ps px kb))