Message Passing: Ping Pong

Message Passing sample inspired by Erlang Ping Pong from here: http://erlang.org/doc/getting_started/conc_prog.html

 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:

let tid () = System.Threading.Thread.CurrentThread.ManagedThreadId
let sleep (ms : int) = System.Threading.Thread.Sleep(ms)

type IAgent<'msg> =
   abstract member Inbox : MailboxProcessor<'msg * IAgent<'msg>>
   abstract member Send : 'msg * IAgent<'msg> -> unit

type Msg =
    | Stop
    | Ping of int
    | Pong of int

let send msg receiver sender =
        sleep (1000)
        (sender :> IAgent<Msg>).Send(msg, receiver)

type pingActor() as self =
    let receiver (inbox : MailboxProcessor<Msg * IAgent<Msg>>) =         
        let rec loop () = 
            async {
                let! (msg, actor) = inbox.Receive()
                match msg with                
                | Pong(n) -> 
                    printfn "[%d] Ping received pong : %d" (tid()) n
                    if n > 1 then
                        self |> send (Ping (n - 1)) actor
                        return! loop ()
                    else
                        printfn "[%d] Ping finished" (tid())
                        self |> send Stop actor
                        return ()
                | _ -> return! loop ()
            }
        loop () 
    let inbox = MailboxProcessor.Start(receiver)    
    interface IAgent<Msg> with
          member this.Inbox = inbox
          member this.Send(msg, actor) = actor.Inbox.Post(msg, upcast this)         

type pongActor() as self =
    let receiver (inbox : MailboxProcessor<Msg * IAgent<Msg>>) = 
        let rec loop () = 
            async {
                let! (msg, actor) = inbox.Receive()
                match msg with
                | Stop -> 
                    printfn "[%d] Pong finished" (tid())         
                    return ()
                | Ping(n) -> 
                    printfn "[%d] Pong received ping : %d" (tid()) n
                    self |> send (Pong n) actor
                    return! loop ()
                | _ -> return! loop ()
            }
        loop () 
    let inbox = MailboxProcessor.Start(receiver)    
    interface IAgent<Msg> with
          member this.Inbox = inbox
          member this.Send(msg, actor) = actor.Inbox.Post(msg, upcast this)

let ping = new pingActor()
let pong = new pongActor()

ping |> send (Ping 3) pong

System.Console.ReadLine() |> ignore

val tid : unit -> int

Full name: Script.tid

namespace System

namespace System.Threading

Multiple items
type Thread =
  inherit CriticalFinalizerObject
  new : start:ThreadStart -> Thread + 3 overloads
  member Abort : unit -> unit + 1 overload
  member ApartmentState : ApartmentState with get, set
  member CurrentCulture : CultureInfo with get, set
  member CurrentUICulture : CultureInfo with get, set
  member DisableComObjectEagerCleanup : unit -> unit
  member ExecutionContext : ExecutionContext
  member GetApartmentState : unit -> ApartmentState
  member GetCompressedStack : unit -> CompressedStack
  member GetHashCode : unit -> int
  ...

Full name: System.Threading.Thread

--------------------
System.Threading.Thread(start: System.Threading.ThreadStart) : unit
System.Threading.Thread(start: System.Threading.ParameterizedThreadStart) : unit
System.Threading.Thread(start: System.Threading.ThreadStart, maxStackSize: int) : unit
System.Threading.Thread(start: System.Threading.ParameterizedThreadStart, maxStackSize: int) : unit

property System.Threading.Thread.CurrentThread: System.Threading.Thread

property System.Threading.Thread.ManagedThreadId: int

val sleep : ms:int -> unit

Full name: Script.sleep

val ms : int

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

System.Threading.Thread.Sleep(timeout: System.TimeSpan) : unit
System.Threading.Thread.Sleep(millisecondsTimeout: int) : unit

type IAgent<'msg> =
  interface
    abstract member Send : 'msg * IAgent<'msg> -> unit
    abstract member Inbox : MailboxProcessor<'msg * IAgent<'msg>>
  end

