#lang racket
Uses continuation marks to inspect the "size" of the delimited continuation.
(require racket/control)
Here is the prompt tag we will be using throughout the example. A library would probably abstract over the particular tag concerned.
(define tag (make-continuation-prompt-tag 'syndicate))
We use this prompt tag in two ways:
- as a prompt tag, to delimit the continuation
- as a continuation-mark key, to place a marker at the outermost frame in the delimited continuation indicating exactly that it is the outermost frame.
We place the value #t
as the marker, so that
call-with-immediate-continuation-mark
passes #t
to its proc
argument exactly when we are in tail position with respect to the
placed continuation mark, and passes #f
otherwise.
This routine checks to see whether we are in the delimited environment at all.
(define (available?)
(continuation-prompt-available? tag))
This is our action. It has three cases:
-
We may be outside the dynamic extent of the prompt tag. In many situations, this would be an error.
-
We may be in tail position with respect to the prompt tag.
-
We may be in non-tail position with respect to the prompt tag.
In the latter two cases, we compute an "effect instruction" to send to our context; and in the last case, we include a captured partial continuation, to be used to continue execution "later".
(define (do-thing arg)
(if (not (available?))
(begin (printf "~a: Outside the handler\n" arg)
'outside-the-handler)
(call-with-immediate-continuation-mark
tag
(lambda (tail?)
(if tail?
(begin (printf "~a: Tail position\n" arg)
(list 'done arg))
(call-with-composable-continuation
(lambda (k)
(abort/cc tag (lambda ()
(printf "~a: Not tail position\n" arg)
(list 'more arg k))))
tag))))))
This is the program we will execute.
The first two calls to do-thing
will be detected as non-tail;
the last, as tail.
(define (script)
(do-thing 1)
(do-thing 2)
(do-thing 3))
First, ensure that detection of being outside the dynamic extent of the prompt works:
(do-thing 0)
Now, start an "effect handler" loop that runs our script
,
interpreting the "effect instructions" it sends us, some of which
will include continuations for producing further computations and
effects.
(let loop ((instruction
(call-with-continuation-prompt
(lambda ()
(with-continuation-mark tag #t
(script)))
tag)))
(printf "Interpreting instruction: ~v\n" instruction)
(match instruction
[(list 'done final-answer)
(printf "Done; final answer: ~a\n" final-answer)]
[(list 'more partial-answer k)
(printf "More to do: partial answer: ~a\n" partial-answer)
(loop (call-with-continuation-prompt (lambda () (k (void))) tag))]))
Finally, just check again that we're properly outside the dynamic extent of the prompt tag.
(do-thing 4)