coma/target-scat.ss
#lang scheme/base

(require
 "../target.ss"
 "../scat.ss"
 scheme/match
 (for-syntax
  "../tools.ss"
  scheme/base))
  

(provide
 tv:)


;; Assembly time evaluation of scat-like code.


;; On top of the generic delayed target-value mechanism this module
;; provides an RPN language called META, which is used in the MACRO
;; dialect to implement assembler patterns like:
;;
;;        (([qw a] [qw b] +)    ([qw (target: a b +)]))
;;
;;   * produces target value computations
;;   * takes non-lexical names as functions from the SCAT namespace
;;   * takes lexical names as quoted values, and performs evaluation
;;

;; Note: partial evaluation is really only for source annotation.
;; However, when targeting an external assembler, this might need to
;; generate expressions in the assembler's expression language. Such a
;; thing probably needs some changes though..


;; Wrap parentheses after partial evaluation for unquote-splicing scat
;; source flattener.
(define (wrap-pe-scat expr)
  (let ((thing (target-value-partial-eval expr)))
    (if (list? thing)
        thing
        (list thing))))

;; Wrap scat functions.
(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))))





;; Create delayed expressions for evaluation and partial evaluation in
;; an RPN dialect which has lexical refs.
(define-syntax (tv: stx)
  ;; Operate on rpn code body, processing lexical and other variables.
  (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))