More CPS.

1 files changed, 23 insertions, 0 deletions

diff --git a/csc/cps.csc b/csc/cps.csc
index 26e0591..e60e198 100644
--- a/csc/cps.csc
+++ b/csc/cps.csc
@@ -8,6 +8,11 @@
             merge)
           (only (csc ir1)
             constant?
+            define-syntax?
+            if-alternate
+            if-consequent
+            if-test
+            if?
             lexical-ref?
             lexical-set-expression
             lexical-set-ref
@@ -20,6 +25,7 @@
             make-lexical-ref)
           (only (csc ir2)
             make-atom
+            make-branch
             make-kargs
             make-ktail
             make-update)
@@ -62,6 +68,23 @@
               (make-soup (cons id (make-kargs (list ref)
                                     (make-update (library-define-ref expr) ref continuation))))
               (to-cps (library-define-expression expr) id next-id))))
+        ((define-syntax? expr)
+          ; no-op
+          (values (make-atom (make-constant #f) continuation) (make-soup)))
+        ((if? expr)
+          (let-values (((id) (next-id))
+                       ((test-ref) (new-ref))
+                       ((true-id) (next-id))
+                       ((false-id) (next-id))
+                       ((true-expr true-soup) (to-cps (if-consequent expr) continuation next-id))
+                       ((false-expr false-soup) (to-cps (if-alternate expr) continuation next-id)))
+            (cps-merge
+              (merge true-soup false-soup
+                (make-soup (cons id (make-kargs (list test-ref)
+                                      (make-branch test-ref true-id false-id)))
+                           (cons true-id (make-kargs '() true-expr))
+                           (cons false-id (make-kargs '() false-expr))))
+              (to-cps (if-test expr) id next-id))))
         (else (error "unexpected type in to-cps" expr))))