{-# LANGUAGE CPP, BangPatterns,
MagicHash, UnboxedTuples, ScopedTypeVariables #-}
module Control.Concurrent.MVar.Strict
(
MVar
, newEmptyMVar
, newMVar
, takeMVar
, putMVar
, readMVar
, swapMVar
, tryTakeMVar
, tryPutMVar
, isEmptyMVar
, withMVar
, modifyMVar_
, modifyMVar
, addMVarFinalizer
) where
import Control.Concurrent.MVar ( newEmptyMVar, takeMVar,
tryTakeMVar, isEmptyMVar, addMVarFinalizer
)
import GHC.Exts
import GHC.Base
import GHC.MVar (MVar(MVar))
import Control.Exception as Exception
import Control.DeepSeq
putMVar :: NFData a => MVar a -> a -> IO ()
#ifndef __HADDOCK__
putMVar :: MVar a -> a -> IO ()
putMVar (MVar MVar# RealWorld a
mvar#) !a
x = a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> IO () -> IO ()
`seq` (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# ->
case MVar# RealWorld a -> a -> State# RealWorld -> State# RealWorld
forall d a. MVar# d a -> a -> State# d -> State# d
putMVar# MVar# RealWorld a
mvar# a
x State# RealWorld
s# of
State# RealWorld
s2# -> (# State# RealWorld
s2#, () #)
#endif
tryPutMVar :: NFData a => MVar a -> a -> IO Bool
#ifndef __HADDOCK__
tryPutMVar :: MVar a -> a -> IO Bool
tryPutMVar (MVar MVar# RealWorld a
mvar#) !a
x = (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool)
-> (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# ->
case MVar# RealWorld a
-> a -> State# RealWorld -> (# State# RealWorld, Int# #)
forall d a. MVar# d a -> a -> State# d -> (# State# d, Int# #)
tryPutMVar# MVar# RealWorld a
mvar# a
x State# RealWorld
s# of
(# State# RealWorld
s, Int#
0# #) -> (# State# RealWorld
s, Bool
False #)
(# State# RealWorld
s, Int#
_ #) -> (# State# RealWorld
s, Bool
True #)
#endif
newMVar :: NFData a => a -> IO (MVar a)
newMVar :: a -> IO (MVar a)
newMVar a
value =
IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar IO (MVar a) -> (MVar a -> IO (MVar a)) -> IO (MVar a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ MVar a
mvar ->
MVar a -> a -> IO ()
forall a. NFData a => MVar a -> a -> IO ()
putMVar MVar a
mvar a
value IO () -> IO (MVar a) -> IO (MVar a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
MVar a -> IO (MVar a)
forall (m :: * -> *) a. Monad m => a -> m a
return MVar a
mvar
readMVar :: NFData a => MVar a -> IO a
readMVar :: MVar a -> IO a
readMVar MVar a
m = ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
_ -> do
a
a <- MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
m
MVar a -> a -> IO ()
forall a. NFData a => MVar a -> a -> IO ()
putMVar MVar a
m a
a
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
swapMVar :: NFData a => MVar a -> a -> IO a
swapMVar :: MVar a -> a -> IO a
swapMVar MVar a
mvar a
new = ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
_ -> do
a
old <- MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
mvar
MVar a -> a -> IO ()
forall a. NFData a => MVar a -> a -> IO ()
putMVar MVar a
mvar a
new
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
old
{-# INLINE withMVar #-}
withMVar :: NFData a => MVar a -> (a -> IO b) -> IO b
withMVar :: MVar a -> (a -> IO b) -> IO b
withMVar MVar a
m a -> IO b
io = ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
a
a <- MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
m
b
b <- IO b -> (SomeException -> IO b) -> IO b
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exception.catch (IO b -> IO b
forall a. IO a -> IO a
unmask (a -> IO b
io a
a))
(\(SomeException
e :: SomeException) -> do MVar a -> a -> IO ()
forall a. NFData a => MVar a -> a -> IO ()
putMVar MVar a
m a
a; SomeException -> IO b
forall a e. Exception e => e -> a
throw SomeException
e)
MVar a -> a -> IO ()
forall a. NFData a => MVar a -> a -> IO ()
putMVar MVar a
m a
a
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
{-# INLINE modifyMVar_ #-}
modifyMVar_ :: NFData a => MVar a -> (a -> IO a) -> IO ()
modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar a
m a -> IO a
io = ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
a
a <- MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
m
a
a' <- IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exception.catch (IO a -> IO a
forall a. IO a -> IO a
unmask (a -> IO a
io a
a))
(\(SomeException
e :: SomeException) -> do MVar a -> a -> IO ()
forall a. NFData a => MVar a -> a -> IO ()
putMVar MVar a
m a
a; SomeException -> IO a
forall a e. Exception e => e -> a
throw SomeException
e)
MVar a -> a -> IO ()
forall a. NFData a => MVar a -> a -> IO ()
putMVar MVar a
m a
a'
{-# INLINE modifyMVar #-}
modifyMVar :: NFData a => MVar a -> (a -> IO (a,b)) -> IO b
modifyMVar :: MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar a
m a -> IO (a, b)
io = ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
a
a <- MVar a -> IO a
forall a. MVar a -> IO a
takeMVar MVar a
m
(a
a',b
b) <- IO (a, b) -> (SomeException -> IO (a, b)) -> IO (a, b)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exception.catch (IO (a, b) -> IO (a, b)
forall a. IO a -> IO a
unmask (a -> IO (a, b)
io a
a))
(\(SomeException
e :: SomeException) -> do MVar a -> a -> IO ()
forall a. NFData a => MVar a -> a -> IO ()
putMVar MVar a
m a
a; SomeException -> IO (a, b)
forall a e. Exception e => e -> a
throw SomeException
e)
MVar a -> a -> IO ()
forall a. NFData a => MVar a -> a -> IO ()
putMVar MVar a
m a
a'
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b