#lang scheme/base
(require
"../target.ss"
"../scat.ss"
scheme/match
(for-syntax
"../tools.ss"
scheme/base))
(provide
tv:)
(define (wrap-pe-scat expr)
(let ((thing
(cond
((target-value? expr) (target-value-source expr))
((target-word? expr) (target-word-name expr))
(else expr))))
(if (list? thing)
thing
(list thing))))
(define (wrap-scat fn)
(match (fn (make-state:stack '()))
((struct stack (ctor (list val)))
val)
((struct stack (ctor lst))
(error 'meta/scat-garbage-state
"~s" lst))))
(define-syntax (tv: stx)
(define (lex-mapper fn-lex [fn-no-lex (lambda (x) x)])
(lambda (stx-lst)
(map
(lambda (stx)
(if
(and (identifier? stx)
(lexical-binding? stx))
(fn-lex stx)
(fn-no-lex stx)))
stx-lst)))
(define code-lst (stx-cdr stx))
(define scat-eval
#`(wrap-scat
(scat:
#,@((lex-mapper
(lambda (id)
#`(quote (unquote (target-value-eval #,id)))))
code-lst))))
(define scat-partial-eval
#`(quasiquote
#,((lex-mapper
(lambda (id)
#`(unquote-splicing (wrap-pe-scat #,id))))
code-lst)))
#`(target-value-delay
#,scat-eval
#,scat-partial-eval))