git.iko.soy/distributed-process
on 8aed555 help sign in
distributed-process/src/Control/Distributed/Process/Internal/StrictMVar.hs
93 lines 2.5 kB history raw
1-- | Like Control.Concurrent.MVar.Strict but reduce to HNF, not NF
2{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
3module Control.Distributed.Process.Internal.StrictMVar
4 ( StrictMVar(StrictMVar)
5 , newEmptyMVar
6 , newMVar
7 , takeMVar
8 , putMVar
9 , readMVar
10 , withMVar
11 , modifyMVar_
12 , modifyMVar
13 , modifyMVarMasked
14 , mkWeakMVar
15 ) where
17import Control.Applicative ((<$>))
18import Control.Monad ((>=>))
19#if MIN_VERSION_base(4,6,0)
20import Control.Exception (evaluate)
21#else
22import Control.Exception (evaluate, mask_, onException)
23#endif
24import qualified Control.Concurrent.MVar as MVar
25 ( MVar
26 , newEmptyMVar
27 , newMVar
28 , takeMVar
29 , putMVar
30 , readMVar
31 , withMVar
32 , modifyMVar_
33 , modifyMVar
34#if MIN_VERSION_base(4,6,0)
35 , modifyMVarMasked
36#endif
37 )
38import GHC.MVar (MVar(MVar))
39import GHC.IO (IO(IO), unIO)
40import GHC.Exts (mkWeak#)
41import GHC.Weak (Weak(Weak))
43newtype StrictMVar a = StrictMVar (MVar.MVar a)
45newEmptyMVar :: IO (StrictMVar a)
46newEmptyMVar = StrictMVar <$> MVar.newEmptyMVar
48newMVar :: a -> IO (StrictMVar a)
49newMVar x = evaluate x >> StrictMVar <$> MVar.newMVar x
51takeMVar :: StrictMVar a -> IO a
52takeMVar (StrictMVar v) = MVar.takeMVar v
54putMVar :: StrictMVar a -> a -> IO ()
55putMVar (StrictMVar v) x = evaluate x >> MVar.putMVar v x
57readMVar :: StrictMVar a -> IO a
58readMVar (StrictMVar v) = MVar.readMVar v
60withMVar :: StrictMVar a -> (a -> IO b) -> IO b
61withMVar (StrictMVar v) = MVar.withMVar v
63modifyMVar_ :: StrictMVar a -> (a -> IO a) -> IO ()
64modifyMVar_ (StrictMVar v) f = MVar.modifyMVar_ v (f >=> evaluate)
66modifyMVar :: StrictMVar a -> (a -> IO (a, b)) -> IO b
67modifyMVar (StrictMVar v) f = MVar.modifyMVar v (f >=> evaluateFst)
68 where
69 evaluateFst :: (a, b) -> IO (a, b)
70 evaluateFst (x, y) = evaluate x >> return (x, y)
72modifyMVarMasked :: StrictMVar a -> (a -> IO (a, b)) -> IO b
73modifyMVarMasked (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
83 where
84 evaluateFst :: (a, b) -> IO (a, b)
85 evaluateFst (x, y) = evaluate x >> return (x, y)
87mkWeakMVar :: StrictMVar a -> IO () -> IO (Weak (StrictMVar a))
88mkWeakMVar q@(StrictMVar (MVar m#)) f = IO $ \s ->
89#if MIN_VERSION_base(4,9,0)
90 case mkWeak# m# q (unIO f) s of (# s', w #) -> (# s', Weak w #)
91#else
92 case mkWeak# m# q f s of (# s', w #) -> (# s', Weak w #)
93#endif