correctly pass closures in an argument list

2 files changed, 21 insertions, 17 deletions

diff --git a/cps.scm b/cps.scm
index e0f5daf..d859a8b 100644
--- a/cps.scm
+++ b/cps.scm
@@ -112,27 +112,29 @@
 
 (define (cps->sexpr form)
   (cond-thunk
-    (after ((let (cps-kappa=> form) => (metakont formal cps-cmd)))
+    (receive-ct (metakont formal cps-cmd) (cps-kappa=> form)
       `(kappa ,formal ,metakont ,(cps->sexpr cps-cmd)))
-    (after ((let (cps-closure=> form)
-              => (formal metakont-formal kont-formal body)))
+    (receive-ct (formal metakont-formal kont-formal body)
+                (cps-closure=> form)
       `(lambda ((,metakont-formal ,kont-formal) ,formal)
          ,(cps->sexpr body)))
-    (after ((let (cps-apply-kont=> form) => (args metakont kont)))
-      (let ((args (if (cps-closure? args)
-                      (cps->sexpr args)
-                      args)))
+    (receive-ct (args metakont kont) (cps-apply-kont=> form)
+      (let ((args (if (symbol? args)
+                      args
+                      (map cps->sexpr args))))
         `(pass ,args ,metakont ,(cps->sexpr kont))))
-    (after ((let (cps-apply=> form) => (proc args metakont kont)))
-      `(apply ,proc ,args ,metakont ,(cps->sexpr kont)))
-    (after ((let (cps-if=> form)
-              => (conditional on-true on-false metakont kont)))
+    (receive-ct (proc args metakont kont) (cps-apply=> form)
+      (let ((args (if (symbol? args)
+                      args
+                      (map cps->sexpr args))))
+        `(apply ,proc ,args ,metakont ,(cps->sexpr kont))))
+    (receive-ct (conditional on-true on-false metakont kont) (cps-if=> form)
       `(if conditional
            ,(cps->sexpr on-true)
            ,(cps->sexpr on-false)
            metakont
            ,(cps->sexpr kont)))
-    (when-ct (or (self-evaluating? form) (symbol? form))
+    (receive-ct _ (simple-evaluate=> form)
       form)
     (else (error "invalid form" form))))
 
@@ -218,8 +220,9 @@
         (let ((metakont-formal (gensym "γ"))
               (return-kont (gensym "κ")))
           (cps-apply-kont
-           (cps-closure formal metakont-formal return-kont
-                        (core->cps expr metakont-formal return-kont))
+           (list
+            (cps-closure formal metakont-formal return-kont
+                         (core->cps expr metakont-formal return-kont)))
            metakont
            kont)))
       ;; (if e e e)
diff --git a/test.scm b/test.scm
index 197b5d0..978746d 100644
--- a/test.scm
+++ b/test.scm
@@ -66,11 +66,11 @@
 
 (test-group "lambda syntax"
   (test "identity"
-        '(pass (lambda ((__γ1 __κ2) (x)) (pass (x) __γ1 __κ2)) () __toplevel)
+        '(pass ((lambda ((__γ1 __κ2) (x)) (pass (x) __γ1 __κ2))) () __toplevel)
         (cps->sexpr (core->cps '(lambda (x) x))))
   (test "let bind"
-        '(pass (lambda ((__γ3 __κ4) (x))
-               (pass (x) __γ3 __κ4)) ()
+        '(pass ((lambda ((__γ3 __κ4) (x))
+                  (pass (x) __γ3 __κ4))) ()
                (kappa (__v2) __γ1
                       (apply __v2 (y) __γ1 __toplevel)))
         (cps->sexpr (core->cps '((lambda (x) x) y)))))
@@ -134,3 +134,4 @@
   (test "multiple quotes on a constant"
         '(''#f)
         (e1 '''#f)))
+