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.csc71
1 files changed, 64 insertions, 7 deletions
diff --git a/csc/cps-test.csc b/csc/cps-test.csc
index dd66078..5bd6c1a 100644
--- a/csc/cps-test.csc
+++ b/csc/cps-test.csc
@@ -1,18 +1,75 @@
(import (scheme base)
+ (only (csc hash-map)
+ map->alist)
+ (only (csc ir1)
+ make-constant
+ make-lexical-ref
+ make-lexical-set
+ make-library-ref)
(only (csc ir2)
ir2=?
make-atom
- make-tail
- make-constant)
+ make-kargs
+ make-ktail
+ make-update)
+ (only (csc loop)
+ loop
+ return)
+ (only (csc sort) sort)
(only (csc testing)
assert-equal
test)
(csc cps))
+(define (soup->alist s)
+ (sort (lambda (x y) (< (car x) (car y))) (map->alist s)))
+
+
+(define (soup=? x y)
+ (and (= (length x) (length y))
+ (loop for x* in x
+ for y* in y
+ unless (and (= (car x*) (car y*))
+ (ir2=? (cdr x*) (cdr y*)))
+ return #f
+ finally (return #t))))
+
+
(test atom-const
- (assert-equal ir2=?
- (make-atom
- (make-constant 5)
- (make-tail))
- (ir1->ir2 (make-constant 5))))
+ (assert-equal soup=?
+ (list
+ (cons 0 (make-kargs '()
+ (make-atom (make-constant 5) 1)))
+ (cons 1 (make-ktail)))
+ (soup->alist (ir1->ir2 (make-constant 5)))))
+
+
+(test atom-lexical-ref
+ (assert-equal soup=?
+ (list
+ (cons 0 (make-kargs '()
+ (make-atom (make-lexical-ref 'var #f) 1)))
+ (cons 1 (make-ktail)))
+ (soup->alist (ir1->ir2 (make-lexical-ref 'var #f)))))
+
+
+(test atom-library-ref
+ (assert-equal soup=?
+ (list
+ (cons 0 (make-kargs '()
+ (make-atom (make-library-ref 'var '(csc builtins)) 1)))
+ (cons 1 (make-ktail)))
+ (soup->alist (ir1->ir2 (make-library-ref 'var '(csc builtins))))))
+
+
+(test lexical-set
+ (assert-equal soup=?
+ (list
+ (cons 0 (make-kargs '()
+ (make-atom (make-constant 5) 2)))
+ (cons 1 (make-ktail))
+ (cons 2 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
+ (make-update (make-lexical-ref 'var #f)
+ (make-lexical-ref 'generated-symbol #f) 1))))
+ (soup->alist (ir1->ir2 (make-lexical-set (make-lexical-ref 'var #f) (make-constant 5))))))