git.iko.soy/distributed-process
on 05616b4 help sign in
distributed-process/src/Control/Distributed/Process/Internal/StrictMVar.hs
66 lines 1.8 kB history raw
1-- | Like Control.Concurrent.MVar.Strict but reduce to HNF, not NF
2{-# LANGUAGE 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 , mkWeakMVar
14 ) where
16import Control.Applicative ((<$>))
17import Control.Monad ((>=>))
18import Control.Exception (evaluate)
19import qualified Control.Concurrent.MVar as MVar
20 ( MVar
21 , newEmptyMVar
22 , newMVar
23 , takeMVar
24 , putMVar
25 , readMVar
26 , withMVar
27 , modifyMVar_
28 , modifyMVar
29 )
30import GHC.MVar (MVar(MVar))
31import GHC.IO (IO(IO))
32import GHC.Prim (mkWeak#)
33import GHC.Weak (Weak(Weak))
35newtype StrictMVar a = StrictMVar (MVar.MVar a)
37newEmptyMVar :: IO (StrictMVar a)
38newEmptyMVar = StrictMVar <$> MVar.newEmptyMVar
40newMVar :: a -> IO (StrictMVar a)
41newMVar x = evaluate x >> StrictMVar <$> MVar.newMVar x
43takeMVar :: StrictMVar a -> IO a
44takeMVar (StrictMVar v) = MVar.takeMVar v
46putMVar :: StrictMVar a -> a -> IO ()
47putMVar (StrictMVar v) x = evaluate x >> MVar.putMVar v x
49readMVar :: StrictMVar a -> IO a
50readMVar (StrictMVar v) = MVar.readMVar v
52withMVar :: StrictMVar a -> (a -> IO b) -> IO b
53withMVar (StrictMVar v) = MVar.withMVar v
55modifyMVar_ :: StrictMVar a -> (a -> IO a) -> IO ()
56modifyMVar_ (StrictMVar v) f = MVar.modifyMVar_ v (f >=> evaluate)
58modifyMVar :: StrictMVar a -> (a -> IO (a, b)) -> IO b
59modifyMVar (StrictMVar v) f = MVar.modifyMVar v (f >=> evaluateFst)
60 where
61 evaluateFst :: (a, b) -> IO (a, b)
62 evaluateFst (x, y) = evaluate x >> return (x, y)
64mkWeakMVar :: StrictMVar a -> IO () -> IO (Weak (StrictMVar a))
65mkWeakMVar m@(StrictMVar (MVar m#)) f = IO $ \s ->
66 case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)