4 people like it.

Semi-Coroutine

This snippet implements a semi-coroutine by continuations.

Semi-Coroutine

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
open FSharpx.Continuation

type Fiber<'T>(f : 'T -> Cont<'T, 'T>) =
  let alive : bool ref = ref true
  let cont : ('T -> Cont<'T, 'T>) ref = ref <| fun x -> cont {
    let! result = f x
    alive := false
    return result
  }
  member this.Yield(x : 'T) : Cont<'T, 'T> =
    callcc <| fun exit ->
      let c = !cont
      cont := exit
      c x
  member this.Resume(x : 'T) : 'T = 
    this.Yield(x) id raise
  member this.IsAlive : bool = !alive

Examples

 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: 
let rec hw = new Fiber<string>(fun first -> cont {
  let! second = hw.Yield(first + "!")
  return first + ", " + second + "!"
})

hw.IsAlive
|> printfn "%b"

hw.Resume("Hello")
|> printfn "%s"

hw.IsAlive
|> printfn "%b"

hw.Resume("World")
|> printfn "%s" 

hw.IsAlive
|> printfn "%b"


let rec fib = new Fiber<int>(fun _ -> cont {
  let a, b = ref 0, ref 1
  while true do
    let c = !a
    a := !b
    b := c + !b
    let! _ = fib.Yield(!a)
    return ()
  return failwith "never reach"
})

for _ in 1..10 do
  fib.Resume(0)
  |> printfn "%d"
Multiple items
type Fiber<'T> =
  new : f:('T -> obj) -> Fiber<'T>
  member Resume : x:'T -> 'T
  member Yield : x:'T -> 'a
  member IsAlive : bool

Full name: Script.Fiber<_>

--------------------
new : f:('T -> obj) -> Fiber<'T>
val f : ('T -> obj)
val alive : bool ref
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val cont : ('T -> obj) ref
val x : 'T
val this : Fiber<'T>
member Fiber.Yield : x:'T -> 'a

Full name: Script.Fiber`1.Yield
val exit : ('T -> obj)
val c : ('T -> obj)
member Fiber.Resume : x:'T -> 'T

Full name: Script.Fiber`1.Resume
member Fiber.Yield : x:'T -> 'a
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val raise : exn:System.Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise
member Fiber.IsAlive : bool

Full name: Script.Fiber`1.IsAlive
val hw : Fiber<string>

Full name: Script.hw
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
val first : string
property Fiber.IsAlive: bool
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
member Fiber.Resume : x:'T -> 'T
val fib : Fiber<int>

Full name: Script.fib
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
Raw view Test code New version

More information

Link:http://fssnip.net/96
Posted:12 years ago
Author:einblicker
Tags: continuations , coroutine