F #: catamorphisme pour les structures de données mutuellement récursives

Question

On suppose la structure suivante mutuellement récursive:

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

Objectif: Générer les catamorphisme communes pour cette structure: foldl, foldr, foldk.

j'ai généré le catamorphisme naïf comme suit:

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

Comment procéder pour « mécaniquement » la génération de la foldl récursive (en utilisant des accumulateurs) et foldr récursive (en utilisant continuations) ?

J'ai traversé Scott's Recursive Types and Folds series et je comprends comment générer 'mécaniquement' les plis pour une structure récursive. Cependant, je ne trouve rien sur google pour faire la chose «mécanique» pour les structures de données récursives. PS: On peut se débarrasser de la récursivité réciproque ci-dessus par in-lining mais on la conserve car elle représente une version simplifiée de la récursivité réciproque dans tpetricek's Markdown parser.

Answer 1

Je ne sais pas si c'est ce que vous cherchez, mais cela semble donner ce que vous voulez (sorte de).
Le point clé étant de traiter que ce qui est « à l'intérieur » du type et laisse ce qui est « extérieur » être manipulé par quelque chose d'autre (une 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 

---

Voici une alternative si elle est plus adapté à ce que vous cherchez:

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