[Haskell-cafe] Re: Asynchronous exception wormholes kill modularity

[Simon Marlow]

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