aboutsummaryrefslogtreecommitdiffstats
path: root/csc/cps-test.csc
diff options
context:
space:
mode:
Diffstat (limited to 'csc/cps-test.csc')
-rw-r--r--csc/cps-test.csc114
1 files changed, 81 insertions, 33 deletions
diff --git a/csc/cps-test.csc b/csc/cps-test.csc
index c72aca6..9881a2d 100644
--- a/csc/cps-test.csc
+++ b/csc/cps-test.csc
@@ -1,6 +1,14 @@
(import (scheme base)
- (only (csc gensym) gensym)
+ (only (csc gensym)
+ gensym
+ gensym?)
(only (csc ir1)
+ %constant
+ %lexical-ref
+ %library-ref
+ constant?
+ lexical-ref?
+ library-ref?
make-call
make-constant
make-define-syntax
@@ -12,7 +20,16 @@
make-library-ref
make-sequence)
(only (csc ir2)
- ir2=?
+ %apply
+ %branch
+ %closure
+ %fix
+ %primitive
+ %variable
+ apply?
+ branch?
+ closure?
+ fix?
make-apply
make-atom
make-branch
@@ -23,13 +40,29 @@
make-klabel
make-ktail
make-primitive
- make-variable)
+ make-variable
+ primitive?
+ variable?)
(only (csc testing)
assert-equal
test)
(csc cps))
+(define transform-ir2
+ (list
+ (cons constant? %constant)
+ (cons lexical-ref? %lexical-ref)
+ (cons library-ref? %library-ref)
+ (cons variable? %variable)
+ (cons primitive? %primitive)
+ (cons branch? %branch)
+ (cons apply? %apply)
+ (cons closure? %closure)
+ (cons fix? %fix)
+ (cons gensym? (lambda (x) 'gensym))))
+
+
(define (test-ref name)
(make-lexical-ref name (gensym)))
@@ -39,42 +72,47 @@
(test atom-const
- (assert-equal ir2=?
+ (assert-equal
(make-apply (test-ref 'tail) (list (make-constant 5)))
- (ir1->ir2 (make-constant 5) tail)))
+ (ir1->ir2 (make-constant 5) tail)
+ transform-ir2))
(test atom-lexical-ref
- (assert-equal ir2=?
+ (assert-equal
(make-apply (test-ref 'tail) (list (test-ref 'var)))
- (ir1->ir2 (test-ref 'var) tail)))
+ (ir1->ir2 (test-ref 'var) tail)
+ transform-ir2))
(test atom-library-ref
- (assert-equal ir2=?
+ (assert-equal
(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)))
+ (ir1->ir2 (make-library-ref 'var '(csc builtins)) tail)
+ transform-ir2))
(test lexical-set
- (assert-equal ir2=?
+ (assert-equal
(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)))
+ tail)
+ transform-ir2))
(test no-op-define-syntax
- (assert-equal ir2=?
+ (assert-equal
(make-apply (test-ref 'tail) (list (make-constant #f)))
(ir1->ir2 (make-define-syntax 'name '(transformer))
- tail)))
+ tail)
+ transform-ir2))
(test branch
- (assert-equal ir2=?
+ (assert-equal
(make-fix
(list
(make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
@@ -85,11 +123,12 @@
(ir1->ir2 (make-if (make-constant #t)
(make-constant 1)
(make-constant 2))
- tail)))
+ tail)
+ transform-ir2))
(test call-closure
- (assert-equal ir2=?
+ (assert-equal
(make-fix
(list
(make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
@@ -98,21 +137,23 @@
(make-constant 1)
(make-constant 2))))
(ir1->ir2 (make-call (test-ref 'f) (list (make-constant 1) (make-constant 2)))
- tail)))
+ tail)
+ transform-ir2))
(test sequence
- (assert-equal ir2=?
+ (assert-equal
(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)))
+ tail)
+ transform-ir2))
(test closure
- (assert-equal ir2=?
+ (assert-equal
(make-fix
(list
(make-closure (test-ref 'generated-symbol)
@@ -126,13 +167,14 @@
(list (test-ref 'a) (test-ref 'b))
(test-ref 'c)
(make-constant 5))
- tail)))
+ tail)
+ transform-ir2))
(test letrec-functions
(define x (test-ref 'x))
(define f (gensym))
- (assert-equal ir2=?
+ (assert-equal
(make-fix
(list
(make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'x)) #f
@@ -146,11 +188,12 @@
(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)))
+ tail)
+ transform-ir2))
(test letrec-in-order
- (assert-equal ir2=?
+ (assert-equal
(make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'b))
(make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'a))
(make-fix
@@ -168,7 +211,8 @@
(make-lambda (list (test-ref 'x)) #f (make-constant 5))
(make-constant 2))
(make-constant 10))
- tail)))
+ tail)
+ transform-ir2))
; What does the following letrec return?
@@ -178,7 +222,7 @@
(test letrec-very-cool
(define f (gensym))
(define x (gensym))
- (assert-equal ir2=?
+ (assert-equal
(make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'x))
(make-fix
(list
@@ -199,12 +243,13 @@
(list (make-lambda '() #f (make-lexical-ref 'x x))
(make-call (make-lexical-ref 'f f) '()))
(make-lexical-ref 'x x))
- tail)))
+ tail)
+ transform-ir2))
(test set-argument
(define test-sym (gensym))
- (assert-equal ir2=?
+ (assert-equal
(make-fix
(list
(make-closure (test-ref 'f) (list (test-ref 'generated-symbol)
@@ -226,11 +271,12 @@
(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)))
+ tail)
+ transform-ir2))
(test set-function
(define test-sym (gensym))
- (assert-equal ir2=?
+ (assert-equal
(make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'f))
(make-fix
(list
@@ -245,7 +291,8 @@
(list test-sym)
(list (make-lambda '() #f (make-constant 10)))
(make-lexical-set (make-lexical-ref 'f test-sym) (make-constant 5)))
- tail)))
+ tail)
+ transform-ir2))
(define (test-var)
@@ -257,7 +304,7 @@
(define f-sym (gensym))
(define ret-sym (gensym))
(define x-sym (gensym))
- (assert-equal ir2=?
+ (assert-equal
(make-primitive 'alloc (list (make-constant 1)) (list (test-var))
(make-fix
(list
@@ -277,4 +324,5 @@
(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))))))))
+ (make-apply (make-lexical-ref 'f f-sym) (list (make-library-ref 'tail '(csc builtins)) (make-constant 10))))))
+ transform-ir2))
generated by cgit v1.3.1 (git 2.54.0) at 2026-09-04 11:10:34 +0000