Change argument passing to use lists.

Using vectors is just horribly complicated combined with builtins like
apply, or procedures that take a rest parameter. Now we pass all
arguments in a list. Hopefully optimization can undo this for known
functions in the future.

1 files changed, 38 insertions, 110 deletions

diff --git a/lib/csc/cps.csc b/lib/csc/cps.csc
index ca6dbf4..1b8df9d 100644
--- a/lib/csc/cps.csc
+++ b/lib/csc/cps.csc
@@ -86,87 +86,6 @@
       (make-lexical-ref 'generated-symbol (gensym)))
 
 
-    ; Converts an IR1 expression to an equivalent expression where every
-    ; procedure takes exactly one argument.
-    (define (argument-conversion expr)
-      (match expr
-        (_ when (or (constant? expr)
-                    (lexical-ref? expr)
-                    (library-ref? expr))
-          expr)
-        ((% %lexical-set ref arg)
-          (make-lexical-set ref (argument-conversion arg)))
-        ((% %library-define ref arg)
-          (make-library-define ref (argument-conversion arg)))
-        ((% %define-syntax _ _) expr)
-        ((% %if test consequent alternate)
-          (make-if
-            (argument-conversion test)
-            (argument-conversion consequent)
-            (argument-conversion alternate)))
-        ((% %call proc args)
-          (define argvec (new-ref))
-          (define nargs (length args))
-          (make-call
-            (make-lambda (list argvec) #f
-              (make-sequence
-                (loop for arg in args
-                      for i from 2
-                      with expr = (make-sequence
-                                    (make-call-builtin 'poke (list (make-constant 0) argvec (make-constant 0)))
-                                    (make-call-builtin 'poke (list (make-constant nargs) argvec (make-constant 1))))
-                      do (set! expr (make-sequence
-                                      expr
-                                      (make-call-builtin 'poke (list (argument-conversion arg) argvec (make-constant i)))))
-                      finally (return expr))
-                (make-call (argument-conversion proc) (list argvec))))
-            (list (make-call-builtin 'alloc (list (make-constant (+ 2 nargs)))))))
-        ((% %call-builtin op args)
-          (make-call-builtin op (map argument-conversion args)))
-        ((% %sequence head tail)
-          (make-sequence
-            (argument-conversion head)
-            (argument-conversion tail)))
-        ((% %lambda args rest body) when rest
-          (define argvec (new-ref))
-          (define nargs (length args))
-          (make-lambda (list argvec) #f
-            (make-if (make-call-builtin 'lt (list (make-call-builtin 'peek (list argvec (make-constant 1)))
-                                                     (make-constant nargs)))
-              (make-call (make-library-ref 'wrong-number-of-arguments '(csc based)) (list argvec))
-              (loop for arg in (reverse args)
-                    for i downfrom (+ 1 nargs)
-                    with expr = (make-call (make-lambda (list rest) #f
-                                             (argument-conversion body))
-                                           (list
-                                             (argument-conversion
-                                               (make-call (make-library-ref 'vector->list '(csc based))
-                                                          (list argvec (make-constant nargs))))))
-                    ; I'm relying on beta reduction here.
-                    do (set! expr (make-call (make-lambda (list arg) #f
-                                               expr)
-                                             (list (make-call-builtin 'peek (list argvec (make-constant i))))))
-                    finally (return expr)))))
-        ((% %lambda args _ body)
-          (define argvec (new-ref))
-          (define nargs (length args))
-          (make-lambda (list argvec) #f
-            (make-if (make-call-builtin 'eq (list (make-call-builtin 'peek (list argvec (make-constant 1)))
-                                                     (make-constant nargs)))
-              (loop for arg in (reverse args)
-                    for i downfrom (+ 1 nargs)
-                    with expr = (argument-conversion body)
-                    do (set! expr (make-call (make-lambda (list arg) #f
-                                               expr)
-                                             (list
-                                               (make-call-builtin 'peek (list argvec (make-constant i))))))
-                    finally (return expr))
-              (make-call (make-library-ref 'wrong-number-of-arguments '(csc based)) (list argvec)))))
-        ((% %letrec in-order? names gensyms exprs body)
-          (make-letrec in-order? names gensyms (map argument-conversion exprs) (argument-conversion body)))
-        (_ (error "Unexpected form in argument-conversion" expr))))
-
-
     ; Update is a CPS expression that is used internally as part of
     ; CPS conversion.
     ; Update expressions are then removed by box-conversion.
@@ -188,11 +107,11 @@
               for value in vals
               if (lambda? value)
                 collect (match value
-                          ((% %lambda args _ body)
+                          ((% %lambda args body)
                             (define continuation (new-ref))
                             (make-closure
                               (make-lexical-ref name gensym)
-                              (cons continuation args)
+                              (list continuation args)
                               (to-cps
                                 body
                                 (lambda (z)
@@ -249,7 +168,7 @@
                     alternate
                     (lambda (result)
                       (make-apply continuation-ref (list result)))))))))
-        ((% %call proc (arg))
+        ((% %call proc args)
           (define return-address (new-ref))
           (define result (new-ref))
           (make-fix
@@ -258,29 +177,32 @@
               proc
               (lambda (f)
                 (to-cps
-                  arg
+                  (loop for arg in (reverse args)
+                        with arglist = (make-constant '())
+                        do (set! arglist (make-call-builtin 'cons (list arg arglist)))
+                        finally (return arglist))
                   (lambda (v)
                     (make-apply f (list return-address v))))))))
         ((% %call-builtin 'call-with-current-continuation (proc))
           (define return-address (new-ref))
-          (define result (new-ref))
-          (define argvec (new-ref))
+          (define current-continuation (new-ref))
+          (define result1 (new-ref))
+          (define result2 (new-ref))
+          (define arglist (new-ref))
           (make-fix
-            (list (make-closure return-address (list result)
-                    (continuation result)))
-            (make-primitive 'alloc (list (make-constant 3)) (list argvec)
-              (make-primitive 'poke (list (make-constant 0) argvec (make-constant 0)) '()
-                (make-primitive 'poke (list (make-constant 1) argvec (make-constant 1)) '()
-                  (make-primitive 'poke (list return-address argvec (make-constant 2)) '()
-                    (to-cps proc
-                      (lambda (f)
-                        (make-apply f (list return-address argvec))))))))))
+            (list (make-closure return-address (list result1)
+                    (continuation result1))
+                  (make-closure current-continuation (list k-unused result2)
+                    (make-apply return-address (list result2))))
+            (make-primitive 'cons (list current-continuation (make-constant '())) (list arglist)
+              (to-cps proc
+                (lambda (f)
+                  (make-apply f (list return-address arglist)))))))
         ((% %call-builtin 'call-with-values (producer consumer))
           (define return-address (new-ref))
           (define consumer-func (new-ref))
           (define result (new-ref))
           (define results (new-ref))
-          (define argvec (new-ref))
           (make-fix
             (list (make-closure return-address (list result)
                     (continuation result))
@@ -288,14 +210,21 @@
                     (to-cps consumer
                       (lambda (c)
                         (make-apply c (list return-address results))))))
-            (make-primitive 'alloc (list (make-constant 2)) (list argvec)
-              (make-primitive 'poke (list (make-constant 0) argvec (make-constant 0)) '()
-                (make-primitive 'poke (list (make-constant 0) argvec (make-constant 1)) '()
-                  (to-cps producer
-                    (lambda (p)
-                      (make-apply p (list consumer-func argvec)))))))))
+            (to-cps producer
+              (lambda (p)
+                (make-apply p (list consumer-func (make-constant '())))))))
         ((% %call-builtin 'apply (proc args))
-          (to-cps (make-call proc (list args)) continuation))
+          (define return-address (new-ref))
+          (define result (new-ref))
+          (make-fix
+            (list (make-closure return-address (list result) (continuation result)))
+            (to-cps
+              proc
+              (lambda (f)
+                (to-cps
+                  args
+                  (lambda (l)
+                    (make-apply f (list return-address l))))))))
         ((% %call-builtin op args)
           (define returns-value? (not (memq op '(poke exit))))
           (loop for arg in (reverse args)
@@ -320,12 +249,12 @@
               (to-cps
                 tail
                 continuation))))
-        ((% %lambda (arg) _ body)
+        ((% %lambda args body)
           (define f (new-ref))
           (define k (new-ref))
           (make-fix
             (list
-              (make-closure f (list k arg)
+              (make-closure f (list k args)
                 (to-cps
                   body
                   (lambda (ret)
@@ -384,7 +313,8 @@
         ((% %fix funs body)
           (loop with m = (get-boxed body)
                 for fun in funs
-                do (set! m (merge m (get-boxed (closure-body fun))))
+                do (set! m (merge m (get-boxed
+                                      (closure-body fun))))
                 finally (return m)))
         (_ (error "Unexpected form in get-boxed" expr))))
 
@@ -477,9 +407,7 @@
 
     (define (ir1->ir2 expr continuation)
       (box-conversion
-        (to-cps
-          (argument-conversion expr)
-          continuation)))
+        (to-cps expr continuation)))
 
 
     (define (hoist expr)