Lecture 27: Continuations

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