Perform argument conversion.

The point of argument conversion is to validate on each function call
that the right number of arguments were passed, and to ensure that no
function has more than 1 argument. This second condition makes CPS
slightly simpler, and ensures that the arguments will all fit in locals.

We take the strategy of allocating a vector for each function call.
Ideally we would optimize away most of these allocations, but for now I
just want it to work.

1 files changed, 184 insertions, 50 deletions

diff --git a/csc/cps-test.csc b/csc/cps-test.csc
index 4259586..84b8b9a 100644
--- a/csc/cps-test.csc
+++ b/csc/cps-test.csc
@@ -116,7 +116,7 @@
   (assert-equal
     (make-fix
       (list
-        (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
+        (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
           (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))))
       (make-branch (make-constant #t)
         (make-apply (test-ref 'generated-symbol) (list (make-constant 1)))
@@ -132,12 +132,21 @@
   (assert-equal
     (make-fix
       (list
-        (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
+        (make-closure (test-ref 'generated-symbol) (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 1)
-                                                 (make-constant 2))))
-    (ir1->ir2 (make-call (test-ref 'f) (list (make-constant 1) (make-constant 2)))
+      (make-fix
+        (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
+                  (make-primitive 'poke (list (make-constant 2) (test-ref 'generated-symbol) (make-constant 1)) '()
+                    (make-primitive 'poke (list (make-constant 10) (test-ref 'generated-symbol) (make-constant 2)) '()
+                      (make-primitive 'poke (list (make-constant 20) (test-ref 'generated-symbol) (make-constant 3)) '()
+                        (make-fix
+                          (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                  (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                          (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))
+        (make-primitive 'alloc (list (make-constant 4)) (list (test-ref 'generated-symbol))
+          (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))
+    (ir1->ir2 (make-call (test-ref 'f) (list (make-constant 10) (make-constant 20)))
               tail)
     transform-ir2))
 
@@ -185,19 +194,49 @@
     transform-ir2))
 
 
-(test closure
+; It's pretty bad
+(test closure-rest
   (assert-equal
     (make-fix
-      (list
-        (make-closure (test-ref 'generated-symbol)
-                      (list (test-ref 'generated-symbol)
-                            (test-ref 'a)
-                            (test-ref 'b))
-                      (test-ref 'c)
-          (make-apply (test-ref 'generated-symbol) (list (make-constant 5)))))
+      (list (make-closure (test-ref 'generated-symbol)
+                                  (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+              (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                (make-primitive 'int<? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                  (make-fix (list (make-closure (test-ref 'generated-symbol)
+                                                (list (test-ref 'generated-symbol))
+                                    (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                    (make-branch (test-ref 'generated-symbol)
+                      (make-fix (list (make-closure (test-ref 'generated-symbol)
+                                                    (list (test-ref 'generated-symbol))
+                                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                        (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                          (make-apply (test-ref 'generated-symbol)
+                                      (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))
+                      (make-fix (list (make-closure (test-ref 'generated-symbol)
+                                                    (list (test-ref 'generated-symbol))
+                                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                        (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-fix
+                            (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                    (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))
+                            (make-fix
+                              (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                                      (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
+                                        (make-primitive 'poke (list (make-constant 2) (test-ref 'generated-symbol) (make-constant 1)) '()
+                                          (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'generated-symbol) (make-constant 2)) '()
+                                            (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 3)) '()
+                                              (make-fix
+                                                (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                                                (make-primitive 'peek (list (make-library-ref 'vector->list '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                                                  (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+                              (make-primitive 'alloc (list (make-constant 4)) (list (test-ref 'generated-symbol))
+                                (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))))))
       (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
     (ir1->ir2 (make-lambda
-                (list (test-ref 'a) (test-ref 'b))
+                '()
                 (test-ref 'c)
                 (make-constant 5))
               tail)
@@ -210,13 +249,41 @@
   (assert-equal
     (make-fix
       (list
-        (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'x)) #f
-          (make-apply (test-ref 'generated-symbol) (list (test-ref 'x)))))
+        (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+          (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+            (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+              (make-fix
+                (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                (make-branch (test-ref 'generated-symbol)
+                  (make-fix
+                    (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                    (make-fix
+                      (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'x))
+                              (make-apply (test-ref 'generated-symbol) (list (test-ref 'x)))))
+                      (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 2)) (list (test-ref 'generated-symbol))
+                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))
+                  (make-fix
+                    (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                    (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                      (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
       (make-fix
         (list
-          (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
+          (make-closure (test-ref 'generated-symbol) (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 10)))))
+        (make-fix
+          (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                  (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
+                    (make-primitive 'poke (list (make-constant 1) (test-ref 'generated-symbol) (make-constant 1)) '()
+                      (make-primitive 'poke (list (make-constant 10) (test-ref 'generated-symbol) (make-constant 2)) '()
+                        (make-fix
+                          (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                  (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                          (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))
+          (make-primitive 'alloc (list (make-constant 3)) (list (test-ref 'generated-symbol))
+            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))
     (ir1->ir2
       (make-letrec #f '(f) (list f)
                    (list (make-lambda (list x) #f x))
@@ -226,23 +293,47 @@
 
 
 (test letrec-in-order
+  (define a (gensym))
+  (define b (gensym))
   (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
-          (list
-            (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'x)) #f
-              (make-apply (test-ref 'generated-symbol) (list (make-constant 5)))))
-          (make-primitive 'poke (list (make-constant 1) (test-ref 'a) (make-constant 0)) '()
-            (make-primitive 'poke (list (make-constant 2) (test-ref 'b) (make-constant 0)) '()
-              (make-apply (test-ref 'tail) (list (make-constant 10))))))))
+        (make-primitive 'poke (list (make-constant 1) (test-ref 'a) (make-constant 0)) '()
+          (make-primitive 'poke (list (test-ref 'a) (test-ref 'b) (make-constant 0)) '()
+            (make-apply (test-ref 'tail) (list (test-ref 'b)))))))
     (ir1->ir2
       (make-letrec #t
-        '(a f b)
-        (list (gensym) (gensym) (gensym))
+        '(a b)
+        (list a (gensym))
         (list (make-constant 1)
-              (make-lambda (list (test-ref 'x)) #f (make-constant 5))
-              (make-constant 2))
+              (make-lexical-ref 'a a))
+        (make-lexical-ref 'b b))
+      tail)
+    transform-ir2))
+
+
+(test letrec-in-order-function
+  (assert-equal
+    (make-fix
+      (list (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+              (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                  (make-fix
+                    (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                    (make-branch (test-ref 'generated-symbol)
+                      (make-apply (test-ref 'generated-symbol) (list (make-constant 5)))
+                      (make-fix
+                        (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                        (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                          (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
+      (make-apply (test-ref 'tail) (list (make-constant 10))))
+    (ir1->ir2
+      (make-letrec #t
+        '(f)
+        (list (gensym))
+        (list (make-lambda '() #f (make-constant 5)))
         (make-constant 10))
       tail)
     transform-ir2))
@@ -259,16 +350,36 @@
     (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'x))
       (make-fix
         (list
-          (make-closure (test-ref 'f) (list (test-ref 'generated-symbol)) #f
-            (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 (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+            (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+              (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                (make-fix
+                  (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                          (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                  (make-branch (test-ref 'generated-symbol)
+                    (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-fix
+                      (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                              (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                      (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
         (make-fix
           (list
-            (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) #f
+            (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-fix
+            (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                    (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 0)) '()
+                      (make-primitive 'poke (list (make-constant 0) (test-ref 'generated-symbol) (make-constant 1)) '()
+                        (make-fix
+                          (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                  (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                          (make-apply (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))
+            (make-primitive 'alloc (list (make-constant 2)) (list (test-ref 'generated-symbol))
+              (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))
     (ir1->ir2
       (make-letrec #t
         '(f x)
@@ -286,16 +397,29 @@
     (make-fix
       (list
         (make-closure (test-ref 'f) (list (test-ref 'generated-symbol)
-                                          (test-ref 'generated-symbol)) #f
-          (make-primitive 'alloc (list (make-constant 1))
-                                 (list (test-ref 'x))
-            (make-primitive 'poke (list (test-ref 'generated-symbol)
-                                        (test-ref 'x)
-                                        (make-constant 0)) '()
-              (make-primitive 'poke (list (make-constant 10)
-                                          (test-ref 'x)
-                                          (make-constant 0)) '()
-                (make-apply (test-ref 'generated-symbol) (list (make-constant #f))))))))
+                                          (test-ref 'generated-symbol))
+          (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+            (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+              (make-fix
+                (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                (make-branch (test-ref 'generated-symbol)
+                  (make-fix
+                    (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                    (make-fix
+                      (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                              (make-primitive 'alloc (list (make-constant 1)) (list (test-ref 'x))
+                                (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'x) (make-constant 0)) '()
+                                  (make-primitive 'poke (list (make-constant 10) (test-ref 'x) (make-constant 0)) '()
+                                    (make-apply (test-ref 'generated-symbol) (list (make-constant #f))))))))
+                      (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 2)) (list (test-ref 'generated-symbol))
+                        (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))
+                  (make-fix
+                    (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                    (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                      (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
       (make-apply (test-ref 'tail) (list (make-constant 5))))
     (ir1->ir2 (make-letrec
                 #f
@@ -312,9 +436,19 @@
   (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)) #f
-            (make-apply (test-ref 'generated-symbol) (list (make-constant 10)))))
+        (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
+                (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                  (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                    (make-fix
+                      (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                              (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                      (make-branch (test-ref 'generated-symbol)
+                        (make-apply (test-ref 'generated-symbol) (list (make-constant 10)))
+                        (make-fix
+                          (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
+                                  (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
+                          (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                            (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
         (make-primitive 'poke (list (test-ref '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)))))))
@@ -341,7 +475,7 @@
     (make-primitive 'alloc (list (make-constant 1)) (list (test-var))
       (make-fix
         (list
-          (make-closure (test-var) (list (test-var) (test-var) (test-var)) #f
+          (make-closure (test-var) (list (test-var) (test-var) (test-var))
             (make-primitive 'peek (list (test-var) (make-constant 0)) (list (test-var))
               (make-primitive 'poke (list (test-var) (test-var) (make-constant 0)) '()
                 (make-primitive 'peek (list (test-var) (make-constant 0)) (list (test-var))
@@ -354,7 +488,7 @@
     (closure-convert (make-primitive 'alloc (list (make-constant 1)) (list (make-lexical-ref 'a a-sym))
                        (make-fix
                          (list
-                           (make-closure (make-lexical-ref 'f f-sym) (list (make-lexical-ref 'ret ret-sym) (make-lexical-ref 'x x-sym)) #f
+                           (make-closure (make-lexical-ref 'f f-sym) (list (make-lexical-ref 'ret ret-sym) (make-lexical-ref 'x x-sym))
                              (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))))))