aboutsummaryrefslogtreecommitdiffstats
path: root/lib/csc/cps-test.csc
diff options
context:
space:
mode:
Diffstat (limited to 'lib/csc/cps-test.csc')
-rw-r--r--lib/csc/cps-test.csc192
1 files changed, 30 insertions, 162 deletions
diff --git a/lib/csc/cps-test.csc b/lib/csc/cps-test.csc
index ab92646..8bef0aa 100644
--- a/lib/csc/cps-test.csc
+++ b/lib/csc/cps-test.csc
@@ -139,18 +139,9 @@
(list
(make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
(make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
- (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
- (make-primitive 'poke (list (make-constant 2) (test-ref 'generated-symbol) (make-constant 1)) '()
- (make-primitive 'poke (list (make-constant 10) (test-ref 'generated-symbol) (make-constant 2)) '()
- (make-primitive 'poke (list (make-constant 20) (test-ref 'generated-symbol) (make-constant 3)) '()
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))
- (make-primitive 'alloc (list (make-constant 4)) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (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))))))
(ir1->ir2 (make-call (test-ref 'f) (list (make-constant 10) (make-constant 20)))
tail)
transform-ir2))
@@ -199,49 +190,13 @@
transform-ir2))
- ; It's pretty bad
- (test closure-rest
+ (test closure
(assert-equal
(make-fix
- (list (make-closure (test-ref 'generated-symbol)
- (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
- (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
- (make-primitive 'lt (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
- (make-fix (list (make-closure (test-ref 'generated-symbol)
- (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-branch (test-ref 'generated-symbol)
- (make-fix (list (make-closure (test-ref 'generated-symbol)
- (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol)
- (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))
- (make-fix (list (make-closure (test-ref 'generated-symbol)
- (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) (test-ref 'c))
- (make-apply (test-ref 'generated-symbol) (list (make-constant 5)))))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
- (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
- (make-primitive 'poke (list (make-constant 2) (test-ref 'generated-symbol) (make-constant 1)) '()
- (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'generated-symbol) (make-constant 2)) '()
- (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 3)) '()
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-primitive 'peek (list *globals* (make-library-ref 'vector->list '(csc based))) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
- (make-primitive 'alloc (list (make-constant 4)) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))))))
+ (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))))
(ir1->ir2 (make-lambda
- '()
(test-ref 'c)
(make-constant 5))
tail)
@@ -254,44 +209,17 @@
(assert-equal
(make-fix
(list
- (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
- (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
- (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-branch (test-ref 'generated-symbol)
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (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) (test-ref 'x))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'x)))))
- (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 2)) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+ (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'x))
+ (make-apply (test-ref 'generated-symbol) (list (test-ref 'x)))))
(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-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
- (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
- (make-primitive 'poke (list (make-constant 1) (test-ref 'generated-symbol) (make-constant 1)) '()
- (make-primitive 'poke (list (make-constant 10) (test-ref 'generated-symbol) (make-constant 2)) '()
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))
- (make-primitive 'alloc (list (make-constant 3)) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (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))))))
(ir1->ir2
(make-letrec #f '(f) (list f)
- (list (make-lambda (list x) #f x))
+ (list (make-lambda x x))
(make-call (make-lexical-ref 'f f) (list (make-constant 10))))
tail)
transform-ir2))
@@ -320,25 +248,15 @@
(test letrec-in-order-function
(assert-equal
(make-fix
- (list (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
- (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
- (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-branch (test-ref 'generated-symbol)
- (make-apply (test-ref 'generated-symbol) (list (make-constant 5)))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+ (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-apply (test-ref 'tail) (list (make-constant 10))))
(ir1->ir2
(make-letrec #t
'(f)
(list (gensym))
- (list (make-lambda '() #f (make-constant 5)))
+ (list (make-lambda (test-ref 'args) (make-constant 5)))
(make-constant 10))
tail)
transform-ir2))
@@ -355,41 +273,21 @@
(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 'generated-symbol))
- (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
- (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-branch (test-ref 'generated-symbol)
- (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))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+ (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-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-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
- (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
- (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 1)) '()
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))
- (make-primitive 'alloc (list (make-constant 2)) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))
+ (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (make-constant '()))))))
(ir1->ir2
(make-letrec #t
'(f x)
(list f x)
- (list (make-lambda '() #f (make-lexical-ref 'x x))
+ (list (make-lambda (test-ref 'args) (make-lexical-ref 'x x))
(make-call (make-lexical-ref 'f f) '()))
(make-lexical-ref 'x x))
tail)
@@ -401,37 +299,18 @@
(assert-equal
(make-fix
(list
- (make-closure (test-ref 'f) (list (test-ref 'generated-symbol)
- (test-ref 'generated-symbol))
- (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
- (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-branch (test-ref 'generated-symbol)
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (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) (test-ref 'generated-symbol))
- (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-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 2)) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+ (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref '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 (make-constant 10) (test-ref 'args) (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))))
+ (list (make-lambda (make-lexical-ref 'args test-sym)
+ (make-lexical-set (make-lexical-ref 'args test-sym) (make-constant 10))))
(make-constant 5))
tail)
transform-ir2))
@@ -441,19 +320,8 @@
(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 'generated-symbol))
- (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
- (make-primitive 'eq (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-branch (test-ref 'generated-symbol)
- (make-apply (test-ref 'generated-symbol) (list (make-constant 10)))
- (make-fix
- (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
- (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
- (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+ (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)) '()
(make-primitive 'poke (list (make-constant 5) (test-ref 'f) (make-constant 0)) '()
(make-apply (test-ref 'tail) (list (make-constant #f)))))))
@@ -461,7 +329,7 @@
#f
'(f)
(list test-sym)
- (list (make-lambda '() #f (make-constant 10)))
+ (list (make-lambda (test-ref 'args) (make-constant 10)))
(make-lexical-set (make-lexical-ref 'f test-sym) (make-constant 5)))
tail)
transform-ir2))
generated by cgit v1.3.1 (git 2.54.0) at 2026-09-04 09:12:51 +0000