HalloWelt

HalloWelt_MessageChains_01.fsx

open System
open System.Threading

// Operator overload for the post message.
let (<!) (proc : MailboxProcessor<_>) msg = proc.Post(msg) 

// Helpers
let thread_id = (fun () -> System.Threading.Thread.CurrentThread.ManagedThreadId)
let start f = MailboxProcessor.Start f

let hallo_actor (next : MailboxProcessor<_>) = 
    start(fun inbox -> 
        printfn "Hallo process (id=%d) is linked to %s" (thread_id()) (next.ToString())
        let rec loop () = async { 
            let! msg = inbox.Receive()
            printfn "Hallo process (id=%d) receives message: %s" (thread_id()) msg
            next <! msg + " Hallo"
            return! loop()}
        loop())
            

let welt_actor (next : MailboxProcessor<_>) = 
    start(fun inbox -> 
        printfn "Welt process (id=%d) is linked to %s" (thread_id()) (next.ToString())
        let rec loop () = async { 
            let! msg = inbox.Receive()
            printfn "Welt process (id=%d) receives message: %s" (thread_id()) msg
            next <! msg + " Welt"
            return! loop()}
        loop())


let print_actor =
    start(fun inbox -> 
        let rec loop () = async { 
            let! msg = inbox.Receive()
            printfn "Print process (id=%d) receives message: %s" (thread_id()) msg
            return! loop()}
        loop())

let agent_chain = hallo_actor (welt_actor (print_actor))
agent_chain <! "Ich sage"

HalloWelt_MessageChains_02.fsx

// /////////////////////////////////////////////////////
//
// First attempt to make it look a bit more Erlang like
//
// /////////////////////////////////////////////////////
open System
open System.Threading

// Operator overload for the post message.
let (<!) (proc : MailboxProcessor<_>) msg = proc.Post(msg) 

// Message type
type command = 
    | Next of MailboxProcessor<command>
    | Msg of string
    

// Helpers
let thread_id = (fun () -> System.Threading.Thread.CurrentThread.ManagedThreadId)
let spawn = MailboxProcessor<command>.Start

let hallo_node = (fun (actor : MailboxProcessor<command>) -> 
        let rec loop (next_actor) = async { 
            let! msg = actor.Receive()
            match msg with
            | Next next ->
                printfn "Hallo process (id=%d) is linked to %s" (thread_id()) (next.ToString())
                return! loop(Some(next))
            | Msg s -> 
                printfn "Hallo process (id=%d) receives message: %s" (thread_id()) s
                next_actor.Value <! Msg(s + " Hallo")
                return! loop(None)
            | _ -> return ()}
        loop(None))

let welt_node = (fun (actor : MailboxProcessor<command>) -> 
        let rec loop (next_actor) = async { 
            let! msg = actor.Receive()
            match msg with
            | Next next ->
                printfn "Welt process (id=%d) is linked to %s" (thread_id()) (next.ToString())
                return! loop(Some(next))
            | Msg s -> 
                printfn "Welt process (id=%d) receives message: %s" (thread_id()) s
                next_actor.Value <! Msg(s + " Welt")
                return! loop(None)
            | _ -> return ()}
        loop(None))


let print_node = (fun (actor : MailboxProcessor<command>) -> 
        let rec loop () = async { 
            let! msg = actor.Receive()
            match msg with
            | Msg s -> 
                printfn "Print process (id=%d) receives message: %s" (thread_id()) s
                return! loop() 
            | _ -> 
                printfn "puke"
                return ()}
        loop())

let hallo = spawn hallo_node
let welt = spawn welt_node
let print = spawn print_node

hallo <! Next welt
welt <! Next print
hallo <! Msg "Ich sage"

HalloWelt_MessageChains_03.fsx

open System
open System.Threading

// Operator overload for the post message.
let (<!) (proc : MailboxProcessor<_>) msg = proc.Post(msg) 

// Message type
type command = 
    | Next of MailboxProcessor<command>
    | Msg of string

// Helpers
let thread_id = (fun () -> System.Threading.Thread.CurrentThread.ManagedThreadId)
let spawn = MailboxProcessor<command>.Start

// Generalised message receiver
let receive (actor : MailboxProcessor<command>) msg_proc = 
        let rec loop next_actor = async { 
            let! msg = actor.Receive()
            let result = msg_proc (msg, next_actor)
            return! loop result
            }
        loop None


let hallo_node = (fun actor -> 
        receive actor (fun (msg, next_actor) -> 
            match msg with
            | Next next ->
                printfn "Hallo process (id=%d) is linked to %s" (thread_id()) (next.ToString())
                Some(next)
            | Msg s ->
                printfn "Hallo process (id=%d) receives message: %s" (thread_id()) s 
                next_actor.Value <! Msg(s + " Hallo")
                None
        ))


let welt_node = (fun actor -> 
        receive actor ( fun (msg, next_actor) -> 
            match msg with
            | Next next ->
                printfn "Welt process (id=%d) is linked to %s" (thread_id()) (next.ToString())
                Some(next)
            | Msg s ->
                printfn "Welt process (id=%d) receives message: %s" (thread_id()) s 
                next_actor.Value <! Msg(s + " Welt")
                None
        ))

let print_node = (fun actor -> 
        receive actor ( fun (msg, next_actor) -> 
            match msg with
            | Msg s ->
                printfn "Print process (id=%d) receives message: %s" (thread_id()) s
                None
            | _ ->
                printfn "puke"
                None
        ))

let hallo = spawn hallo_node
let welt = spawn welt_node
let print = spawn print_node

hallo <! Next welt
welt <! Next print
hallo <! Msg "Ich sage"

Output

> 
Hallo process (id=6) is linked to Microsoft.FSharp.Control.FSharpMailboxProcessor`1[System.String]

val agent_chain : MailboxProcessor<string>

Welt process (id=3) is linked to Microsoft.FSharp.Control.FSharpMailboxProcessor`1[System.String]
> 
Hallo process (id=13) receives message: Ich sage
Welt process (id=14) receives message: Ich sage Hallo
Print process (id=14) receives message: Ich sage Hallo Welt
>