F#: Катаморфизмы для взаимно рекурсивных структур данных

Question

Предположим следующую взаимно рекурсивную структуру:

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

Цель: создать общие катаморфизмы для этой структуры: foldl, foldr, foldk.

Я породил наивный катаморфизм следующим образом:

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')

Как мне "механически" генерировать хвост-рекурсивный фолд (используя аккумуляторы) и хвост-рекурсивный фолд (используя продолжения)?

Я прошел серию рекурсивных типов и складок Скотта, и я понимаю, как генерировать складки для рекурсивной структуры "механически". Однако я не могу найти в Google ничего, что могло бы сделать "механическую" вещь для рекурсивных структур данных.

PS: Можно избавиться от описанной выше взаимной рекурсии с помощью встроенной функции, но давайте оставим ее, поскольку она представляет собой упрощенную версию взаимной рекурсии в анализаторе tpetricek Markdown.

Answer 1

Я абсолютно не уверен, что это то, что вы ищете, но это, кажется, дает то, что вы хотите (вроде).
Ключевым моментом является обработка только того, что находится "внутри" типа, а то, что "снаружи", обрабатывается чем-то другим (некоторая абстракция).

//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

---

Вот также альтернатива, если она больше подходит для того, что вы ищете:

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