Continue work on continuation passing style.

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))))))