@@ -1,5 +1,5 @@
11-- | Like Control.Concurrent.MVar.Strict but reduce to HNF, not NF
2−{-# LANGUAGE MagicHash, UnboxedTuples #-}
2+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
33module Control.Distributed.Process.Internal.StrictMVar
44 ( StrictMVar(StrictMVar)
55 , newEmptyMVar
@@ -16,7 +16,11 @@ module Control.Distributed.Process.Internal.StrictMVar
1616
1717import Control.Applicative ((<$>))
1818import Control.Monad ((>=>))
19+#if MIN_VERSION_base(4,6,0)
1920import Control.Exception (evaluate)
21+#else
22+import Control.Exception (evaluate, mask_, onException)
23+#endif
2024import qualified Control.Concurrent.MVar as MVar
2125 ( MVar
2226 , newEmptyMVar
@@ -27,7 +31,9 @@ import qualified Control.Concurrent.MVar as MVar
2731 , withMVar
2832 , modifyMVar_
2933 , modifyMVar
34+#if MIN_VERSION_base(4,6,0)
3035 , modifyMVarMasked
36+#endif
3137 )
3238import GHC.MVar (MVar(MVar))
3339import GHC.IO (IO(IO))
@@ -64,7 +70,16 @@ modifyMVar (StrictMVar v) f = MVar.modifyMVar v (f >=> evaluateFst)
6470 evaluateFst (x, y) = evaluate x >> return (x, y)
6571
6672modifyMVarMasked :: StrictMVar a -> (a -> IO (a, b)) -> IO b
67−modifyMVarMasked (StrictMVar v) f = MVar.modifyMVarMasked v (f >=> evaluateFst)
73+modifyMVarMasked (StrictMVar v) f =
74+#if MIN_VERSION_base(4,6,0)
75+ MVar.modifyMVarMasked v (f >=> evaluateFst)
76+#else
77+ mask_ $ do
78+ a <- MVar.takeMVar v
79+ (a',b) <- (f a >>= evaluate) `onException` MVar.putMVar v a
80+ MVar.putMVar v a'
81+ return b
82+#endif
6883 where
6984 evaluateFst :: (a, b) -> IO (a, b)
7085 evaluateFst (x, y) = evaluate x >> return (x, y)