145 lines
5.1 KiB
Scheme
145 lines
5.1 KiB
Scheme
;;; 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 ([fcode (code () () 12)])


;;; (let ([f (closure fcode)])


;;; (procedure? f)))


;;;


;;; The codes binds code names to code points. Every code


;;; is of the form (code (formals ...) (freevars ...) 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 uniquelabels 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 codename freevars ...) is generated the same way a


;;; (vector val* ...) is generated: First, the codelabel 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


;;; si8(%esp), si12(%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.




(addtestswithstringoutput "procedure?"


[(procedure? (lambda (x) x)) => "#t\n"]


[(let ([f (lambda (x) x)]) (procedure? f)) => "#t\n"]


[(procedure? (makevector 0)) => "#f\n"]


[(procedure? (makestring 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"]


)






(addtestswithstringoutput "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"]


)






(addtestswithstringoutput "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"]


)






(addtestswithstringoutput "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"]


)
