8 people like it.
Like the snippet!

Bananas in F#

A pattern for programming with generic folds (catamorphisms). Based on the classic "Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire" (1991) (Meijer, Fokkinga, Paterson).

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38:

// http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.41.125

type ListF<'a, 'b> = Empty | Cons of 'a * 'b
type List<'a> = InL of ListF<'a, List<'a>> with
    member self.Out() = let (InL x) = self in x
type PeanoF<'b> = Zero | Suc of 'b
type Peano = InP of PeanoF<Peano> with
    member self.Out() = let (InP x) = self in x

let inline out x = (^MF : (member Out : unit -> ^F) (x))

// Binary Functor
type BiFunctor = F with
    static member ($) (F, x:ListF<_, _>) = 
        fun f g -> 
            match x with
            | Empty -> Empty
            | Cons (x, xs) -> Cons (f x, g xs)
    static member ($) (F, x:PeanoF<_>) = 
        fun f g -> 
            match x with
            | Zero -> Zero
            | Suc x -> Suc (g x)

let inline bmap f g x = (F $ x) f g

// (|φ|)
let inline cata phi x = 
    let rec cata' x = 
        phi (bmap id cata' (out x))
    cata' x

// Example
let threeP = InP (Suc (InP (Suc (InP (Suc (InP Zero))))))
let threeL = InL (Cons (1, (InL (Cons (2, (InL (Cons (3, (InL Empty)))))))))

cata (fun x -> match x with Suc n -> n + 1 | Zero -> 0) threeP // 3
cata (fun x -> match x with Cons (x, l) -> x :: l| Empty -> []) threeL // [1; 2; 3]

union case ListF.Empty: ListF<'a,'b>

union case ListF.Cons: 'a * 'b -> ListF<'a,'b>

Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'a> =
| InL of ListF<'a,List<'a>>
member Out : unit -> ListF<'a,List<'a>>

Full name: Script.List<_>

union case List.InL: ListF<'a,List<'a>> -> List<'a>

type ListF<'a,'b> =
| Empty
| Cons of 'a * 'b

Full name: Script.ListF<_,_>

val self : List<'a>

member List.Out : unit -> ListF<'a,List<'a>>

Full name: Script.List`1.Out

val x : ListF<'a,List<'a>>

type PeanoF<'b> =
| Zero
| Suc of 'b

Full name: Script.PeanoF<_>

union case PeanoF.Zero: PeanoF<'b>

union case PeanoF.Suc: 'b -> PeanoF<'b>

type Peano =
| InP of PeanoF<Peano>
member Out : unit -> PeanoF<Peano>

Full name: Script.Peano

union case Peano.InP: PeanoF<Peano> -> Peano

val self : Peano

member Peano.Out : unit -> PeanoF<Peano>

Full name: Script.Peano.Out

val x : PeanoF<Peano>

val out : x:'MF -> 'F (requires member Out)

Full name: Script.out

val x : 'MF (requires member Out)

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

type BiFunctor =
  | F
  static member ( $ ) : F:BiFunctor * x:ListF<'a,'b> -> (('a -> 'c) -> ('b -> 'd) -> ListF<'c,'d>)
  static member ( $ ) : F:BiFunctor * x:PeanoF<'a> -> ('b -> ('a -> 'c) -> PeanoF<'c>)

Full name: Script.BiFunctor

union case BiFunctor.F: BiFunctor

val x : ListF<'a,'b>

val f : ('a -> 'c)

val g : ('b -> 'd)

val x : 'a

val xs : 'b

val x : PeanoF<'a>

val f : 'b

val g : ('a -> 'c)

val bmap : f:'a -> g:'b -> x:'c -> 'd (requires member ( $ ))

Full name: Script.bmap

val f : 'a

val g : 'b

val x : 'c (requires member ( $ ))

val cata : phi:('a -> 'b) -> x:'c -> 'b (requires member Out and member ( $ ))

Full name: Script.cata

val phi : ('a -> 'b)

val x : 'c (requires member Out and member ( $ ))

val cata' : ('c -> 'b) (requires member Out and member ( $ ))

val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id

val threeP : Peano

Full name: Script.threeP

val threeL : List<int>

Full name: Script.threeL

val x : PeanoF<int>

val n : int

val x : ListF<int,int list>

val x : int

val l : int list

Raw view Test code New version

More information

Link:	http://fssnip.net/ae
Posted:	12 years ago
Author:	Nick Palladinos
Tags:	catamorphisms