trampoline.fs

type Next<'T> =
  | Done    of 'T
  | Jump    of Trampoline<'T>
and Trampoline<'T> = unit -> Next<'T>

module Trampoline =
  let Return v : Trampoline<'T> =
    fun () ->
      Done v

  let rec Bind (t : Trampoline<'T>) (uf : 'T -> Trampoline<'U>) : Trampoline<'U> =
    fun () ->
      match t () with
      | Done tv -> Jump (uf tv)
      | Jump tb -> Jump (Bind tb uf)

  let inline (>>=) t uf = Bind t uf

  type TrampolineBuilder() =
    member x.Bind   (t, uf) = Bind t uf
    member x.Return (v)     = Return v

  let Bounce<'T> (t : Trampoline<'T>) : 'T =
    let rec loop tt =
      match tt () with
      | Done v    -> v
      | Jump ttt  -> loop ttt
    loop t

let trampoline = Trampoline.TrampolineBuilder ()

let rec fac n =
  trampoline {
    match n with
    | 0 -> return 1
    | _ ->
      let! p = fac (n - 1)
      return p*n
  }

let rec fib n =
  trampoline {
    match n with
    | 0 -> return 1
    | 1 -> return 1
    | _ ->
      let! p1 = fib (n - 1)
      let! p2 = fib (n - 2)
      return p1 + p2
  }

[<EntryPoint>]
let main argv = 
  printfn "fac 6: %A" (Trampoline.Bounce (fac 6))
  printfn "fib 3: %A" (Trampoline.Bounce (fib 6))
  0