Sunday, April 7, 2013

On CPS - Part 2

"I was employed in passing to and fro
About relieving of the sentinels."
-- Shakespeare, Henry VI Part I
Act II Scene I Lines 69-70

Continuous passing style (CPS) is way of  programming in which you take direct control of the control flow by passing where the called function will return.

In the example above, the "function" is passed "values" to operate on along with the "continue function" it will pass control to after it is done (hence it does not return directly to the caller).  Using this style of programming one can construct the call stack.

Why would anyone want to do this?  Say you want to execute a recursive function obtaining some value really deep in the recursion.  The Fibonacci sequence is a great example of this type of problem.  Say you want to find the value of the 100,000th number in the Fibonacci sequence (well maybe this is pushing it for what I am going to show in this blog post, but you get the idea).

Non-CPS example (on

let rec fib =
  | 0 | 1 -> 1
  | n -> fib (n-2) + fib (n-1);;

If you were going to look for the 100,000th Fibonacci number using the standard recursive solution, you would get a stack overflow.  What you would like to do is use the heap instead of the stack, but how does one do that?  This is where CPS comes into play.  If you are working on a system which supports it, your continuations will go into the heap instead of being placed on the stack.

CPS example (on

let rec fib_cps n k =
  match n with
  | 0 | 1 -> k 1
  | n -> fib_cps (n-1)
         (fun x -> fib_cps (n-2) (fun y -> k (x+y)));;

What you are doing in the example above is creating a closure with the next two calls which will placed in the heap.  Once fib_cps(0) and fib_cps(1) are hit then the whole calculation is solved for and the value is returned to the caller of the function.

For the Fibonacci sequence this is still wasteful since same values are calculated many times.

In the figure above, everything in salmon color is wasted effort.  What we would rather do is reuse the values we have already calculated (which is way you would not want to use this method to calculate the 100,000th Fibonacci number).

Along the lines of reducing waste we can look at using a data structure instead of using a closure.

Defunctionalization example (on

type fib_cont =
  | Fib_zero
  | Fib_minus1 of int * fib_cont
  | Fib_minus2 of fib_cont * int;;

let rec fib_cps_defun n k =
  match n with
  | 0 | 1 -> fib_cont_eval 1 k
  | n -> fib_cps_defun (n-1) (Fib_minus1 (n, k))
and fib_cont_eval acc =
  | Fib_zero -> acc
  | Fib_minus1 (n, k) -> 
      fib_cps_defun (n-2) (Fib_minus2 (k, acc))
  | Fib_minus2 (k, acc') -> fib_cont_eval (acc+acc') k;;

I first came across this idea, while reading what I will say is one of the greatest responses on StackOverflow.    What we are doing is constructing the heap with the Fib_minus1 type and then evaluating this to it function fib(n-1) + fib(n-2).  This can be more efficient on systems where data structures are easier to allocate than allocation of a closure call.

We still have not solved the problem of finding the 100,000th Fibonacci number, but we are along the correct path.

Full example (using FsUnit):

open NUnit.Framework
open FsUnit

type fib_cont =
  | Fib_zero
  | Fib_minus1 of int * fib_cont
  | Fib_minus2 of fib_cont * int

let rec fib_cps_defun n k =
  match n with
  | 0 | 1 -> fib_cont_eval 1 k
  | n -> fib_cps_defun (n-1) (Fib_minus1 (n, k))
and fib_cont_eval acc =
  | Fib_zero -> acc
  | Fib_minus1 (n, k) -> fib_cps_defun (n-2) (Fib_minus2 (k, acc))
  | Fib_minus2 (k, acc') -> fib_cont_eval (acc+acc') k

let fib n = fib_cps_defun n Fib_zero

let ``Validate that fib 0 is 1`` () =
  fib 0 |> should equal 1

let ``Validate that fib 1 is 1`` () =
  fib 1 |> should equal 1

let ``Validate that fib 2 is 2`` () =
  fib 2 |> should equal 2

let ``Validate that fib 3 is 3`` () =
  fib 3 |> should equal 3

let ``Validate that fib 4 is 5`` () =
  fib 4 |> should equal 5

let ``Validate that fib 17 is 2584`` () =
  fib 17 |> should equal 2584