4

Assume the following mutually recursive structure:

type Tree<'a> = 
    | Empty 
    | Node of 'a * 'a Forest
and Forest<'a> = 
    | Nil 
    | Cons of 'a Tree * 'a Forest

Goal: Generate the common catamorphisms for this structure: foldl, foldr, foldk.

I have generated the naive-catamorphism as follows:

let rec foldTree fEmpty fNode fNil fCons = 
    function 
    | Empty -> fEmpty
    | Node (a, f) -> fNode a (foldForest fEmpty fNode fNil fCons f)
and foldForest fEmpty fNode fNil fCons =
    function
    | Nil -> fNil
    | Cons (t, f') -> fCons (foldTree fEmpty fNode fNil fCons t) (foldForest fEmpty fNode fNil fCons f')

How do I go about 'mechanically' generating the tail-recursive foldl (using accumulators) and tail-recursive foldr (using continuations)?

I have been through Scott's Recursive Types and Folds series and I understand how to generate the folds for a recursive structure 'mechanically'. However I cannot find anything on google to do the 'mechanical' thing for recursive data structures.

PS: One can get rid of the mutual-recursion above by in-lining but lets retain it as it represents a simplified version of the mutual recursion in tpetricek's Markdown parser.

Partha P. Das
  • 165
  • 3
  • 5
  • 1
    What do you mean by "mechanically"? As far as I can see, your function does what you wanted, but I'm not sure how you want to improve it? – Tomas Petricek Oct 27 '16 at 14:33
  • 1
    (On a slightly unrelated note, I find this way of tree processing nice in theory, but in practice, I think it is more useful to write more specialized functions for the common tree operations that you might actually want to do on your tree - and let people just pattern match if they need the fully general structure. In other words, I think "catamorphisms" are not very useful for readable code - which is why the Markdown parser does not implement them :)) – Tomas Petricek Oct 27 '16 at 14:34

1 Answers1

1

I'm totally unsure if that's what you're looking for but this seems to give what you want (sort-of).
The key point being to handle only what is "inside" the type and leaves what is "outside" be handled by something else (some abstraction)

//val foldTree : 'a -> ('b -> 'c -> 'a) -> ('b Forest -> 'c) -> 'b Tree -> 'a
let foldTree fEmpty fNode fForest = function
  Empty       -> fEmpty
| Node (a, f) -> fNode a (fForest f)

// val foldForest : 'a -> ('b -> 'a -> 'a) -> ('c Tree -> 'b) -> 'c Forest -> 'a
let rec foldForest fNil fCons fTree =
  let recurse = foldForest fNil fCons fTree
  function
    Nil         -> fNil
  | Cons (t, f) -> fCons (fTree t) (recurse f)

let foldForestAcc fNil fCons fTree =
  let rec aux acc = function
    Nil         -> acc
  | Cons (t, f) -> aux (fCons (fTree t) acc) f
  aux fNil

let foldForestCont fNil fCons fTree =
  let rec aux cont = function
    Nil         -> cont fNil
  | Cons (t, f) -> aux (fCons (fTree t) >> cont) f
  aux id

Here is also an alternative if it's more suited to what you seek :

let fold fEmpty fNode fNil fCons =
  let rec auxT = function
    Empty       -> fEmpty
  | Node (a, f) -> fNode a (auxF f)
  and auxF = function
    Nil         -> fNil
  | Cons (t, f) -> fCons (auxT t) (auxF f)
  auxT

let foldAcc fEmpty fNode fNil fCons =
  let rec auxT acc = function
    Empty       -> acc
  | Node (a, f) -> fNode a (auxF fNil f)
  and auxF acc = function
    Nil         -> acc
  | Cons (t, f) -> auxF (fCons (auxT fEmpty t) acc) f
  auxT fEmpty

let foldCont fEmpty fNode fNil fCons =
  let rec auxT cont = function
    Empty -> cont fEmpty
  | Node (a, f) -> cont (fNode a (auxF id f))
  and auxF cont = function
    Nil -> cont fNil
  | Cons (t, f) -> auxF (cont >> fCons (auxT id t)) f
  auxT id
Sehnsucht
  • 5,019
  • 17
  • 27