summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-04 14:14:25 +0800
committerLudovic Courtès <ludo@gnu.org>2013-04-05 22:54:14 +0200
commit55e26a49dbc5fa7ccbf218305d88b0b37db4db3f (patch)
tree39c618a29dc54a15d5c5c757430d89c01071886b
parentd888b531681c8528a2daafe0bea70c0a42313da6 (diff)
downloadguile-55e26a49dbc5fa7ccbf218305d88b0b37db4db3f.tar.gz
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.
-rw-r--r--doc/ref/api-control.texi49
-rw-r--r--module/ice-9/control.scm32
-rw-r--r--module/ice-9/futures.scm11
-rw-r--r--test-suite/tests/control.test30
4 files changed, 107 insertions, 15 deletions
diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi
index 320812dfb..278a03dcb 100644
--- a/doc/ref/api-control.texi
+++ b/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
diff --git a/module/ice-9/control.scm b/module/ice-9/control.scm
index 5f25738fa..3eb71a483 100644
--- a/module/ice-9/control.scm
+++ b/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 ...))
diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm
index 35a36ca59..90bbe53ff 100644
--- a/module/ice-9/futures.scm
+++ b/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.
diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test
index 1c30b9c07..5b292c4df 100644
--- a/test-suite/tests/control.test
+++ b/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"