Implement multiple return values.

1 files changed, 56 insertions, 44 deletions

diff --git a/lib/csc/cps-test.csc b/lib/csc/cps-test.csc
index 8bef0aa..256e9e3 100644
--- a/lib/csc/cps-test.csc
+++ b/lib/csc/cps-test.csc
@@ -74,10 +74,13 @@
       (make-lexical-ref name (gensym)))
 
 
-    (define (tail x)
+    (define (tail x multi)
       (make-apply (test-ref 'tail) (list x)))
 
 
+    (define generated-symbol (test-ref 'generated-symbol))
+
+
     (test atom-const
       (assert-equal
         (make-apply (test-ref 'tail) (list (make-constant 5)))
@@ -94,8 +97,8 @@
 
     (test atom-library-ref
       (assert-equal
-        (make-primitive 'peek (list *globals* (make-library-ref 'var '(csc builtins))) (list (test-ref 'generated-symbol))
-          (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
+        (make-primitive 'peek (list *globals* (make-library-ref 'var '(csc builtins))) (list generated-symbol)
+          (make-apply (test-ref 'tail) (list generated-symbol)))
         (ir1->ir2 (make-library-ref 'var '(csc builtins)) tail)
         transform-ir2))
 
@@ -121,11 +124,13 @@
       (assert-equal
         (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-closure generated-symbol (list generated-symbol)
+              (make-apply (test-ref 'tail) (list generated-symbol))))
           (make-branch (make-constant #t)
-            (make-apply (test-ref 'generated-symbol) (list (make-constant 1)))
-            (make-apply (test-ref 'generated-symbol) (list (make-constant 2)))))
+            (make-primitive 'cons (list (make-constant 1) (make-constant '())) (list generated-symbol)
+              (make-apply generated-symbol (list generated-symbol)))
+            (make-primitive 'cons (list (make-constant 2) (make-constant '())) (list generated-symbol)
+              (make-apply generated-symbol (list generated-symbol)))))
         (ir1->ir2 (make-if (make-constant #t)
                     (make-constant 1)
                     (make-constant 2))
@@ -137,11 +142,11 @@
       (assert-equal
         (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-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))))))
+            (make-closure generated-symbol (list generated-symbol)
+              (make-apply (test-ref 'tail) (list generated-symbol))))
+          (make-primitive 'cons (list (make-constant 20) (make-constant '())) (list generated-symbol)
+            (make-primitive 'cons (list (make-constant 10) generated-symbol) (list generated-symbol)
+              (make-apply (test-ref 'f) (list generated-symbol generated-symbol)))))
         (ir1->ir2 (make-call (test-ref 'f) (list (make-constant 10) (make-constant 20)))
                   tail)
         transform-ir2))
@@ -149,17 +154,17 @@
 
     (test call-builtin-alloc
       (assert-equal
-        (make-primitive 'alloc (list (make-constant 10)) (list (test-ref 'generated-symbol))
-          (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
+        (make-primitive 'alloc (list (make-constant 10)) (list generated-symbol)
+          (make-apply (test-ref 'tail) (list generated-symbol)))
         (ir1->ir2 (make-call-builtin 'alloc (list (make-constant 10))) tail)
         transform-ir2))
 
 
     (test call-builtin-peek
       (assert-equal
-        (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'generated-symbol))
-          (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
-            (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
+        (make-primitive 'alloc (list (make-constant 1)) (list generated-symbol)
+          (make-primitive 'peek (list generated-symbol (make-constant 0)) (list generated-symbol)
+            (make-apply (test-ref 'tail) (list generated-symbol))))
         (ir1->ir2
           (make-call-builtin 'peek (list (make-call-builtin 'alloc (list (make-constant 1))) (make-constant 0)))
           tail)
@@ -168,8 +173,8 @@
 
     (test call-builtin-poke
       (assert-equal
-        (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'generated-symbol))
-          (make-primitive 'poke (list (make-constant 10) (test-ref 'generated-symbol) (make-constant 0)) '()
+        (make-primitive 'alloc (list (make-constant 1)) (list generated-symbol)
+          (make-primitive 'poke (list (make-constant 10) generated-symbol (make-constant 0)) '()
             (make-apply (test-ref 'tail) (list (make-constant #f)))))
         (ir1->ir2
           (make-call-builtin 'poke (list (make-constant 10)
@@ -193,9 +198,10 @@
     (test closure
       (assert-equal
         (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-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
+          (list (make-closure generated-symbol (list generated-symbol (test-ref 'c))
+                  (make-primitive 'cons (list (make-constant 5) (make-constant '())) (list generated-symbol)
+                    (make-apply generated-symbol (list generated-symbol)))))
+          (make-apply (test-ref 'tail) (list generated-symbol)))
         (ir1->ir2 (make-lambda
                     (test-ref 'c)
                     (make-constant 5))
@@ -209,14 +215,15 @@
       (assert-equal
         (make-fix
           (list
-            (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'x))
-              (make-apply (test-ref 'generated-symbol) (list (test-ref 'x)))))
+            (make-closure (test-ref 'f) (list generated-symbol (test-ref 'x))
+              (make-primitive 'cons (list (test-ref 'x) (make-constant '())) (list generated-symbol)
+                (make-apply generated-symbol (list generated-symbol)))))
           (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-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))))))
+              (make-closure generated-symbol (list generated-symbol)
+                (make-apply (test-ref 'tail) (list generated-symbol))))
+            (make-primitive 'cons (list (make-constant 10) (make-constant '())) (list generated-symbol)
+              (make-apply (test-ref 'f) (list generated-symbol generated-symbol)))))
         (ir1->ir2
           (make-letrec #f '(f) (list f)
                        (list (make-lambda x x))
@@ -249,8 +256,9 @@
       (assert-equal
         (make-fix
           (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-closure (test-ref 'f) (list generated-symbol (test-ref 'args))
+              (make-primitive 'cons (list (make-constant 5) (make-constant '())) (list generated-symbol)
+                (make-apply generated-symbol (list generated-symbol)))))
           (make-apply (test-ref 'tail) (list (make-constant 10))))
         (ir1->ir2
           (make-letrec #t
@@ -273,16 +281,18 @@
         (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 '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-closure (test-ref 'f) (list generated-symbol (test-ref 'args))
+                (make-primitive 'peek (list (test-ref 'x) (make-constant 0)) (list generated-symbol)
+                  (make-primitive 'cons (list generated-symbol (make-constant '())) (list generated-symbol)
+                    (make-apply generated-symbol (list 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-apply (test-ref 'f) (list (test-ref 'generated-symbol) (make-constant '()))))))
+                (make-closure generated-symbol (list generated-symbol)
+                  (make-primitive 'assert-singleton (list generated-symbol) (list generated-symbol)
+                    (make-primitive 'poke (list generated-symbol (test-ref 'x) (make-constant 0)) '()
+                      (make-primitive 'peek (list (test-ref 'x) (make-constant 0)) (list generated-symbol)
+                        (make-apply (test-ref 'tail) (list generated-symbol)))))))
+              (make-apply (test-ref 'f) (list generated-symbol (make-constant '()))))))
         (ir1->ir2
           (make-letrec #t
             '(f x)
@@ -299,11 +309,12 @@
       (assert-equal
         (make-fix
           (list
-            (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+            (make-closure (test-ref 'f) (list generated-symbol 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 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-primitive 'cons (list (make-constant #f) (make-constant '())) (list generated-symbol)
+                      (make-apply generated-symbol (list generated-symbol))))))))
           (make-apply (test-ref 'tail) (list (make-constant 5))))
         (ir1->ir2 (make-letrec
                     #f
@@ -320,9 +331,10 @@
       (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 '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)) '()
+            (list (make-closure generated-symbol (list generated-symbol (test-ref 'args))
+                    (make-primitive 'cons (list (make-constant 10) (make-constant '())) (list generated-symbol)
+                      (make-apply generated-symbol (list generated-symbol)))))
+            (make-primitive 'poke (list 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)))))))
         (ir1->ir2 (make-letrec