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