Last active
November 4, 2023 00:50
-
-
Save mrange/0cde624b7cb7b34973b2 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
// ---------------------------------------------------------------------------- | |
open System | |
open System.Threading | |
open System.Collections.Generic | |
// ---------------------------------------------------------------------------- | |
type Continuation<'T> = 'T -> unit | |
type Coroutine<'T> = Continuation<'T> -> unit | |
// ---------------------------------------------------------------------------- | |
module Coroutine = | |
let Bind (t : Coroutine<'T>) (fu : 'T -> Coroutine<'U>) : Coroutine<'U> = | |
fun continuation -> | |
let inner tv = | |
let u = fu tv | |
u continuation | |
t inner | |
let Combine (t : Coroutine<'T>) (u : Coroutine<'U>) : Coroutine<'U> = | |
fun continuation -> | |
let inner _ = | |
u continuation | |
t inner | |
let Delay (ft : unit -> Coroutine<'T>) : Coroutine<'T> = | |
fun continuation -> | |
let t = ft () | |
t continuation | |
let For (s : seq<'T>) (ft : 'T -> Coroutine<unit>) : Coroutine<unit> = | |
fun continuation -> | |
let e = s.GetEnumerator () | |
let rec loop () = | |
if e.MoveNext () then | |
let t = ft e.Current | |
t loop | |
else | |
e.Dispose () | |
continuation () | |
loop () | |
let Return v : Coroutine<'T> = | |
fun continuation -> | |
continuation v | |
let ReturnFrom t : Coroutine<'T> = t | |
let While (test : unit -> bool) (t : Coroutine<unit>) : Coroutine<unit> = | |
fun continuation -> | |
let rec loop () = | |
if test () then | |
t loop | |
else | |
continuation () | |
loop () | |
let Zero : Coroutine<unit> = | |
fun continuation -> | |
continuation () | |
type CoroutineBuilder() = | |
member x.Bind (t, fu) = Bind t fu | |
member x.Combine (t,u) = Combine t u | |
member x.Delay (ft) = Delay ft | |
member x.For (s, ft) = For s ft | |
member x.Return (v) = Return v | |
member x.ReturnFrom (t) = ReturnFrom t | |
member x.While (test, t)= While test t | |
member x.Zero () = Zero | |
let coroutine = Coroutine.CoroutineBuilder() | |
let (Yield : Coroutine<unit>, RunYielded: unit -> unit) = | |
let yielded = Queue<unit->unit> () | |
let y continuation = | |
yielded.Enqueue continuation | |
let run () = | |
while yielded.Count > 0 do | |
yielded.Dequeue () () | |
y, run | |
let ( >>= ) (t, fu) = Coroutine.Bind t fu | |
let Child (t : Coroutine<'T>) : Coroutine<Coroutine<'T>> = | |
fun continuation -> | |
let rc = ref None | |
let rv = ref None | |
let nt : Coroutine<'T> = | |
fun nc -> | |
match !rv with | |
| Some v -> nc v | |
| None -> | |
rc := Some nc | |
let childc v = | |
match !rc with | |
| Some c -> c v | |
| None -> | |
rv := Some v | |
t childc | |
continuation nt | |
let Run (cr : Coroutine<'T>) : 'T = | |
let value = ref None | |
cr <| fun v -> value := Some v | |
RunYielded () | |
(!value).Value | |
// ---------------------------------------------------------------------------- | |
let Trace (kind : string) (i : int) = | |
let tid = Thread.CurrentThread.ManagedThreadId; | |
Console.WriteLine ("{0} - {1}: {2}", tid, kind, i); | |
let Pop (q : Queue<'T>) = | |
coroutine { | |
while q.Count = 0 do | |
do! Yield | |
return q.Dequeue () | |
} | |
let Push (q : Queue<'T>) (v : 'T) : unit = | |
q.Enqueue v | |
let queue = Queue<int> () | |
let rec Popper = | |
coroutine { | |
let! first = Pop queue | |
let mutable v = first | |
while v > -1 do | |
Trace "Popped" v | |
let! rest = Pop queue | |
v <- rest | |
Trace "Pop done" -1 | |
return () | |
} | |
let Pusher = | |
coroutine { | |
for v = 0 to 10 do | |
Trace "Pushed" v | |
Push queue v | |
do! Yield | |
Trace "Push done" -1 | |
Push queue -1 | |
do! Yield | |
} | |
let sample = | |
coroutine { | |
Trace "Sample" 0 | |
let! popper = Child Popper | |
let! pusher = Child Pusher | |
do! popper | |
do! pusher | |
} | |
[<EntryPoint>] | |
[<STAThread>] | |
let main argv = | |
try | |
Run sample | |
with | |
| e -> printfn "Exception: %s" e.Message | |
0 | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
@saboco you are totally free to code it in whatever way you see fit. The syntax for yield is
'T -> M<'T>
and for YieldFrom it isM<'T> -> M<'T>
. The type that you use for'T
is up to the designer of the computation expression. See: https://learn.microsoft.com/en-us/dotnet/fsharp/language-reference/computation-expressions#creating-a-new-type-of-computation-expression(I know this is 4 years in the future since your question, and I didn't write the code above, but maybe it helps someone else happening upon this post)