#lang scheme/base
(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))
(ns (target) (define-syntax slurp rpn-slurp))
(compositions (scat) live:
(hilo> swap 8 <<< or)
(>hilo dup 8 <<< swap #xFF and)
(ps 8 sign-extend p)
(px byte->string d)
(_ps 16 sign-extend p)
(_px word->string d)
(_p p)
)
(prefix-parsers/meta
(target) live:
((_1cmd: w) (t> t> hilo> w))
((1cmd: w) (t> w)))
(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/meta
(target) live:
((see w) ('w tsee))
((msee w) ('w msee))
((vsee w) ('w vsee))
((help w) ('w print-doc))
((start w) ('w target-find-code tstart/b))
((|'| w) ('w target-find-code _>t)) ((dump w) ('w target-find-code f! fdump))
((plot n) ('n plot))
((2plot n) ('n 2plot))
((@) (t> access-bank t@ >t))
((!) (t> t> swap access-bank t!))
((|.|) (t> p))
)
(define scheme read-eval-print-loop)
(define-syntax-rule (!: e ...)
(lambda (state)
(begin e ...)
state))
(prefix-parsers
(target)
((inline-code (c ...)) (,(!: (eval '(forth-begin c ...))) commit))
((declare: parser name) (inline-code (parser name)))
((compile-line:) (slurp inline-code))
((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))