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
Control.Exception:
finally :: IO a -> IO b -> IO a a `finally` sequel = blockedApply a $ \a' -> do r <- a' `onException` sequel _ <- sequel return r
bracket :: IO a-> (a -> IO b) -> (a -> IO c) -> IO c bracket before after thing = blockedApply2 thing $ \thing' -> do a <- before r <- thing' a `onException` after a _ <- after a return r
bracketOnError :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracketOnError before after thing = blockedApply2 thing $ \thing' -> do a <- before thing' a `onException` after a
Control.Concurrent.MVar:
withMVar :: MVar a -> (a -> IO b) -> IO b withMVar m io = blockedApply2 io $ \io' -> do a <- takeMVar m b <- io' a `onException` putMVar m a putMVar m a return b
modifyMVar_ :: MVar a -> (a -> IO a) -> IO () modifyMVar_ m io = blockedApply2 io $ \io' -> do a <- takeMVar m a' <- io' a `onException` putMVar m a putMVar m a'
modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b modifyMVar m io = blockedApply2 io $ \io' -> do a <- takeMVar m (a',b) <- io' a `onException` putMVar m a putMVar m a' return b
Foreign.Marshal.Pool:
withPool :: (Pool -> IO b) -> IO b withPool act = blockedApply2 act $ \act' -> do pool <- newPool val <- catchAny (act' pool) (\e -> do freePool pool; throw e) freePool pool return val
I'm not proposing to make this change (yet) because I first would like to have some discussion on this. Thanks for reading this rather long mail, Bas