{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
module Control.Prim.Concurrent.MVar
(
MVar(..)
, isEmptyMVar
, isSameMVar
, newMVar
, newLazyMVar
, newDeepMVar
, newEmptyMVar
, putMVar
, putLazyMVar
, putDeepMVar
, tryPutMVar
, tryPutLazyMVar
, tryPutDeepMVar
, writeMVar
, readMVar
, tryReadMVar
, takeMVar
, tryTakeMVar
, clearMVar
, swapMVar
, swapLazyMVar
, swapDeepMVar
, withMVar
, withMVarMasked
, modifyMVar_
, modifyMVarMasked_
, modifyFetchOldMVar
, modifyFetchOldMVarMasked
, modifyFetchNewMVar
, modifyFetchNewMVarMasked
, modifyMVar
, modifyMVarMasked
, mkWeakMVar
, toBaseMVar
, fromBaseMVar
) where
import Control.DeepSeq
import Control.Prim.Monad
import Control.Prim.Exception
import GHC.Exts
import GHC.Weak
import qualified GHC.MVar as GHC
data MVar a s = MVar (MVar# s a)
instance Eq (MVar a s) where
== :: MVar a s -> MVar a s -> Bool
(==) = MVar a s -> MVar a s -> Bool
forall a s. MVar a s -> MVar a s -> Bool
isSameMVar
{-# INLINE (==) #-}
isSameMVar :: forall a s. MVar a s -> MVar a s -> Bool
isSameMVar :: MVar a s -> MVar a s -> Bool
isSameMVar (MVar MVar# s a
mvar1#) (MVar MVar# s a
mvar2#) = Int# -> Bool
isTrue# (MVar# s a -> MVar# s a -> Int#
forall d a. MVar# d a -> MVar# d a -> Int#
sameMVar# MVar# s a
mvar1# MVar# s a
mvar2#)
{-# INLINE isSameMVar #-}
isEmptyMVar :: forall a m s. MonadPrim s m => MVar a s -> m Bool
isEmptyMVar :: MVar a s -> m Bool
isEmptyMVar (MVar MVar# s a
mvar#) =
(State# s -> (# State# s, Bool #)) -> m Bool
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Bool #)) -> m Bool)
-> (State# s -> (# State# s, Bool #)) -> m Bool
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case MVar# s a -> State# s -> (# State# s, Int# #)
forall d a. MVar# d a -> State# d -> (# State# d, Int# #)
isEmptyMVar# MVar# s a
mvar# State# s
s of
(# State# s
s', Int#
isEmpty# #) -> (# State# s
s', Int# -> Bool
isTrue# Int#
isEmpty# #)
{-# INLINE isEmptyMVar #-}
newMVar :: forall a m s. MonadPrim s m => a -> m (MVar a s)
newMVar :: a -> m (MVar a s)
newMVar a
a = m (MVar a s)
forall a (m :: * -> *) s. MonadPrim s m => m (MVar a s)
newEmptyMVar m (MVar a s) -> (MVar a s -> m (MVar a s)) -> m (MVar a s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar a s
mvar -> MVar a s
mvar MVar a s -> m () -> m (MVar a s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a s -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putMVar MVar a s
mvar a
a
{-# INLINE newMVar #-}
newLazyMVar :: forall a m s. MonadPrim s m => a -> m (MVar a s)
newLazyMVar :: a -> m (MVar a s)
newLazyMVar a
a = m (MVar a s)
forall a (m :: * -> *) s. MonadPrim s m => m (MVar a s)
newEmptyMVar m (MVar a s) -> (MVar a s -> m (MVar a s)) -> m (MVar a s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar a s
mvar -> MVar a s
mvar MVar a s -> m () -> m (MVar a s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a s -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
a
{-# INLINE newLazyMVar #-}
newDeepMVar :: forall a m s. (NFData a, MonadPrim s m) => a -> m (MVar a s)
newDeepMVar :: a -> m (MVar a s)
newDeepMVar a
a = m (MVar a s)
forall a (m :: * -> *) s. MonadPrim s m => m (MVar a s)
newEmptyMVar m (MVar a s) -> (MVar a s -> m (MVar a s)) -> m (MVar a s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar a s
mvar -> MVar a s
mvar MVar a s -> m () -> m (MVar a s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a s -> a -> m ()
forall a (m :: * -> *) s.
(NFData a, MonadPrim s m) =>
MVar a s -> a -> m ()
putDeepMVar MVar a s
mvar a
a
{-# INLINE newDeepMVar #-}
newEmptyMVar :: forall a m s. MonadPrim s m => m (MVar a s)
newEmptyMVar :: m (MVar a s)
newEmptyMVar =
(State# s -> (# State# s, MVar a s #)) -> m (MVar a s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, MVar a s #)) -> m (MVar a s))
-> (State# s -> (# State# s, MVar a s #)) -> m (MVar a s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case State# s -> (# State# s, MVar# s a #)
forall d a. State# d -> (# State# d, MVar# d a #)
newMVar# State# s
s of
(# State# s
s', MVar# s a
mvar# #) -> (# State# s
s', MVar# s a -> MVar a s
forall a s. MVar# s a -> MVar a s
MVar MVar# s a
mvar# #)
{-# INLINE newEmptyMVar #-}
putMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m ()
putMVar :: MVar a s -> a -> m ()
putMVar MVar a s
mvar a
x = MVar a s -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar (a
x a -> MVar a s -> MVar a s
`seq` MVar a s
mvar) a
x
{-# INLINE putMVar #-}
putLazyMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar :: MVar a s -> a -> m ()
putLazyMVar (MVar MVar# s a
mvar#) a
x = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MVar# s a -> a -> State# s -> State# s
forall d a. MVar# d a -> a -> State# d -> State# d
putMVar# MVar# s a
mvar# a
x)
{-# INLINE putLazyMVar #-}
putDeepMVar :: forall a m s. (NFData a, MonadPrim s m) => MVar a s -> a -> m ()
putDeepMVar :: MVar a s -> a -> m ()
putDeepMVar MVar a s
mvar a
x = MVar a s -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar (a
x a -> MVar a s -> MVar a s
forall a b. NFData a => a -> b -> b
`deepseq` MVar a s
mvar) a
x
{-# INLINE putDeepMVar #-}
tryPutMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m Bool
tryPutMVar :: MVar a s -> a -> m Bool
tryPutMVar MVar a s
mvar a
x = MVar a s -> a -> m Bool
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m Bool
tryPutLazyMVar (a
x a -> MVar a s -> MVar a s
`seq` MVar a s
mvar) a
x
{-# INLINE tryPutMVar #-}
tryPutLazyMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m Bool
tryPutLazyMVar :: MVar a s -> a -> m Bool
tryPutLazyMVar (MVar MVar# s a
mvar#) a
x =
(State# s -> (# State# s, Bool #)) -> m Bool
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Bool #)) -> m Bool)
-> (State# s -> (# State# s, Bool #)) -> m Bool
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case MVar# s a -> a -> State# s -> (# State# s, Int# #)
forall d a. MVar# d a -> a -> State# d -> (# State# d, Int# #)
tryPutMVar# MVar# s a
mvar# a
x State# s
s of
(# State# s
s', Int#
b# #) -> (# State# s
s', Int# -> Bool
isTrue# Int#
b# #)
{-# INLINE tryPutLazyMVar #-}
tryPutDeepMVar :: forall a m s. (NFData a, MonadPrim s m) => MVar a s -> a -> m Bool
tryPutDeepMVar :: MVar a s -> a -> m Bool
tryPutDeepMVar MVar a s
mvar a
x = MVar a s -> a -> m Bool
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m Bool
tryPutLazyMVar MVar a s
mvar (a -> m Bool) -> a -> m Bool
forall a b. (a -> b) -> a -> b
$! a -> a
forall a. NFData a => a -> a
force a
x
{-# INLINE tryPutDeepMVar #-}
writeMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m ()
writeMVar :: MVar a s -> a -> m ()
writeMVar MVar a s
mvar a
a =
ST s () -> m ()
forall a (n :: * -> *) (m :: * -> *) s.
(MonadPrim s m, MonadPrimBase s n) =>
n a -> m a
maskPrimBase_ (ST s () -> m ()) -> ST s () -> m ()
forall a b. (a -> b) -> a -> b
$ do
MVar a s -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m ()
clearMVar (a
a a -> MVar a s -> MVar a s
`seq` MVar a s
mvar)
MVar a s -> a -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
a :: ST s ()
{-# INLINE writeMVar #-}
swapMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m a
swapMVar :: MVar a s -> a -> m a
swapMVar MVar a s
mvar a
new =
ST s a -> m a
forall a (n :: * -> *) (m :: * -> *) s.
(MonadPrim s m, MonadPrimBase s n) =>
n a -> m a
maskPrimBase_ (ST s a -> m a) -> ST s a -> m a
forall a b. (a -> b) -> a -> b
$ do
a
old <- MVar a s -> ST s a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar (a
new a -> MVar a s -> MVar a s
`seq` MVar a s
mvar)
a
old a -> ST s () -> ST s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (MVar a s -> a -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
new :: ST s ())
{-# INLINE swapMVar #-}
swapLazyMVar :: forall a m s. MonadPrim s m => MVar a s -> a -> m a
swapLazyMVar :: MVar a s -> a -> m a
swapLazyMVar MVar a s
mvar a
new =
ST s a -> m a
forall a (n :: * -> *) (m :: * -> *) s.
(MonadPrim s m, MonadPrimBase s n) =>
n a -> m a
maskPrimBase_ (ST s a -> m a) -> ST s a -> m a
forall a b. (a -> b) -> a -> b
$ do
a
old <- MVar a s -> ST s a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a s
mvar
a
old a -> ST s () -> ST s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (MVar a s -> a -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
new :: ST s ())
{-# INLINE swapLazyMVar #-}
swapDeepMVar :: forall a m s. (NFData a, MonadPrim s m) => MVar a s -> a -> m a
swapDeepMVar :: MVar a s -> a -> m a
swapDeepMVar MVar a s
mvar a
new =
ST s a -> m a
forall a (n :: * -> *) (m :: * -> *) s.
(MonadPrim s m, MonadPrimBase s n) =>
n a -> m a
maskPrimBase_ (ST s a -> m a) -> ST s a -> m a
forall a b. (a -> b) -> a -> b
$ do
a
old <- MVar a s -> ST s a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar (a
new a -> MVar a s -> MVar a s
forall a b. NFData a => a -> b -> b
`deepseq` MVar a s
mvar)
a
old a -> ST s () -> ST s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (MVar a s -> a -> ST s ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a s
mvar a
new :: ST s ())
{-# INLINE swapDeepMVar #-}
takeMVar :: forall a m s. MonadPrim s m => MVar a s -> m a
takeMVar :: MVar a s -> m a
takeMVar (MVar MVar# s a
mvar#) = (State# s -> (# State# s, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, a #)) -> m a)
-> (State# s -> (# State# s, a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \ State# s
s# -> MVar# s a -> State# s -> (# State# s, a #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
takeMVar# MVar# s a
mvar# State# s
s#
{-# INLINE takeMVar #-}
tryTakeMVar :: forall a m s. MonadPrim s m => MVar a s -> m (Maybe a)
tryTakeMVar :: MVar a s -> m (Maybe a)
tryTakeMVar (MVar MVar# s a
mvar#) =
(State# s -> (# State# s, Maybe a #)) -> m (Maybe a)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Maybe a #)) -> m (Maybe a))
-> (State# s -> (# State# s, Maybe a #)) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case MVar# s a -> State# s -> (# State# s, Int#, a #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryTakeMVar# MVar# s a
mvar# State# s
s of
(# State# s
s', Int#
0#, a
_ #) -> (# State# s
s', Maybe a
forall a. Maybe a
Nothing #)
(# State# s
s', Int#
_, a
a #) -> (# State# s
s', a -> Maybe a
forall a. a -> Maybe a
Just a
a #)
{-# INLINE tryTakeMVar #-}
readMVar :: forall a m s. MonadPrim s m => MVar a s -> m a
readMVar :: MVar a s -> m a
readMVar (MVar MVar# s a
mvar#) = (State# s -> (# State# s, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim (MVar# s a -> State# s -> (# State# s, a #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
readMVar# MVar# s a
mvar#)
{-# INLINE readMVar #-}
tryReadMVar :: forall a m s. MonadPrim s m => MVar a s -> m (Maybe a)
tryReadMVar :: MVar a s -> m (Maybe a)
tryReadMVar (MVar MVar# s a
mvar#) =
(State# s -> (# State# s, Maybe a #)) -> m (Maybe a)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Maybe a #)) -> m (Maybe a))
-> (State# s -> (# State# s, Maybe a #)) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case MVar# s a -> State# s -> (# State# s, Int#, a #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryReadMVar# MVar# s a
mvar# State# s
s of
(# State# s
s', Int#
0#, a
_ #) -> (# State# s
s', Maybe a
forall a. Maybe a
Nothing #)
(# State# s
s', Int#
_, a
a #) -> (# State# s
s', a -> Maybe a
forall a. a -> Maybe a
Just a
a #)
{-# INLINE tryReadMVar #-}
clearMVar :: forall a m s. MonadPrim s m => MVar a s -> m ()
clearMVar :: MVar a s -> m ()
clearMVar (MVar MVar# s a
mvar#) =
(State# s -> (# State# s, () #)) -> m ()
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, () #)) -> m ())
-> (State# s -> (# State# s, () #)) -> m ()
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case MVar# s a -> State# s -> (# State# s, Int#, a #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryTakeMVar# MVar# s a
mvar# State# s
s of
(# State# s
s', Int#
_, a
_ #) -> (# State# s
s', () #)
{-# INLINE clearMVar #-}
withMVar :: forall a b m. MonadUnliftPrim RW m => MVar a RW -> (a -> m b) -> m b
withMVar :: MVar a RW -> (a -> m b) -> m b
withMVar MVar a RW
mvar !a -> m b
action =
((forall b. m b -> m b) -> m b) -> m b
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m b) -> m b)
-> ((forall b. m b -> m b) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> do
a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
b
b <- m b -> m b
forall b. m b -> m b
restore (a -> m b
action a
a) m b -> (SomeException -> m b) -> m b
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m b
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
b
b b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a
{-# INLINE withMVar #-}
withMVarMasked :: forall a b m. MonadUnliftPrim RW m => MVar a RW -> (a -> m b) -> m b
withMVarMasked :: MVar a RW -> (a -> m b) -> m b
withMVarMasked MVar a RW
mvar !a -> m b
action =
m b -> m b
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ do
a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
b
b <- a -> m b
action a
a m b -> (SomeException -> m b) -> m b
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m b
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
b
b b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a
{-# INLINE withMVarMasked #-}
modifyFetchLazyMVar :: MonadUnliftPrim RW m => (a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar :: (a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar a -> a -> b
select MVar a RW
mvar a -> m a
action = do
a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
a
a' <- a -> m a
action a
a m a -> (SomeException -> m a) -> m a
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m a
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
a -> a -> b
select a
a a
a' b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a'
{-# INLINE modifyFetchLazyMVar #-}
modifyMVar_ :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m ()
modifyMVar_ :: MVar a RW -> (a -> m a) -> m ()
modifyMVar_ MVar a RW
mvar = m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m a -> m ()) -> ((a -> m a) -> m a) -> (a -> m a) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a RW -> (a -> m a) -> m a
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVar MVar a RW
mvar
{-# INLINE modifyMVar_ #-}
modifyMVarMasked_ :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m ()
modifyMVarMasked_ :: MVar a RW -> (a -> m a) -> m ()
modifyMVarMasked_ MVar a RW
mvar !a -> m a
action =
m () -> m ()
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (a -> a -> ()) -> MVar a RW -> (a -> m a) -> m ()
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar (\a
_ a
_ -> ()) MVar a RW
mvar (a -> m a
action (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyMVarMasked_ #-}
modifyFetchOldMVar :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVar :: MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVar MVar a RW
mvar !a -> m a
action =
((forall b. m b -> m b) -> m a) -> m a
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m a) -> m a)
-> ((forall b. m b -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore ->
(a -> a -> a) -> MVar a RW -> (a -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar a -> a -> a
forall a b. a -> b -> a
const MVar a RW
mvar ((a -> m a) -> m a) -> (a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a
a ->
m a -> m a
forall b. m b -> m b
restore (a -> m a
action a
a m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyFetchOldMVar #-}
modifyFetchOldMVarMasked :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVarMasked :: MVar a RW -> (a -> m a) -> m a
modifyFetchOldMVarMasked MVar a RW
mvar !a -> m a
action =
m a -> m a
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> MVar a RW -> (a -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar a -> a -> a
forall a b. a -> b -> a
const MVar a RW
mvar (a -> m a
action (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyFetchOldMVarMasked #-}
modifyFetchNewMVar :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m a
modifyFetchNewMVar :: MVar a RW -> (a -> m a) -> m a
modifyFetchNewMVar MVar a RW
mvar !a -> m a
action =
((forall b. m b -> m b) -> m a) -> m a
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m a) -> m a)
-> ((forall b. m b -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore ->
(a -> a -> a) -> MVar a RW -> (a -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a b. a -> b -> a
const) MVar a RW
mvar ((a -> m a) -> m a) -> (a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \a
a ->
m a -> m a
forall b. m b -> m b
restore (a -> m a
action a
a m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyFetchNewMVar #-}
modifyFetchNewMVarMasked :: forall a m. MonadUnliftPrim RW m => MVar a RW -> (a -> m a) -> m a
modifyFetchNewMVarMasked :: MVar a RW -> (a -> m a) -> m a
modifyFetchNewMVarMasked MVar a RW
mvar !a -> m a
action =
m a -> m a
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> MVar a RW -> (a -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftPrim RW m =>
(a -> a -> b) -> MVar a RW -> (a -> m a) -> m b
modifyFetchLazyMVar ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a b. a -> b -> a
const) MVar a RW
mvar (a -> m a
action (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \a
a' -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a')
{-# INLINE modifyFetchNewMVarMasked #-}
modifyMVar :: forall a b m. MonadUnliftPrim RW m => MVar a RW -> (a -> m (a, b)) -> m b
modifyMVar :: MVar a RW -> (a -> m (a, b)) -> m b
modifyMVar MVar a RW
mvar a -> m (a, b)
action =
((forall b. m b -> m b) -> m b) -> m b
forall a (m :: * -> *) s.
MonadUnliftPrim s m =>
((forall b. m b -> m b) -> m a) -> m a
mask (((forall b. m b -> m b) -> m b) -> m b)
-> ((forall b. m b -> m b) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
restore -> do
a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
let run :: m (a, b)
run = m (a, b) -> m (a, b)
forall b. m b -> m b
restore (a -> m (a, b)
action a
a m (a, b) -> ((a, b) -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: (a, b)
t@(!a
_, b
_) -> (a, b) -> m (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a, b)
t)
(a
a', b
b) <- m (a, b)
run m (a, b) -> (SomeException -> m (a, b)) -> m (a, b)
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m (a, b) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m (a, b)
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
b
b b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a'
{-# INLINE modifyMVar #-}
modifyMVarMasked :: forall a b m. MonadUnliftPrim RW m => MVar a RW -> (a -> m (a, b)) -> m b
modifyMVarMasked :: MVar a RW -> (a -> m (a, b)) -> m b
modifyMVarMasked MVar a RW
mvar a -> m (a, b)
action =
m b -> m b
forall a (m :: * -> *) s. MonadUnliftPrim s m => m a -> m a
mask_ (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ do
a
a <- MVar a RW -> m a
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> m a
takeMVar MVar a RW
mvar
let run :: m (a, b)
run = a -> m (a, b)
action a
a m (a, b) -> ((a, b) -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :: (a, b)
t@(!a
_, b
_) -> (a, b) -> m (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a, b)
t
(a
a', b
b) <- m (a, b)
run m (a, b) -> (SomeException -> m (a, b)) -> m (a, b)
forall a (m :: * -> *).
MonadUnliftPrim RW m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
exc -> MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a m () -> m (a, b) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m (a, b)
forall e s (m :: * -> *) a.
(Exception e, MonadPrim s m) =>
e -> m a
throw SomeException
exc
b
b b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MVar a RW -> a -> m ()
forall a (m :: * -> *) s. MonadPrim s m => MVar a s -> a -> m ()
putLazyMVar MVar a RW
mvar a
a'
{-# INLINE modifyMVarMasked #-}
mkWeakMVar ::
forall a b m. MonadUnliftPrim RW m
=> MVar a RW
-> m b
-> m (Weak (MVar a RW))
mkWeakMVar :: MVar a RW -> m b -> m (Weak (MVar a RW))
mkWeakMVar mvar :: MVar a RW
mvar@(MVar MVar# RW a
mvar#) !m b
finalizer =
m b
-> ((State# RW -> (# State# RW, b #))
-> State# RW -> (# State# RW, Weak (MVar a RW) #))
-> m (Weak (MVar a RW))
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
runInPrimBase m b
finalizer (((State# RW -> (# State# RW, b #))
-> State# RW -> (# State# RW, Weak (MVar a RW) #))
-> m (Weak (MVar a RW)))
-> ((State# RW -> (# State# RW, b #))
-> State# RW -> (# State# RW, Weak (MVar a RW) #))
-> m (Weak (MVar a RW))
forall a b. (a -> b) -> a -> b
$ \State# RW -> (# State# RW, b #)
f# State# RW
s ->
case MVar# RW a
-> MVar a RW
-> (State# RW -> (# State# RW, b #))
-> State# RW
-> (# State# RW, Weak# (MVar a RW) #)
forall a b c.
a
-> b
-> (State# RW -> (# State# RW, c #))
-> State# RW
-> (# State# RW, Weak# b #)
mkWeak# MVar# RW a
mvar# MVar a RW
mvar State# RW -> (# State# RW, b #)
f# State# RW
s of
(# State# RW
s', Weak# (MVar a RW)
weak# #) -> (# State# RW
s', Weak# (MVar a RW) -> Weak (MVar a RW)
forall v. Weak# v -> Weak v
Weak Weak# (MVar a RW)
weak# #)
{-# INLINE mkWeakMVar #-}
toBaseMVar :: MVar a RW -> GHC.MVar a
toBaseMVar :: MVar a RW -> MVar a
toBaseMVar (MVar MVar# RW a
mvar#) = MVar# RW a -> MVar a
forall a. MVar# RW a -> MVar a
GHC.MVar MVar# RW a
mvar#
{-# INLINE toBaseMVar #-}
fromBaseMVar :: GHC.MVar a -> MVar a RW
fromBaseMVar :: MVar a -> MVar a RW
fromBaseMVar (GHC.MVar MVar# RW a
mvar#) = MVar# RW a -> MVar a RW
forall a s. MVar# s a -> MVar a s
MVar MVar# RW a
mvar#
{-# INLINE fromBaseMVar #-}