0 people like it.
Like the snippet!

snippet

 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: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81:

open System.Collections.Concurrent

type Channel<'Msg>() =
    let bc = new BlockingCollection<'Msg>()

    member this.Send value =
        bc.Add value

    member this.Receive =
        bc.Take()

type FIOVisitor =
    abstract VisitInput<'Msg, 'Success> : Input<'Msg, 'Success> -> 'Success
    abstract VisitOutput<'Msg, 'Success> : Output<'Msg, 'Success> -> 'Success
    abstract VisitConcurrent<'Async, 'Success> : Concurrent<'Async, 'Success> -> 'Success
    abstract VisitAwait<'Async, 'Success> : Await<'Async, 'Success> -> 'Success
    abstract VisitSucceed<'Success> : Succeed<'Success> -> 'Success
and [<AbstractClass>] FIO<'Success>() =
    abstract Visit<'Success> : FIOVisitor -> 'Success
and Input<'Msg, 'Success>(chan : Channel<'Msg>, cont : 'Msg -> FIO<'Success>) =
    inherit FIO<'Success>()
    member internal this.Chan = chan
    member internal this.Cont = cont
    override this.Visit<'Success>(input) =
        input.VisitInput<'Msg, 'Success>(this)
and Output<'Msg, 'Success>(value : 'Msg, chan : Channel<'Msg>, cont : unit -> FIO<'Success>) =
    inherit FIO<'Success>()
    member internal this.Value = value
    member internal this.Chan = chan
    member internal this.Cont = cont
    override this.Visit<'Success>(input) =
        input.VisitOutput<'Msg, 'Success>(this)
and Concurrent<'Async, 'Success>(eff : FIO<'Async>, cont : Async<'Async> -> FIO<'Success>) =
    inherit FIO<'Success>()
    member internal this.Eff = eff
    member internal this.Cont = cont
    override this.Visit<'Success>(con) =
        con.VisitConcurrent<'Async, 'Success>(this)
and Await<'Async, 'Success>(task : Async<'Async>, cont : 'Async -> FIO<'Success>) =
    inherit FIO<'Success>()
    member internal this.Task = task
    member internal this.Cont = cont
    override this.Visit<'Success>(await) =
        await.VisitAwait<'Async, 'Success>(this)
and Succeed<'Success>(value : 'Success) =
    inherit FIO<'Success>()
    member internal this.Value = value
    override this.Visit<'Success>(input) =
        input.VisitSucceed<'Success>(this)

let Send<'Msg, 'Success>(value : 'Msg, chan : Channel<'Msg>, cont : (unit -> FIO<'Success>)) : Output<'Msg, 'Success> = Output(value, chan, cont)
let Receive<'Msg, 'Success>(chan : Channel<'Msg>, cont : ('Msg -> FIO<'Success>)) : Input<'Msg, 'Success> = Input(chan, cont)
let Parallel<'SuccessA, 'SuccessB, 'SuccessC>(effA : FIO<'SuccessA>, effB : FIO<'SuccessB>, cont : ('SuccessA * 'SuccessB -> FIO<'SuccessC>)) : Concurrent<'SuccessA, 'SuccessC>=
    Concurrent(effA, fun asyncA ->
        Concurrent(effB, fun asyncB ->
            Await(asyncA, fun succA ->
                Await(asyncB, fun succB ->
                    cont (succA, succB)))))
let End() : Succeed<unit> = Succeed ()

let rec NaiveEval<'Success> (eff : FIO<'Success>) : 'Success =
    eff.Visit({ 
        new FIOVisitor with
            member _.VisitInput<'Msg, 'Success>(input : Input<'Msg, 'Success>) =
                let value = input.Chan.Receive
                NaiveEval <| input.Cont value
            member _.VisitOutput<'Msg, 'Success>(output : Output<'Msg, 'Success>) =
                output.Chan.Send output.Value
                NaiveEval <| output.Cont ()
            member _.VisitConcurrent(con) =
                let work = async {
                    return NaiveEval con.Eff
                }
                let task = Async.AwaitTask <| Async.StartAsTask work
                NaiveEval <| con.Cont task
            member _.VisitAwait(await) =
                let succ = Async.RunSynchronously await.Task
                NaiveEval <| await.Cont succ
            member _.VisitSucceed<'Success>(succ : Succeed<'Success>) =
                succ.Value
    })

namespace System

namespace System.Collections

namespace System.Collections.Concurrent

Multiple items
type Channel<'Msg> =
  new : unit -> Channel<'Msg>
  member Send : value:'Msg -> unit
  member Receive : 'Msg

--------------------
new : unit -> Channel<'Msg>

val bc : BlockingCollection<'Msg>

Multiple items
type BlockingCollection<'T> =
  new : unit -> BlockingCollection<'T> + 3 overloads
  member Add : item:'T -> unit + 1 overload
  member BoundedCapacity : int
  member CompleteAdding : unit -> unit
  member CopyTo : array:'T[] * index:int -> unit
  member Count : int
  member Dispose : unit -> unit
  member GetConsumingEnumerable : unit -> IEnumerable<'T> + 1 overload
  member IsAddingCompleted : bool
  member IsCompleted : bool
  ...

--------------------
BlockingCollection() : BlockingCollection<'T>
BlockingCollection(boundedCapacity: int) : BlockingCollection<'T>
BlockingCollection(collection: IProducerConsumerCollection<'T>) : BlockingCollection<'T>
BlockingCollection(collection: IProducerConsumerCollection<'T>, boundedCapacity: int) : BlockingCollection<'T>

val this : Channel<'Msg>

val value : 'Msg

BlockingCollection.Add(item: 'Msg) : unit
BlockingCollection.Add(item: 'Msg, cancellationToken: System.Threading.CancellationToken) : unit

BlockingCollection.Take() : 'Msg
BlockingCollection.Take(cancellationToken: System.Threading.CancellationToken) : 'Msg

Multiple items
type Input<'Msg,'Success> =
  inherit FIO<'Success>
  new : chan:Channel<'Msg> * cont:('Msg -> FIO<'Success>) -> Input<'Msg,'Success>
  override Visit : input:FIOVisitor -> 'Success
  member internal Chan : Channel<'Msg>
  member internal Cont : ('Msg -> FIO<'Success>)

--------------------
new : chan:Channel<'Msg> * cont:('Msg -> FIO<'Success>) -> Input<'Msg,'Success>

Multiple items
type Output<'Msg,'Success> =
  inherit FIO<'Success>
  new : value:'Msg * chan:Channel<'Msg> * cont:(unit -> FIO<'Success>) -> Output<'Msg,'Success>
  override Visit : input:FIOVisitor -> 'Success
  member internal Chan : Channel<'Msg>
  member internal Cont : (unit -> FIO<'Success>)
  member internal Value : 'Msg

--------------------
new : value:'Msg * chan:Channel<'Msg> * cont:(unit -> FIO<'Success>) -> Output<'Msg,'Success>

Multiple items
type Async =
  static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
  static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
  static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
  static member AwaitTask : task:Task -> Async<unit>
  static member AwaitTask : task:Task<'T> -> Async<'T>
  static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
  static member CancelDefaultToken : unit -> unit
  static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
  static member Choice : computations:seq<Async<'T option>> -> Async<'T option>
  static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
  ...

--------------------
type Async<'T> =

Multiple items
type Concurrent<'Async,'Success> =
  inherit FIO<'Success>
  new : eff:FIO<'Async> * cont:(Async<'Async> -> FIO<'Success>) -> Concurrent<'Async,'Success>
  override Visit : con:FIOVisitor -> 'Success
  member internal Cont : (Async<'Async> -> FIO<'Success>)
  member internal Eff : FIO<'Async>

--------------------
new : eff:FIO<'Async> * cont:(Async<'Async> -> FIO<'Success>) -> Concurrent<'Async,'Success>

Multiple items
type Await<'Async,'Success> =
  inherit FIO<'Success>
  new : task:Async<'Async> * cont:('Async -> FIO<'Success>) -> Await<'Async,'Success>
  override Visit : await:FIOVisitor -> 'Success
  member internal Cont : ('Async -> FIO<'Success>)
  member internal Task : Async<'Async>

--------------------
new : task:Async<'Async> * cont:('Async -> FIO<'Success>) -> Await<'Async,'Success>

Multiple items
type Succeed<'Success> =
  inherit FIO<'Success>
  new : value:'Success -> Succeed<'Success>
  override Visit : input:FIOVisitor -> 'Success
  member internal Value : 'Success

--------------------
new : value:'Success -> Succeed<'Success>

Multiple items
type AbstractClassAttribute =
inherit Attribute
new : unit -> AbstractClassAttribute

--------------------
new : unit -> AbstractClassAttribute

Multiple items
type FIO<'Success> =
new : unit -> FIO<'Success>
abstract member Visit : FIOVisitor -> 'Success

--------------------
new : unit -> FIO<'Success>

type FIOVisitor =
  interface
    abstract member VisitAwait : Await<'Async,'Success> -> 'Success
    abstract member VisitConcurrent : Concurrent<'Async,'Success> -> 'Success
    abstract member VisitInput : Input<'Msg,'Success> -> 'Success
    abstract member VisitOutput : Output<'Msg,'Success> -> 'Success
    abstract member VisitSucceed : Succeed<'Success> -> 'Success
  end

val chan : Channel<'Msg>

val cont : ('Msg -> FIO<'Success>)

val this : Input<'Msg,'Success>

val input : FIOVisitor

abstract member FIOVisitor.VisitInput : Input<'Msg,'Success> -> 'Success

val cont : (unit -> FIO<'Success>)

type unit = Unit

val this : Output<'Msg,'Success>

abstract member FIOVisitor.VisitOutput : Output<'Msg,'Success> -> 'Success

val eff : FIO<'Async>

val cont : (Async<'Async> -> FIO<'Success>)

val this : Concurrent<'Async,'Success>

val con : FIOVisitor

abstract member FIOVisitor.VisitConcurrent : Concurrent<'Async,'Success> -> 'Success

val task : Async<'Async>

val cont : ('Async -> FIO<'Success>)

val this : Await<'Async,'Success>

val await : FIOVisitor

abstract member FIOVisitor.VisitAwait : Await<'Async,'Success> -> 'Success

val value : 'Success

val this : Succeed<'Success>

abstract member FIOVisitor.VisitSucceed : Succeed<'Success> -> 'Success

val Send : value:'Msg * chan:Channel<'Msg> * cont:(unit -> FIO<'Success>) -> Output<'Msg,'Success>

val Receive : chan:Channel<'Msg> * cont:('Msg -> FIO<'Success>) -> Input<'Msg,'Success>

val Parallel : effA:FIO<'SuccessA> * effB:FIO<'SuccessB> * cont:('SuccessA * 'SuccessB -> FIO<'SuccessC>) -> Concurrent<'SuccessA,'SuccessC>

val effA : FIO<'SuccessA>

val effB : FIO<'SuccessB>

val cont : ('SuccessA * 'SuccessB -> FIO<'SuccessC>)

val asyncA : Async<'SuccessA>

val asyncB : Async<'SuccessB>

val succA : 'SuccessA

val succB : 'SuccessB

val End : unit -> Succeed<unit>

val NaiveEval : eff:FIO<'Success> -> 'Success

val eff : FIO<'Success>

abstract member FIO.Visit : FIOVisitor -> 'Success

val input : Input<'Msg,'Success>

property Input.Chan: Channel<'Msg> with get

property Channel.Receive: 'Msg with get

property Input.Cont: 'Msg -> FIO<'Success> with get

val output : Output<'Msg,'Success>

property Output.Chan: Channel<'Msg> with get

member Channel.Send : value:'Msg -> unit

property Output.Value: 'Msg with get

property Output.Cont: unit -> FIO<'Success> with get

val con : Concurrent<'a,'b>

val work : Async<'a>

val async : AsyncBuilder

property Concurrent.Eff: FIO<'a> with get

val task : Async<'a>

static member Async.AwaitTask : task:System.Threading.Tasks.Task -> Async<unit>
static member Async.AwaitTask : task:System.Threading.Tasks.Task<'T> -> Async<'T>

static member Async.StartAsTask : computation:Async<'T> * ?taskCreationOptions:System.Threading.Tasks.TaskCreationOptions * ?cancellationToken:System.Threading.CancellationToken -> System.Threading.Tasks.Task<'T>

property Concurrent.Cont: Async<'a> -> FIO<'b> with get

val await : Await<'a,'b>

val succ : 'a

static member Async.RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:System.Threading.CancellationToken -> 'T

property Await.Task: Async<'a> with get

property Await.Cont: 'a -> FIO<'b> with get

val succ : Succeed<'Success>

property Succeed.Value: 'Success with get

Raw view Test code New version

More information

Link:	http://fssnip.net/864
Posted:	4 years ago
Author:
Tags: