Two Phases Evaluation.

;---------------------------------------------------------------
;
; In this post, I implement simple support for "two phases" evaluation,
; in the form of function "prepare" that accepts code as an argument,
; and returns "prepared" code. Prepared code consists of original
; expressions, except
;
; [1] expressions of a form
;
;       (prepare-time expr1 ... exprn)

;     Such expressions are evaluated during prepare-time and replaced
;     with their results in prepared code. Again, except
;
;     [1a] if result of the evaluation during prepare time is
;          symbol !! then expression is omitted from prepared code.
;
; [2] expressions of the form (F expr1 ... exprn) where F evaluates to
;     function or macro which contains 'prepare-time symbol, for
;     example
;
;            (lambda-macro(x)
;               'prepare-time
;                (list '* x x))
;
;     Such function or macro calls are evaluated duringe prepare-time
;     and replaced in prepared code with results of their evaluation.
;
;---------------------------------------------------------------
;
; mapg and cleang are versions of map and clean that respect
; lambda and lambda-macro expressions.

(set 'mapg (lambda(f L)
             (append (cond ((lambda? L) (lambda))
                           ((macro? L)  (lambda-macro))
                           (true '()))
                      (map f L))))

(set 'cleang (lambda(f L)
               (append (cond ((lambda? L) (lambda))
                             ((macro? L)  (lambda-macro))
                             (true '()))
                        (clean f L))))

;---------------------------------------------------------------

(set 'prepare-time begin)
(set '!! '!!)

(set 'prepare-time-fn?
      (lambda(expr)(and (symbol? expr)
                        (or (lambda? (eval expr)) (macro? (eval expr)))
                        (= (nth 1 (eval expr)) ''prepare-time))))

(set 'prepare
     (lambda(expr)
        (let ((result
              (if (and (list? expr)
                       (not (empty? expr)))
                          
                   (if (= (first expr) 'prepare-time)
                       (eval expr)           ; [1]
                       
                       (begin (set 'expr (mapg prepare expr)); recursion
                              
                              (if (prepare-time-fn? (first expr))
                                  (eval expr) ; [2]
                                  expr)))
                   expr)))                    ; general case
             
             (if (list? result)
                 (cleang (lambda(x)(= x !!)) result) ; [1a]
                  result))))

; And that's it. Really simple.
;---------------------------------------------------------------
; Now, I'll test it. I'll first define one macro (in CL Scheme style)
; in normal code, and one "normal" function, bot of them will be
; used in code that should be prepared.

(set 'diff-squares
     (lambda-macro(x y)
        'prepare-time
        (expand '(- (* x x) (* y y))
                'x 'y)))
                
(set 'mirror (lambda(x)
                (append x (reverse x))))
                
; and here is relatively complicated code that uses already
; defined macro, with some prepare-time expressions, and one
; of them even contain definition of new, recursive "prepare-time"
; macro. Prepare-time statements frequently end with !!, but not
; always.
                
(set 'code
     '(begin (println "Eval time: starting.")
             (prepare-time (println "Prepare-time: starting.")!!)
             
             (println (diff-squares (+ 3 1) (- 3 1)))
             (println (mirror '(1 2 3)))
             (prepare-time (println "Prepare-time:"
                                    (mirror '(1 0 4 0 5)))!!)
             (prepare-time (set 'fib
                                (lambda-macro(n)
                                  'prepare-time
                                  (let ((en (eval n)))
                                       (if (< en 2)
                                           '1
                                           (let ((n1 (- en 1))
                                                 (n2 (- en 2)))
                                                (list '+
                                                      (fib n1)
                                                      (fib n2)))))))!!)
             (prepare-time (set 'fibi (eval (fib 6)))!!)
             (println "Eval time: " (prepare-time fibi) " is prepared.")
             (prepare-time (println "Prepare-time: " fibi " is prepared.")!!)
             (println (diff-squares (fib 3) (fib 2)))))

; TEST

(println "------------------------------------------------------")
(println "CODE: ")
(println)
(println code)
(println "------------------------------------------------------")
(println "PREPARE TIME:")
(println)
(set 'prepared-code (prepare code))
(println "------------------------------------------------------")
(println "PREPARED CODE:")
(println)
(println prepared-code)
(println "------------------------------------------------------")
(println "EVALUATION OF PREPARED CODE:")
(println)
(eval prepared-code)

(exit)

;======================================================
; RESULTS:
;------------------------------------------------------
; CODE:
;
; (begin
;  (println "Eval time: starting.")
;  (prepare-time (println "Prepare-time: starting.") !!)
;  (println (diff-squares (+ 3 1) (- 3 1)))
;  (println (mirror '(1 2 3)))
;  (prepare-time (println "Prepare-time:" (mirror '(1 0 4 0 5))) !!)
;  (prepare-time (set 'fib (lambda-macro (n) 'prepare-time
;     (let ((en (eval n)))
;      (if (< en 2)
;       '1
;       (let ((n1 (- en 1)) (n2 (- en 2)))
;        (list '+ (fib n1) (fib n2))))))) !!)
;  (prepare-time (set 'fibi (eval (fib 6))) !!)
;  (println "Eval time: " (prepare-time fibi) " is prepared.")
;  (prepare-time (println "Prepare-time: " fibi " is prepared.") !!)
;  (println (diff-squares (fib 3) (fib 2))))
;  
; ------------------------------------------------------
; PREPARE TIME:
;
; Prepare-time: starting.
; Prepare-time:(1 0 4 0 5 5 0 4 0 1)
; Prepare-time: 13 is prepared.
; ------------------------------------------------------
; PREPARED CODE:
;
; (begin
;  (println "Eval time: starting.")
;  (println (- (* (+ 3 1) (+ 3 1)) (* (- 3 1) (- 3 1))))
;  (println (mirror '(1 2 3)))
;  (println "Eval time: " 13 " is prepared.")
;  (println (- (* (+ (+ 1 1) 1) (+ (+ 1 1) 1)) (* (+ 1 1) (+ 1 1)))))
; ------------------------------------------------------
; EVALUATION OF PREPARED CODE:
;
; Eval time: starting.
; 12
; (1 2 3 3 2 1)
; Eval time: 13 is prepared.
; 5
;
;
; It works.