I have the following usage of the block queue https://msdn.microsoft.com/en-us/library/vstudio/hh297096(v=vs.100).aspx. How to make sure some of the function executions to be atomic?
The following is a testable example.
// ----------------------------------------------------------------------------
// Blocking queue agent
// ----------------------------------------------------------------------------
open System
open System.Collections.Generic
type Agent<'T> = MailboxProcessor<'T>
type internal BlockingAgentMessage<'T> =
| Add of 'T * AsyncReplyChannel<unit>
| Get of AsyncReplyChannel<'T>
/// Agent that implements an asynchronous blocking queue
type BlockingQueueAgent<'T>(maxLength) =
let agent = Agent.Start(fun agent ->
let queue = new Queue<_>()
let rec emptyQueue() =
agent.Scan(fun msg ->
match msg with
| Add(value, reply) -> Some(enqueueAndContinue(value, reply))
| _ -> None )
and fullQueue() =
agent.Scan(fun msg ->
match msg with
| Get(reply) -> Some(dequeueAndContinue(reply))
| _ -> None )
and runningQueue() = async {
let! msg = agent.Receive()
match msg with
| Add(value, reply) -> return! enqueueAndContinue(value, reply)
| Get(reply) -> return! dequeueAndContinue(reply) }
and enqueueAndContinue (value, reply) = async {
reply.Reply()
queue.Enqueue(value)
return! chooseState() }
and dequeueAndContinue (reply) = async {
reply.Reply(queue.Dequeue())
return! chooseState() }
and chooseState() =
if queue.Count = 0 then emptyQueue()
elif queue.Count < maxLength then runningQueue()
else fullQueue()
// Start with an empty queue
emptyQueue() )
/// Asynchronously adds item to the queue. The operation ends when
/// there is a place for the item. If the queue is full, the operation
/// will block until some items are removed.
member x.AsyncAdd(v:'T, ?timeout) =
agent.PostAndAsyncReply((fun ch -> Add(v, ch)), ?timeout=timeout)
/// Asynchronously gets item from the queue. If there are no items
/// in the queue, the operation will block unitl items are added.
member x.AsyncGet(?timeout) =
agent.PostAndAsyncReply(Get, ?timeout=timeout)
// ----------------------------------------------------------------------------
open System.Threading
let ag = new BlockingQueueAgent<int>(3)
async {
for i in 0 .. 10 do
// The following 5 lines need to be atomic
printfn "1. before add %d" i
Thread.Sleep(1000)
printfn "2. before add %d" i
Thread.Sleep(1000)
printfn "3. before add %d" i
do! ag.AsyncAdd(i)
printfn "Added %d" i }
|> Async.Start
async {
while true do
do! Async.Sleep(1000)
let! v = ag.AsyncGet()
// The following 5 lines need to be atomic
printfn "1. process %d" v
Thread.Sleep(1000)
printfn "2. process %d" v
Thread.Sleep(1000)
printfn "3. process %d" v
printfn "Got %d" v }
|> Async.Start
You could use a Mutex.
In .NET, you can use the Mutex class, if you need interprocess locking.
If you only need to synchronise within an AppDomain, perhaps a lock is enough..?
Related
Building on a snippet and answer, would it be possible to return results to the caller from the throttling queue? I've tried PostAndAsyncReply to receive reply on a channel but it's throwing an error if I pipe it with Enqueue. Here's the code.
Appreciate a F# core vanilla based solution around Queue or Mailbox design patterns.
Question
The question is to be able to call functions asynchronously based on the throttle (max 3 at a time), passing each item from the array, wait on the whole queue/array until it's finished while collecting all the results and then return the results to the caller. (Return the results to the caller is what's pending in here)
Callee Code
// Message type used by the agent - contains queueing
// of work items and notification of completion
type ThrottlingAgentMessage =
| Completed
| Enqueue of Async<unit>
/// Represents an agent that runs operations in concurrently. When the number
/// of concurrent operations exceeds 'limit', they are queued and processed later
let throttlingAgent limit =
MailboxProcessor.Start(fun inbox ->
async {
// The agent body is not executing in parallel,
// so we can safely use mutable queue & counter
let queue = System.Collections.Generic.Queue<Async<unit>>()
let running = ref 0
while true do
// Enqueue new work items or decrement the counter
// of how many tasks are running in the background
let! msg = inbox.Receive()
match msg with
| Completed -> decr running
| Enqueue w -> queue.Enqueue(w)
// If we have less than limit & there is some work to
// do, then start the work in the background!
while running.Value < limit && queue.Count > 0 do
let work = queue.Dequeue()
incr running
do! // When the work completes, send 'Completed'
// back to the agent to free a slot
async {
do! work
inbox.Post(Completed)
}
|> Async.StartChild
|> Async.Ignore
})
let requestDetailAsync (url: string) : Async<Result<string, Error>> =
async {
Console.WriteLine ("Simulating request " + url)
try
do! Async.Sleep(1000) // let's say each request takes about a second
return Ok (url + ":body...")
with :? WebException as e ->
return Error {Code = "500"; Message = "Internal Server Error"; Status = HttpStatusCode.InternalServerError}
}
let requestMasterAsync() : Async<Result<System.Collections.Concurrent.ConcurrentBag<_>, Error>> =
async {
let urls = [|
"http://www.example.com/1";
"http://www.example.com/2";
"http://www.example.com/3";
"http://www.example.com/4";
"http://www.example.com/5";
"http://www.example.com/6";
"http://www.example.com/7";
"http://www.example.com/8";
"http://www.example.com/9";
"http://www.example.com/10";
|]
let results = System.Collections.Concurrent.ConcurrentBag<_>()
let agent = throttlingAgent 3
for url in urls do
async {
let! res = requestDetailAsync url
results.Add res
}
|> Enqueue
|> agent.Post
return Ok results
}
Caller Code
[<TestMethod>]
member this.TestRequestMasterAsync() =
match Entity.requestMasterAsync() |> Async.RunSynchronously with
| Ok result -> Console.WriteLine result
| Error error -> Console.WriteLine error
You could use Hopac.Streams for that. With such tool it is pretty trivial:
open Hopac
open Hopac.Stream
open System
let requestDetailAsync url = async {
Console.WriteLine ("Simulating request " + url)
try
do! Async.Sleep(1000) // let's say each request takes about a second
return Ok (url + ":body...")
with :? Exception as e ->
return Error e
}
let requestMasterAsync() : Stream<Result<string,exn>> =
[| "http://www.example.com/1"
"http://www.example.com/2"
"http://www.example.com/3"
"http://www.example.com/4"
"http://www.example.com/5"
"http://www.example.com/6"
"http://www.example.com/7"
"http://www.example.com/8"
"http://www.example.com/9"
"http://www.example.com/10" |]
|> Stream.ofSeq
|> Stream.mapPipelinedJob 3 (requestDetailAsync >> Job.fromAsync)
requestMasterAsync()
|> Stream.iterFun (printfn "%A")
|> queue //prints all results asynchronously
let allResults : Result<string,exn> list =
requestMasterAsync()
|> Stream.foldFun (fun results cur -> cur::results ) []
|> run //fold stream into list synchronously
ADDED
In case you want to use only vanilla FSharp.Core with mailboxes only try this:
type ThrottlingAgentMessage =
| Completed
| Enqueue of Async<unit>
let inline (>>=) x f = async.Bind(x, f)
let inline (>>-) x f = async.Bind(x, f >> async.Return)
let throttlingAgent limit =
let agent = MailboxProcessor.Start(fun inbox ->
let queue = System.Collections.Generic.Queue<Async<unit>>()
let startWork work =
work
>>- fun _ -> inbox.Post Completed
|> Async.StartChild |> Async.Ignore
let rec loop curWorkers =
inbox.Receive()
>>= function
| Completed when queue.Count > 0 ->
queue.Dequeue() |> startWork
>>= fun _ -> loop curWorkers
| Completed ->
loop (curWorkers - 1)
| Enqueue w when curWorkers < limit ->
w |> startWork
>>= fun _ -> loop (curWorkers + 1)
| Enqueue w ->
queue.Enqueue w
loop curWorkers
loop 0)
Enqueue >> agent.Post
It is pretty much the same logic, but slightly optimized to not use queue if there is free worker capacity (just start job and don't bother with queue/dequeue).
throttlingAgent is a function int -> Async<unit> -> unit
Because we don't want client to bother with our internal ThrottlingAgentMessage type.
use like this:
let throttler = throttlingAgent 3
for url in urls do
async {
let! res = requestDetailAsync url
results.Add res
}
|> throttler
I've written this f# echo server:
open System.Net
open System.Net.Sockets
open System.IO
open System
open System.Text
open System.Collections.Generic
let addr = IPAddress.Parse("127.0.0.1")
let listener = new TcpListener(addr, 2000)
listener.Start()
let rec loop2(c:TcpClient,sr:StreamReader,sw:StreamWriter)=async {
let line=sr.ReadLine()
if not(line=null) then
match line with
|"quit"->
sr.Close()
sw.Close()
c.Close()
|_ ->
if line.Equals("left") then
sw.WriteLine("right")
return! loop2(c,sr,sw)
sw.WriteLine(line)
return! loop2(c,sr,sw)
else
sr.Close()
sw.Close()
c.Close()
}
let loop()=async {
while true do
let c=listener.AcceptTcpClient()
let d = c.GetStream()
let sr = new StreamReader(d)
let sw = new StreamWriter(d)
sw.AutoFlush<-true
Async.Start(loop2(c,sr,sw))
}
Async.RunSynchronously(loop())
This program can do:
echo the client's message
when client said 'left',return 'right'
when client said 'quit',close the connection
but when I run the programming,when a client sent 'left',get 'right',and sent 'quit',i got this exception:
not handled exception: System.ObjectDisposedException: (con't write
to closed) TextWriter。 in
Microsoft.FSharp.Control.CancellationTokenOps.Start#1192-1.Invoke(Exception
e) in .$Control.loop#419-40(Trampoline this,
FSharpFunc2 action) in
Microsoft.FSharp.Control.Trampoline.ExecuteAction(FSharpFunc2
firstAction) in
Microsoft.FSharp.Control.TrampolineHolder.Protect(FSharpFunc`2
firstAction) in
.$Control.-ctor#476-1.Invoke(Object state) in
System.Threading.QueueUserWorkItemCallback.WaitCallback_Context(Object
state) in
System.Threading.ExecutionContext.RunInternal(ExecutionContext
executionContext, ContextCallback callback, Object state,
BooleanpreserveSyncCtx) in
System.Threading.ExecutionContext.Run(ExecutionContext
executionContext, ContextCallback callback, Object state, Boolean
preserveSyncCtx) in
System.Threading.QueueUserWorkItemCallback.System.Threading.IThreadPoolWorkItem.ExecuteWorkItem()
in System.Threading.ThreadPoolWorkQueue.Dispatch() in
System.Threading._ThreadPoolWaitCallback.PerformWaitCallback() . .
.(press any key to continue)
Screenshot of program in action
Screenshot of exception
how can i fix this problem?
The problem is that, unlike what you might expect from its namesake in imperative languages, return in a computation expression doesn't short-circuit. So once the return! in the if line.Equals("right") returns, ie. after the socket has been closed, the code after the if block is run and tries to write to the closed socket. The fix is to put those two lines in an else:
if line.Equals("left") then
sw.WriteLine("right")
return! loop2(c,sr,sw)
else
sw.WriteLine(line)
return! loop2(c,sr,sw)
As an additional style tip, this whole body can be implemented as a match:
let rec loop2(c:TcpClient,sr:StreamReader,sw:StreamWriter)=async {
let line=sr.ReadLine()
match line with
| null | "quit" ->
sr.Close()
sw.Close()
c.Close()
| "left" ->
sw.WriteLine("right")
return! loop2(c,sr,sw)
| _ ->
sw.WriteLine(line)
return! loop2(c,sr,sw)
}
The problem in your code is here:
if line.Equals("left") then
sw.WriteLine("right")
return! loop2(c,sr,sw)
sw.WriteLine(line)
return! loop2(c,sr,sw)
If a "left" is received, it writes "right" and then executes nested loop2s until a "quit" is received. Then, after all of that is complete, it tries to write line and execute more nested loop2s. Of course, by this point, you have disposed of the connection, hence the exception.
It seems like writing line should be in an else block, which would prevent the error:
if line.Equals("left") then
sw.WriteLine("right")
else
sw.WriteLine(line)
return! loop2(c,sr,sw)
Of course, you can also integrate this check with your pattern match. The example below will handle the null checking and each string option all in one structure.
let line = Option.ofObj <| sr.ReadLine()
match line with
|None
|Some("quit") ->
sr.Close()
sw.Close()
|Some("left") ->
sw.WriteLine("right")
return! loop2(c,sr,sw)
|Some(line) ->
sw.WriteLine(line)
return! loop2(c,sr,sw)
Note that your async block is completely useless because you have simply used blocking functions such as AcceptTcpClient(), ReadLine() and WriteLine(). Putting these functions inside an async block does not magically make them asynchronous. If you want to work asynchronously, it has to be async all the way down.
I'm guessing your objective here is to asynchronously accept clients as they arrive, handling each client asynchronously within a different function.
Most of the .NET API in this area is written in terms of Task<'T> rather than the F#-specific async<'T>, so I would recommend creating some helper functions:
let writeLineAsync (sw:StreamWriter) (text : string) =
sw.WriteLineAsync(text).ContinueWith(fun t -> ())
|> Async.AwaitTask
let readLineAsync (sr:StreamReader) =
sr.ReadLineAsync()
|> Async.AwaitTask
let acceptClientAsync (l : TcpListener) =
l.AcceptTcpClientAsync()
|> Async.AwaitTask
Then you can create a properly asynchronous version:
let rec handleClient (c:TcpClient) (sr:StreamReader) (sw:StreamWriter) =
async {
let! line = readLineAsync sr
match Option.ofObj(line) with
|None
|Some("quit")->
sr.Close()
sw.Close()
|Some("left") ->
do! writeLineAsync sw "right"
return! loop2(c,sr,sw)
|Some(line) ->
do! writeLineAsync sw line
return! loop2(c,sr,sw)
}
let loop() =
async {
let! c = acceptClientAsync listener
let sr = new StreamReader(c.GetStream())
let sw = new StreamWriter(c.GetStream())
sw.AutoFlush <- true
do! handleClient c sr sw |> Async.StartChild |> Async.Ignore
return! loop()
}
Background.
I am trying to figure out MailboxProcessor. The idea is to use it as a some kind of state machine and pass arguments around between the states and then quit. Some parts are going to have async communication so I made a Sleep there.
It's a console application, making a Post does nothing because main thread quits and kills everything behind it. I am making a PostAndReply in main.
Also, I have tried without
let sleepWorkflow = async
, doesn't make any difference.
Questions.
(I am probably doing something wrong)
Go24 is not async. Changing RunSynchronously to StartImmediate makes no visible difference. The end should be somewhere below GetMe instead. At the same time Done is printed after Fetch. Isn't the control supposed t be returned to the main thread on sleep?
Go24, wait
go24 1, end
Fetch 1
Done
GetMe
...
Run time is terrible slow. Without delay in Fetch it's about 10s (stopwatch). I thought F# threads are lightweight and should use threadpool.
According to debugger it takes appr 1s to create every and it looks like real threads.
Also, changing to [1..100] will "pause" the program for 100s, according to ProcessExplorer 100 threads are created during that time and only then everything is printed. I would actually prefer fewer threads and slow increase.
Code.
Program.fs
[<EntryPoint>]
let main argv =
let a = Mailbox.MessageBasedCounter.DoGo24 1
let a = Mailbox.MessageBasedCounter.DoFetch 1
let b = Mailbox.MessageBasedCounter.GetMe
let task i = async {
//Mailbox.MessageBasedCounter.DoGo24 1
let a = Mailbox.MessageBasedCounter.DoFetch i
return a
}
let stopWatch = System.Diagnostics.Stopwatch.StartNew()
let x =
[1..10]
|> Seq.map task
|> Async.Parallel
|> Async.RunSynchronously
stopWatch.Stop()
printfn "%f" stopWatch.Elapsed.TotalMilliseconds
printfn "a: %A" a
printfn "b: %A" b
printfn "x: %A" x
0 // return an integer exit code
Mailbox.fs
module Mailbox
#nowarn "40"
type parserMsg =
| Go24 of int
| Done
| Fetch of int * AsyncReplyChannel<string>
| GetMe of AsyncReplyChannel<string>
type MessageBasedCounter () =
/// Create the agent
static let agent = MailboxProcessor.Start(fun inbox ->
// the message processing function
let rec messageLoop() = async{
let! msg = inbox.Receive()
match msg with
| Go24 n ->
let sleepWorkflow = async{
printfn "Go24, wait"
do! Async.Sleep 4000
MessageBasedCounter.DoDone() // POST Done.
printfn "go24 %d, end" n
return! messageLoop()
}
Async.RunSynchronously sleepWorkflow
| Fetch (i, repl) ->
let sync = async{
printfn "Fetch %d" i
do! Async.Sleep 1000
repl.Reply( "Reply Fetch " + i.ToString() ) // Reply to the caller
return! messageLoop()
}
Async.RunSynchronously sync
| GetMe (repl) ->
let sync = async{
printfn "GetMe"
repl.Reply( "GetMe" ) // Reply to the caller
return! messageLoop()
}
Async.RunSynchronously sync
| Done ->
let sync = async{
printfn "Done"
return! messageLoop()
}
Async.RunSynchronously sync
}
// start the loop
messageLoop()
)
// public interface to hide the implementation
static member DoDone () = agent.Post( Done )
static member DoGo24 (i:int) = agent.Post( Go24(i) )
static member DoFetch (i:int) = agent.PostAndReply( fun reply -> Fetch(i, reply) )
static member GetMe = agent.PostAndReply( GetMe )
I'm not necessarily sure that this is the main problem, but the nested asyncs and Async.RunSynchrously in the agent code look suspicious.
You do not need to create a nested async - you can just call asynchronous operations in the body of the match clauses directly:
// the message processing function
let rec messageLoop() = async{
let! msg = inbox.Receive()
match msg with
| Go24 n ->
printfn "Go24, wait"
do! Async.Sleep 4000
MessageBasedCounter.DoDone()
printfn "go24 %d, end" n
return! messageLoop()
| Fetch (i, repl) ->
(...)
Aside from that, it is important to understand that the agent has exactly one instance of the body computation running. So, if you block the body of the agent, all other operations will be queued.
If you want to start some task (like the synchronous operations) in the background and resume the agent immediately, you can use Async.Start inside the body (but be sure to call the main loop recursively in the main part of the body):
| Go24 n ->
// Create work item that will run in the background
let work = async {
printfn "Go24, wait"
do! Async.Sleep 4000
MessageBasedCounter.DoDone()
printfn "go24 %d, end" n }
// Queue the work in a thread pool to be processed
Async.Start(work)
// Continue the message loop, waiting for other messages
return! messageLoop()
I am using F# mailBoxProcessor to asynchronously process messages received from multiple network ends.
The code works as expected until I added function call getTreasuryYield after inbox.receive().
It gets stuck every time at inbox.receive() after running for a few seconds.
GetTreasuryYield is a quite slow method since it involves database and IO operations, but I
still do not understand how it gets stuck.
Any HELP will be appreciated.
let start rvSetting (agent:Agent<Message>) messageSelector=
try
TIBCO.Rendezvous.Environment.Open()
let _transport = new NetTransport(rvSetting.rvService, rvSetting.rvNetwork, rvSetting.rvDaemon)
let _listener = new Listener(TIBCO.Rendezvous.Queue.Default, _transport, rvSetting.rvSubject, null)
_listener.MessageReceived.Add(fun args->
printfn "before sent"
if messageSelector(args.Message) then
printfn "Message sent to agent: %A" args.Message
agent.Post(args.Message))
let rec dispatch() =
async{
try
TIBCO.Rendezvous.Queue.Default.Dispatch()
return! dispatch()
with
| e -> _log.Error(e.ToString())
}
Async.Start(dispatch())
with
|e -> printfn "%A" e.Message
_log.Error(e.Message)
let agent = new Agent<Message>(fun inbox ->
let rec loop() =
async{
let! (m : Message) = inbox.Receive()
// This line causes the problem
printfn "%A" (getTreasuryYieldFromMessage m)
Async.Start(treasuryAction m)
return! loop()
}
loop())
agent.Error.Add raise
[<EntryPoint>]
let main argv =
//start rvCorporate agent (fun x -> true)
agent.Start()
start rvTreasury agent treasurySelector
Console.ReadLine() |> ignore
0
I have an F# 3.0 agent wrapped in a class:
type AgentWrapper() =
let myAgent = Agent.Start(fun inbox ->
let rec loop (state: int) =
async {
let! (replyChannel: AsyncReplyChannel<int>) = inbox.Receive()
let newState = state + 1
replyChannel.Reply newState
return! loop newState
}
loop 0 )
member private this.agent = myAgent
member this.Send () =
this.agent.PostAndReply (fun replyChannel -> replyChannel)
When I send messages to it as follows:
let f = new AgentWrapper ()
f.Send () |> printf "Reply: %d\n"
f.Send () |> printf "Reply: %d\n"
f.Send () |> printf "Reply: %d\n"
I get the expected responses:
Reply: 1
Reply: 2
Reply: 3
However, if I remove the let binding for the agent and directly assign it to the this.agent property:
type AgentWrapper() =
member private this.agent = Agent.Start(fun inbox ->
let rec loop (state: int) =
async {
let! (replyChannel: AsyncReplyChannel<int>) = inbox.Receive()
let newState = state + 1
replyChannel.Reply newState
return! loop newState
}
loop 0 )
member this.Send () =
this.agent.PostAndReply (fun replyChannel -> replyChannel)
I then get the responses:
Reply: 1
Reply: 1
Reply: 1
I've been staring at this for hours and I can't understand why the agent is getting re-initialised every time I call AgentWrapper.Send. It feels like this.agent is getting reassigned every time I call it (i.e. acting like a method, not a property). What am I missing?
It feels like this.agent is getting reassigned every time I call it
(i.e. acting like a method, not a property). What am I missing?
This is exactly what happens, and is documented in the spec (relevant part from 18.13.1 follows)
Static and instance property members are evaluated every time the
member is invoked. For example, in the following, the body of the
member is evaluated each time C.Time is evaluated:
type C () =
static member Time = System.DateTime.Now
This is analgous to your situation