diff options
Diffstat (limited to 'lib/csc/cps-test.csc')
| -rw-r--r-- | lib/csc/cps-test.csc | 100 |
1 files changed, 56 insertions, 44 deletions
diff --git a/lib/csc/cps-test.csc b/lib/csc/cps-test.csc index 8bef0aa..256e9e3 100644 --- a/lib/csc/cps-test.csc +++ b/lib/csc/cps-test.csc @@ -74,10 +74,13 @@ (make-lexical-ref name (gensym))) - (define (tail x) + (define (tail x multi) (make-apply (test-ref 'tail) (list x))) + (define generated-symbol (test-ref 'generated-symbol)) + + (test atom-const (assert-equal (make-apply (test-ref 'tail) (list (make-constant 5))) @@ -94,8 +97,8 @@ (test atom-library-ref (assert-equal - (make-primitive 'peek (list *globals* (make-library-ref 'var '(csc builtins))) (list (test-ref 'generated-symbol)) - (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))) + (make-primitive 'peek (list *globals* (make-library-ref 'var '(csc builtins))) (list generated-symbol) + (make-apply (test-ref 'tail) (list generated-symbol))) (ir1->ir2 (make-library-ref 'var '(csc builtins)) tail) transform-ir2)) @@ -121,11 +124,13 @@ (assert-equal (make-fix (list - (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) - (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))) + (make-closure generated-symbol (list generated-symbol) + (make-apply (test-ref 'tail) (list generated-symbol)))) (make-branch (make-constant #t) - (make-apply (test-ref 'generated-symbol) (list (make-constant 1))) - (make-apply (test-ref 'generated-symbol) (list (make-constant 2))))) + (make-primitive 'cons (list (make-constant 1) (make-constant '())) (list generated-symbol) + (make-apply generated-symbol (list generated-symbol))) + (make-primitive 'cons (list (make-constant 2) (make-constant '())) (list generated-symbol) + (make-apply generated-symbol (list generated-symbol))))) (ir1->ir2 (make-if (make-constant #t) (make-constant 1) (make-constant 2)) @@ -137,11 +142,11 @@ (assert-equal (make-fix (list - (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) - (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))) - (make-primitive 'cons (list (make-constant 20) (make-constant '())) (list (test-ref 'generated-symbol)) - (make-primitive 'cons (list (make-constant 10) (test-ref 'generated-symbol)) (list (test-ref 'generated-symbol)) - (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))) + (make-closure generated-symbol (list generated-symbol) + (make-apply (test-ref 'tail) (list generated-symbol)))) + (make-primitive 'cons (list (make-constant 20) (make-constant '())) (list generated-symbol) + (make-primitive 'cons (list (make-constant 10) generated-symbol) (list generated-symbol) + (make-apply (test-ref 'f) (list generated-symbol generated-symbol))))) (ir1->ir2 (make-call (test-ref 'f) (list (make-constant 10) (make-constant 20))) tail) transform-ir2)) @@ -149,17 +154,17 @@ (test call-builtin-alloc (assert-equal - (make-primitive 'alloc (list (make-constant 10)) (list (test-ref 'generated-symbol)) - (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))) + (make-primitive 'alloc (list (make-constant 10)) (list generated-symbol) + (make-apply (test-ref 'tail) (list generated-symbol))) (ir1->ir2 (make-call-builtin 'alloc (list (make-constant 10))) tail) transform-ir2)) (test call-builtin-peek (assert-equal - (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'generated-symbol)) - (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol)) - (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))) + (make-primitive 'alloc (list (make-constant 1)) (list generated-symbol) + (make-primitive 'peek (list generated-symbol (make-constant 0)) (list generated-symbol) + (make-apply (test-ref 'tail) (list generated-symbol)))) (ir1->ir2 (make-call-builtin 'peek (list (make-call-builtin 'alloc (list (make-constant 1))) (make-constant 0))) tail) @@ -168,8 +173,8 @@ (test call-builtin-poke (assert-equal - (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'generated-symbol)) - (make-primitive 'poke (list (make-constant 10) (test-ref 'generated-symbol) (make-constant 0)) '() + (make-primitive 'alloc (list (make-constant 1)) (list generated-symbol) + (make-primitive 'poke (list (make-constant 10) generated-symbol (make-constant 0)) '() (make-apply (test-ref 'tail) (list (make-constant #f))))) (ir1->ir2 (make-call-builtin 'poke (list (make-constant 10) @@ -193,9 +198,10 @@ (test closure (assert-equal (make-fix - (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'c)) - (make-apply (test-ref 'generated-symbol) (list (make-constant 5))))) - (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))) + (list (make-closure generated-symbol (list generated-symbol (test-ref 'c)) + (make-primitive 'cons (list (make-constant 5) (make-constant '())) (list generated-symbol) + (make-apply generated-symbol (list generated-symbol))))) + (make-apply (test-ref 'tail) (list generated-symbol))) (ir1->ir2 (make-lambda (test-ref 'c) (make-constant 5)) @@ -209,14 +215,15 @@ (assert-equal (make-fix (list - (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'x)) - (make-apply (test-ref 'generated-symbol) (list (test-ref 'x))))) + (make-closure (test-ref 'f) (list generated-symbol (test-ref 'x)) + (make-primitive 'cons (list (test-ref 'x) (make-constant '())) (list generated-symbol) + (make-apply generated-symbol (list generated-symbol))))) (make-fix (list - (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) - (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))) - (make-primitive 'cons (list (make-constant 10) (make-constant '())) (list (test-ref 'generated-symbol)) - (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))) + (make-closure generated-symbol (list generated-symbol) + (make-apply (test-ref 'tail) (list generated-symbol)))) + (make-primitive 'cons (list (make-constant 10) (make-constant '())) (list generated-symbol) + (make-apply (test-ref 'f) (list generated-symbol generated-symbol))))) (ir1->ir2 (make-letrec #f '(f) (list f) (list (make-lambda x x)) @@ -249,8 +256,9 @@ (assert-equal (make-fix (list - (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'args)) - (make-apply (test-ref 'generated-symbol) (list (make-constant 5))))) + (make-closure (test-ref 'f) (list generated-symbol (test-ref 'args)) + (make-primitive 'cons (list (make-constant 5) (make-constant '())) (list generated-symbol) + (make-apply generated-symbol (list generated-symbol))))) (make-apply (test-ref 'tail) (list (make-constant 10)))) (ir1->ir2 (make-letrec #t @@ -273,16 +281,18 @@ (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'x)) (make-fix (list - (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'args)) - (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-closure (test-ref 'f) (list generated-symbol (test-ref 'args)) + (make-primitive 'peek (list (test-ref 'x) (make-constant 0)) (list generated-symbol) + (make-primitive 'cons (list generated-symbol (make-constant '())) (list generated-symbol) + (make-apply generated-symbol (list generated-symbol)))))) (make-fix (list - (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) - (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) (make-constant '())))))) + (make-closure generated-symbol (list generated-symbol) + (make-primitive 'assert-singleton (list generated-symbol) (list generated-symbol) + (make-primitive 'poke (list generated-symbol (test-ref 'x) (make-constant 0)) '() + (make-primitive 'peek (list (test-ref 'x) (make-constant 0)) (list generated-symbol) + (make-apply (test-ref 'tail) (list generated-symbol))))))) + (make-apply (test-ref 'f) (list generated-symbol (make-constant '())))))) (ir1->ir2 (make-letrec #t '(f x) @@ -299,11 +309,12 @@ (assert-equal (make-fix (list - (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)) + (make-closure (test-ref 'f) (list generated-symbol generated-symbol) (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'args)) - (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'args) (make-constant 0)) '() + (make-primitive 'poke (list generated-symbol (test-ref 'args) (make-constant 0)) '() (make-primitive 'poke (list (make-constant 10) (test-ref 'args) (make-constant 0)) '() - (make-apply (test-ref 'generated-symbol) (list (make-constant #f)))))))) + (make-primitive 'cons (list (make-constant #f) (make-constant '())) (list generated-symbol) + (make-apply generated-symbol (list generated-symbol)))))))) (make-apply (test-ref 'tail) (list (make-constant 5)))) (ir1->ir2 (make-letrec #f @@ -320,9 +331,10 @@ (assert-equal (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) (test-ref 'args)) - (make-apply (test-ref 'generated-symbol) (list (make-constant 10))))) - (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'f) (make-constant 0)) '() + (list (make-closure generated-symbol (list generated-symbol (test-ref 'args)) + (make-primitive 'cons (list (make-constant 10) (make-constant '())) (list generated-symbol) + (make-apply generated-symbol (list generated-symbol))))) + (make-primitive 'poke (list 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 |