Evaluation Context🔗ℹ

2.1 Typed Racket Definitions🔗ℹ

The following type definitions are provided for use with Typed Racket. They formalize the correspondence between control operators and classical logic.

(define-type ⊥ Nothing)

(define-type (¬ a) (→ a ⊥))

(define-type Label (¬ Label))

This recursive type reflects the fact that goto itself is a Label.

(define-type (LEM a) (∪ a (¬ a)))

3.1 Loop🔗ℹ

A simple counted loop using a first-class label:

(let ([x 0])

(define loop (label))

(set! x (add1 x))

(when (< x 7) (goto loop))

(displayln x))

3.2 Early Return🔗ℹ

Short-circuiting a product computation when a zero is encountered.

Using call/cc:

(define (mul . r*)

(call/cc

(λ (return)

(for/fold ([res (*)] #:result (return res))

([r (in-list r*)])

(if (zero? r)

(return r)

(* res r))))))

Using cc:

(define (mul . r*)

(define result (cc))

(when (continuation? result)

(for/fold ([res (*)] #:result (cc result res))

([r (in-list r*)])

(if (zero? r)

(cc result r)

(* res r))))

result)

Using label and goto:

(define (mul . r*)

(define first? #t)

(define result (*))

(define l (label))

(when first?

(set! first? #f)

(for ([r (in-list r*)])

(when (zero? r)

(set! result r)

(goto l))

(set! result (* result r))))

result)

3.3 Light-Weight Processes🔗ℹ

A simple cooperative multitasking scheduler. Multiple "threads" yield control with pause and are round-robin scheduled through a queue.

Using call/cc:

(let ([lwp-queue (make-queue)])

(define (lwp thk)

(enqueue! lwp-queue thk))

(define (start)

(when (non-empty-queue? lwp-queue)

((dequeue! lwp-queue))))

(define (pause)

(call/cc

(λ (k)

(enqueue! lwp-queue (λ () (k #f)))

(start))))

(lwp (λ () (let f () (pause) (display #\h) (f))))

(lwp (λ () (let f () (pause) (display #\e) (f))))

(lwp (λ () (let f () (pause) (display #\y) (f))))

(lwp (λ () (let f () (pause) (display #\!) (f))))

(lwp (λ () (let f () (pause) (newline)     (f))))

(start))

Using cc:

(let ([lwp-queue (make-queue)])

(define (lwp thk)

(enqueue! lwp-queue thk))

(define (start)

(when (non-empty-queue? lwp-queue)

((dequeue! lwp-queue))))

(define (pause)

(define k (cc))

(when k

(enqueue! lwp-queue (λ () (cc k #f)))

(start)))

(lwp (λ () (let f () (pause) (display #\h) (f))))

(lwp (λ () (let f () (pause) (display #\e) (f))))

(lwp (λ () (let f () (pause) (display #\y) (f))))

(lwp (λ () (let f () (pause) (display #\!) (f))))

(lwp (λ () (let f () (pause) (newline)     (f))))

(start))

Using label and goto:

(let ([lwp-queue (make-queue)])

(define (lwp thk)

(enqueue! lwp-queue thk))

(define (start)

(when (non-empty-queue? lwp-queue)

((dequeue! lwp-queue))))

(define (pause)

(define first? #t)

(define l (label))

(when first?

(set! first? #f)

(enqueue! lwp-queue (λ () (goto l)))

(start)))

(lwp (λ () (let f () (pause) (display #\h) (f))))

(lwp (λ () (let f () (pause) (display #\e) (f))))

(lwp (λ () (let f () (pause) (display #\y) (f))))

(lwp (λ () (let f () (pause) (display #\!) (f))))

(lwp (λ () (let f () (pause) (newline)     (f))))

(start))

3.4 Ambiguous Operator🔗ℹ

McCarthy’s amb operator for nondeterministic programming via backtracking. The operator explores alternatives depth-first and backtracks on failure.

Using call/cc:

(let ([task* '()])

(define (fail)

(if (null? task*)

(error "Amb tree exhausted")

((car task*))))

(define (amb* . alt*)

(call/cc

(λ (task)

(unless (null? alt*)

(set! task* (cons task task*)))))

(when (null? alt*) (fail))

(define alt (car alt*))

(set! alt* (cdr alt*))

(when (null? alt*) (set! task* (cdr task*)))

(alt))

(define-syntax-rule (amb exp* ...) (amb* (λ () exp*) ...))

(let ([w-1 (amb "the" "that" "a")]

[w-2 (amb "frog" "elephant" "thing")]

[w-3 (amb "walked" "treaded" "grows")]

[w-4 (amb "slowly" "quickly")])

(define (joins? left right)

(equal?

(string-ref left (sub1 (string-length left)))

(string-ref right 0)))

(unless (joins? w-1 w-2) (amb))

(unless (joins? w-2 w-3) (amb))

(unless (joins? w-3 w-4) (amb))

(list w-1 w-2 w-3 w-4)))

Using cc:

(let ([task* '()])

(define (fail)

(if (null? task*)

(error "Amb tree exhausted")

(cc (car task*) #f)))

(define (amb* . alt*)

(define task (cc))

(when (null? alt*) (fail))

(when task

(set! task* (cons task task*)))

(define alt (car alt*))

(set! alt* (cdr alt*))

(when (null? alt*) (set! task* (cdr task*)))

(alt))

(define-syntax-rule (amb exp* ...) (amb* (λ () exp*) ...))

(let ([w-1 (amb "the" "that" "a")]

[w-2 (amb "frog" "elephant" "thing")]

[w-3 (amb "walked" "treaded" "grows")]

[w-4 (amb "slowly" "quickly")])

(define (joins? left right)

(equal?

(string-ref left (sub1 (string-length left)))

(string-ref right 0)))

(unless (joins? w-1 w-2) (amb))

(unless (joins? w-2 w-3) (amb))

(unless (joins? w-3 w-4) (amb))

(list w-1 w-2 w-3 w-4)))

Using label and goto:

(let ([task* '()])

(define (fail)

(if (null? task*)

(error "Amb tree exhausted")

(goto (car task*))))

(define (amb* . alt*)

(define first? #t)

(define task (label))

(when (null? alt*) (fail))

(when first?

(set! first? #f)

(set! task* (cons task task*)))

(define alt (car alt*))

(set! alt* (cdr alt*))

(when (null? alt*) (set! task* (cdr task*)))

(alt))

(define-syntax-rule (amb exp* ...) (amb* (λ () exp*) ...))

(let ([w-1 (amb "the" "that" "a")]

[w-2 (amb "frog" "elephant" "thing")]

[w-3 (amb "walked" "treaded" "grows")]

[w-4 (amb "slowly" "quickly")])

(define (joins? left right)

(equal?

(string-ref left (sub1 (string-length left)))

(string-ref right 0)))

(unless (joins? w-1 w-2) (amb))

(unless (joins? w-2 w-3) (amb))

(unless (joins? w-3 w-4) (amb))

(list w-1 w-2 w-3 w-4)))

All three produce '("that" "thing" "grows" "slowly").

3.5 Yin-Yang Puzzle🔗ℹ

David Madore’s famous puzzle, which exploits the fact that goto is itself a Label. Since Label = (¬ Label), any label can be passed to any other label.

(let ([yin (label)])

(display #\@)

(let ([yang (label)])

(display #\*)

(yin yang)))

Using call/cc:

(let ([kn (call/cc (λ (k) k))])

(display #\@)

(let ([kn+1 (call/cc (λ (k) k))])

(display #\*)

(kn kn+1)))

Using cc:

(let ([kn (cc)])

(display #\@)

(let ([kn+1 (cc)])

(display #\*)

(cc kn kn+1)))

Using label and goto:

(let* ([k #f] [k0 (label)])

(unless k (set! k k0) (goto k))

(display #\@)

(let* ([kn k] [kn+1 (label)])

(when (eq? kn k) (set! k kn+1) (goto k))

(display #\*)

(goto kn)))

CPS transform (no continuations at all):

(define (k0 kn)

(display #\@)

(define (kn+1 k)

(display #\*)

(kn k))

(kn+1 kn+1))

(k0 k0)

3.6 Defining call/cc🔗ℹ

call/cc can be defined in terms of cc:

(define (call/cc proc [prompt-tag (default-continuation-prompt-tag)])

(define v* (cc prompt-tag))

(if (list? v*)

(apply values v*)

(proc (λ vs (cc v* vs)))))

And in terms of label and goto:

(define (call/cc proc [prompt-tag (default-continuation-prompt-tag)])

(define v* #f)

(define l (label prompt-tag))

(if v*

(apply values v*)

(proc (λ vs (set! v* vs) (goto l)))))

3.7 Context-Frozen Thunks🔗ℹ

The wait/fc operator creates context-frozen thunks: computations that run in the evaluation context where they were defined, not where they are called. This freezes exception handlers, dynamic-wind guards, parameterize bindings, and other context-sensitive state, while ordinary mutable variables remain live. return/cc is the specialization of wait/fc to plain thunks. return-with-values is the degenerate case where no context is frozen at all.