racket/control: Racketize & remove trailing whitespace
original commit: ed9c612cae3ac53984445fbe6731ca0870915932
This commit is contained in:
Asumu Takikawa
parent
9b7e9c5feb
commit
3f831d6f4b
|
|
@ -1,268 +1,268 @@
|
||||||
(module control racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require (for-syntax racket/base))
|
(require (for-syntax racket/base))
|
||||||
|
|
||||||
(provide call/prompt call/comp abort/cc
|
(provide call/prompt call/comp abort/cc
|
||||||
|
|
||||||
abort
|
abort
|
||||||
|
|
||||||
fcontrol %
|
|
||||||
|
|
||||||
control prompt control-at prompt-at
|
fcontrol %
|
||||||
;; `-at' variations expect a prompt tag
|
|
||||||
|
|
||||||
shift reset shift-at reset-at
|
control prompt control-at prompt-at
|
||||||
|
;; `-at' variations expect a prompt tag
|
||||||
|
|
||||||
control0 prompt0 control0-at prompt0-at
|
shift reset shift-at reset-at
|
||||||
shift0 reset0 shift0-at reset0-at
|
|
||||||
|
|
||||||
spawn
|
|
||||||
|
|
||||||
splitter
|
control0 prompt0 control0-at prompt0-at
|
||||||
|
shift0 reset0 shift0-at reset0-at
|
||||||
|
|
||||||
new-prompt set cupto)
|
spawn
|
||||||
|
|
||||||
;; ----------------------------------------
|
splitter
|
||||||
|
|
||||||
(define call/prompt call-with-continuation-prompt)
|
new-prompt set cupto)
|
||||||
(define call/comp call-with-composable-continuation)
|
|
||||||
(define abort/cc abort-current-continuation)
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(define (abort . vals)
|
(define call/prompt call-with-continuation-prompt)
|
||||||
(abort-current-continuation
|
(define call/comp call-with-composable-continuation)
|
||||||
(default-continuation-prompt-tag)
|
(define abort/cc abort-current-continuation)
|
||||||
(lambda () (apply values vals))))
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
;; Sitaram, PLDI'93
|
|
||||||
;; The `%' here is compable with Sitaram & Felleisen, LSC'90,
|
|
||||||
;; since we make the handler optional.
|
|
||||||
|
|
||||||
(define (fcontrol f #:tag [prompt-tag (default-continuation-prompt-tag)])
|
(define (abort . vals)
|
||||||
(call-with-composable-continuation
|
(abort-current-continuation
|
||||||
(lambda (k)
|
(default-continuation-prompt-tag)
|
||||||
(abort-current-continuation
|
(lambda () (apply values vals))))
|
||||||
prompt-tag
|
|
||||||
f
|
|
||||||
k))))
|
|
||||||
|
|
||||||
(define-syntax %
|
;; ----------------------------------------
|
||||||
(syntax-rules ()
|
;; Sitaram, PLDI'93
|
||||||
[(_ expr handler #:tag prompt-tag)
|
;; The `%' here is compable with Sitaram & Felleisen, LSC'90,
|
||||||
(call-with-continuation-prompt
|
;; since we make the handler optional.
|
||||||
(lambda () expr)
|
|
||||||
prompt-tag
|
|
||||||
handler)]
|
|
||||||
[(_ expr handler)
|
|
||||||
(call-with-continuation-prompt
|
|
||||||
(lambda () expr)
|
|
||||||
(default-continuation-prompt-tag)
|
|
||||||
handler)]
|
|
||||||
[(_ expr)
|
|
||||||
(call-with-continuation-prompt
|
|
||||||
(lambda () expr))]))
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
(define (fcontrol f #:tag [prompt-tag (default-continuation-prompt-tag)])
|
||||||
;; Predecessors of Sitaram, PLDI'93
|
(call-with-composable-continuation
|
||||||
;; Felleisen, Wand, Friedman, & Duba, LFP'88
|
(lambda (k)
|
||||||
;; Instead of `#', we use `prompt' as in Felleisen, POPL'88
|
(abort-current-continuation
|
||||||
;; (where `control' is called `F')
|
prompt-tag
|
||||||
;; See also Sitaram and Felleisen, LSC'90
|
f
|
||||||
|
k))))
|
||||||
|
|
||||||
;; Helpder function: abort-current-continuation/keep-prompt is
|
(define-syntax %
|
||||||
;; like abort-current-continuation, but it always leaves the
|
(syntax-rules ()
|
||||||
;; prompt in place, independent of the prompt's handler.
|
[(_ expr handler #:tag prompt-tag)
|
||||||
;; This is possible via call/cc (i.e., it must be possible
|
(call-with-continuation-prompt
|
||||||
;; to abort and keep a prompt, because call/cc needs it).
|
(lambda () expr)
|
||||||
(define (abort-current-continuation/keep-prompt tag thunk)
|
prompt-tag
|
||||||
((call-with-continuation-prompt
|
handler)]
|
||||||
(lambda ()
|
[(_ expr handler)
|
||||||
((call-with-current-continuation
|
(call-with-continuation-prompt
|
||||||
(lambda (k) (lambda () k))
|
(lambda () expr)
|
||||||
tag)))
|
(default-continuation-prompt-tag)
|
||||||
tag)
|
handler)]
|
||||||
thunk))
|
[(_ expr)
|
||||||
|
(call-with-continuation-prompt
|
||||||
|
(lambda () expr))]))
|
||||||
|
|
||||||
;; call-with-control, parameterized over whether to keep the
|
;; ----------------------------------------
|
||||||
;; prompt (if the prompt's handler gives us the option of
|
;; Predecessors of Sitaram, PLDI'93
|
||||||
;; removing it). The generated function is the same
|
;; Felleisen, Wand, Friedman, & Duba, LFP'88
|
||||||
;; as fcontrol when `abort-cc' is `abort-current-continuation'.
|
;; Instead of `#', we use `prompt' as in Felleisen, POPL'88
|
||||||
(define (make-call-with-control abort-cc)
|
;; (where `control' is called `F')
|
||||||
;; Uses call/cc to always keep the enclosing prompt.
|
;; See also Sitaram and Felleisen, LSC'90
|
||||||
(letrec ([call-with-control
|
|
||||||
(case-lambda
|
|
||||||
[(f) (call-with-control f (default-continuation-prompt-tag))]
|
|
||||||
[(f tag) (call-with-composable-continuation
|
|
||||||
(lambda (k)
|
|
||||||
(abort-cc
|
|
||||||
tag
|
|
||||||
(lambda ()
|
|
||||||
(f k))))
|
|
||||||
tag)])])
|
|
||||||
call-with-control))
|
|
||||||
|
|
||||||
(define call-with-control
|
;; Helpder function: abort-current-continuation/keep-prompt is
|
||||||
(make-call-with-control abort-current-continuation/keep-prompt))
|
;; like abort-current-continuation, but it always leaves the
|
||||||
|
;; prompt in place, independent of the prompt's handler.
|
||||||
|
;; This is possible via call/cc (i.e., it must be possible
|
||||||
|
;; to abort and keep a prompt, because call/cc needs it).
|
||||||
|
(define (abort-current-continuation/keep-prompt tag thunk)
|
||||||
|
((call-with-continuation-prompt
|
||||||
|
(lambda ()
|
||||||
|
((call-with-current-continuation
|
||||||
|
(lambda (k) (lambda () k))
|
||||||
|
tag)))
|
||||||
|
tag)
|
||||||
|
thunk))
|
||||||
|
|
||||||
(define-syntax define-control-macros
|
;; call-with-control, parameterized over whether to keep the
|
||||||
(syntax-rules ()
|
;; prompt (if the prompt's handler gives us the option of
|
||||||
[(_ control control-at call-with-control)
|
;; removing it). The generated function is the same
|
||||||
(begin
|
;; as fcontrol when `abort-cc' is `abort-current-continuation'.
|
||||||
(define-syntax (control stx)
|
(define (make-call-with-control abort-cc)
|
||||||
(syntax-case stx ()
|
;; Uses call/cc to always keep the enclosing prompt.
|
||||||
[(control id expr0 expr (... ...))
|
(letrec ([call-with-control
|
||||||
(identifier? #'id)
|
(case-lambda
|
||||||
#'(call-with-control (lambda (id) expr0 expr (... ...)))]))
|
[(f) (call-with-control f (default-continuation-prompt-tag))]
|
||||||
(define-syntax (control-at stx)
|
[(f tag) (call-with-composable-continuation
|
||||||
(syntax-case stx ()
|
(lambda (k)
|
||||||
[(control-at tag id expr0 expr (... ...))
|
(abort-cc
|
||||||
(identifier? #'id)
|
tag
|
||||||
#'(call-with-control (lambda (id) expr0 expr (... ...)) tag)])))]))
|
(lambda ()
|
||||||
|
(f k))))
|
||||||
(define-control-macros control control-at call-with-control)
|
tag)])])
|
||||||
|
call-with-control))
|
||||||
|
|
||||||
(define-syntax define-prompt-macros
|
(define call-with-control
|
||||||
(syntax-rules ()
|
(make-call-with-control abort-current-continuation/keep-prompt))
|
||||||
[(_ prompt prompt-at call-with-prompt)
|
|
||||||
(begin
|
|
||||||
(define-syntax prompt
|
|
||||||
(syntax-rules ()
|
|
||||||
[(prompt expr0 expr (... ...))
|
|
||||||
(call-with-prompt (lambda () expr0 expr (... ...)))]))
|
|
||||||
(define-syntax prompt-at
|
|
||||||
(syntax-rules ()
|
|
||||||
[(prompt-at tag expr0 expr (... ...))
|
|
||||||
(call-with-prompt (lambda () expr0 expr (... ...)) tag)])))]))
|
|
||||||
|
|
||||||
(define-prompt-macros prompt prompt-at call-with-continuation-prompt)
|
(define-syntax define-control-macros
|
||||||
|
(syntax-rules ()
|
||||||
|
[(_ control control-at call-with-control)
|
||||||
|
(begin
|
||||||
|
(define-syntax (control stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(control id expr0 expr (... ...))
|
||||||
|
(identifier? #'id)
|
||||||
|
#'(call-with-control (lambda (id) expr0 expr (... ...)))]))
|
||||||
|
(define-syntax (control-at stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(control-at tag id expr0 expr (... ...))
|
||||||
|
(identifier? #'id)
|
||||||
|
#'(call-with-control (lambda (id) expr0 expr (... ...)) tag)])))]))
|
||||||
|
|
||||||
;; ----------------------------------------
|
(define-control-macros control control-at call-with-control)
|
||||||
;; Danvy & Filinski, LFP'90
|
|
||||||
|
|
||||||
;; call-with-shift, parameterized over whether to keep the prompt
|
(define-syntax define-prompt-macros
|
||||||
;; (if the prompt's handler gives us the option of removing it),
|
(syntax-rules ()
|
||||||
;; and whether the new one is removable:
|
[(_ prompt prompt-at call-with-prompt)
|
||||||
(define (make-call-with-shift abort-cc inserted-handler)
|
(begin
|
||||||
(letrec ([call-with-shift
|
(define-syntax prompt
|
||||||
(case-lambda
|
(syntax-rules ()
|
||||||
[(f) (call-with-shift f (default-continuation-prompt-tag))]
|
[(prompt expr0 expr (... ...))
|
||||||
[(f tag)
|
(call-with-prompt (lambda () expr0 expr (... ...)))]))
|
||||||
(call-with-composable-continuation
|
(define-syntax prompt-at
|
||||||
(lambda (k)
|
(syntax-rules ()
|
||||||
(abort-cc
|
[(prompt-at tag expr0 expr (... ...))
|
||||||
tag
|
(call-with-prompt (lambda () expr0 expr (... ...)) tag)])))]))
|
||||||
(lambda ()
|
|
||||||
(f (lambda vals
|
|
||||||
(call-with-continuation-prompt
|
|
||||||
(lambda ()
|
|
||||||
(apply k vals))
|
|
||||||
tag
|
|
||||||
inserted-handler))))))
|
|
||||||
tag)])])
|
|
||||||
call-with-shift))
|
|
||||||
|
|
||||||
(define call-with-shift
|
(define-prompt-macros prompt prompt-at call-with-continuation-prompt)
|
||||||
(make-call-with-shift abort-current-continuation/keep-prompt #f))
|
|
||||||
|
|
||||||
(define-control-macros shift shift-at call-with-shift)
|
;; ----------------------------------------
|
||||||
|
;; Danvy & Filinski, LFP'90
|
||||||
|
|
||||||
(define-prompt-macros reset reset-at call-with-continuation-prompt)
|
;; call-with-shift, parameterized over whether to keep the prompt
|
||||||
|
;; (if the prompt's handler gives us the option of removing it),
|
||||||
;; ----------------------------------------
|
;; and whether the new one is removable:
|
||||||
;; Shan, SCHEME'04
|
(define (make-call-with-shift abort-cc inserted-handler)
|
||||||
;; Kiselyov, Indiana CS TR-611, 2005
|
(letrec ([call-with-shift
|
||||||
;;
|
(case-lambda
|
||||||
;; The `control0' and `shift0' here are closer to Kiselyov, in that
|
[(f) (call-with-shift f (default-continuation-prompt-tag))]
|
||||||
;; `control0' and `shift0' only behave as in Shan when paired with
|
[(f tag)
|
||||||
;; `prompt0' or `reset0' (which are two names for the same thing).
|
|
||||||
;; When paired with `prompt' or `reset' (again, the same thing),
|
|
||||||
;; they act like `control' and `shift'.
|
|
||||||
;;
|
|
||||||
;; This difference is intentional. The programmer that inserts a
|
|
||||||
;; prompt should choose whether the current continuation is visible
|
|
||||||
;; or not. Note, also, that `control' and `shift' work whether
|
|
||||||
;; they're paired with `prompt'/`reset' or `prompt0'/`reset0'.
|
|
||||||
|
|
||||||
(define call-with-control0
|
|
||||||
;; Uses abort-current-continuation, so that the prompt
|
|
||||||
;; is removed --- if the prompt is willing to be removed.
|
|
||||||
(make-call-with-control abort-current-continuation))
|
|
||||||
|
|
||||||
(define call-with-shift0
|
|
||||||
;; Uses abort-current-continuation, so that the prompt
|
|
||||||
;; is removed --- if the prompt is willing to be removed.
|
|
||||||
;; The prompt installed with the captured continuation is
|
|
||||||
;; itself willing to be removed.
|
|
||||||
(make-call-with-shift abort-current-continuation (lambda (thunk) (thunk))))
|
|
||||||
|
|
||||||
(define-control-macros control0 control0-at call-with-control0)
|
|
||||||
|
|
||||||
(define-control-macros shift0 shift0-at call-with-shift0)
|
|
||||||
|
|
||||||
(define call-with-prompt0
|
|
||||||
(case-lambda
|
|
||||||
[(thunk) (call-with-prompt0 thunk (default-continuation-prompt-tag))]
|
|
||||||
[(thunk tag)
|
|
||||||
(call-with-continuation-prompt thunk tag (lambda (thunk) (thunk)))]))
|
|
||||||
|
|
||||||
(define-prompt-macros prompt0 prompt0-at call-with-prompt0)
|
|
||||||
|
|
||||||
(define-prompt-macros reset0 reset0-at call-with-prompt0)
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
|
||||||
;; Hieb & Dybvig, PPOPP'90
|
|
||||||
|
|
||||||
(define (spawn f)
|
|
||||||
(let ([p (make-continuation-prompt-tag)])
|
|
||||||
(call-with-continuation-prompt
|
|
||||||
(lambda ()
|
|
||||||
(f (lambda (f)
|
|
||||||
(call-with-composable-continuation
|
(call-with-composable-continuation
|
||||||
(lambda (k)
|
(lambda (k)
|
||||||
(abort-current-continuation
|
(abort-cc
|
||||||
p
|
tag
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(f (lambda vals
|
(f (lambda vals
|
||||||
(call-with-continuation-prompt
|
(call-with-continuation-prompt
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(apply k vals))
|
(apply k vals))
|
||||||
p
|
tag
|
||||||
(lambda (thunk) (thunk))))))))
|
inserted-handler))))))
|
||||||
p))))
|
tag)])])
|
||||||
p
|
call-with-shift))
|
||||||
(lambda (thunk) (thunk)))))
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
(define call-with-shift
|
||||||
;; Queinnec & Serpette, POPL'91
|
(make-call-with-shift abort-current-continuation/keep-prompt #f))
|
||||||
|
|
||||||
(define (splitter receiver)
|
(define-control-macros shift shift-at call-with-shift)
|
||||||
(let ([p (make-continuation-prompt-tag)])
|
|
||||||
(call-with-continuation-prompt
|
|
||||||
(lambda ()
|
|
||||||
(receiver (lambda (thunk)
|
|
||||||
(abort-current-continuation
|
|
||||||
p
|
|
||||||
thunk))
|
|
||||||
(lambda (proc)
|
|
||||||
(call-with-composable-continuation
|
|
||||||
proc
|
|
||||||
p))))
|
|
||||||
p
|
|
||||||
(lambda (thunk) (thunk)))))
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
(define-prompt-macros reset reset-at call-with-continuation-prompt)
|
||||||
;; Gunter, Remy, & Rieke, FPLCA'95
|
|
||||||
;; Unfortunately, the "prompt"s in Gunter et al. are what
|
|
||||||
;; we call "prompt tags". In our terminology, a "prompt"
|
|
||||||
;; is a tagged instance in a continuation.
|
|
||||||
|
|
||||||
(define (new-prompt) (make-continuation-prompt-tag))
|
;; ----------------------------------------
|
||||||
|
;; Shan, SCHEME'04
|
||||||
|
;; Kiselyov, Indiana CS TR-611, 2005
|
||||||
|
;;
|
||||||
|
;; The `control0' and `shift0' here are closer to Kiselyov, in that
|
||||||
|
;; `control0' and `shift0' only behave as in Shan when paired with
|
||||||
|
;; `prompt0' or `reset0' (which are two names for the same thing).
|
||||||
|
;; When paired with `prompt' or `reset' (again, the same thing),
|
||||||
|
;; they act like `control' and `shift'.
|
||||||
|
;;
|
||||||
|
;; This difference is intentional. The programmer that inserts a
|
||||||
|
;; prompt should choose whether the current continuation is visible
|
||||||
|
;; or not. Note, also, that `control' and `shift' work whether
|
||||||
|
;; they're paired with `prompt'/`reset' or `prompt0'/`reset0'.
|
||||||
|
|
||||||
(define-syntax set (make-rename-transformer #'prompt0-at))
|
(define call-with-control0
|
||||||
|
;; Uses abort-current-continuation, so that the prompt
|
||||||
|
;; is removed --- if the prompt is willing to be removed.
|
||||||
|
(make-call-with-control abort-current-continuation))
|
||||||
|
|
||||||
(define-syntax cupto (make-rename-transformer #'control0-at))
|
(define call-with-shift0
|
||||||
|
;; Uses abort-current-continuation, so that the prompt
|
||||||
|
;; is removed --- if the prompt is willing to be removed.
|
||||||
|
;; The prompt installed with the captured continuation is
|
||||||
|
;; itself willing to be removed.
|
||||||
|
(make-call-with-shift abort-current-continuation (lambda (thunk) (thunk))))
|
||||||
|
|
||||||
|
(define-control-macros control0 control0-at call-with-control0)
|
||||||
|
|
||||||
|
(define-control-macros shift0 shift0-at call-with-shift0)
|
||||||
|
|
||||||
|
(define call-with-prompt0
|
||||||
|
(case-lambda
|
||||||
|
[(thunk) (call-with-prompt0 thunk (default-continuation-prompt-tag))]
|
||||||
|
[(thunk tag)
|
||||||
|
(call-with-continuation-prompt thunk tag (lambda (thunk) (thunk)))]))
|
||||||
|
|
||||||
|
(define-prompt-macros prompt0 prompt0-at call-with-prompt0)
|
||||||
|
|
||||||
|
(define-prompt-macros reset0 reset0-at call-with-prompt0)
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
;; Hieb & Dybvig, PPOPP'90
|
||||||
|
|
||||||
|
(define (spawn f)
|
||||||
|
(let ([p (make-continuation-prompt-tag)])
|
||||||
|
(call-with-continuation-prompt
|
||||||
|
(lambda ()
|
||||||
|
(f (lambda (f)
|
||||||
|
(call-with-composable-continuation
|
||||||
|
(lambda (k)
|
||||||
|
(abort-current-continuation
|
||||||
|
p
|
||||||
|
(lambda ()
|
||||||
|
(f (lambda vals
|
||||||
|
(call-with-continuation-prompt
|
||||||
|
(lambda ()
|
||||||
|
(apply k vals))
|
||||||
|
p
|
||||||
|
(lambda (thunk) (thunk))))))))
|
||||||
|
p))))
|
||||||
|
p
|
||||||
|
(lambda (thunk) (thunk)))))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
;; Queinnec & Serpette, POPL'91
|
||||||
|
|
||||||
|
(define (splitter receiver)
|
||||||
|
(let ([p (make-continuation-prompt-tag)])
|
||||||
|
(call-with-continuation-prompt
|
||||||
|
(lambda ()
|
||||||
|
(receiver (lambda (thunk)
|
||||||
|
(abort-current-continuation
|
||||||
|
p
|
||||||
|
thunk))
|
||||||
|
(lambda (proc)
|
||||||
|
(call-with-composable-continuation
|
||||||
|
proc
|
||||||
|
p))))
|
||||||
|
p
|
||||||
|
(lambda (thunk) (thunk)))))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
;; Gunter, Remy, & Rieke, FPLCA'95
|
||||||
|
;; Unfortunately, the "prompt"s in Gunter et al. are what
|
||||||
|
;; we call "prompt tags". In our terminology, a "prompt"
|
||||||
|
;; is a tagged instance in a continuation.
|
||||||
|
|
||||||
|
(define (new-prompt) (make-continuation-prompt-tag))
|
||||||
|
|
||||||
|
(define-syntax set (make-rename-transformer #'prompt0-at))
|
||||||
|
|
||||||
|
(define-syntax cupto (make-rename-transformer #'control0-at))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
|
||||||
;; ----------------------------------------
|
|
||||||
)
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user