0 people like it.

Ring benchmark (no effects)

 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: 
82: 
83: 
84: 
85: 
86: 
87: 
88: 
89: 
90: 
91: 
    type private Process =
        { Name: string
          ChanSend: Channel<int>
          ChanRecv: Channel<int>
        }

    let private createSendProcess (chanSend : Channel<int>) (chanRecv : Channel<int>) value name m =
        let rec create n = 
            if n = 1 then
                chanSend.Send value
                printfn $"%s{name} sent: %A{value}"
                let recv = chanRecv.Receive
                printfn $"%s{name} received: %A{recv}"
            else 
                chanSend.Send value
                printfn $"%s{name} sent: %A{value}"
                let recv = chanRecv.Receive
                printfn $"%s{name} received: %A{recv}"
                create (n - 1)
        create m

    let private createRecvProcess (chanRecv : Channel<int>) (chanSend : Channel<int>) name m =
        let rec create n =
            if n = 1 then
                let recv = chanRecv.Receive
                printfn $"%s{name} received: %A{recv}"
                let value = recv + 10
                chanSend.Send value
                printfn $"%s{name} sent: %A{value}"
            else
                let recv = chanRecv.Receive
                printfn $"%s{name} received: %A{recv}"
                let value = recv + 10
                chanSend.Send value
                printfn $"%s{name} sent: %A{value}"
                create (n - 1)
        create m

    let processRing processCount roundCount =
        let getRecvChan index (chans : Channel<int> list) =
            match index with
            | i when i - 1 < 0 -> chans.Item (List.length chans - 1)
            | i                -> chans.Item (i - 1)

        let rec createProcesses chans allChans index acc =
            match chans with
            | []    -> acc
            | c::cs -> let proc = {Name = $"p{index}"; ChanSend = c; ChanRecv = getRecvChan index allChans}
                       createProcesses cs allChans (index + 1) (acc @ [proc])

        let rec createProcessRing procs index m =
            match procs with
            | pa::pb::[] when index = 0 -> let sendAsync = async {
                                                            createSendProcess pa.ChanSend pa.ChanRecv 0 pa.Name m
                                                          }
                                           let recvAsync = async {
                                                            createRecvProcess pb.ChanRecv pb.ChanSend pb.Name m
                                                          }
                                           let sendTask = Async.AwaitTask <| Async.StartAsTask sendAsync
                                           let recvTask = Async.AwaitTask <| Async.StartAsTask recvAsync
                                           Async.RunSynchronously sendTask
                                           Async.RunSynchronously recvTask
            | pa::pb::[]                -> let recvAsync1 = async {
                                                            createRecvProcess pa.ChanRecv pa.ChanSend pa.Name m
                                                          }
                                           let recvAsync2 = async {
                                                            createRecvProcess pb.ChanRecv pb.ChanSend pb.Name m
                                                          }
                                           let recvTask1 = Async.AwaitTask <| Async.StartAsTask recvAsync1
                                           let recvTask2 = Async.AwaitTask <| Async.StartAsTask recvAsync2
                                           Async.RunSynchronously recvTask1
                                           Async.RunSynchronously recvTask2
            | p::ps when index = 0      -> let sendAsync = async {
                                                             createSendProcess p.ChanSend p.ChanRecv 0 p.Name m
                                                           }
                                           let sendTask = Async.AwaitTask <| Async.StartAsTask sendAsync
                                           createProcessRing ps (index + 1) m
                                           Async.RunSynchronously sendTask
            | p::ps                     -> let recvAsync = async {
                                                                 createRecvProcess p.ChanRecv p.ChanSend p.Name m
                                                              }
                                           let sendTask = Async.AwaitTask <| Async.StartAsTask recvAsync
                                           createProcessRing ps (index + 1) m
                                           Async.RunSynchronously sendTask
            | _                         -> failwith $"createProcessRing failed! m = %A{m}"

        let chans = [for _ in 1..processCount -> Channel<int>()]

        let processes = createProcesses chans chans 0 []

        createProcessRing processes 0 roundCount
Process.Name: string
Multiple items
val string : value:'T -> string

--------------------
type string = System.String
Process.ChanSend: obj
Multiple items
val int : value:'T -> int (requires member op_Explicit)

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

--------------------
type int<'Measure> = int
Process.ChanRecv: obj
val private createSendProcess : chanSend:'a -> chanRecv:'b -> value:'c -> name:'d -> m:'e -> 'f
val chanSend : 'a
val chanRecv : 'b
val value : 'c
val name : 'd
val m : 'e
val create : (int -> unit)
val n : int
val printfn : format:Printf.TextWriterFormat<'T> -> 'T
Raw view Test code New version

More information

Link:http://fssnip.net/866
Posted:3 years ago
Author:
Tags: