27 people like it.
Like the snippet!

Object oriented as it was supposed to be ?

The snippet shows implementing object orientation using mail box processor. In this context object orientation have this simple definition: "Objects acts on message passing". The objects created this way are thread safe too :). Not sure how much practical this would be in todays context where object oriented has gone the wrong way.

 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:

module Incrementer = 
    //Interface of our object
    type IncrementerObj = 
        {
            Increment:(int -> unit)
            Decrement:(int -> unit)
            Value:(unit -> int)
        }
    //Internal messages that the object can process
    type private Message = 
                | Increment of int
                | Decrement of int
                | Value of AsyncReplyChannel<int>
    //The constructor for object
    let newIncrementer () = 
        let m = MailboxProcessor<Message>.Start(fun mbox ->
                        let v = ref 0
                        let rec ret () = async {
                                                let! msg = mbox.Receive()
                                                match msg with
                                                | Increment x -> v := !v + x
                                                | Decrement x -> v := !v - x
                                                | Value r -> r.Reply !v
                                                return! ret()
                                            }
                        ret ()
                    )
        {
            Increment = (fun x -> m.Post(Increment x))
            Decrement = (fun x -> m.Post(Decrement x))
            Value = (fun _ -> m.PostAndReply(fun (r:AsyncReplyChannel<int>) -> Value r))
        }


let o = Incrementer.newIncrementer()
o.Increment(10)
o.Increment(100)
o.Decrement(50)
printf "%d" (o.Value())

type IncrementerObj =
  {Increment: int -> unit;
   Decrement: int -> unit;
   Value: unit -> int;}

Full name: Script.Incrementer.IncrementerObj

IncrementerObj.Increment: int -> unit

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

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

IncrementerObj.Decrement: int -> unit

IncrementerObj.Value: unit -> int

type private Message =
  | Increment of int
  | Decrement of int
  | Value of AsyncReplyChannel<int>

Full name: Script.Incrementer.Message

union case Message.Increment: int -> Message

union case Message.Decrement: int -> Message

union case Message.Value: AsyncReplyChannel<int> -> Message

type AsyncReplyChannel<'Reply>
member Reply : value:'Reply -> unit

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

val newIncrementer : unit -> IncrementerObj

Full name: Script.Incrementer.newIncrementer

val m : MailboxProcessor<Message>

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>

val mbox : MailboxProcessor<Message>

val v : int ref

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 ret : (unit -> Async<'a>)

val async : AsyncBuilder

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

val msg : Message

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

val x : int

val r : AsyncReplyChannel<int>

member AsyncReplyChannel.Reply : value:'Reply -> unit

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

member MailboxProcessor.PostAndReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> 'Reply

val o : Incrementer.IncrementerObj

Full name: Script.o

module Incrementer

from Script

val newIncrementer : unit -> Incrementer.IncrementerObj

Full name: Script.Incrementer.newIncrementer

Incrementer.IncrementerObj.Increment: int -> unit

Incrementer.IncrementerObj.Decrement: int -> unit

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

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

Incrementer.IncrementerObj.Value: unit -> int

Raw view Test code New version

More information

Link:	http://fssnip.net/3a
Posted:	13 years ago
Author:	Ankur Dhama
Tags:	object oriented , message passing