5 people like it.
Like the snippet!
The dining philosophers
The dining philosophers problem implemented using a waiter.
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:
|
open System
let flip f x y = f y x
let rec cycle s = seq { yield! s; yield! cycle s }
type Agent<'T> = MailboxProcessor<'T>
type Message = Waiting of (Set<int> * AsyncReplyChannel<unit>) | Done of Set<int>
let reply (c: AsyncReplyChannel<_>) = c.Reply()
let strategy forks waiting =
let aux, waiting = List.partition (fst >> flip Set.isSubset forks) waiting
let forks = aux |> List.map fst |> List.fold (-) forks
List.iter (snd >> reply) aux
forks, waiting
let waiter strategy forkCount =
Agent<_>.Start(fun inbox ->
let rec loop forks waiting =
async { let forks, waiting = strategy forks waiting
let! msg = inbox.Receive()
match msg with
| Waiting r -> return! loop forks (waiting @ [r])
| Done f -> return! loop (forks + f) waiting }
loop (Set.ofList (List.init forkCount id)) [])
let philosopher (waiter: Agent<_>) name forks =
let rng = new Random()
let forks = Set.ofArray forks
Agent<_>.Start(fun inbox ->
let rec loop () =
async { printfn "%s is thinking" name
do! Async.Sleep(rng.Next(100, 500))
printfn "%s is hungry" name
do! waiter.PostAndAsyncReply(fun c -> Waiting (forks, c))
printfn "%s is eating" name
do! Async.Sleep(rng.Next(100, 500))
printfn "%s is done eating" name
waiter.Post(Done (forks))
return! loop () }
loop ())
[<EntryPoint>]
let main args =
let forks = Seq.init 5 id |> cycle |> Seq.windowed 2 |> Seq.take 5 |> Seq.toList
let names = ["plato"; "aristotel"; "kant"; "nietzsche"; "russel"]
let waiter = waiter strategy 5
List.map2 (philosopher waiter) names forks |> ignore
Console.ReadLine() |> ignore
0
|
namespace System
val flip : f:('a -> 'b -> 'c) -> x:'b -> y:'a -> 'c
Full name: Script.flip
val f : ('a -> 'b -> 'c)
val x : 'b
val y : 'a
val cycle : s:seq<'a> -> seq<'a>
Full name: Script.cycle
val s : seq<'a>
Multiple items
val seq : sequence:seq<'T> -> seq<'T>
Full name: Microsoft.FSharp.Core.Operators.seq
--------------------
type seq<'T> = Collections.Generic.IEnumerable<'T>
Full name: Microsoft.FSharp.Collections.seq<_>
type Agent<'T> = MailboxProcessor<'T>
Full name: Script.Agent<_>
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:Threading.CancellationToken -> MailboxProcessor<'Msg>
type Message =
| Waiting of (Set<int> * AsyncReplyChannel<unit>)
| Done of Set<int>
Full name: Script.Message
union case Message.Waiting: (Set<int> * AsyncReplyChannel<unit>) -> Message
Multiple items
module Set
from Microsoft.FSharp.Collections
--------------------
type Set<'T (requires comparison)> =
interface IComparable
interface IEnumerable
interface IEnumerable<'T>
interface ICollection<'T>
new : elements:seq<'T> -> Set<'T>
member Add : value:'T -> Set<'T>
member Contains : value:'T -> bool
override Equals : obj -> bool
member IsProperSubsetOf : otherSet:Set<'T> -> bool
member IsProperSupersetOf : otherSet:Set<'T> -> bool
...
Full name: Microsoft.FSharp.Collections.Set<_>
--------------------
new : elements:seq<'T> -> Set<'T>
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 AsyncReplyChannel<'Reply>
member Reply : value:'Reply -> unit
Full name: Microsoft.FSharp.Control.AsyncReplyChannel<_>
type unit = Unit
Full name: Microsoft.FSharp.Core.unit
union case Message.Done: Set<int> -> Message
val reply : c:AsyncReplyChannel<unit> -> unit
Full name: Script.reply
val c : AsyncReplyChannel<unit>
member AsyncReplyChannel.Reply : value:'Reply -> unit
val strategy : forks:Set<'a> -> waiting:(Set<'a> * AsyncReplyChannel<unit>) list -> Set<'a> * (Set<'a> * AsyncReplyChannel<unit>) list (requires comparison)
Full name: Script.strategy
val forks : Set<'a> (requires comparison)
val waiting : (Set<'a> * AsyncReplyChannel<unit>) list (requires comparison)
val aux : (Set<'a> * AsyncReplyChannel<unit>) list (requires comparison)
Multiple items
module List
from Microsoft.FSharp.Collections
--------------------
type List<'T> =
| ( [] )
| ( :: ) of Head: 'T * Tail: 'T list
interface IEnumerable
interface IEnumerable<'T>
member Head : 'T
member IsEmpty : bool
member Item : index:int -> 'T with get
member Length : int
member Tail : 'T list
static member Cons : head:'T * tail:'T list -> 'T list
static member Empty : 'T list
Full name: Microsoft.FSharp.Collections.List<_>
val partition : predicate:('T -> bool) -> list:'T list -> 'T list * 'T list
Full name: Microsoft.FSharp.Collections.List.partition
val fst : tuple:('T1 * 'T2) -> 'T1
Full name: Microsoft.FSharp.Core.Operators.fst
val isSubset : set1:Set<'T> -> set2:Set<'T> -> bool (requires comparison)
Full name: Microsoft.FSharp.Collections.Set.isSubset
val map : mapping:('T -> 'U) -> list:'T list -> 'U list
Full name: Microsoft.FSharp.Collections.List.map
val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State
Full name: Microsoft.FSharp.Collections.List.fold
val iter : action:('T -> unit) -> list:'T list -> unit
Full name: Microsoft.FSharp.Collections.List.iter
val snd : tuple:('T1 * 'T2) -> 'T2
Full name: Microsoft.FSharp.Core.Operators.snd
val waiter : strategy:(Set<int> -> (Set<int> * AsyncReplyChannel<unit>) list -> Set<int> * (Set<int> * AsyncReplyChannel<unit>) list) -> forkCount:int -> MailboxProcessor<Message>
Full name: Script.waiter
val strategy : (Set<int> -> (Set<int> * AsyncReplyChannel<unit>) list -> Set<int> * (Set<int> * AsyncReplyChannel<unit>) list)
val forkCount : int
val inbox : MailboxProcessor<Message>
val loop : (Set<int> -> (Set<int> * AsyncReplyChannel<unit>) list -> Async<'a>)
val forks : Set<int>
val waiting : (Set<int> * AsyncReplyChannel<unit>) list
val async : AsyncBuilder
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val msg : Message
member MailboxProcessor.Receive : ?timeout:int -> Async<'Msg>
val r : Set<int> * AsyncReplyChannel<unit>
val f : Set<int>
val ofList : elements:'T list -> Set<'T> (requires comparison)
Full name: Microsoft.FSharp.Collections.Set.ofList
val init : length:int -> initializer:(int -> 'T) -> 'T list
Full name: Microsoft.FSharp.Collections.List.init
val id : x:'T -> 'T
Full name: Microsoft.FSharp.Core.Operators.id
val philosopher : waiter:Agent<Message> -> name:string -> forks:int [] -> MailboxProcessor<'a>
Full name: Script.philosopher
val waiter : Agent<Message>
val name : string
val forks : int []
val rng : Random
Multiple items
type Random =
new : unit -> Random + 1 overload
member Next : unit -> int + 2 overloads
member NextBytes : buffer:byte[] -> unit
member NextDouble : unit -> float
Full name: System.Random
--------------------
Random() : unit
Random(Seed: int) : unit
val ofArray : array:'T [] -> Set<'T> (requires comparison)
Full name: Microsoft.FSharp.Collections.Set.ofArray
val inbox : MailboxProcessor<'a>
val loop : (unit -> Async<'b>)
val printfn : format:Printf.TextWriterFormat<'T> -> 'T
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
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<'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 FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken
Full name: Microsoft.FSharp.Control.Async
--------------------
type Async<'T>
Full name: Microsoft.FSharp.Control.Async<_>
static member Async.Sleep : millisecondsDueTime:int -> Async<unit>
Random.Next() : int
Random.Next(maxValue: int) : int
Random.Next(minValue: int, maxValue: int) : int
member MailboxProcessor.PostAndAsyncReply : buildMessage:(AsyncReplyChannel<'Reply> -> 'Msg) * ?timeout:int -> Async<'Reply>
member MailboxProcessor.Post : message:'Msg -> unit
Multiple items
type EntryPointAttribute =
inherit Attribute
new : unit -> EntryPointAttribute
Full name: Microsoft.FSharp.Core.EntryPointAttribute
--------------------
new : unit -> EntryPointAttribute
val main : args:string [] -> int
Full name: Script.main
val args : string []
val forks : int [] list
module Seq
from Microsoft.FSharp.Collections
val init : count:int -> initializer:(int -> 'T) -> seq<'T>
Full name: Microsoft.FSharp.Collections.Seq.init
val windowed : windowSize:int -> source:seq<'T> -> seq<'T []>
Full name: Microsoft.FSharp.Collections.Seq.windowed
val take : count:int -> source:seq<'T> -> seq<'T>
Full name: Microsoft.FSharp.Collections.Seq.take
val toList : source:seq<'T> -> 'T list
Full name: Microsoft.FSharp.Collections.Seq.toList
val names : string list
val waiter : MailboxProcessor<Message>
val map2 : mapping:('T1 -> 'T2 -> 'U) -> list1:'T1 list -> list2:'T2 list -> 'U list
Full name: Microsoft.FSharp.Collections.List.map2
val ignore : value:'T -> unit
Full name: Microsoft.FSharp.Core.Operators.ignore
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
Console.ReadLine() : string
More information