F # Continued Walkthrough FoldBack

Question

I struggle with understanding lag with CPS. This 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

It is 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 template is as follows:

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 it work? what does it mean?

Answer 1

I think the best way to understand the style of continuing the transfer is to compare the regular version of the continuation of the function with the continuation. Using your “even worse” example of a tree fold, first write a function using regular recursion:

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 case Node, because we call loop, then call loopagain, and then finally call f.

, " ". cont. Leaf return Leaf Leaf . Node :

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

, , , loop let, loop , , .

, , , - let fun !