X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent%2FMVar.hs;h=9a95b8ff0817236d34d952bd8e0673da8c6b2f97;hb=41e8fba828acbae1751628af50849f5352b27873;hp=d4a1a4822edd7a293ecc9712e7d7c1e0d81b70fa;hpb=6dabfc0c6c48e9b370dfb23f07d1459d06e1b59b;p=ghc-base.git diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs index d4a1a48..9a95b8f 100644 --- a/Control/Concurrent/MVar.hs +++ b/Control/Concurrent/MVar.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP, NoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.MVar @@ -40,13 +42,18 @@ import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, #endif #ifdef __GLASGOW_HASKELL__ -import GHC.Conc ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, +import GHC.MVar ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer ) #endif +#ifdef __GLASGOW_HASKELL__ +import GHC.Base +#else import Prelude -import Control.Exception +#endif + +import Control.Exception.Base {-| This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value @@ -54,7 +61,7 @@ import Control.Exception -} readMVar :: MVar a -> IO a readMVar m = - block $ do + mask_ $ do a <- takeMVar m putMVar m a return a @@ -67,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 @@ -83,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 @@ -97,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' {-| @@ -109,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