X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent%2FMVar.hs;h=9a95b8ff0817236d34d952bd8e0673da8c6b2f97;hb=41e8fba828acbae1751628af50849f5352b27873;hp=521b4996bbea22923ec48b7b20c4e2c02127c71e;hpb=d2063b5b0be014545b21819172c87756efcb0b0c;p=ghc-base.git

diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs
index 521b499..9a95b8f 100644
--- a/Control/Concurrent/MVar.hs
+++ b/Control/Concurrent/MVar.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Concurrent.MVar
@@ -45,7 +47,12 @@ import GHC.MVar ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
                 )
 #endif
 
+#ifdef __GLASGOW_HASKELL__
+import GHC.Base
+#else
 import Prelude
+#endif
+
 import Control.Exception.Base
 
 {-|
@@ -54,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
@@ -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