8 people like it.

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