On 25/03/2010 11:57, Bas van Dijk wrote:
Dear all, (sorry for this long mail)
When programming in the IO monad you have to be careful about asynchronous exceptions. These nasty little worms can be thrown to you at any point in your IO computation. You have to be extra careful when doing, what must be, an atomic transaction like:
do old<- takeMVar m new<- f old `onException` putMVar m old putMVar m new
If an asynchronous exception is thrown to you right after you have taken your MVar the putMVar will not be executed anymore and will leave your MVar in the empty state. This can possibly lead to dead-lock.
The standard solution for this is to use a function like modifyMVar_:
modifyMVar_ :: MVar a -> (a -> IO a) -> IO () modifyMVar_ m io = block $ do a<- takeMVar m a'<- unblock (io a) `onException` putMVar m a putMVar m a'
As you can see this will first block asynchronous exceptions before taking the MVar.
It is usually better to be in the blocked state as short as possible to ensure that asynchronous exceptions can be handled as soon as possible. This is why modifyMVar_ unblocks the the inner (io a).
However now comes the problem I would like to talk about. What if I want to use modifyMVar_ as part of a bigger atomic transaction. As in:
block $ do ... modifyMVar_ m f ...
From a quick glanse at this code it looks like asynchronous exceptions can't be thrown to this transaction because we block them. However the unblock in modifyMVar_ opens an asynchronous exception "wormhole" right into our blocked computation. This destroys modularity.
Besides modifyMVar_ the following functions suffer the same problem:
* Control.Exception.finally/bracket/bracketOnError * Control.Concurrent.MVar.withMVar/modifyMVar_/modifyMVar * Foreign.Marshal.Pool.withPool
We can solve it by introducing two handy functions 'blockedApply' and 'blockedApply2' and wrapping each of the operations in them:
import Control.Exception import Control.Concurrent.MVar import Foreign.Marshal.Pool import GHC.IO ( catchAny )
blockedApply :: IO a -> (IO a -> IO b) -> IO b blockedApply a f = do b<- blocked if b then f a else block $ f $ unblock a
blockedApply2 :: (c -> IO a) -> ((c -> IO a) -> IO b) -> IO b blockedApply2 g f = do b<- blocked if b then f g else block $ f $ unblock . g
Nice, I hadn't noticed that you can now code this up in the library since we added 'blocked'. Unfortunately this isn't cheap: 'blocked' is currently an out-of-line call to the RTS, so if we want to start using it for important things like finally and bracket, then we should put some effort into optimising it. I'd also be amenable to having block/unblock count nesting levels instead, I don't think it would be too hard to implement and it wouldn't require any changes at the library level. Incedentally, I've been using the term "mask" rather than "block" in this context, as "block" is far too overloaded. It would be nice to change the terminology in the library too, leaving the old functions around for backwards compatibility of course. Cheers, Simon