X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent%2FMVar.hs;h=9a95b8ff0817236d34d952bd8e0673da8c6b2f97;hb=41e8fba828acbae1751628af50849f5352b27873;hp=352d01ec138dfcefc6d50548273475680218245f;hpb=167f2174f717dc3698c9e66928860cd8e6fb822b;p=ghc-base.git diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs index 352d01e..9a95b8f 100644 --- a/Control/Concurrent/MVar.hs +++ b/Control/Concurrent/MVar.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.MVar @@ -60,7 +61,7 @@ import Control.Exception.Base -} readMVar :: MVar a -> IO a readMVar m = - block $ do + mask_ $ do a <- takeMVar m putMVar m a return a @@ -73,7 +74,7 @@ readMVar m = -} swapMVar :: MVar a -> a -> IO a swapMVar mvar new = - block $ do + mask_ $ do old <- takeMVar mvar putMVar mvar new return old @@ -89,9 +90,9 @@ swapMVar mvar new = -- http://www.haskell.org//pipermail/haskell/2006-May/017907.html withMVar :: MVar a -> (a -> IO b) -> IO b withMVar m io = - block $ do + mask $ \restore -> do a <- takeMVar m - b <- unblock (io a) `onException` putMVar m a + b <- restore (io a) `onException` putMVar m a putMVar m a return b @@ -103,9 +104,9 @@ withMVar m io = {-# INLINE modifyMVar_ #-} modifyMVar_ :: MVar a -> (a -> IO a) -> IO () modifyMVar_ m io = - block $ do + mask $ \restore -> do a <- takeMVar m - a' <- unblock (io a) `onException` putMVar m a + a' <- restore (io a) `onException` putMVar m a putMVar m a' {-| @@ -115,8 +116,8 @@ modifyMVar_ m io = {-# INLINE modifyMVar #-} modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b modifyMVar m io = - block $ do + mask $ \restore -> do a <- takeMVar m - (a',b) <- unblock (io a) `onException` putMVar m a + (a',b) <- restore (io a) `onException` putMVar m a putMVar m a' return b