call/cc
construct. args
inside a complex expression, as in ( ... (f args) ... )
Then the continuation of (f args)
can be expressed as a lambda term like this (define cc (lambda (f-result) ( ... f-result ... ) ) )
f-result
is in the same position as (f args)
was in the original expression. Then the original expression is equivalent to (cc (f args))
cc
as the future of the computation after (f args)
completes, we could pass that future directly to f
as an additional argument k
. When f
is finished, it invokes k
on the value that (f args)
computed, doing something like this ( (lambda (args k) (k (f args))) cc )
call/cc
does. ( ... (call/cc fc) ... )
bundles up the future evaluation around the call/cc
into a continuation that is passed as a parameter to fc
. (call/cc (lambda (k) (k 42)))
call/cc
. While (+ 1 2 (call/cc (lambda (k) (k 42))))
+
expression, and results in 45 as the value of the full expression. (define (h k) (k '(42 45)))
and then use it, for example, like this (first (call/cc h))
call/cc
assumes that the function it is invoking accepts exactly one parameter, namely the continuation. So if you need to pass additional parameters, you need to wrap them up first by building a closure to pass into the call/cc
. For example the call/cc
form of the f
in this (+ 42 (f 3 4))
would be (+ 42 (call/cc (lambda(k) (k (f 3 4))) ) )
#lang racket |
|
; break will be bound to the continuation of the read-eval-print loop |
|
(call/cc (lambda (break) |
(print "hello")(newline) |
(break "I'm outta here") ; continue with the original context |
(print "world")(newline) |
)) |
|
; the break arrives here with the value of "I'm outta here" |
; as the result from the call/cc |
i
is local to the outer lambda, and keeps its state over multiple resumptions. It is re-invoked in the middle of the evaluation. Note how the continuation captures control flow, but the global state changes between invocations of the continuation. #lang racket |
(define resume-test-3 #f) |
|
(define test-3 (lambda () |
; the let defines a variable i local to the lambda, and |
; sets its value to 0 |
(let ((i 0)) |
; |
(call/cc (lambda (k) (set! resume-test-3 k))) |
; |
; The next time the-continuation is called, we start here. |
(displayln "I am back ") |
(set! i (+ i 1)) |
; and return the value i |
i |
) |
)) |
|
(test-3) |
(resume-test-3) |
(resume-test-3) |
#lang racket |
|
; tree abstract data type |
; a leaf is a single element list with Content |
; a branch is a 3 element list with Content, Left, and Right |
|
(define Content (lambda (tree) (first tree))) |
(define Left (lambda (tree) (second tree))) |
(define Right (lambda (tree) (third tree))) |
|
(define AtLeaf? (lambda (tree) (null? (rest tree)))) |
(define At+? (lambda (tree) (eq? (Content tree) '+))) |
(define At*? (lambda (tree) (eq? (Content tree) '*))) |
(define At-? (lambda (tree) (eq? (Content tree) '-))) |
(define At/? (lambda (tree) (eq? (Content tree) '/))) |
|
; evaluate the expression, but do bogus things with bad situations |
; we should bailout to the caller when we cannot proceed to compute |
|
(define ArithEvalV1 |
(lambda (tree) |
(if (AtLeaf? tree) (Content tree) |
(let ( |
(lval (ArithEvalV1 (Left tree))) |
(rval (ArithEvalV1 (Right tree))) |
) |
(cond |
( (At+? tree) (+ lval rval) ) |
( (At*? tree) (* lval rval) ) |
( (At-? tree) (- lval rval) ) |
( (At/? tree) (if (= rval 0) "Divide by 0" (/ lval rval) ) ) |
( #t (list "Unknown Operator" (Content tree))) |
) |
))) |
) |
|
|
(define t1 '(+ (1) (* (2) (3) ))) |
;(ArithEvalV1 t1) |
(define t2 '(/ (10) (- (7) (+ (1) (* (2) (3) ))))) |
;(ArithEvalV1 t2) |
(define t3 '(+ (1) (** (2) (3) ))) |
;(ArithEvalV1 t3) |
|
; ok, this is what we would like to do, passing in a routine that terminates |
; and bailout to the caller returning an error value. |
(define ArithEvalV2 |
(lambda (tree) |
|
(letrec |
( (E (lambda (tree bailout) |
(if (AtLeaf? tree) (Content tree) |
(let ( |
(lval (E (Left tree) bailout)) |
(rval (E (Right tree) bailout)) |
) |
(cond |
( (At+? tree) (+ lval rval) ) |
( (At*? tree) (* lval rval) ) |
( (At-? tree) (- lval rval) ) |
( (At/? tree) (if (= rval 0) (bailout "Divide by 0") (/ lval rval) ) ) |
( #t (bailout (list "Unknown Operator" (Content tree))) ) |
) |
))) |
)) |
(E tree (lambda (x) (list "bailing out with" x))) |
) |
) |
) |
|
;(ArithEvalV2 t1) |
;(ArithEvalV2 t2) |
;(ArithEvalV2 t3) |
|
(define ArithEvalV3 |
(lambda (tree) |
; this next operation calls the function with the current continuation |
; so we can bailout and leap to the future with our return value. |
|
(call-with-current-continuation ; see also let/cc |
(lambda (bailout) |
(letrec |
( (E (lambda (tree) |
(if (AtLeaf? tree) (Content tree) |
(let ( |
(lval (E (Left tree))) |
(rval (E (Right tree))) |
) |
(cond |
( (At+? tree) (+ lval rval) ) |
( (At*? tree) (* lval rval) ) |
( (At-? tree) (- lval rval) ) |
( (At/? tree) (if (= rval 0) (bailout "Divide by 0") (/ lval rval) ) ) |
( #t (bailout (list "Unknown Operator" (Content tree))) ) |
) |
))) |
)) |
(E tree) |
) ) ) |
) |
) |
|
(ArithEvalV3 t1) |
(ArithEvalV3 t2) |
(ArithEvalV3 t3) |
|
(define ArithEvalV4 |
(lambda (tree) |
; an escape continuation is a more lightweight version of the current |
; continuation, and only exists within the dynamic context of the |
; call-with-escape-continuation |
|
(call-with-escape-continuation ; see also let/ec |
(lambda (bailout) |
(letrec |
( (E (lambda (tree) |
(if (AtLeaf? tree) (Content tree) |
(let ( |
(lval (E (Left tree))) |
(rval (E (Right tree))) |
) |
(cond |
( (At+? tree) (+ lval rval) ) |
( (At*? tree) (* lval rval) ) |
( (At-? tree) (- lval rval) ) |
( (At/? tree) (if (= rval 0) (bailout "Divide by 0") (/ lval rval) ) ) |
( #t (bailout (list "Unknown Operator" (Content tree))) ) |
) |
))) |
)) |
(E tree) |
) ) ) |
) |
) |
|
;(ArithEvalV4 t1) |
;(ArithEvalV4 t2) |
;(ArithEvalV4 t3) |
#lang racket |
|
(define R1-c (lambda (arg) (display "Error R1-c not defined yet") )) |
(define R2-c (lambda (arg) (display "Error R2-c not defined yet") )) |
|
(define R1 |
(lambda () |
(call/cc |
(lambda (break) |
(let ((i 5)) |
; capture our continuation, but bail out of further execution |
(call/cc (lambda (k) (set! R1-c k) (break "R1-c defined"))) |
; |
; The next time the-continuation is called, we start here. |
(display "R1 - I am back ") |
; we are mutating the state inside the continuation, so we get |
; a new result everytime we invoke the continuation |
(set! i (- i 1)) |
(display i) (newline) |
(if (> i 0) (R2-c 0) i) |
) |
) |
) |
)) |
|
(define R2 |
(lambda () |
(call/cc |
(lambda (break) |
(let ((i 5)) |
; capture our continuation, but bail out of further execution |
(call/cc (lambda (k) (set! R2-c k) (break "R2-c defined"))) |
; |
; The next time the-continuation is called, we start here. |
(display "R2 - I am back ") |
; we are mutating the state inside the continuation, so we get |
; a new result everytime we invoke the continuation |
(set! i (+ i 1)) |
(display i) (newline) |
(R1-c 0) |
i) |
) |
) |
) |
) |
|
; to start things off we need to |
(R1) |
(R2) |
(R1-c) ; or (R2-c) if you want R2 to go first |
#lang racket |
|
; pattern for |
; TRY |
; CATCH |
; RESUME |
|
(define testit (lambda (x y default) |
|
; RESUME |
(call/cc |
(lambda (RESUME) ; when everything is finished we invoke RESUME |
|
(call/cc |
(lambda (THROW) ; the context around this is the catch |
; TRY |
; here is the body of the try, which computes result |
|
(let ((result |
; compute the result in here, or throw |
(if (not (eq? 0 y)) (/ x y) (THROW)) |
)) |
|
; it worked, so return result |
(RESUME result) |
) |
) |
) |
|
; CATCH |
; what happens here is the catch, invoked only if we throw |
; in this case we return the default value |
(display "Caught exception")(newline) |
|
(RESUME default) |
) |
) |
|
)) |
|
(testit 4 2 "div by 0") |
(testit 4 0 "div by 0") |
|
#lang racket |
|
; pattern for |
; TRY |
; CATCH |
; RESUME |
|
(define testit (lambda (x y default) |
|
; RESUME |
(call/cc |
(lambda (RESUME) ; when everything is finished we invoke RESUME |
|
(let ( (exception |
|
; the context around this is the catch, it expects an exception result |
(call/cc |
(lambda (THROW) |
; TRY |
; here is the body of the try, which computes result |
|
(let ((result |
; compute the result in here, or throw |
(if (not (eq? 0 y)) (/ x y) (THROW "DivBy0")) |
)) |
|
; it worked, so return result |
(RESUME result) |
) |
) |
) ) ) |
|
|
; CATCH |
; what happens here is the catch, invoked only if we throw |
; in this case we return the default value |
(display "Caught ")(display exception)(newline) |
(RESUME default) |
|
) |
) |
|
))) |
|
(testit 4 2 "Arrgh, do not divide by 0") |
(testit 4 0 "Arrgh, do not divide by 0") |
#lang racket |
|
; pattern for |
; TRY |
; CATCH |
; RESUME |
|
(define testit |
(lambda (x y default) |
|
; RESUME |
(call/cc |
(lambda (RESUME) ; when everything is finished we invoke RESUME |
|
(let ( |
(exception |
|
; the context around this is the catch, it expects an exception result |
(call/cc |
(lambda (THROW) |
; TRY |
; here is the body of the try, which computes result |
|
(let ((result |
; compute the result in here, or throw |
(if (not (eq? 0 y)) (/ x y) (THROW "DivBy0")) |
)) |
|
; it worked, so return result |
(if (eq? result 5) (THROW "My bad") |
(RESUME result)) |
) |
) |
) ) ) |
|
|
; CATCH |
; what happens here is the catch, invoked only if we throw |
; in this case we return the default value |
(display "Caught ")(display exception)(newline) |
(if (equal? exception "DivBy0") (RESUME default) (RESUME (list "Got" exception))) |
|
) |
) |
|
))) |
|
(testit 4 2 "Arrgh, do not divide by 0") |
(testit 4 0 "Arrgh, do not divide by 0") |
(testit 10 2 "Arrgh, do not divide by 0") |
#lang racket |
|
(define p1-c #f) |
|
(define p1 |
(lambda () |
(call/cc (lambda (yield) ; yield control and return to caller |
(let ( (x 0) ) |
|
(set! x (+ x 1)) |
(display x) (newline) |
|
; the first checkpoint |
(call/cc (lambda (c) (set! p1-c c) (yield x))) |
|
(set! x (+ x 1)) |
(display x) (newline) |
|
; the second checkpoint |
(call/cc (lambda (c) (set! p1-c c) (yield x))) |
|
; there is no third checkpoint! |
(set! p1-c (lambda () "Hey, I'm finished")) |
|
"done" |
))) |
)) |
|
(p1) |
|
; what happens if you uncomment this |
; (p1-c) |
#lang racket |
|
(define p2-c #f) |
(define p2 |
(lambda () |
(call/cc (lambda (yield) |
(letrec ( (x 0) |
; p is a continuously running program, that periodically yields and |
; returns, but can be resumed by invoking continuation p2-c |
(p (lambda () (begin |
(set! x (+ x 1)) |
(display x) (newline) |
|
(call/cc (lambda (c) (set! p2-c c) (yield x))) |
|
(p) |
))) |
) |
; start p |
(p) |
; we shoud never get here |
"p is done" |
))) |
)) |
|
(p2) |
; what happens if you uncomment this |
; (p2-c) |
#lang racket |
(define x 0) ; shared state |
|
(define p1-c #f) |
(define p1 |
(lambda () |
; set up a yield continuation |
(call/cc (lambda (yield) |
(do () (#f) ; a do forever loop |
(set! x (+ x 1)) |
(display x) (newline) |
|
(call/cc (lambda (c) (set! p1-c c) (yield x))) |
|
))) |
) |
; yield gets us here |
) |
|
; define the checkpoint continuations |
(p1) |
; what happens when we uncomment this |
;(p1-c) |
|
#lang racket |
|
(require "ThreadsV3.rkt") |
|
(define p1 |
(lambda () |
|
(display "p1: checkpoint 1")(newline) (yield) |
(display "p1: checkpoint 2")(newline) (yield) |
(display "p1: checkpoint 3")(newline) (yield) |
|
(display "p1: finished")(newline) |
"p1: done" |
)) |
|
(define p2 |
(lambda () |
|
(display "p2: checkpoint 1")(newline) (yield) |
(display "p2: checkpoint 2")(newline) (yield) |
(display "p2: checkpoint 3")(newline) (yield) |
|
(display "p2: finished")(newline) |
"p2: done" |
)) |
|
(scheduler-init) |
(create-thread p1) |
(create-thread p2) |
(scheduler-start) |
|
#lang racket |
|
(require "ThreadsV3.rkt") |
|
(define make-counter |
(lambda (init incr) |
(let ( (counter init) ) |
(list |
(lambda () counter) ; return the current value |
(lambda () (set! counter init) ) ; reset to the initial value |
(lambda () (set! counter (+ counter incr)) counter) ; increment and return the current value |
(lambda () (set! counter (- counter incr)) counter) ; decrement and return the current value |
)))) |
|
(define counter (make-counter 0 1)) |
(define thread-num (first counter)) |
(define thread-reset (second counter)) |
(define ++thread-num (third counter)) |
(define --thread-num (fourth counter)) |
|
; parallel search of a tree |
|
; thread definer that returns a function that searches the current |
; list for a target token. |
(define def-p |
(lambda (T token id) |
(lambda () |
(display (list "thread " id " on " T " ")) |
(newline) |
|
(if (list? T) |
(if (null? T) |
'() |
|
; T is a list, spawn a thread for each element of list, then yield |
(begin |
(map |
(lambda (e) (create-thread (def-p e token (++thread-num) )) ) |
T |
) |
(yield) |
) |
) |
|
; T is an atom, see if it matches token |
(begin |
;(display (queue-get)) (display " ") |
(if (eq? T token) (display "match") (display "mismatch")) (newline) |
) |
) |
) |
) |
) |
|
(define tree |
'( 1 2 1 ( 3 4 1 ( 2 1 ) 1 2 ) 4 (4 3 2 1 ))) |
|
(scheduler-init) |
(thread-reset) |
(create-thread (def-p tree 1 (thread-num) )) |
(scheduler-start) |
#lang racket |
|
(provide scheduler-init) |
(provide scheduler-start) |
(provide create-thread) |
(provide yield) |
|
|
; yield-cc is the continuation that returns to the scheduler and starts the next |
; thread. It's argument is used to control the behaviour of the scheduler. |
|
(define yield-cc #f) |
|
; interface to the queue that is local to the scheduler. |
|
(define queue-add #f) |
(define queue-head #f) |
(define queue-remove #f) |
(define queue-empty #f) |
(define queue-get #f) |
|
; when the scheduler has no more threads to schedule, it invokes this continuation to |
; return to the point after the scheduler-start invocation. scheduler-start sets up |
; this, so strange things will happen if scheduler-start isn't called. |
|
(define scheduler-return #f) |
|
(define scheduler-init |
(lambda () |
(call/cc |
(lambda (return-from-init) |
|
(let ( (queue '()) ) |
(begin |
(set! queue-empty (lambda () (null? queue))) |
(set! queue-head (lambda () (first queue))) |
(set! queue-add (lambda (item) (set! queue (append queue (list item))))) |
(set! queue-remove (lambda () (let ( (head (first queue)) ) (set! queue (rest queue)) head)) ) |
(set! queue-get (lambda () queue)) |
|
; define yield point |
(let ( |
(thread-cc |
(call/cc (lambda (c) (set! yield-cc c) (return-from-init "scheduler-initialized") ) ) ) |
) |
|
; yield returns to this point with the continuation for the thread just yielding |
; queue up this thread, if it returned a continuation, otherwise the thread is |
; finished. |
(if (continuation? thread-cc) (queue-add thread-cc) |
#f |
;(display (list "thread terminates with " thread-cc)) |
) |
;(display (list "thread yields" thread-cc queue) )(newline) |
|
; invoke new thread if any on queue |
(if (queue-empty) |
(begin (display "scheduler done") (newline) (scheduler-return) ) |
((queue-remove) #f)) |
) |
))) |
))) |
|
(define scheduler-start |
(lambda () (call/cc |
(lambda (c) (set! scheduler-return c) (yield-cc #f))) |
)) |
|
; we should also have a termination function that is called when the thread finally |
; completes (if ever) |
|
(define create-thread |
(lambda (p) (queue-add (lambda (c) (display (list "thread returns" (p) ) (yield-cc #f) ))) ) |
) |
|
(define-syntax-rule (yield) |
(call/cc (lambda (c) (yield-cc c))) |
) |
|
10. Continuations continued Notes on Functional Programming / Version 2.10 2014-02-24 |