Source code in the fsharp programming language

type IChurch =
  abstract Apply : ('a -> 'a) -> ('a -> 'a)

let zeroChurch = { new IChurch with override __.Apply _ = id }
let oneChurch = { new IChurch with override __.Apply f = f }
let succChurch (n: IChurch) =
  { new IChurch with override __.Apply f = fun x -> f (n.Apply f x) }
let addChurch (m: IChurch) (n: IChurch) =
  { new IChurch with override __.Apply f = fun x -> m.Apply f (n.Apply f x) }
let multChurch (m: IChurch) (n: IChurch) =
  { new IChurch with override __.Apply f = m.Apply (n.Apply f) }
let expChurch (m: IChurch) (n: IChurch) =
  { new IChurch with override __.Apply f = n.Apply m.Apply f }
let iszeroChurch (n: IChurch) =
  { new IChurch with
      override __.Apply f = n.Apply (fun _ -> zeroChurch.Apply) oneChurch.Apply f }
let predChurch (n: IChurch) =
  { new IChurch with
      override __.Apply f = fun x -> n.Apply (fun g h -> h (g f))
                                             (fun _ -> x) id }
let subChurch (m: IChurch) (n: IChurch) =
  { new IChurch with override __.Apply f = (n.Apply predChurch m).Apply f }
let divChurch (dvdnd: IChurch) (dvsr: IChurch) =
  let rec divr (n: IChurch) (d: IChurch) =
    { new IChurch with
        override __.Apply f =
          ((fun (v: IChurch) -> // test v for Church zeroChurch...
              v.Apply (fun _ -> (succChurch (divr v d)).Apply) // if not zeroChurch
                                zeroChurch.Apply)(subChurch n d)) f }
  divr (succChurch dvdnd) dvsr

let chtoi (ch: IChurch) = ch.Apply ((+) 1) 0
let itoch i = List.fold (>>) id (List.replicate i succChurch) zeroChurch

#nowarn "25" // skip incomplete pattern warning
[<EntryPoint>]
let main _ =
    let [c3; c4; c11; c12] = List.map itoch [3; 4; 11; 12]

    [ addChurch c3 c4
    ; multChurch c3 c4
    ; expChurch c3 c4
    ; expChurch c4 c3
    ; iszeroChurch zeroChurch
    ; iszeroChurch oneChurch
    ; predChurch c3
    ; subChurch c11 c3
    ; divChurch c11 c3
    ; divChurch c12 c3
    ] |> List.map chtoi |> printfn "%A"
    0 // return an integer exit code


// types...
type Church = Church of (Church -> Church)
let applyChurch (Church chf) charg = chf charg
let composeChurch (Church chlf) (Church chrf) =
  Church <| fun f -> (chlf << chrf) f  

let churchZero = Church(fun _ -> Church id)
let churchOne = Church id
let succChurch (Church chf) =
  Church <| fun f -> composeChurch f <| chf f
let addChurch cha chb =
  Church <| fun f -> composeChurch (applyChurch cha f) (applyChurch chb f)
let multChurch cha chb =
  composeChurch cha chb
let expChurch chbs chexp =
  applyChurch chexp chbs
let isZeroChurch ch =
  applyChurch (applyChurch ch (Church <| fun _ -> churchZero)) churchOne
let predChurch ch =
  Church <| fun f -> Church <| fun x ->
    let prdf = Church <| fun g -> Church <| fun h ->
                            applyChurch h (applyChurch g f)
    applyChurch (applyChurch (applyChurch ch prdf)
                             (Church <| fun _ -> x)) <| Church id
let subChurch cha chb =
  applyChurch (applyChurch chb <| Church predChurch) cha
  
let divChurch chdvdnd chdvsr =
  let rec divr n =
    let loop v = Church <| fun _ -> succChurch <| divr v
    let tst v = applyChurch (applyChurch v <| loop v) churchZero
    tst <| subChurch n chdvsr
  divr <| succChurch chdvdnd

let intToChurch i =
  List.fold (>>) id (List.replicate i succChurch) churchZero
let churchToInt ch =
  let mutable count: int = 0
  let addint1 = Church <| fun v -> count <- count + 1; v
  applyChurch (applyChurch ch addint1) churchZero |> ignore
  count

#nowarn "25" // eliminate incomplete pattern match warning
[<EntryPoint>]
let main _ =
  let [c3; c4; c11; c12] = List.map intToChurch [3; 4; 11; 12]
  [ addChurch c3 c4
  ; multChurch c3 c4
  ; expChurch c3 c4
  ; expChurch c4 c3
  ; isZeroChurch churchZero
  ; isZeroChurch c3
  ; predChurch c4
  ; subChurch c11 c3
  ; divChurch c11 c3
  ; division c12 c3
  ] |> List.map churchToInt |> printfn "%A"
  0 // return an integer exit code


#nowarn "25" // eliminate incomplete pattern match warning

// types...
type Church<'a> = Church of (Church<'a> -> Church<'a>)
                | ArityZero of 'a
let applyChurch (Church chf) charg =
  chf charg
let composeChurch (Church chlf) (Church chrf) =
  Church <| fun f -> (chlf << chrf) f

let churchZero<'a> = Church <| fun (_: Church<'a>) -> Church id
let churchOne = Church id
let succChurch (Church chf) =
  Church <| fun f -> composeChurch f <| chf f
let addChurch cha chb =
  Church <| fun f -> composeChurch (applyChurch cha f) (applyChurch chb f)
let multChurch cha chb =
  composeChurch cha chb
let expChurch chbs chexp =
  applyChurch chexp chbs
let isZeroChurch ch =
  applyChurch (applyChurch ch (Church <| fun _ -> churchZero)) churchOne
let predChurch ch =
  Church <| fun f -> Church <| fun x ->
    let prdf = Church <| fun g -> Church <| fun h ->
                            applyChurch h (applyChurch g f)
    applyChurch (applyChurch (applyChurch ch prdf)
                             (Church <| fun _ -> x)) <| Church id
let subChurch cha chb =
  applyChurch (applyChurch chb <| Church predChurch) cha
  
let divChurch chdvdnd chdvsr =
  let rec divr n =
    let loop v = Church <| fun _ -> succChurch <| divr v
    let tst v = applyChurch (applyChurch v <| loop v) churchZero
    tst <| subChurch n chdvsr
  divr <| succChurch chdvdnd

let intToChurch<'a> i =
  List.fold (>>) id (List.replicate i succChurch) churchZero<'a>
let churchToInt ch =
  let succInt = Church <| fun (ArityZero v) -> ArityZero <| v + 1
  match applyChurch (applyChurch ch succInt) <| ArityZero 0 with
    ArityZero r -> r

[<EntryPoint>]
let main _ =
  let [c3; c4; c11; c12] = List.map intToChurch [3; 4; 11; 12]
  [ addChurch c3 c4
  ; multChurch c3 c4
  ; expChurch c3 c4
  ; expChurch c4 c3
  ; isZeroChurch churchZero
  ; isZeroChurch c3
  ; predChurch c4
  ; subChurch c11 c3
  ; divChurch c11 c3
  ; divChurch c12 c3
  ] |> List.map churchToInt |> printfn "%A"
  0 // return an integer exit code