;; Macro expansion for partial evaluation.

;; This builds on the ideas:
;;  * macros are an endomap on instructions + compilation stack
;;  * macros have no side effects
;;  * a subset of macros reduce to endomaps on stacks of literals

;; From this follows that the endomaps of stacks of literals can be
;; isolated by just executing the macros. This seems easier than
;; having to specify special classes of macros. This is "Evidence
;; Based Typing" ;)

;; Some special cases:
;;  * a variable is a 0->1 constant map
;;  * a constant postprocessor is a 1->1 constant map

;; FIXME: this is the start of an attempt to
;; - eliminate the 'meta' dictionary
;; - move all logic to macros and some smart way to delay evaluation
;;   of constants to assembly time (for ease of debugging)

;; in order to get this working well, some simplifications are
;; necessary: right now it's a bit too ad-hoc.


(module macro-eval mzscheme
  (require (lib "match.ss")
           "list-utils.ss"
           "ns.ss")
  
  (provide (all-defined)
           ;; macro-eval/fail
           )
  
  ;; Evaluate (execute) a macro for its value. This works for macros
  ;; that return a single immediate value. It's ok to do this because
  ;; macros have no side effects.


  (define (macro-eval/fail name)
    (with-handlers
        ((exn:fail?
          (lambda (ex) #f))) ;; FIXME: too tolerant!!
      (macro-eval-name name)))
  
  (define (macro-eval-name name)
    (let*
        ((macro (ns-ref `(macro ,name)))
         (stack (macro-eval-on macro '())))
      ;; (printf "~a\n" stack)
      (match stack
             ((immediate) immediate)
             (other
              (error 'macro-eval-multiple-values
                     "~s" other)))))
  
  ;; Evaluate a macro. This only makes sense when it maps literals ->
  ;; literals.  The core routine will throw exceptions when a certain
  ;; condition isn't met.

  (define (macro-eval-on macro stack)
    (let ((out (macro (wrap-qw stack))))
      
      ;; m stack (compilation state) must be empty
      (unless (= (length out) 1)
        (error 'macro-stack-not-empty
               "asm: ~s, stack: ~s"
               (car out)
               (cdr out)))
               
      ;; result needs to contain only 'qw' opcodes
      (let-values
          (((qws rest)
            (split-qw (car out))))
        (unless (null? rest)
          (error 'non-literal-result
                 "~s" rest))
        qws)))
      

  (define qw?
    (match-lambda
     (('qw value) #t)
     (other #f)))
    
  
  ;; Split off literals
  (define (split-qw instructions)
    (let-values
        (((head tail)
          (split-collect instructions qw?)))
      (values
       (map cadr head)
       tail)))

  ;; Wrap as qw
  (define (wrap-qw lst)
    (map (lambda (value)
           `(qw ,value)) lst))

  ;; Inspect the effect of a macro.

  ;;  1. detect if macro returns 'qw'
  ;;  2. catch a number of 'qw'
  ;;  3. find that tail in the input


  (define (macro-analyse in out)
    (let-values
        (((in-qw  i) (split-qw in))
         ((out-qw o) (split-qw out)))
      (if (eq? i o)
          (values in-qw out-qw i)
          (error 'non-literal-ops))))
         
  )