CS223, 5/21/2010

Continuations
=============

A continuation is like a function that represents "the rest of the
computation" from some point during the execution of a program.

It is the "dynamic context" of some subcomputation (e.g. of the
evaluation of some expression).  The continuation is expecting to
receive a value from that subcomputation, of some statically
determined type.  A first class continuation is a continuation
that has been captured as a value, and when it is captured it is
usually bound to a variable.  We can "invoke" such a continuation
value very much like calling a function, passing it the value
it was expecting at the point it was captured.

   type 'a cont    (* 'a is the value expected by the continuation *)

To invoke a continuation, we use a function "throw", which is
analogous to function application.  But unlike a function call,
a continuation invocation does not return -- we have transfered
control to another suspended computation. Thus a throw expression
can have any type.

   val throw: 'a cont -> 'a -> 'b

[Sometimes a special syntax like "throw e to k" is used instead
of the default application syntax "throw k e".  We will stick with
application-style syntax here.]


* Escaping by throwing to a continuation:
Here we will give an example that uses a continuation to escape
from the middle of a computation, returning a value "prematurely".
To capture the current continuation at a point, we will use a
special form of let:

  letcc c in exp end

which binds the variable c to the continuation of the entire letcc
expression.

  fun mult0 list (l: int list) : int =
      letcc ret in
	let fun mult nil = 1
	      | mult (0::) = throw 0 to ret
	      | mult (n::l) = n * mult l
	in mult l end
      end

Here is an alternative version the captures the continuation of the
main let body.

  fun mult list l =
      let fun mult nil ret = 1
	    | mult (0::) ret = throw 0 to ret
	    | mult (n::l) ret = n * mult l ret
       in letcc ret in (mult l) ret end
      end


* Composing a function and a continuation
Here is a more interesting and trickier example.  We want to
compose a function and a continuation, in the sense that before
invoking the continuation, we apply the function to a value to
produce the value passed to the continuation.

  val  compose : ('a -> 'b) * 'b cont -> 'a cont

  fun compose (f, k) =
      letcc ret 
       in throw (f (letcc r in throw r to ret end)) k
      end

Here is how this works:

   ... [compose even k] ...

let k1 : bool cont be the continuation of the call of compose (roughtly
the rest of the program, represented by the dots)
 
   [compose even k] expands to

      [letcc ret {ret = k1}
        in throw (even [(letcc r in throw r to ret end)]) to k   {r = k2}
       end]

k2 is returned by the call of compose.

when an integer, say 3, is later thrown to this k2, the call
of even proceeds with the argument 3. even 3 returns false, which
is thrown to k, the original continuation argument of this call
of compose.

-----------------------
* Continuation Passing Style (CPS) version of mult

We can use this idea in a more direct and explicit way by
creating our own continuation functions and passing them through
a computation as explicit parameters.  We call this "continuation
passing style", or CPS.

  fun mult nil = 1
    | mult (n::l) = n * mult l

  fun cps_mult nil k = k 1
    | cps_mult (n::l) k = cps_mult l (fn r => k (n * r))

  fun mult l = cps_mult l (fn r => r)

  cps_mult : int list -> (int -> 'a) -> 'a

  fun mult l = cps_mult l (fn x => x)

-----------

Version with extra escape continuation:

  fun cps_mult_list l k =
      let fun cps_mult nil k0 k = k 1
	     | cps_mult (0::_) k0 k = k0 0
	     | cps_mult (n::l) k0 k = cps_mult l k0 (fn p => k (n*p))
       in cps_mult l k k end

  cps_mult : int list -> (int -> 'a) -> (int -> 'a) -> 'a


---------------------------------------------------------------------

Coroutines

  val buf : int ref = ref 0

  fun produce (n:int, cons:state) =
      (buf := n; produce (n+1, resume cons))

  fun consume (prod:state) =
      (print (!buf); consume (resume prod))



-------------
How do we implement resume?

Here we will use callcc from SMLofNJ.Cont instead of letcc.

  val callcc : ('a cont -> 'a) -> 'a
  val throw : 'a cont -> 'a -> 'b

-----------
  datatype state = S of state cont

  fun resume (S k : state) : state =
      callcc (fn (k’ : state cont) => throw k (S k’))

  val buf : int ref = ref 0

  fun produce (n:int, cons:state) =
      (buf := n; produce (n+1, resume cons))

  fun consume (prod:state) =
      (print (Int.toString(!buf)); consume (resume prod))

  fun run () =
      consume (callcc (fn k : state cont => produce (0, S k)))


----------------------------------------------------------------------
Threads
=======

Here we will extend the coroutine idea to implement multiple threads
(or lightweight processes) as continuations.  Here the transfer of
control is handled by a thread scheduler (function dispatch) instead
of having threads directly pass control among themselves.

This model resemples "cooperative multitasking", where threads have to
voluntarily give up ("yield") control so another thread can get a
chance to run.

We assume a structure implementing the imperative queue abstraction.

signature QUEUE =
sig
  type 'a queue
  exception Dequeue
  val mkQueue : unit -> 'a queue
  val enqueue : 'a queue * 'a -> unit
  val dequeue : 'a queue -> 'a
end		    

structure Queue : QUEUE

-------------------------------------------------------------
signature THREADS =
sig
  exception NoRunnableThreads
  val fork : (unit -> unit) -> unit
  val yield : unit -> unit
  val exit : unit -> ’a
end


structure Threads :> THREADS =
struct
  open SMLofNJ.Cont

  exception NoRunnableThreads

  type thread = unit cont

  val readyQueue : thread Queue.queue = Queue.mkQueue()

  fun dispatch () = 
      let val t = Queue.dequeue readyQueue
                  handle Queue.Dequeue => raise NoRunnableThreads
       in throw t ()
      end

  fun exit () = dispatch()

  fun enqueue t = Queue.enqueue (readyQueue, t)

  fun fork f =
      callcc (fn parent => (enqueue parent; f (); exit()))

  fun yield () =
      callcc (fn parent => (enqueue parent; dispatch()))

end


structure Client1 =
struct
  open Threads
  val buffer : int ref = ref (~1)

  fun producer n =
      (buffer := n ; yield () ; producer (n+1))

  fun consumer () =
      (print (Int.toString (!buffer) ^ "\n"); yield (); consumer())

  fun run () =
      (fork (consumer); producer 0)
end


structure Client2 =
struct
  open Threads
  val buffer : int option ref = ref NONE

  fun producer n =
      (case !buffer
	 of NONE => (buffer := SOME n ; yield() ; producer (n+1))
	  | SOME _ => (yield (); producer n))

  fun consumer () =
      (case !buffer
	 of NONE => (yield (); consumer())
	  | SOME n => (print (Int.toString n ^ "\n"); buffer := NONE;
		       yield(); consumer()))

  fun run () =
      (fork (consumer); producer 0)

end