Skip to content

Instantly share code, notes, and snippets.

@ast-hugger
Last active October 7, 2022 22:59
Show Gist options
  • Save ast-hugger/79738ad20d24fff826854268da44078d to your computer and use it in GitHub Desktop.
Save ast-hugger/79738ad20d24fff826854268da44078d to your computer and use it in GitHub Desktop.
Delimited continuations in terms of call/cc
;; Delimited continuations
#lang racket ; but will work in any Scheme (without this line)
;; There are other implementations along the same lines floating around.
;; Here we are trying to paint a more comprehensible (or at least a less
;; incomprehensible) picture by structuring the implementation as three
;; distinct layers:
;; Layer 1
;;
;; The "stackable labels" mechanism. Introduces 'label!' and 'jump!' control
;; primitives similar in spirit to the common labels and gotos. The difference
;; is that labels and jumps are not labeled. Instead, there is an implicit stack
;; of labels. A label is pushed onto it when a 'label!' expression is evaluated.
;; A 'jump!' pops the top label off the stack and jumps to it, in effect
;; returning from the 'label!' expression that set the label. The 'jump!'
;; expression itself never returns.
(define labels '())
;; The stack can also be implemented as a variable bound to a wrapper closure which
;; rebinds it to the previous closure and then invokes the wrapped continuation.
;; But a mundane stack of cons cells is more instructive and easy to examine.
(define-syntax label!
(syntax-rules ()
((push-label! expr)
(call-with-current-continuation
(lambda (k)
(set! labels (cons k labels))
expr)))))
(define (jump! v)
(let ((k (car labels)))
(set! labels (cdr labels))
(k v)))
;; Layer 2
;;
;; Effectively shift and reset, cast as higher-order functions
;; shift/0 and reset/0 to separate the actual control logic from the
;; delaying of evaluation required by the real shift and reset.
(define (reset/0 body)
(label! (jump! (body))))
(define (shift/0 body)
(call-with-current-continuation
(lambda (k)
(jump! (body (escaper k))))))
(define (escaper k)
(lambda (v)
(label! (k v))))
;; Layer 3
;;
;; The actual shift and reset--straightforward and ultimately unimportant.
(define-syntax reset
(syntax-rules ()
((reset e ...) (reset/0 (lambda () e ...)))))
(define-syntax shift
(syntax-rules ()
((shift r e ...) (shift/0 (lambda (r) e ...)))))
;; Examples
(define (ex1) ; should be 7
(reset (+ 3 4)))
(define (ex2) ; should be 4
(reset (+ 3 (shift k 4))))
(define (ex3) ; should be 7
(reset (+ 3 (shift k (k 4)))))
(define (ex4) ; should be 12
(* 2 (reset (+ 1 (shift k (k 5))))))
(define (ex5) ; should be 16
(reset (* 2 (shift k (k (k 4))))))
(define (ex6) ; should be 14
(reset (* 2 (shift k (+ (k 3) (k 4))))))
(define (ex7) ; should display a12b12
(reset
(display (shift k (k "a") (k "b")))
(display (shift k (k 1) (k 2)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment