git.iko.soy/distributed-process
on master help sign in
Replacement for modifyMVarMasked for GHC <= 7.4.
b3037d8Mathieu Boespflug
src/Control/Distributed/Process/Internal/StrictMVar.hs+17−2
compare with master
unifiedsplit
@@ -1,5 +1,5 @@
1-- | Like Control.Concurrent.MVar.Strict but reduce to HNF, not NF
1-- | Like Control.Concurrent.MVar.Strict but reduce to HNF, not NF
2−{-# LANGUAGE MagicHash, UnboxedTuples #-}
2+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
3module Control.Distributed.Process.Internal.StrictMVar
3module Control.Distributed.Process.Internal.StrictMVar
4 ( StrictMVar(StrictMVar)
4 ( StrictMVar(StrictMVar)
5 , newEmptyMVar
5 , newEmptyMVar
@@ -16,7 +16,11 @@ module Control.Distributed.Process.Internal.StrictMVar
16
16
17import Control.Applicative ((<$>))
17import Control.Applicative ((<$>))
18import Control.Monad ((>=>))
18import Control.Monad ((>=>))
19+#if MIN_VERSION_base(4,6,0)
19import Control.Exception (evaluate)
20import Control.Exception (evaluate)
21+#else
22+import Control.Exception (evaluate, mask_, onException)
23+#endif
20import qualified Control.Concurrent.MVar as MVar
24import qualified Control.Concurrent.MVar as MVar
21 ( MVar
25 ( MVar
22 , newEmptyMVar
26 , newEmptyMVar
@@ -27,7 +31,9 @@ import qualified Control.Concurrent.MVar as MVar
27 , withMVar
31 , withMVar
28 , modifyMVar_
32 , modifyMVar_
29 , modifyMVar
33 , modifyMVar
34+#if MIN_VERSION_base(4,6,0)
30 , modifyMVarMasked
35 , modifyMVarMasked
36+#endif
31 )
37 )
32import GHC.MVar (MVar(MVar))
38import GHC.MVar (MVar(MVar))
33import GHC.IO (IO(IO))
39import GHC.IO (IO(IO))
@@ -64,7 +70,16 @@ modifyMVar (StrictMVar v) f = MVar.modifyMVar v (f >=> evaluateFst)
64 evaluateFst (x, y) = evaluate x >> return (x, y)
70 evaluateFst (x, y) = evaluate x >> return (x, y)
65
71
66modifyMVarMasked :: StrictMVar a -> (a -> IO (a, b)) -> IO b
72modifyMVarMasked :: StrictMVar a -> (a -> IO (a, b)) -> IO b
73+modifyMVarMasked (StrictMVar v) f =
74+#if MIN_VERSION_base(4,6,0)
67−modifyMVarMasked (StrictMVar v) f = MVar.modifyMVarMasked v (f >=> evaluateFst)
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
68 where
83 where
69 evaluateFst :: (a, b) -> IO (a, b)
84 evaluateFst :: (a, b) -> IO (a, b)
70 evaluateFst (x, y) = evaluate x >> return (x, y)
85 evaluateFst (x, y) = evaluate x >> return (x, y)