Skip to content

Instantly share code, notes, and snippets.

@tonyg
Last active September 21, 2024 20:01
Show Gist options
  • Save tonyg/1e1c7d03ad21bad37419123b31ff6f47 to your computer and use it in GitHub Desktop.
Save tonyg/1e1c7d03ad21bad37419123b31ff6f47 to your computer and use it in GitHub Desktop.
#lang racket

Detecting Tail Position With Respect To A Prompt Tag

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)
#lang racket
;;;
;;; # Detecting Tail Position With Respect To A Prompt Tag
;;;
;;; 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment