Add call/ec' and let/ec'.

Based on a patch by Nala Ginrut <nalaginrut@gmail.com>,
with suggestions from Mark H. Weaver.

* module/ice-9/control.scm (call-with-escape-continuation, call/ec): New
  procedures.
  (let-escape-continuation, let/ec): New macros.
* module/ice-9/futures.scm (let/ec): Remove.
* test-suite/tests/control.test ("escape-only continuations")["call/ec",
  "let/ec"]: New tests.
* doc/ref/api-control.texi (Prompt Primitives): Document `call/ec',
  `let/ec', and their long names.

doc/ref/api-control.texi

@@ -574,9 +574,56 @@ both.
 
 Before moving on, we should mention that if the handler of a prompt is a
 @code{lambda} expression, and the first argument isn't referenced, an abort to
-that prompt will not cause a continuation to be reified. This can be an
+that prompt will not cause a continuation to be reified.  This can be an
 important efficiency consideration to keep in mind.
 
+@cindex continuation, escape
+One example where this optimization matters is @dfn{escape
+continuations}.  Escape continuations are delimited continuations whose
+only use is to make a non-local exit---i.e., to escape from the current
+continuation.  Such continuations are invoked only once, and for this
+reason they are sometimes called @dfn{one-shot continuations}.
+
+The constructs below are syntactic sugar atop prompts to simplify the
+use of escape continuations.
+
+@deffn {Scheme Procedure} call-with-escape-continuation proc
+@deffnx {Scheme Procedure} call/ec proc
+Call @var{proc} with an escape continuation.
+
+In the example below, the @var{return} continuation is used to escape
+the continuation of the call to @code{fold}.
+
+@lisp
+(use-modules (ice-9 control)
+             (srfi srfi-1))
+
+(define (prefix x lst)
+  ;; Return all the elements before the first occurrence
+  ;; of X in LST.
+  (call/ec
+    (lambda (return)
+      (fold (lambda (element prefix)
+              (if (equal? element x)
+                  (return (reverse prefix))  ; escape `fold'
+                  (cons element prefix)))
+            '()
+            lst))))
+
+(prefix 'a '(0 1 2 a 3 4 5))
+@result{} (0 1 2)
+@end lisp
+@end deffn
+
+@deffn {Scheme Syntax} let-escape-continuation k body @dots{}
+@deffnx {Scheme Syntax} let/ec k body @dots{}
+Bind @var{k} within @var{body} to an escape continuation.
+
+This is equivalent to
+@code{(call/ec (lambda (@var{k}) @var{body} @dots{}))}.
+@end deffn
+
+
 @node Shift and Reset
 @subsubsection Shift, Reset, and All That
 

module/ice-9/control.scm

@@ -1,6 +1,6 @@
 ;;; Beyond call/cc
 
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -21,7 +21,9 @@
 (define-module (ice-9 control)
   #:re-export (call-with-prompt abort-to-prompt
                default-prompt-tag make-prompt-tag)
-  #:export (% abort shift reset shift* reset*))
+  #:export (% abort shift reset shift* reset*
+            call-with-escape-continuation call/ec
+            let-escape-continuation let/ec))
 
 (define (abort . args)
   (apply abort-to-prompt (default-prompt-tag) args))
@@ -76,3 +78,29 @@
 
 (define (shift* fc)
   (shift c (fc c)))
+
+(define (call-with-escape-continuation proc)
+  "Call PROC with an escape continuation."
+  (let ((tag (list 'call/ec)))
+    (call-with-prompt tag
+                      (lambda ()
+                        (proc (lambda args
+                                (apply abort-to-prompt tag args))))
+                      (lambda (_ . args)
+                        (apply values args)))))
+
+(define call/ec call-with-escape-continuation)
+
+(define-syntax-rule (let-escape-continuation k body ...)
+  "Bind K to an escape continuation within the lexical extent of BODY."
+  (let ((tag (list 'let/ec)))
+    (call-with-prompt tag
+                      (lambda ()
+                        (let ((k (lambda args
+                                   (apply abort-to-prompt tag args))))
+                          body ...))
+                      (lambda (_ . results)
+                        (apply values results)))))
+
+(define-syntax-rule (let/ec k body ...)
+  (let-escape-continuation k body ...))

module/ice-9/futures.scm

@@ -23,6 +23,7 @@
   #:use-module (srfi srfi-11)
   #:use-module (ice-9 q)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 control)
   #:export (future make-future future? touch))
 
 ;;; Author: Ludovic Courtès <ludo@gnu.org>
@@ -105,16 +106,6 @@ touched."
       (lambda () (begin e0 e1 ...))
       (lambda () (unlock-mutex x)))))
 
-(define-syntax-rule (let/ec k e e* ...)           ; TODO: move to core
-  (let ((tag (make-prompt-tag)))
-    (call-with-prompt
-     tag
-     (lambda ()
-       (let ((k (lambda args (apply abort-to-prompt tag args))))
-         e e* ...))
-     (lambda (_ res) res))))
-
-
 (define %future-prompt
   ;; The prompt futures abort to when they want to wait for another
   ;; future.

test-suite/tests/control.test

@@ -1,7 +1,7 @@
 ;;;;                                                          -*- scheme -*-
 ;;;; control.test --- test suite for delimited continuations
 ;;;;
-;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -20,6 +20,7 @@
 (define-module (test-suite test-control)
   #:use-module (ice-9 control)
   #:use-module (system vm vm)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (test-suite lib))
 
@@ -77,7 +78,32 @@
                  (abort 'foo 'bar 'baz)
                  (error "unexpected exit"))
                (lambda (k . args)
-                 args)))))
+                 args))))
+
+  (pass-if-equal "call/ec" '(0 1 2)            ; example from the manual
+    (let ((prefix
+           (lambda (x lst)
+             (call/ec
+              (lambda (return)
+                (fold (lambda (element prefix)
+                        (if (equal? element x)
+                            (return (reverse prefix))
+                            (cons element prefix)))
+                      '()
+                      lst))))))
+      (prefix 'a '(0 1 2 a 3 4 5))))
+
+  (pass-if-equal "let/ec" '(0 1 2)
+    (let ((prefix
+           (lambda (x lst)
+             (let/ec return
+               (fold (lambda (element prefix)
+                       (if (equal? element x)
+                           (return (reverse prefix))
+                           (cons element prefix)))
+                     '()
+                     lst)))))
+      (prefix 'a '(0 1 2 a 3 4 5)))))
 
 ;;; And the case in which the compiler has to reify the continuation.
 (with-test-prefix/c&e "reified continuations"