diff options
Diffstat (limited to 'csc/cps-test.csc')
| -rw-r--r-- | csc/cps-test.csc | 202 |
1 files changed, 135 insertions, 67 deletions
diff --git a/csc/cps-test.csc b/csc/cps-test.csc index 3f0d743..c72aca6 100644 --- a/csc/cps-test.csc +++ b/csc/cps-test.csc @@ -22,7 +22,8 @@ make-kargs make-klabel make-ktail - make-primitive) + make-primitive + make-variable) (only (csc testing) assert-equal test) @@ -128,85 +129,152 @@ tail))) -(test letrec-in-order +(test letrec-functions + (define x (test-ref 'x)) + (define f (gensym)) (assert-equal ir2=? (make-fix (list - (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) - (test-ref 'x)) #f - (make-apply (test-ref 'generated-symbol) (list (make-constant 5))))) + (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'x)) #f + (make-apply (test-ref 'generated-symbol) (list (test-ref 'x))))) (make-fix (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))) + (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (make-constant 10))))) + (ir1->ir2 + (make-letrec #f '(f) (list f) + (list (make-lambda (list x) #f x)) + (make-call (make-lexical-ref 'f f) (list (make-constant 10)))) + tail))) + + +(test letrec-in-order + (assert-equal ir2=? + (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'b)) + (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'a)) (make-fix (list - (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) - (test-ref 'a)) #f - (make-fix - (list - (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f - (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))))) - (make-fix - (list - (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) - (test-ref 'b)) #f - (make-apply (test-ref 'generated-symbol) (list (make-constant 10))))) - (make-apply (test-ref 'generated-symbol) - (list (test-ref 'generated-symbol) - (make-constant 2))))))) - (make-apply (test-ref 'generated-symbol) - (list (test-ref 'generated-symbol) - (make-constant 1)))))) - (ir1->ir2 (make-letrec - #t - '(a f b) - (list (gensym) (gensym) (gensym)) - (list (make-constant 1) - (make-lambda (list (test-ref 'x)) #f (make-constant 5)) - (make-constant 2)) - (make-constant 10)) - tail))) + (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'x)) #f + (make-apply (test-ref 'generated-symbol) (list (make-constant 5))))) + (make-primitive 'poke (list (make-constant 1) (test-ref 'a) (make-constant 0)) '() + (make-primitive 'poke (list (make-constant 2) (test-ref 'b) (make-constant 0)) '() + (make-apply (test-ref 'tail) (list (make-constant 10)))))))) + (ir1->ir2 + (make-letrec #t + '(a f b) + (list (gensym) (gensym) (gensym)) + (list (make-constant 1) + (make-lambda (list (test-ref 'x)) #f (make-constant 5)) + (make-constant 2)) + (make-constant 10)) + tail))) + + +; What does the following letrec return? +; (letrec* ((f (lambda () x)) +; (x (f))) +; x) +(test letrec-very-cool + (define f (gensym)) + (define x (gensym)) + (assert-equal ir2=? + (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'x)) + (make-fix + (list + (make-closure (test-ref 'f) (list (test-ref 'generated-symbol)) #f + (make-primitive 'peek (list (test-ref 'x) (make-constant 0)) (list (test-ref 'generated-symbol)) + (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))) + (make-fix + (list + (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f + (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'x) (make-constant 0)) '() + (make-primitive 'peek (list (test-ref 'x) (make-constant 0)) (list (test-ref 'generated-symbol)) + (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))))) + (make-apply (test-ref 'f) (list (test-ref 'generated-symbol)))))) + (ir1->ir2 + (make-letrec #t + '(f x) + (list f x) + (list (make-lambda '() #f (make-lexical-ref 'x x)) + (make-call (make-lexical-ref 'f f) '())) + (make-lexical-ref 'x x)) + tail))) (test set-argument - (make-fix - (list - (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) - (test-ref 'generated-symbol)) #f - (make-primitive 'alloc (list (make-constant 1)) - (list (test-ref 'x)) - (make-primitive 'poke (list (test-ref 'generated-symbol) - (test-ref 'x) - (make-constant 0)) '() - (make-primitive 'poke (list (make-constant 10) + (define test-sym (gensym)) + (assert-equal ir2=? + (make-fix + (list + (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) + (test-ref 'generated-symbol)) #f + (make-primitive 'alloc (list (make-constant 1)) + (list (test-ref 'x)) + (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'x) (make-constant 0)) '() - (make-apply (test-ref 'generated-symbol) (list (make-constant #f)))))))) - (make-apply (test-ref 'tail) (make-constant 5))) - (ir1->ir2 (make-letrec - #f - '(f) - (list (gensym)) - (list (make-lambda (list (test-ref 'x)) #f - (make-lexical-set (test-ref 'x) (make-constant 10)))) - (make-constant 5)) - tail)) - + (make-primitive 'poke (list (make-constant 10) + (test-ref 'x) + (make-constant 0)) '() + (make-apply (test-ref 'generated-symbol) (list (make-constant #f)))))))) + (make-apply (test-ref 'tail) (list (make-constant 5)))) + (ir1->ir2 (make-letrec + #f + '(f) + (list (gensym)) + (list (make-lambda (list (make-lexical-ref 'x test-sym)) #f + (make-lexical-set (make-lexical-ref 'x test-sym) (make-constant 10)))) + (make-constant 5)) + tail))) (test set-function - (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'f)) - (make-fix - (list - (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f - (make-apply (test-ref 'generated-symbol) (list (make-constant 10))))) - (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'f) (make-constant 0)) '() - (make-primitive 'poke (list (make-constant 5) (test-ref 'f) (make-constant 0)) '() - (make-apply (test-ref 'tail) (make-constant #f)))))) - (ir1->ir2 (make-letrec - #f - '(f) - (list (gensym)) - (list (make-lambda '() #f (make-constant 10))) - (make-lexical-set (test-ref 'f) (make-constant 5))) - tail)) + (define test-sym (gensym)) + (assert-equal ir2=? + (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'f)) + (make-fix + (list + (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f + (make-apply (test-ref 'generated-symbol) (list (make-constant 10))))) + (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'f) (make-constant 0)) '() + (make-primitive 'poke (list (make-constant 5) (test-ref 'f) (make-constant 0)) '() + (make-apply (test-ref 'tail) (list (make-constant #f))))))) + (ir1->ir2 (make-letrec + #f + '(f) + (list test-sym) + (list (make-lambda '() #f (make-constant 10))) + (make-lexical-set (make-lexical-ref 'f test-sym) (make-constant 5))) + tail))) + + +(define (test-var) + (make-variable (gensym))) + + +(test closure-convert-primitive + (define a-sym (gensym)) + (define f-sym (gensym)) + (define ret-sym (gensym)) + (define x-sym (gensym)) + (assert-equal ir2=? + (make-primitive 'alloc (list (make-constant 1)) (list (test-var)) + (make-fix + (list + (make-closure (test-var) (list (test-var) (test-var) (test-var)) #f + (make-primitive 'peek (list (test-var) (make-constant 0)) (list (test-var)) + (make-primitive 'poke (list (test-var) (test-var) (make-constant 0)) '() + (make-primitive 'peek (list (test-var) (make-constant 0)) (list (test-var)) + (make-apply (test-var) (list (test-var) (make-constant #f)))))))) + (make-primitive 'alloc (list (make-constant 2)) (list (test-var)) + (make-primitive 'poke (list (test-var) (test-var) (make-constant 0)) '() + (make-primitive 'poke (list (test-var) (test-var) (make-constant 1)) '() + (make-primitive 'peek (list (test-var) (make-constant 0)) (list (test-var)) + (make-apply (test-var) (list (test-var) (make-library-ref 'tail '(csc builtins)) (make-constant 10))))))))) + (closure-convert (make-primitive 'alloc (list (make-constant 1)) (list (make-lexical-ref 'a a-sym)) + (make-fix + (list + (make-closure (make-lexical-ref 'f f-sym) (list (make-lexical-ref 'ret ret-sym) (make-lexical-ref 'x x-sym)) #f + (make-primitive 'poke (list (make-lexical-ref 'x x-sym) (make-lexical-ref 'a a-sym) (make-constant 0)) '() + (make-apply (make-lexical-ref 'ret ret-sym) (list (make-constant #f)))))) + (make-apply (make-lexical-ref 'f f-sym) (list (make-library-ref 'tail '(csc builtins)) (make-constant 10)))))))) |