Merge pull request #252 from picrin-scheme/escape-continuation

make benz's call/cc accessible from picrin
picrin-scheme · Jan 26, 2015 · 4c3a9fe · 4c3a9fe
2 parents 58f856a + 7d772fc
commit 4c3a9fe
Show file tree

Hide file tree

Showing 3 changed files with 23 additions and 0 deletions.
diff --git a/contrib/03.callcc/callcc.c b/contrib/03.callcc/callcc.c
@@ -287,6 +287,10 @@ pic_callcc_callcc(pic_state *pic)
 void
 pic_init_callcc(pic_state *pic)
 {
+  pic_deflibrary (pic, "(picrin control)") {
+    pic_define(pic, "escape", pic_ref(pic, pic->PICRIN_BASE, "call-with-current-continuation"));
+  }
+
   pic_deflibrary (pic, "(scheme base)") {
     pic_redefun(pic, pic->PICRIN_BASE, "call-with-current-continuation", pic_callcc_callcc);
     pic_redefun(pic, pic->PICRIN_BASE, "call/cc", pic_callcc_callcc);

diff --git a/contrib/10.partcont/docs/doc.rst b/contrib/10.partcont/docs/doc.rst
@@ -6,3 +6,6 @@ Delimited control operators.
 - **(reset h)**
 - **(shift k)**
 
+Escape Continuation
+
+- **(escape f)**
diff --git a/t/escape.scm b/t/escape.scm
@@ -0,0 +1,16 @@
+(import (scheme base)
+		(picrin control)
+        (picrin test))
+
+(test-begin)
+
+(test 1 (escape (lambda (exit) (begin (exit 1) 2))))
+
+(define cont #f)
+
+(test "calling dead escape continuation"
+	  (guard (c ((error-object? c) (error-object-message c)))
+			 (escape (lambda (exit) (set! cont exit)))
+			 (cont 3)))
+
+(test-end)