Full name: Script.IAgent<_>

abstract member IAgent.Inbox : MailboxProcessor<'msg * IAgent<'msg>>

Full name: Script.IAgent`1.Inbox

Multiple items
type MailboxProcessor<'Msg> =
  interface IDisposable
  new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:CancellationToken -> MailboxProcessor<'Msg>
  member Post : message:'Msg -> unit
  member PostAndAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply>
  member PostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply
  member PostAndTryAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply option>
  member Receive : ?timeout:int -> Async<'Msg>
  member Scan : scanner:('Msg -> Async<'T> option) * ?timeout:int -> Async<'T>
  member Start : unit -> unit
  member TryPostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply option
  ...

Full name: Microsoft.FSharp.Control.MailboxProcessor<_>

--------------------
new : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:System.Threading.CancellationToken -> MailboxProcessor<'Msg>

abstract member IAgent.Send : 'msg * IAgent<'msg> -> unit

Full name: Script.IAgent`1.Send

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

type Msg =
  | Stop
  | Ping of int
  | Pong of int

Full name: Script.Msg

union case Msg.Stop: Msg

union case Msg.Ping: int -> Msg

union case Msg.Pong: int -> Msg

val send : msg:Msg -> receiver:IAgent<Msg> -> sender:IAgent<Msg> -> unit

Full name: Script.send

val msg : Msg

val receiver : IAgent<Msg>

val sender : IAgent<Msg>

Multiple items
type pingActor =
interface IAgent<Msg>
new : unit -> pingActor

Full name: Script.pingActor

--------------------
new : unit -> pingActor

val self : pingActor

val receiver : (MailboxProcessor<Msg * IAgent<Msg>> -> Async<unit>)

val inbox : MailboxProcessor<Msg * IAgent<Msg>>

val loop : (unit -> Async<unit>)

val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async

val actor : IAgent<Msg>

member MailboxProcessor.Receive : ?timeout:int -> Async<'Msg>

val n : int

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn

static member MailboxProcessor.Start : body:(MailboxProcessor<'Msg> -> Async<unit>) * ?cancellationToken:System.Threading.CancellationToken -> MailboxProcessor<'Msg>

val this : pingActor

override pingActor.Inbox : MailboxProcessor<Msg * IAgent<Msg>>

Full name: Script.pingActor.Inbox

override pingActor.Send : msg:Msg * actor:IAgent<Msg> -> unit

Full name: Script.pingActor.Send

property IAgent.Inbox: MailboxProcessor<Msg * IAgent<Msg>>

member MailboxProcessor.Post : message:'Msg -> unit

Multiple items
type pongActor =
interface IAgent<Msg>
new : unit -> pongActor

Full name: Script.pongActor

--------------------
new : unit -> pongActor

val self : pongActor

val this : pongActor

override pongActor.Inbox : MailboxProcessor<Msg * IAgent<Msg>>

Full name: Script.pongActor.Inbox

override pongActor.Send : msg:Msg * actor:IAgent<Msg> -> unit

Full name: Script.pongActor.Send

val ping : pingActor

Full name: Script.ping

val pong : pongActor

Full name: Script.pong

type Console =
  static member BackgroundColor : ConsoleColor with get, set
  static member Beep : unit -> unit + 1 overload
  static member BufferHeight : int with get, set
  static member BufferWidth : int with get, set
  static member CapsLock : bool
  static member Clear : unit -> unit
  static member CursorLeft : int with get, set
  static member CursorSize : int with get, set
  static member CursorTop : int with get, set
  static member CursorVisible : bool with get, set
  ...

Full name: System.Console

System.Console.ReadLine() : string

val ignore : value:'T -> unit

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

Raw view Test code New version

More information

Link:	http://fssnip.net/7PC
Posted:	8 years ago
Author:	Fabio Galuppo
Tags:	mailboxprocessor , message passing