Limit degree of parallelism using an agent

 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: 

open System.Collections.Generic

/// The agent handles two kind of messages - the 'Start' message is sent
/// when the caller wants to start a new work item. The 'Finished' message
/// is sent (by the agent itself) when one work item is completed.
type LimitAgentMessage = 
  | Start of Async<unit>
  | Finished

/// A function that takes the limit - the maximal number of operations it
/// will run in parallel - and returns an agent that accepts new
/// tasks via the 'Start' message 
let threadingLimitAgent limit = MailboxProcessor.Start(fun inbox -> async {
  // Keep number of items running & queue of items to run later
  // NOTE: We keep an explicit queue, so that we can e.g. start dropping 
  // items if there are too many requests (or do something else)
  // NOTE: The loop is only accessed from one thread at each time
  // so we can just use non-thread-safe queue & mutation
  let queue = Queue<_>()
  let count = ref 0
  while true do
    let! msg = inbox.Receive() 
    // When we receive Start, add the work to the queue
    // When we receive Finished, do count--
    match msg with 
    | Start work -> queue.Enqueue(work)
    | Finished -> decr count
    // After something happened, we check if we can
    // start a next task from the queue
    if count.Value < limit && queue.Count > 0 then
      incr count
      let work = queue.Dequeue()
      // Start it in a thread pool (on background)
      Async.Start(async { 
        do! work
        inbox.Post(Finished) }) })

// Create an agent that can run at most 2 tasks in parallel
// and send 10 work items that take 1 second to the queue 
let agent = threadingLimitAgent 2
for i in 0 .. 10 do
  agent.Post(Start(async {
    do! Async.Sleep(1000)
    printfn "Finished: %d" i
  }))

namespace System

namespace System.Collections

namespace System.Collections.Generic

type LimitAgentMessage =
  | Start of Async<unit>
  | Finished

Full name: Script.LimitAgentMessage


 The agent handles two kind of messages - the 'Start' message is sent
 when the caller wants to start a new work item. The 'Finished' message
 is sent (by the agent itself) when one work item is completed.

union case LimitAgentMessage.Start: Async<unit> -> LimitAgentMessage

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

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

union case LimitAgentMessage.Finished: LimitAgentMessage

val threadingLimitAgent : limit:int -> MailboxProcessor<LimitAgentMessage>

Full name: Script.threadingLimitAgent


 A function that takes the limit - the maximal number of operations it
 will run in parallel - and returns an agent that accepts new
 tasks via the 'Start' message

val limit : int

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>

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

val inbox : MailboxProcessor<LimitAgentMessage>

val async : AsyncBuilder

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

val queue : Queue<Async<unit>>

Multiple items
type Queue<'T> =
  new : unit -> Queue<'T> + 2 overloads
  member Clear : unit -> unit
  member Contains : item:'T -> bool
  member CopyTo : array:'T[] * arrayIndex:int -> unit
  member Count : int
  member Dequeue : unit -> 'T
  member Enqueue : item:'T -> unit
  member GetEnumerator : unit -> Enumerator<'T>
  member Peek : unit -> 'T
  member ToArray : unit -> 'T[]
  ...
  nested type Enumerator

Full name: System.Collections.Generic.Queue<_>

--------------------
Queue() : unit
Queue(capacity: int) : unit
Queue(collection: IEnumerable<'T>) : unit

val count : 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 msg : LimitAgentMessage

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

val work : Async<unit>

Queue.Enqueue(item: Async<unit>) : unit

val decr : cell:int ref -> unit

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

property Ref.Value: int

property Queue.Count: int

val incr : cell:int ref -> unit

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

Queue.Dequeue() : Async<unit>

static member Async.Start : computation:Async<unit> * ?cancellationToken:System.Threading.CancellationToken -> unit

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

val agent : MailboxProcessor<LimitAgentMessage>

Full name: Script.agent

val i : int32

static member Async.Sleep : millisecondsDueTime:int -> Async<unit>

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

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