simple_coroutine.fs

// ----------------------------------------------------------------------------
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

I found this code fascinating.
As long as I searched for good resources to learn continuations an ultimately coroutines, I haven't found any that goes as far as to understand how to desing a code like this. I know there is much that comes from experience with this kind of code, but if you have any article, book or something else that can help me in my learning process it would be very much welcome.

I wanted to know if it's a limitation of f# that almost all implementations I've found yield is always ((unit -> unit) -> unit), it can't be implemented a yield that yields values?

@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 is M<'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)