diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-04-04 14:14:25 +0800 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-04-05 22:54:14 +0200 |
commit | 55e26a49dbc5fa7ccbf218305d88b0b37db4db3f (patch) | |
tree | 39c618a29dc54a15d5c5c757430d89c01071886b | |
parent | d888b531681c8528a2daafe0bea70c0a42313da6 (diff) | |
download | guile-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.texi | 49 | ||||
-rw-r--r-- | module/ice-9/control.scm | 32 | ||||
-rw-r--r-- | module/ice-9/futures.scm | 11 | ||||
-rw-r--r-- | test-suite/tests/control.test | 30 |
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" |