Some examples using continuations:
let fun f (c: int cont): int = throw c 5 in callcc f end let fun f (x:int) (c: int cont): int = throw c (x+1) in callcc(f 2) end
Writing an infinite loop the hard way:
let val cref: int cont option ref = ref NONE fun f(c: int cont): int = (cref := SOME(c); 5) in callcc f; case !cref of NONE => "finished" | SOME(co) => throw co 4 end
Continuations as a substitute for exceptions:
let fun g(n: real) (errors: int option cont) : int option = if n < 0.0 then throw errors NONE else SOME(Real.trunc(Math.sqrt(n))) fun f (x:int) (y:int) (errors: int option cont): int option = if y = 0 then throw errors NONE else SOME(x div y+valOf(g 10.0 errors)) in case callcc(f 13 3) of NONE => "runtime error" | SOME(z) => "Answer is "^Int.toString(z) end let fun plot(f: real->real) = (* Draw a picture of f, calling it many times to acquire * data. *) print(Real.toString(f(1.0))^"\n") in callcc (fn(c: unit cont) => let fun g(n: real) : real = if n < 0.0 then throw c () else Math.sqrt(n) in plot(g); () end) end
Implementing Concurrent ML using continuations:
(* Mini-CML! (Non-preemptive) Adapted from A. Appel, J. Reppy *) signature QUEUE = sig (* Imperative FIFO queue *) type 'a queue val new: unit -> 'a queue val insert: 'a queue -> 'a -> unit exception Empty val remove: 'a queue -> 'a val empty: 'a queue -> bool end type thread = unit cont (* threads waiting to run *) val ready : thread Queue.queue = Queue.new() val enqueue: thread -> unit = Queue.insert ready fun dispatch () = throw (Queue.remove ready) () fun spawn(f: unit->unit) = callcc (fn parent_k => (enqueue parent_k; f (); dispatch())) fun yield(): unit = callcc(fn k => (enqueue k; dispatch())) fun exit() = if Queue.empty(ready) then () else dispatch() structure Queue :> QUEUE = struct datatype 'a queue = Q of {front: 'a list ref, rear: 'a list ref} fun new () = Q{front = ref [], rear = ref []} fun insert (Q{rear, ...}) x = (rear := x :: !rear) exception Empty fun remove (Q{front=ref[], rear=ref[]}) = raise Empty | remove (Q{front as (ref []), rear as (ref l)}) = let val (x::r) = rev l in front := r; rear := []; x end | remove (Q{front as (ref(x::r)), ...}) = (front := r; x) fun empty(Q{front=ref[],...}) = true | empty(_) = false end
This is essentially how CML is implemented! The only thing we're missing here is preemption: the ability of the scheduler to interrupt (preempt) the execution of the current thread once its quantum has expired. This requires some kind of low-level timer, probably provided by the hardware.
Some of our CML examples using the hand-coded threads package. We need to add
a call to yield()
to the "spew" example because these
threads are non-preemptive.
fun CMLprog1() = let fun spew(s) = (print (s); yield(); spew(s)) in spawn(fn() => spew("hello!")); spawn(fn() => spew("goodbye!")); print "MAIN THREAD DONE"; exit() end fun CMLprog2() = let val result = ref 0 fun wait() = if !result = 0 then (yield(); wait()) else () in spawn (fn() => result := 2+2); wait(); print(Int.toString(!result)^"\n"); exit() end