#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)