fix evaluation of bound variable continuationsHEADmaster

2 files changed, 20 insertions, 4 deletions

diff --git a/cps.scm b/cps.scm
index d859a8b..2061e1d 100644
--- a/cps.scm
+++ b/cps.scm
@@ -306,14 +306,22 @@
 
 (define prompt? integer?)
 
+(define special-values '(__toplevel __unwind))
 (define (eval-cps dynenv lexenv tmpenv expr)
   (define envs
     (mapping-union tmpenv lexenv dynenv))
   (define (throw-error msg . others)
-    (apply error msg dynenv lexenv tmpenv expr others))
+    (apply error msg
+           (mapping->alist dynenv)
+           (mapping->alist lexenv)
+           (mapping->alist tmpenv)
+           (cps->sexpr expr)
+           others))
   (define (lookup key)
-    (mapping-ref envs key
-                 (cut throw-error "invalid key")))
+    (if (memq key special-values)
+        key
+        (mapping-ref envs key
+                     (cut throw-error "invalid key" key))))
   (define (eval-simple expr)
     (cond
       ((symbol? expr) (lookup expr))
@@ -366,7 +374,7 @@
       (else (throw-error "invalid procedure" proc))))
   (cond-thunk
     (receive-ct (args metakont kont) (cps-apply-kont=> expr)
-      (eval-kont kont
+      (eval-kont (eval-simple kont)
                  (eval-args args)
                  (eval-simple metakont)))
     (receive-ct (proc args metakont kont) (cps-apply=> expr)
diff --git a/test.scm b/test.scm
index 978746d..1601329 100644
--- a/test.scm
+++ b/test.scm
@@ -135,3 +135,11 @@
         '(''#f)
         (e1 '''#f)))
 
+(test-group "procedures"
+  (test-assert "closure"
+               (cps-closure?
+                (car (e1 '(lambda (x) x)))))
+  (test "apply closure"
+        '(5)
+        (e1 '((lambda (x) x) 5))))
+