4 people like it.

Monadic Trampoline

A monadic trampoline for stack-overflow free programming.

 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: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
type TrampValue<'T> =
    | DelayValue of Delay<'T>
    | ReturnValue of Return<'T>
    | BindValue of IBind<'T>
and ITramp<'T> = 
    abstract member Value : TrampValue<'T>
    abstract member Run : unit -> 'T

and Delay<'T>(f : unit -> ITramp<'T>) =
    member self.Func = f 
    interface ITramp<'T> with
        member self.Value = DelayValue self
        member self.Run () = (f ()).Run()

and Return<'T>(x :'T) = 
    member self.Value = x
    interface ITramp<'T> with
        member self.Value = ReturnValue self
        member self.Run () = x

and IBind<'T> = 
    abstract Bind<'R> : ('T -> ITramp<'R>) -> ITramp<'R>
and Bind<'T, 'R>(tramp : ITramp<'T>, f : ('T -> ITramp<'R>)) = 
    interface IBind<'R> with
        member self.Bind<'K>(f' : 'R -> ITramp<'K>) : ITramp<'K> =
            new Bind<'T, 'K>(tramp, fun t -> new Bind<'R, 'K>(f t, (fun r -> f' r)) :> _) :> _
    interface ITramp<'R> with
        member self.Value = BindValue self
        member self.Run () = 
            match tramp.Value with
            | BindValue b -> b.Bind(f).Run() 
            | ReturnValue r -> (f r.Value).Run()
            | DelayValue d -> (new Bind<'T, 'R>(d.Func (), f) :> ITramp<'R>).Run() 

// Builder
type TrampBuilder() = 
    member self.Return a = new Return<_>(a) :> ITramp<_>
    member self.Bind(tramp, f) = 
        new Bind<'T, 'R>(tramp, f) :> ITramp<'R>
    member self.Delay f = 
        new Delay<_>(f) :> ITramp<_>
   
let tramp = new TrampBuilder()

let run (tramp : ITramp<'T>) = tramp.Run()

// Example
let rec inc a = 
    tramp {
        if a = 1 then return 1
        else
            let! x = inc (a - 1)
            return x + 1
    } 

inc 1000000 |> run
union case TrampValue.DelayValue: Delay<'T> -> TrampValue<'T>
Multiple items
type Delay<'T> =
  interface ITramp<'T>
  new : f:(unit -> ITramp<'T>) -> Delay<'T>
  member Func : (unit -> ITramp<'T>)

Full name: Script.Delay<_>

--------------------
new : f:(unit -> ITramp<'T>) -> Delay<'T>
union case TrampValue.ReturnValue: Return<'T> -> TrampValue<'T>
Multiple items
type Return<'T> =
  interface ITramp<'T>
  new : x:'T -> Return<'T>
  member Value : 'T

Full name: Script.Return<_>

--------------------
new : x:'T -> Return<'T>
union case TrampValue.BindValue: IBind<'T> -> TrampValue<'T>
type IBind<'T> =
  interface
    abstract member Bind : ('T -> ITramp<'R>) -> ITramp<'R>
  end

Full name: Script.IBind<_>
type ITramp<'T> =
  interface
    abstract member Run : unit -> 'T
    abstract member Value : TrampValue<'T>
  end

Full name: Script.ITramp<_>
abstract member ITramp.Value : TrampValue<'T>

Full name: Script.ITramp`1.Value
type TrampValue<'T> =
  | DelayValue of Delay<'T>
  | ReturnValue of Return<'T>
  | BindValue of IBind<'T>

Full name: Script.TrampValue<_>
abstract member ITramp.Run : unit -> 'T

Full name: Script.ITramp`1.Run
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
val f : (unit -> ITramp<'T>)
val self : Delay<'T>
member Delay.Func : (unit -> ITramp<'T>)

Full name: Script.Delay`1.Func
override Delay.Value : TrampValue<'T>

Full name: Script.Delay`1.Value
override Delay.Run : unit -> 'T

Full name: Script.Delay`1.Run
val x : 'T
val self : Return<'T>
member Return.Value : 'T

Full name: Script.Return`1.Value
override Return.Value : TrampValue<'T>

Full name: Script.Return`1.Value
override Return.Run : unit -> 'T

Full name: Script.Return`1.Run
Multiple items
abstract member IBind.Bind : ('T -> ITramp<'R>) -> ITramp<'R>

Full name: Script.IBind`1.Bind

--------------------
type Bind<'T,'R> =
  interface ITramp<'R>
  interface IBind<'R>
  new : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> Bind<'T,'R>

Full name: Script.Bind<_,_>

--------------------
new : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> Bind<'T,'R>
Multiple items
type Bind<'T,'R> =
  interface ITramp<'R>
  interface IBind<'R>
  new : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> Bind<'T,'R>

Full name: Script.Bind<_,_>

--------------------
new : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> Bind<'T,'R>
val tramp : ITramp<'T>
val f : ('T -> ITramp<'R>)
val self : Bind<'T,'R>
Multiple items
override Bind.Bind : f':('R -> ITramp<'K>) -> ITramp<'K>

Full name: Script.Bind`2.Bind

--------------------
type Bind<'T,'R> =
  interface ITramp<'R>
  interface IBind<'R>
  new : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> Bind<'T,'R>

Full name: Script.Bind<_,_>

--------------------
new : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> Bind<'T,'R>
val f' : ('R -> ITramp<'K>)
val t : 'T
val r : 'R
override Bind.Value : TrampValue<'R>

Full name: Script.Bind`2.Value
override Bind.Run : unit -> 'R

Full name: Script.Bind`2.Run
property ITramp.Value: TrampValue<'T>
val b : IBind<'T>
abstract member IBind.Bind : ('T -> ITramp<'R>) -> ITramp<'R>
val r : Return<'T>
property Return.Value: 'T
val d : Delay<'T>
property Delay.Func: unit -> ITramp<'T>
Multiple items
type TrampBuilder =
  new : unit -> TrampBuilder
  member Bind : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> ITramp<'R>
  member Delay : f:(unit -> ITramp<'a>) -> ITramp<'a>
  member Return : a:'b -> ITramp<'b>

Full name: Script.TrampBuilder

--------------------
new : unit -> TrampBuilder
val self : TrampBuilder
Multiple items
member TrampBuilder.Return : a:'b -> ITramp<'b>

Full name: Script.TrampBuilder.Return

--------------------
type Return<'T> =
  interface ITramp<'T>
  new : x:'T -> Return<'T>
  member Value : 'T

Full name: Script.Return<_>

--------------------
new : x:'T -> Return<'T>
val a : 'b
Multiple items
member TrampBuilder.Bind : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> ITramp<'R>

Full name: Script.TrampBuilder.Bind

--------------------
type Bind<'T,'R> =
  interface ITramp<'R>
  interface IBind<'R>
  new : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> Bind<'T,'R>

Full name: Script.Bind<_,_>

--------------------
new : tramp:ITramp<'T> * f:('T -> ITramp<'R>) -> Bind<'T,'R>
Multiple items
member TrampBuilder.Delay : f:(unit -> ITramp<'a>) -> ITramp<'a>

Full name: Script.TrampBuilder.Delay

--------------------
type Delay<'T> =
  interface ITramp<'T>
  new : f:(unit -> ITramp<'T>) -> Delay<'T>
  member Func : (unit -> ITramp<'T>)

Full name: Script.Delay<_>

--------------------
new : f:(unit -> ITramp<'T>) -> Delay<'T>
val f : (unit -> ITramp<'a>)
val tramp : TrampBuilder

Full name: Script.tramp
val run : tramp:ITramp<'T> -> 'T

Full name: Script.run
abstract member ITramp.Run : unit -> 'T
val inc : a:int -> ITramp<int>

Full name: Script.inc
val a : int
val x : int
Raw view New version

More information

Link:http://fssnip.net/dK
Posted:4 years ago
Author:Nick Palladinos
Tags: monad , trampoline