diff options
Diffstat (limited to 'csc/cps-test.csc')
| -rw-r--r-- | csc/cps-test.csc | 153 |
1 files changed, 101 insertions, 52 deletions
diff --git a/csc/cps-test.csc b/csc/cps-test.csc index d3cfb6d..3f0d743 100644 --- a/csc/cps-test.csc +++ b/csc/cps-test.csc @@ -1,4 +1,5 @@ (import (scheme base) + (only (csc gensym) gensym) (only (csc ir1) make-call make-constant @@ -13,55 +14,60 @@ (only (csc ir2) ir2=? make-apply - make-fix make-atom make-branch make-call-closure make-closure + make-fix make-kargs make-klabel make-ktail - make-update) + make-primitive) (only (csc testing) assert-equal test) (csc cps)) +(define (test-ref name) + (make-lexical-ref name (gensym))) + + (define (tail x) - (make-apply (make-lexical-ref 'tail #f) (list x))) + (make-apply (test-ref 'tail) (list x))) (test atom-const (assert-equal ir2=? - (make-apply (make-lexical-ref 'tail #f) (list (make-constant 5))) + (make-apply (test-ref 'tail) (list (make-constant 5))) (ir1->ir2 (make-constant 5) tail))) (test atom-lexical-ref (assert-equal ir2=? - (make-apply (make-lexical-ref 'tail #f) (list (make-lexical-ref 'var #f))) - (ir1->ir2 (make-lexical-ref 'var #f) tail))) + (make-apply (test-ref 'tail) (list (test-ref 'var))) + (ir1->ir2 (test-ref 'var) tail))) (test atom-library-ref (assert-equal ir2=? - (make-apply (make-lexical-ref 'tail #f) - (list (make-library-ref 'var '(csc builtins)))) + (make-primitive 'peek (list (make-library-ref 'var '(csc builtins)) (make-constant 0)) + (list (test-ref 'generated-symbol)) + (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))) (ir1->ir2 (make-library-ref 'var '(csc builtins)) tail))) (test lexical-set (assert-equal ir2=? - (make-update (make-lexical-ref 'var #f) (make-constant 5) - (make-apply (make-lexical-ref 'tail #f) (list (make-constant #f)))) - (ir1->ir2 (make-lexical-set (make-lexical-ref 'var #f) (make-constant 5)) + (make-primitive 'poke (list (make-constant 5) (test-ref 'var) (make-constant 0)) '() + (make-apply (test-ref 'tail) (list (make-constant #f)))) + (ir1->ir2 (make-lexical-set (test-ref 'var) (make-constant 5)) tail))) (test no-op-define-syntax (assert-equal ir2=? - (make-apply (make-lexical-ref 'tail #f) (list (make-constant #f))) + (make-apply (test-ref 'tail) (list (make-constant #f))) (ir1->ir2 (make-define-syntax 'name '(transformer)) tail))) @@ -70,11 +76,11 @@ (assert-equal ir2=? (make-fix (list - (make-closure (make-lexical-ref 'generated-symbol #f) (list (make-lexical-ref 'generated-symbol #f)) #f - (make-apply (make-lexical-ref 'tail #f) (list (make-lexical-ref 'generated-symbol #f))))) + (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f + (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))) (make-branch (make-constant #t) - (make-apply (make-lexical-ref 'generated-symbol #f) (list (make-constant 1))) - (make-apply (make-lexical-ref 'generated-symbol #f) (list (make-constant 2))))) + (make-apply (test-ref 'generated-symbol) (list (make-constant 1))) + (make-apply (test-ref 'generated-symbol) (list (make-constant 2))))) (ir1->ir2 (make-if (make-constant #t) (make-constant 1) (make-constant 2)) @@ -85,22 +91,22 @@ (assert-equal ir2=? (make-fix (list - (make-closure (make-lexical-ref 'generated-symbol #f) (list (make-lexical-ref 'generated-symbol #f)) #f - (make-apply (make-lexical-ref 'tail #f) (list (make-lexical-ref 'generated-symbol #f))))) - (make-apply (make-lexical-ref 'f #f) (list (make-lexical-ref 'generated-symbol #f) + (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 1) (make-constant 2)))) - (ir1->ir2 (make-call (make-lexical-ref 'f #f) (list (make-constant 1) (make-constant 2))) + (ir1->ir2 (make-call (test-ref 'f) (list (make-constant 1) (make-constant 2))) tail))) (test sequence (assert-equal ir2=? - (make-update (make-lexical-ref 'a #f) (make-constant 5) - (make-update (make-lexical-ref 'b #f) (make-constant 6) - (make-apply (make-lexical-ref 'tail #f) (list (make-constant #f))))) - (ir1->ir2 (make-sequence (make-lexical-set (make-lexical-ref 'a #f) (make-constant 5)) - (make-lexical-set (make-lexical-ref 'b #f) (make-constant 6))) + (make-primitive 'poke (list (make-constant 5) (test-ref 'a) (make-constant 0)) '() + (make-primitive 'poke (list (make-constant 6) (test-ref 'b) (make-constant 0)) '() + (make-apply (test-ref 'tail) (list (make-constant #f))))) + (ir1->ir2 (make-sequence (make-lexical-set (test-ref 'a) (make-constant 5)) + (make-lexical-set (test-ref 'b) (make-constant 6))) tail))) @@ -108,16 +114,16 @@ (assert-equal ir2=? (make-fix (list - (make-closure (make-lexical-ref 'generated-symbol #f) - (list (make-lexical-ref 'generated-symbol #f) - (make-lexical-ref 'a #f) - (make-lexical-ref 'b #f)) - (make-lexical-ref 'c #f) - (make-apply (make-lexical-ref 'generated-symbol #f) (list (make-constant 5))))) - (make-apply (make-lexical-ref 'tail #f) (list (make-lexical-ref 'generated-symbol #f)))) + (make-closure (test-ref 'generated-symbol) + (list (test-ref 'generated-symbol) + (test-ref 'a) + (test-ref 'b)) + (test-ref 'c) + (make-apply (test-ref 'generated-symbol) (list (make-constant 5))))) + (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))) (ir1->ir2 (make-lambda - (list (make-lexical-ref 'a #f) (make-lexical-ref 'b #f)) - (make-lexical-ref 'c #f) + (list (test-ref 'a) (test-ref 'b)) + (test-ref 'c) (make-constant 5)) tail))) @@ -126,38 +132,81 @@ (assert-equal ir2=? (make-fix (list - (make-closure (make-lexical-ref 'f #f) (list (make-lexical-ref 'generated-symbol #f) - (make-lexical-ref 'x #f)) #f - (make-apply (make-lexical-ref 'generated-symbol #f) (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 (make-constant 5))))) (make-fix (list - (make-closure (make-lexical-ref 'generated-symbol #f) (list (make-lexical-ref 'generated-symbol #f)) #f - (make-apply (make-lexical-ref 'tail #f) (list (make-lexical-ref 'generated-symbol #f))))) + (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f + (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))) (make-fix (list - (make-closure (make-lexical-ref 'generated-symbol #f) (list (make-lexical-ref 'generated-symbol #f) - (make-lexical-ref 'a #f)) #f + (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) + (test-ref 'a)) #f (make-fix (list - (make-closure (make-lexical-ref 'generated-symbol #f) (list (make-lexical-ref 'generated-symbol #f)) #f - (make-apply (make-lexical-ref 'generated-symbol #f) (list (make-lexical-ref 'generated-symbol #f))))) + (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 (make-lexical-ref 'generated-symbol #f) (list (make-lexical-ref 'generated-symbol #f) - (make-lexical-ref 'b #f)) #f - (make-apply (make-lexical-ref 'generated-symbol #f) (list (make-constant 10))))) - (make-apply (make-lexical-ref 'generated-symbol #f) - (list (make-lexical-ref 'generated-symbol #f) + (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 (make-lexical-ref 'generated-symbol #f) - (list (make-lexical-ref 'generated-symbol #f) + (make-apply (test-ref 'generated-symbol) + (list (test-ref 'generated-symbol) (make-constant 1)))))) (ir1->ir2 (make-letrec #t '(a f b) - '(#f #f #f) + (list (gensym) (gensym) (gensym)) (list (make-constant 1) - (make-lambda (list (make-lexical-ref 'x #f)) #f (make-constant 5)) + (make-lambda (list (test-ref 'x)) #f (make-constant 5)) (make-constant 2)) (make-constant 10)) 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) + (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)) + + +(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)) |