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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to