ikarus/src/old-tests/tests-2.1-req.scm

;;; one possible implementation strategy for procedures is via closure
;;; conversion.  

;;; Lambda does many things at the same time:
;;; 1) It creates a procedure object (ie. one that passes procedure?)
;;; 2) It contains both code (what to do when applied) and data (what 
;;;    variables it references.
;;; 3) The procedure object, in addition to passing procedure?, can be
;;;    applied to arguments.

;;; First step: separate code from data:
;;; convert every program containing lambda to a program containing 
;;; codes and closures:
;;; (let ([f (lambda () 12)]) (procedure? f))
;;; =>
;;; (codes ([f-code (code () () 12)]) 
;;;   (let ([f (closure f-code)])
;;;     (procedure? f)))
;;;
;;; The codes binds code names to code points.  Every code 
;;; is of the form (code (formals ...) (free-vars ...) body)
;;; 
;;; sexpr 
;;; => recordize
;;; recognize lambda forms and applications
;;; =>
;;; (let ([y 12])
;;;   (let ([f (lambda (x) (fx+ y x))])
;;;     (fx+ (f 10) (f 0)))) 
;;; => convert closures
;;; (let ([y 12])
;;;   (let ([f (closure (code (x) (y) (fx+ x y)) y)])
;;;     (fx+ (call f 10) (call f 0))
;;; => lift codes
;;; (codes ([code0 (code (x) (y) (fx+ x y))])
;;;   (let ([y 12])
;;;     (let ([f (closure code0 y)])
;;;       (fx+ (call f 10) (call f 0)))))
;;; => code generation
;;; 1) codes form generates unique-labels for every code and 
;;;    binds the names of the code to these labels.
;;; 2) Every code object has a list of formals and a list of free vars.
;;;    The formals are at stack locations -4(%esp), -8(%esp), -12(%esp), ...
;;;    The free vars are at -2(%edi), 2(%edi), 6(%edi), 10(%edi) ...
;;;    These are inserted in the environment and then the body of the code
;;;    is generated.
;;; 3) A (closure code-name free-vars ...) is generated the same way a 
;;;    (vector val* ...) is generated:  First, the code-label and the free
;;;    variables are placed at 0(%ebp), 4(%ebp), 8(%ebp), etc.. 
;;;    A closure pointer is placed in %eax, and %ebp is incremented to the
;;;    next boundary.
;;; 4) A (call f arg* ...) does the following:
;;;    a) evaluates the args and places them at contiguous stack locations
;;;       si-8(%esp), si-12(%esp), ... (leaving room for two values).
;;;    b) The value of the current closure pointer, %edi, is saved on the
;;;       stack at si(%esp).
;;;    c) The closure pointer of the callee is loaded in %edi.
;;;    d) The value of %esp is adjusted by si
;;;    e) An indirect call to -6(%edi) is issued.
;;;    f) After return, the value of %esp is adjusted back by -si
;;;    g) The value of the closure pointer is restored.
;;;    The returned value is still in %eax.

(add-tests-with-string-output "procedure?"
  [(procedure? (lambda (x) x)) => "#t\n"]
  [(let ([f (lambda (x) x)]) (procedure? f)) => "#t\n"]
  [(procedure? (make-vector 0)) => "#f\n"]
  [(procedure? (make-string 0)) => "#f\n"]
  [(procedure? (cons 1 2)) => "#f\n"]
  [(procedure? #\S) => "#f\n"]
  [(procedure? ()) => "#f\n"]
  [(procedure? #t) => "#f\n"]
  [(procedure? #f) => "#f\n"]
  [(string? (lambda (x) x)) => "#f\n"]
  [(vector? (lambda (x) x)) => "#f\n"]
  [(boolean? (lambda (x) x)) => "#f\n"]
  [(null? (lambda (x) x)) => "#f\n"]
  [(not (lambda (x) x)) => "#f\n"]
)


(add-tests-with-string-output "applying thunks"
  [(let ([f (lambda () 12)]) (f)) => "12\n"]
  [(let ([f (lambda () (fx+ 12 13))]) (f)) => "25\n"]
  [(let ([f (lambda () 13)]) (fx+ (f) (f))) => "26\n"]
  [(let ([f (lambda () 
              (let ([g (lambda () (fx+ 2 3))])
                (fx* (g) (g))))])
    (fx+ (f) (f))) => "50\n"]
  [(let ([f (lambda () 
              (let ([f (lambda () (fx+ 2 3))])
                (fx* (f) (f))))])
    (fx+ (f) (f))) => "50\n"]
  [(let ([f (if (boolean? (lambda () 12))
                (lambda () 13)
                (lambda () 14))])
     (f)) => "14\n"]
)


(add-tests-with-string-output "parameter passing"
 [(let ([f (lambda (x) x)]) (f 12)) => "12\n"]
 [(let ([f (lambda (x y) (fx+ x y))]) (f 12 13)) => "25\n"]
 [(let ([f (lambda (x)
             (let ([g (lambda (x y) (fx+ x y))])
               (g x 100)))])
   (f 1000)) => "1100\n"]
 [(let ([f (lambda (g) (g 2 13))])
    (f (lambda (n m) (fx* n m)))) => "26\n"]
 [(let ([f (lambda (g) (fx+ (g 10) (g 100)))])
   (f (lambda (x) (fx* x x)))) => "10100\n"]
 [(let ([f (lambda (f n m)
             (if (fxzero? n)
                 m
                 (f f (fxsub1 n) (fx* n m))))])
   (f f 5 1)) => "120\n"]
 [(let ([f (lambda (f n)
             (if (fxzero? n)
                 1
                 (fx* n (f f (fxsub1 n)))))])
   (f f 5)) => "120\n"]
)
 

(add-tests-with-string-output "closures"
 [(let ([n 12])
    (let ([f (lambda () n)])
      (f))) => "12\n"]
 [(let ([n 12])
    (let ([f (lambda (m) (fx+ n m))])
      (f 100))) => "112\n"]
 [(let ([f (lambda (f n m)
             (if (fxzero? n)
                 m
                 (f (fxsub1 n) (fx* n m))))])
   (let ([g (lambda (g n m) (f (lambda (n m) (g g n m)) n m))])
     (g g 5 1))) => "120\n"]
 [(let ([f (lambda (f n)
             (if (fxzero? n)
                 1
                 (fx* n (f (fxsub1 n)))))])
   (let ([g (lambda (g n) (f (lambda (n) (g g n)) n))])
     (g g 5))) => "120\n"]
)