The dining philosophers

 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: 

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 strategy1 forks = function
    | (f: Set<int>, c)::ws when f.IsSubsetOf(forks) -> reply c; forks - f, ws
    | ws -> forks, ws

let strategy2 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 strategy1 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 strategy1 : forks:Set<int> -> _arg1:(Set<int> * AsyncReplyChannel<unit>) list -> Set<int> * (Set<int> * AsyncReplyChannel<unit>) list

Full name: Script.strategy1

val forks : Set<int>

val f : Set<int>

val ws : (Set<int> * AsyncReplyChannel<unit>) list

val strategy2 : forks:Set<'a> -> waiting:(Set<'a> * AsyncReplyChannel<unit>) list -> Set<'a> * (Set<'a> * AsyncReplyChannel<unit>) list (requires comparison)

Full name: Script.strategy2

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