Skip to content

Instantly share code, notes, and snippets.

@eulerfx eulerfx/cell.fs
Created Nov 24, 2017

Embed
What would you like to do?
type ExecContext () =
class
// TODO: scheduler, storage
end
[<AbstractClass>]
type Cont<'a> () =
abstract RunCont : ExecContext * 'a -> unit
[<AbstractClass>]
type Cell<'a> () =
abstract RunCell : ExecContext * Cont<'a> -> unit
/// Encases the monadic bind operation ('a -> Cell<'b>) -> Cell<'a> -> Cell<'b>
[<AbstractClass>]
type CellBind<'a, 'b> () =
inherit Cell<'b> ()
[<DefaultValue>]
val mutable cellA : Cell<'a>
member __.Init (c:Cell<'a>) =
__.cellA <- c
abstract DoBind : 'a -> Cell<'b>
override __.RunCell (ctx:ExecContext, cont:Cont<'b>) =
__.cellA.RunCell (ctx, CellBindCont(__, cont))
and CellBindCont<'a, 'b> (cb:CellBind<'a, 'b>, contB:Cont<'b>) =
inherit Cont<'a> ()
override __.RunCont (ctx, a:'a) =
cb.DoBind(a).RunCell (ctx, contB)
/// Encases the functor map operation ('a -> 'b) -> Cell<'a> -> Cell<'b>
[<AbstractClass>]
type CellMap<'a, 'b> () =
inherit Cell<'b> ()
[<DefaultValue>]
val mutable cellA : Cell<'a>
member __.Init (c:Cell<'a>) =
__.cellA <- c
abstract DoMap : 'a -> 'b
override __.RunCell (ctx:ExecContext, cont:Cont<'b>) =
__.cellA.RunCell (ctx, CellMapCont(__, cont))
and CellMapCont<'a, 'b> (cb:CellMap<'a, 'b>, contB:Cont<'b>) =
inherit Cont<'a> ()
override __.RunCont (ctx, a:'a) =
contB.RunCont (ctx, cb.DoMap a)
[<AbstractClass>]
type CellDelay<'a> () =
inherit Cell<'a> ()
abstract DoDelay : unit -> Cell<'a>
override __.RunCell (ctx:ExecContext, cont:Cont<'a>) =
__.DoDelay().RunCell(ctx,cont)
type CellAsync<'a> (a:Async<'a>) =
inherit Cell<'a> ()
override __.RunCell (ctx:ExecContext, cont:Cont<'a>) =
let ok a = cont.RunCont (ctx,a)
let err (e:#exn) = ()
Async.StartWithContinuations (a, ok, err, err)
module Cell =
let point (a:'a) : Cell<'a> =
{ new Cell<'a> () with override __.RunCell (ctx,cont) = cont.RunCont (ctx,a) }
let map (f:'a -> 'b) (c:Cell<'a>) : Cell<'b> =
let cm = { new CellMap<'a, 'b> () with override __.DoMap a = f a }
cm.Init c
cm :> _
let bind (f:'a -> Cell<'b>) (c:Cell<'a>) : Cell<'b> =
let cb = { new CellBind<'a, 'b> () with override __.DoBind a = f a }
cb.Init c
cb :> _
let delay (f:unit -> Cell<'a>) : Cell<'a> =
{ new Cell<'a> () with
override __.RunCell (ctx,cont) =
let c = f ()
c.RunCell (ctx,cont) }
let run (c:Cell<'a>) : 'a =
let mutable res = Unchecked.defaultof<_>
let mre = new System.Threading.ManualResetEvent(false)
let ctx = new ExecContext()
let cont =
{ new Cont<'a> () with
override __.RunCont (ctx,a) =
res <- a
mre.Set () |> ignore
() }
c.RunCell (ctx, cont)
mre.WaitOne() |> ignore
res
let ofAsync (a:Async<'a>) : Cell<'a> =
CellAsync<'a> (a) :> _
type Builder () =
member __.Bind (c:Cell<'a>, f:'a -> Cell<'b>) = bind f c
member __.Return (a:'a) = point a
member __.Delay (f:unit -> Cell<'a>) = delay f
[<AutoOpen>]
module CellEx =
let cell = new Cell.Builder ()
let wfB = cell {
return 100
}
let wfA = cell {
let! a = wfB
let! b = Cell.ofAsync (Async.Sleep 100)
return a + 2
}
let result = Cell.run wfA
printfn "%A" result
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.