eulerfx · November 24, 2017 21:13 · Nov 24, 2017
diff --git a/cell.fs b/cell.fs
@@ -0,0 +1,137 @@
+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
No results found