Add builtin operations to IR1.

1 files changed, 28 insertions, 14 deletions

diff --git a/csc/cps.csc b/csc/cps.csc
index a5b7d3b..d8cd8bd 100644
--- a/csc/cps.csc
+++ b/csc/cps.csc
@@ -15,6 +15,7 @@
             merge)
           (only (csc ir1)
             %call
+            %call-builtin
             %define-syntax
             %if
             %lambda
@@ -161,20 +162,33 @@
               (lambda (f)
                 ; Technically the order of evaluation is unspecified.
                 ; We evaluate expressions left to right.
-                ;
-                ; I would use the loop macro, but it mutates the loop
-                ; variables which plays badly with building a lambda.
-                (let loop ((args* (reverse args))
-                           (exprs (lambda (vals)
-                                    (make-apply f (cons return-address (reverse vals))))))
-                  (if (null? args*)
-                    (exprs '())
-                    (loop (cdr args*)
-                          (lambda (vals)
-                            (to-cps
-                              (car args*)
-                              (lambda (val)
-                                (exprs (cons val vals))))))))))))
+                (loop for arg in (reverse args)
+                      with expr = (lambda (vals)
+                                    (make-apply f (cons return-address (reverse vals))))
+                      do (set! expr (let ((e* expr)
+                                          (arg* arg)) ; make copies to avoid modifying the expr in the closure.
+                                      (lambda (vals)
+                                        (to-cps arg*
+                                          (lambda (val)
+                                            (e* (cons val vals)))))))
+                      finally (return (expr '())))))))
+        ((% %call-builtin op args)
+          (define returns-value? (not (symbol=? op 'poke)))
+          (loop for arg in (reverse args)
+                with expr = (lambda (vals)
+                              (if returns-value?
+                                (let ((result (new-ref)))
+                                  (make-primitive op (reverse vals) (list result)
+                                    (continuation result)))
+                                (make-primitive op (reverse vals) '()
+                                  (continuation (make-constant #f)))))
+                do (set! expr (let ((e* expr)
+                                    (arg* arg))
+                                (lambda (vals)
+                                  (to-cps arg*
+                                    (lambda (val)
+                                      (e* (cons val vals)))))))
+                finally (return (expr '()))))
         ((% %sequence head tail)
           (to-cps
             head