F# Continuation Passing FoldBack

Question

I am struggling with understanding foldback with CPS. This one I can understand:

let listFoldBack combine acc l =
  let rec Loop l cont =
    match l with
    | h :: t -> Loop t (fun racc -> cont (combine h racc))
    | [] -> cont acc
  Loop l id     

listFoldBack   (fun x a  -> (2*x::a) ) [] [1;2;3]

// call sequence
[1;2;3]    id
Loop [2;3] (fun a -> (combine 1 a))
Loop [3]   (fun a -> (combine 1 (combine 2 a)))
Loop []    (fun a -> (combine 1 (combine 2 (combine 3 a))))
           (fun a -> (combine 1 (combine 2 (combine 3 a)))) []
           2::(4::(6::[]))

---

But then:

let  fib n =
  let rec fibc a cont =
    if a <= 2 then cont 1
    else      
      fibc (a - 2) (fun x -> fibc (a - 1) (fun y -> cont(x + y)))      
  fibc n id

// call sequence
fibc (4) id
 fibc (2) (fun x -> fibc (3) (fun y -> id(x + y)))
   (fun x -> fibc (3) (fun y -> id(x + y))) (1) 
     fibc (3) (fun y -> id(1 + y))
       fibc (1) (fun x -> fibc (2) (fun y -> (fun z -> id(1+z)) (x + y)))
          fibc (2) (fun y -> (fun z -> id(1+z))(1 + y)))
            (fun y -> (fun z -> id(1+z))(1 + y))) (1)
               fun z -> id(1+z)(1+1)
                 id (1+2)
                   3

Very difficult to follow.

---

Even worse:

type Tree<'a> =
    | Leaf
    | Node of 'a * Tree<'a> * Tree<'a>

let node x l r = Node(x,l,r)

let treeFoldBack f leaf tree =
    let rec loop t cont = 
        match t with 
        | Leaf -> cont leaf
        | Node(x,l,r) -> loop l (fun lacc -> 
            loop r (fun racc -> cont(f x lacc racc))) 
    loop tree id

let tree1 =
    (node 4
        (node 2
            (node 1 Leaf Leaf)
            (node 3 Leaf Leaf))
        (node 6
            (node 5 Leaf Leaf)
            (node 7 Leaf Leaf)))

    // call sequence by means of text replacing 
        ... a lot of steps, lines too long to fit
        cont(f 4 (f 2 (f 1 Leaf Leaf) (f 3 Leaf Leaf)) 
        (f 6 (f 5 Leaf Leaf) (f 7 Leaf Leaf))))

The result is correct, but very difficult to follow. For all cases the pattern is like:

loop l (fun lacc -> loop r (fun racc -> cont(f x lacc racc))) 
calculate loop l, result goes in lacc.
calculate loop r, result goes in racc.
calculate f x lacc racc and result is argument for cont.

Why does this work? how to understand this?

Answer 1

I think that the best way to understand continuation passing style is to compare the ordinary non-continuation version of a function with the continuation-based function. Using your "even worse" example of tree fold, let's write the function using ordinary recursion first:

let treeFoldBack f leaf tree =
    let rec loop t = 
        match t with 
        | Leaf -> leaf
        | Node(x,l,r) -> 
            let lacc = loop l // Process left and return result
            let racc = loop r // Process right and return result
            f x lacc racc     // Aggregate current, left and right
    loop tree

As you can see, the function is not tail-recursive in the Node case, because we call loop, then call loop again and then finally call f.

The idea of continuations is to add a parameter that represents "what to do after the current operation has completed". This is captured by cont. In case of Leaf, we just replace returning leaf with calling continuation with leaf as an argument. The Node case is more elaborate:

let treeFoldBack f leaf tree =
    let rec loop t cont = 
        match t with 
        | Leaf -> cont leaf
        | Node(x,l,r) -> 
            loop l (fun lacc -> // Process left and continue with result
              loop r (fun racc -> // Process right and continue with result
                cont(f x lacc racc))) // Aggregate and invoke final continuation
    loop tree id

As you can see, the structure is the same as before - but rather than calling loop and storing the result using let, we now call loop and pass it a function that gets the result and does the rest of the work.

This looks a bit confusing until you get used to it - but the key thing is that this is actually a fairly mechanical translation - you just replace let with fun in the right way!