More CPS.

I improved the abstraction in to-cps.

1 files changed, 42 insertions, 11 deletions

diff --git a/csc/cps-test.csc b/csc/cps-test.csc
index 0aead27..ea1d177 100644
--- a/csc/cps-test.csc
+++ b/csc/cps-test.csc
@@ -2,17 +2,21 @@
         (only (csc hash-map)
           map->alist)
         (only (csc ir1)
+          make-call
           make-constant
           make-define-syntax
           make-if
           make-lexical-ref
           make-lexical-set
-          make-library-ref)
+          make-library-ref
+          make-sequence)
         (only (csc ir2)
           ir2=?
           make-atom
           make-branch
+          make-call-closure
           make-kargs
+          make-klabel
           make-ktail
           make-update)
         (only (csc loop)
@@ -42,7 +46,7 @@
 (test atom-const
   (assert-equal soup=?
     (list
-      (cons 0 (make-kargs '()
+      (cons 0 (make-klabel
                 (make-atom (make-constant 5) 1)))
       (cons 1 (make-ktail)))
     (soup->alist (ir1->ir2 (make-constant 5)))))
@@ -51,7 +55,7 @@
 (test atom-lexical-ref
   (assert-equal soup=?
     (list
-      (cons 0 (make-kargs '()
+      (cons 0 (make-klabel
                 (make-atom (make-lexical-ref 'var #f) 1)))
       (cons 1 (make-ktail)))
     (soup->alist (ir1->ir2 (make-lexical-ref 'var #f)))))
@@ -60,7 +64,7 @@
 (test atom-library-ref
   (assert-equal soup=?
     (list
-      (cons 0 (make-kargs '()
+      (cons 0 (make-klabel
                 (make-atom (make-library-ref 'var '(csc builtins)) 1)))
       (cons 1 (make-ktail)))
     (soup->alist (ir1->ir2 (make-library-ref 'var '(csc builtins))))))
@@ -69,7 +73,7 @@
 (test lexical-set
   (assert-equal soup=?
     (list
-      (cons 0 (make-kargs '()
+      (cons 0 (make-klabel
                 (make-atom (make-constant 5) 2)))
       (cons 1 (make-ktail))
       (cons 2 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
@@ -81,7 +85,7 @@
 (test no-op-define-syntax
   (assert-equal soup=?
     (list
-      (cons 0 (make-kargs '() (make-atom (make-constant #f) 1)))
+      (cons 0 (make-klabel (make-atom (make-constant #f) 1)))
       (cons 1 (make-ktail)))
     (soup->alist (ir1->ir2 (make-define-syntax 'name '(transformer))))))
 
@@ -89,13 +93,40 @@
 (test branch
   (assert-equal soup=?
     (list
-      (cons 0 (make-kargs '() (make-atom (make-constant #t) 2)))
+      (cons 0 (make-klabel (make-atom (make-constant #t) 4)))
       (cons 1 (make-ktail))
-      (cons 2 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
+      (cons 2 (make-klabel (make-atom (make-constant 1) 1)))
+      (cons 3 (make-klabel (make-atom (make-constant 2) 1)))
+      (cons 4 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
                 (make-branch (make-lexical-ref 'generated-symbol #f)
-                  3 4)))
-      (cons 3 (make-kargs '() (make-atom (make-constant 1) 1)))
-      (cons 4 (make-kargs '() (make-atom (make-constant 2) 1))))
+                  2 3))))
     (soup->alist (ir1->ir2 (make-if (make-constant #t)
                              (make-constant 1)
                              (make-constant 2))))))
+
+
+(test call-closure
+  (assert-equal soup=?
+    (list
+      (cons 0 (make-klabel (make-atom (make-lexical-ref 'f #f) 4)))
+      (cons 1 (make-ktail))
+      (cons 2 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
+                (make-call-closure (make-lexical-ref 'generated-symbol #f)
+                  (list (make-lexical-ref 'generated-symbol #f)
+                        (make-lexical-ref 'generated-symbol #f))
+                  1)))
+      (cons 3 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
+                (make-atom (make-constant 2) 2)))
+      (cons 4 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
+                (make-atom (make-constant 1) 3))))
+    (soup->alist (ir1->ir2 (make-call (make-lexical-ref 'f #f) (list (make-constant 1) (make-constant 2)))))))
+
+
+(test sequence
+  (assert-equal soup=?
+    (list
+      (cons 0 (make-klabel (make-atom (make-constant 1) 2)))
+      (cons 1 (make-ktail))
+      (cons 2 (make-klabel (make-atom (make-constant 2) 1))))
+    (soup->alist (ir1->ir2 (make-sequence (make-constant 1)
+                                          (make-constant 2))))))