{-# language UnboxedTuples #-}
{-# language UnboxedSums #-}
{-# language RoleAnnotations #-}
{-# language ScopedTypeVariables #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language MagicHash #-}
{-# language RankNTypes #-}
{-# language PatternSynonyms #-}
{-# language ViewPatterns #-}
{-# language BangPatterns #-}
module Data.Primitive.Unlifted.MVar.ST
( UnliftedMVar_ (..)
, UnliftedMVar
, newUnliftedMVar
, newEmptyUnliftedMVar
, takeUnliftedMVar
, tryTakeUnliftedMVar
, putUnliftedMVar
, tryPutUnliftedMVar
, readUnliftedMVar
, tryReadUnliftedMVar
, isEmptyUnliftedMVar
, swapUnliftedMVar
, withUnliftedMVar
, withUnliftedMVarMasked
, modifyUnliftedMVar
, modifyUnliftedMVar_
, modifyUnliftedMVarMasked
, modifyUnliftedMVarMasked_
) where
import Data.Primitive.Unlifted.Class (PrimUnlifted (..))
import Data.Primitive.Unlifted.MVar.Primops
import Data.Primitive.Unlifted.Box
import GHC.Exts (isTrue#, State#, RealWorld)
import GHC.ST (ST (..))
import GHC.IO (IO (..))
import qualified Control.Exception as E
import Control.Monad.Primitive (primToST, stToPrim)
import Data.Coerce (coerce)
mask :: ((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b) -> ST RealWorld b
{-# INLINE mask #-}
mask :: forall b.
((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b
mask (forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b
f = IO b -> ST (PrimState IO) b
forall (m :: * -> *) a. PrimBase m => m a -> ST (PrimState m) a
primToST (IO b -> ST (PrimState IO) b) -> IO b -> ST (PrimState IO) b
forall a b. (a -> b) -> a -> b
$ ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask (\forall a. IO a -> IO a
restore -> ST (PrimState IO) b -> IO b
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState IO) b -> IO b) -> ST (PrimState IO) b -> IO b
forall a b. (a -> b) -> a -> b
$ (forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b
f (IO a -> ST RealWorld a
IO a -> ST (PrimState IO) a
forall (m :: * -> *) a. PrimBase m => m a -> ST (PrimState m) a
primToST (IO a -> ST RealWorld a)
-> (ST RealWorld a -> IO a) -> ST RealWorld a -> ST RealWorld a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
restore (IO a -> IO a)
-> (ST RealWorld a -> IO a) -> ST RealWorld a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST RealWorld a -> IO a
ST (PrimState IO) a -> IO a
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim))
mask_ :: ST RealWorld a -> ST RealWorld a
{-# INLINE mask_ #-}
mask_ :: forall a. ST RealWorld a -> ST RealWorld a
mask_ ST RealWorld a
f = ((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld a)
-> ST RealWorld a
forall b.
((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b
mask (((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld a)
-> ST RealWorld a)
-> ((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld a)
-> ST RealWorld a
forall a b. (a -> b) -> a -> b
$ \forall a. ST RealWorld a -> ST RealWorld a
_ -> ST RealWorld a
f
primitive_ :: (State# s -> State# s) -> ST s ()
{-# INLINE primitive_ #-}
primitive_ :: forall s. (State# s -> State# s) -> ST s ()
primitive_ State# s -> State# s
f = STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (\State# s
s -> (# State# s -> State# s
f State# s
s, () #))
onException :: forall a b. ST RealWorld a -> ST RealWorld b -> ST RealWorld a
{-# INLINE onException #-}
onException :: forall a b. ST RealWorld a -> ST RealWorld b -> ST RealWorld a
onException = (IO a -> IO b -> IO a)
-> ST RealWorld a -> ST RealWorld b -> ST RealWorld a
forall a b. Coercible a b => a -> b
coerce (IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
E.onException :: IO a -> IO b -> IO a)
data UnliftedMVar_ s a unlifted_a
= UnliftedMVar (UnliftedMVar# s unlifted_a)
type role UnliftedMVar_ nominal phantom representational
type UnliftedMVar s a = UnliftedMVar_ s a (Unlifted a)
instance unlifted_a ~ Unlifted a => PrimUnlifted (UnliftedMVar_ s a unlifted_a) where
{-# INLINE toUnlifted# #-}
{-# INLINE fromUnlifted# #-}
type Unlifted (UnliftedMVar_ s _ unlifted_a) = UnliftedMVar# s unlifted_a
toUnlifted# :: UnliftedMVar_ s a unlifted_a
-> Unlifted (UnliftedMVar_ s a unlifted_a)
toUnlifted# (UnliftedMVar UnliftedMVar# s unlifted_a
mv) = UnliftedMVar# s unlifted_a
Unlifted (UnliftedMVar_ s a unlifted_a)
mv
fromUnlifted# :: Unlifted (UnliftedMVar_ s a unlifted_a)
-> UnliftedMVar_ s a unlifted_a
fromUnlifted# Unlifted (UnliftedMVar_ s a unlifted_a)
mv = UnliftedMVar# s unlifted_a -> UnliftedMVar_ s a unlifted_a
forall s a (unlifted_a :: UnliftedType).
UnliftedMVar# s unlifted_a -> UnliftedMVar_ s a unlifted_a
UnliftedMVar UnliftedMVar# s unlifted_a
Unlifted (UnliftedMVar_ s a unlifted_a)
mv
instance unlifted_a ~ Unlifted a => Eq (UnliftedMVar_ s a unlifted_a) where
{-# INLINE (==) #-}
UnliftedMVar UnliftedMVar# s unlifted_a
mv1 == :: UnliftedMVar_ s a unlifted_a
-> UnliftedMVar_ s a unlifted_a -> Bool
== UnliftedMVar UnliftedMVar# s unlifted_a
mv2
= Int# -> Bool
isTrue# (UnliftedMVar# s unlifted_a -> UnliftedMVar# s unlifted_a -> Int#
forall s (a :: UnliftedType).
UnliftedMVar# s a -> UnliftedMVar# s a -> Int#
sameUnliftedMVar# UnliftedMVar# s unlifted_a
mv1 UnliftedMVar# s unlifted_a
mv2)
newUnliftedMVar
:: PrimUnlifted a
=> a -> ST s (UnliftedMVar s a)
newUnliftedMVar :: forall a s. PrimUnlifted a => a -> ST s (UnliftedMVar s a)
newUnliftedMVar a
a = do
UnliftedMVar s a
mv <- ST s (UnliftedMVar s a)
forall s a. ST s (UnliftedMVar s a)
newEmptyUnliftedMVar
UnliftedMVar s a -> a -> ST s ()
forall a s. PrimUnlifted a => UnliftedMVar s a -> a -> ST s ()
putUnliftedMVar UnliftedMVar s a
mv a
a
UnliftedMVar s a -> ST s (UnliftedMVar s a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnliftedMVar s a
mv
newEmptyUnliftedMVar :: ST s (UnliftedMVar s a)
{-# INLINE newEmptyUnliftedMVar #-}
newEmptyUnliftedMVar :: forall s a. ST s (UnliftedMVar s a)
newEmptyUnliftedMVar = STRep s (UnliftedMVar s a) -> ST s (UnliftedMVar s a)
forall s a. STRep s a -> ST s a
ST (STRep s (UnliftedMVar s a) -> ST s (UnliftedMVar s a))
-> STRep s (UnliftedMVar s a) -> ST s (UnliftedMVar s a)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case State# s -> (# State# s, UnliftedMVar# s (Unlifted a) #)
forall s (a :: UnliftedType).
State# s -> (# State# s, UnliftedMVar# s a #)
newUnliftedMVar# State# s
s of
(# State# s
s', UnliftedMVar# s (Unlifted a)
mv #) -> (# State# s
s', UnliftedMVar# s (Unlifted a) -> UnliftedMVar s a
forall s a (unlifted_a :: UnliftedType).
UnliftedMVar# s unlifted_a -> UnliftedMVar_ s a unlifted_a
UnliftedMVar UnliftedMVar# s (Unlifted a)
mv #)
takeUnliftedMVar
:: PrimUnlifted a
=> UnliftedMVar s a -> ST s a
{-# INLINE takeUnliftedMVar #-}
takeUnliftedMVar :: forall a s. PrimUnlifted a => UnliftedMVar s a -> ST s a
takeUnliftedMVar = UnliftedMVar_ s a (Unlifted a) -> ST s a
forall a s x.
PrimUnlifted a =>
UnliftedMVar_ s x (Unlifted a) -> ST s a
takeUnliftedMVar_
takeUnliftedMVarBox
:: UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
{-# INLINE takeUnliftedMVarBox #-}
takeUnliftedMVarBox :: forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
takeUnliftedMVarBox = UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
UnliftedMVar_ s x (Unlifted (Box unlifted_a))
-> ST s (Box unlifted_a)
forall a s x.
PrimUnlifted a =>
UnliftedMVar_ s x (Unlifted a) -> ST s a
takeUnliftedMVar_
takeUnliftedMVar_
:: PrimUnlifted a
=> UnliftedMVar_ s x (Unlifted a) -> ST s a
{-# INLINE takeUnliftedMVar_ #-}
takeUnliftedMVar_ :: forall a s x.
PrimUnlifted a =>
UnliftedMVar_ s x (Unlifted a) -> ST s a
takeUnliftedMVar_ (UnliftedMVar UnliftedMVar# s (Unlifted a)
mv) = STRep s a -> ST s a
forall s a. STRep s a -> ST s a
ST (STRep s a -> ST s a) -> STRep s a -> ST s a
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case UnliftedMVar# s (Unlifted a)
-> State# s -> (# State# s, Unlifted a #)
forall s (a :: UnliftedType).
UnliftedMVar# s a -> State# s -> (# State# s, a #)
takeUnliftedMVar# UnliftedMVar# s (Unlifted a)
mv State# s
s of
(# State# s
s', Unlifted a
a #) -> (# State# s
s', Unlifted a -> a
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# Unlifted a
a #)
tryTakeUnliftedMVar
:: PrimUnlifted a
=> UnliftedMVar s a -> ST s (Maybe a)
{-# INLINE tryTakeUnliftedMVar #-}
tryTakeUnliftedMVar :: forall a s. PrimUnlifted a => UnliftedMVar s a -> ST s (Maybe a)
tryTakeUnliftedMVar (UnliftedMVar UnliftedMVar# s (Unlifted a)
mv) = STRep s (Maybe a) -> ST s (Maybe a)
forall s a. STRep s a -> ST s a
ST (STRep s (Maybe a) -> ST s (Maybe a))
-> STRep s (Maybe a) -> ST s (Maybe a)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case UnliftedMVar# s (Unlifted a)
-> State# s -> (# State# s, (# (# #) | Unlifted a #) #)
forall s (a :: UnliftedType).
UnliftedMVar# s a -> State# s -> (# State# s, (# (# #) | a #) #)
tryTakeUnliftedMVar# UnliftedMVar# s (Unlifted a)
mv State# s
s of
(# State# s
s', (# | Unlifted a
a #) #) -> (# State# s
s', a -> Maybe a
forall a. a -> Maybe a
Just (Unlifted a -> a
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# Unlifted a
a) #)
(# State# s
s', (# (##) | #) #) -> (# State# s
s', Maybe a
forall a. Maybe a
Nothing #)
putUnliftedMVar
:: PrimUnlifted a
=> UnliftedMVar s a -> a -> ST s ()
{-# INLINE putUnliftedMVar #-}
putUnliftedMVar :: forall a s. PrimUnlifted a => UnliftedMVar s a -> a -> ST s ()
putUnliftedMVar = UnliftedMVar_ s a (Unlifted a) -> a -> ST s ()
forall a s x.
PrimUnlifted a =>
UnliftedMVar_ s x (Unlifted a) -> a -> ST s ()
putUnliftedMVar_
putUnliftedMVarBox
:: UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
{-# INLINE putUnliftedMVarBox #-}
putUnliftedMVarBox :: forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox = UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
UnliftedMVar_ s x (Unlifted (Box unlifted_a))
-> Box unlifted_a -> ST s ()
forall a s x.
PrimUnlifted a =>
UnliftedMVar_ s x (Unlifted a) -> a -> ST s ()
putUnliftedMVar_
putUnliftedMVar_
:: PrimUnlifted a
=> UnliftedMVar_ s x (Unlifted a) -> a -> ST s ()
{-# INLINE putUnliftedMVar_ #-}
putUnliftedMVar_ :: forall a s x.
PrimUnlifted a =>
UnliftedMVar_ s x (Unlifted a) -> a -> ST s ()
putUnliftedMVar_ (UnliftedMVar UnliftedMVar# s (Unlifted a)
mv) a
a = (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
primitive_ ((State# s -> State# s) -> ST s ())
-> (State# s -> State# s) -> ST s ()
forall a b. (a -> b) -> a -> b
$
UnliftedMVar# s (Unlifted a) -> Unlifted a -> State# s -> State# s
forall s (a :: UnliftedType).
UnliftedMVar# s a -> a -> State# s -> State# s
putUnliftedMVar# UnliftedMVar# s (Unlifted a)
mv (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
a)
tryPutUnliftedMVar
:: PrimUnlifted a
=> UnliftedMVar s a -> a -> ST s Bool
{-# INLINE tryPutUnliftedMVar #-}
tryPutUnliftedMVar :: forall a s. PrimUnlifted a => UnliftedMVar s a -> a -> ST s Bool
tryPutUnliftedMVar (UnliftedMVar UnliftedMVar# s (Unlifted a)
mv) a
a = STRep s Bool -> ST s Bool
forall s a. STRep s a -> ST s a
ST (STRep s Bool -> ST s Bool) -> STRep s Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case UnliftedMVar# s (Unlifted a)
-> Unlifted a -> State# s -> (# State# s, Int# #)
forall s (a :: UnliftedType).
UnliftedMVar# s a -> a -> State# s -> (# State# s, Int# #)
tryPutUnliftedMVar# UnliftedMVar# s (Unlifted a)
mv (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
a) State# s
s of
(# State# s
s', Int#
0# #) -> (# State# s
s', Bool
False #)
(# State# s
s', Int#
_ #) -> (# State# s
s', Bool
True #)
readUnliftedMVar
:: PrimUnlifted a
=> UnliftedMVar s a -> ST s a
{-# INLINE readUnliftedMVar #-}
readUnliftedMVar :: forall a s. PrimUnlifted a => UnliftedMVar s a -> ST s a
readUnliftedMVar (UnliftedMVar UnliftedMVar# s (Unlifted a)
mv) = STRep s a -> ST s a
forall s a. STRep s a -> ST s a
ST (STRep s a -> ST s a) -> STRep s a -> ST s a
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case UnliftedMVar# s (Unlifted a)
-> State# s -> (# State# s, Unlifted a #)
forall s (a :: UnliftedType).
UnliftedMVar# s a -> State# s -> (# State# s, a #)
readUnliftedMVar# UnliftedMVar# s (Unlifted a)
mv State# s
s of
(# State# s
s', Unlifted a
a #) -> (# State# s
s', Unlifted a -> a
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# Unlifted a
a #)
tryReadUnliftedMVar
:: PrimUnlifted a
=> UnliftedMVar s a -> ST s (Maybe a)
{-# INLINE tryReadUnliftedMVar #-}
tryReadUnliftedMVar :: forall a s. PrimUnlifted a => UnliftedMVar s a -> ST s (Maybe a)
tryReadUnliftedMVar (UnliftedMVar UnliftedMVar# s (Unlifted a)
mv) = STRep s (Maybe a) -> ST s (Maybe a)
forall s a. STRep s a -> ST s a
ST (STRep s (Maybe a) -> ST s (Maybe a))
-> STRep s (Maybe a) -> ST s (Maybe a)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case UnliftedMVar# s (Unlifted a)
-> State# s -> (# State# s, (# (# #) | Unlifted a #) #)
forall s (a :: UnliftedType).
UnliftedMVar# s a -> State# s -> (# State# s, (# (# #) | a #) #)
tryReadUnliftedMVar# UnliftedMVar# s (Unlifted a)
mv State# s
s of
(# State# s
s', (# (##) | #) #) -> (# State# s
s', Maybe a
forall a. Maybe a
Nothing #)
(# State# s
s', (# | Unlifted a
a #) #) -> (# State# s
s', a -> Maybe a
forall a. a -> Maybe a
Just (Unlifted a -> a
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# Unlifted a
a) #)
isEmptyUnliftedMVar
:: UnliftedMVar s a -> ST s Bool
{-# INLINE isEmptyUnliftedMVar #-}
isEmptyUnliftedMVar :: forall s a. UnliftedMVar s a -> ST s Bool
isEmptyUnliftedMVar (UnliftedMVar UnliftedMVar# s (Unlifted a)
mv) = STRep s Bool -> ST s Bool
forall s a. STRep s a -> ST s a
ST (STRep s Bool -> ST s Bool) -> STRep s Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
case UnliftedMVar# s (Unlifted a) -> State# s -> (# State# s, Int# #)
forall s (a :: UnliftedType).
UnliftedMVar# s a -> State# s -> (# State# s, Int# #)
isEmptyUnliftedMVar# UnliftedMVar# s (Unlifted a)
mv State# s
s of
(# State# s
s', Int#
0# #) -> (# State# s
s', Bool
False #)
(# State# s
s', Int#
_ #) -> (# State# s
s', Bool
True #)
swapUnliftedMVar
:: PrimUnlifted a
=> UnliftedMVar RealWorld a -> a -> ST RealWorld a
{-# INLINE swapUnliftedMVar #-}
swapUnliftedMVar :: forall a.
PrimUnlifted a =>
UnliftedMVar RealWorld a -> a -> ST RealWorld a
swapUnliftedMVar UnliftedMVar RealWorld a
mvar a
new =
Box (Unlifted a) -> a
forall a. PrimUnlifted a => Box (Unlifted a) -> a
fromBox (Box (Unlifted a) -> a)
-> ST RealWorld (Box (Unlifted a)) -> ST RealWorld a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ST RealWorld (Box (Unlifted a)) -> ST RealWorld (Box (Unlifted a))
forall a. ST RealWorld a -> ST RealWorld a
mask_ (ST RealWorld (Box (Unlifted a))
-> ST RealWorld (Box (Unlifted a)))
-> ST RealWorld (Box (Unlifted a))
-> ST RealWorld (Box (Unlifted a))
forall a b. (a -> b) -> a -> b
$ do
Box (Unlifted a)
old <- UnliftedMVar RealWorld a -> ST RealWorld (Box (Unlifted a))
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
takeUnliftedMVarBox UnliftedMVar RealWorld a
mvar
UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
mvar Box (Unlifted a)
new_box
Box (Unlifted a) -> ST RealWorld (Box (Unlifted a))
forall a. a -> ST RealWorld a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Box (Unlifted a)
old)
where !new_box :: Box (Unlifted a)
new_box = a -> Box (Unlifted a)
forall a. PrimUnlifted a => a -> Box (Unlifted a)
toBox a
new
withUnliftedMVar
:: PrimUnlifted a
=> UnliftedMVar RealWorld a -> (a -> ST RealWorld b) -> ST RealWorld b
{-# INLINE withUnliftedMVar #-}
withUnliftedMVar :: forall a b.
PrimUnlifted a =>
UnliftedMVar RealWorld a -> (a -> ST RealWorld b) -> ST RealWorld b
withUnliftedMVar UnliftedMVar RealWorld a
m a -> ST RealWorld b
f =
((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b
forall b.
((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b
mask (((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b)
-> ((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b
forall a b. (a -> b) -> a -> b
$ \forall a. ST RealWorld a -> ST RealWorld a
restore -> do
Box (Unlifted a)
a <- UnliftedMVar RealWorld a -> ST RealWorld (Box (Unlifted a))
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
takeUnliftedMVarBox UnliftedMVar RealWorld a
m
b
b <- ST RealWorld b -> ST RealWorld b
forall a. ST RealWorld a -> ST RealWorld a
restore (a -> ST RealWorld b
f (Box (Unlifted a) -> a
forall a. PrimUnlifted a => Box (Unlifted a) -> a
fromBox Box (Unlifted a)
a)) ST RealWorld b -> ST RealWorld () -> ST RealWorld b
forall a b. ST RealWorld a -> ST RealWorld b -> ST RealWorld a
`onException` UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a
UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a
b -> ST RealWorld b
forall a. a -> ST RealWorld a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
withUnliftedMVarMasked
:: PrimUnlifted a
=> UnliftedMVar RealWorld a -> (a -> ST RealWorld b) -> ST RealWorld b
{-# INLINE withUnliftedMVarMasked #-}
withUnliftedMVarMasked :: forall a b.
PrimUnlifted a =>
UnliftedMVar RealWorld a -> (a -> ST RealWorld b) -> ST RealWorld b
withUnliftedMVarMasked UnliftedMVar RealWorld a
m a -> ST RealWorld b
st =
ST RealWorld b -> ST RealWorld b
forall a. ST RealWorld a -> ST RealWorld a
mask_ (ST RealWorld b -> ST RealWorld b)
-> ST RealWorld b -> ST RealWorld b
forall a b. (a -> b) -> a -> b
$ do
Box (Unlifted a)
a <- UnliftedMVar RealWorld a -> ST RealWorld (Box (Unlifted a))
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
takeUnliftedMVarBox UnliftedMVar RealWorld a
m
b
b <- a -> ST RealWorld b
st (Box (Unlifted a) -> a
forall a. PrimUnlifted a => Box (Unlifted a) -> a
fromBox Box (Unlifted a)
a) ST RealWorld b -> ST RealWorld () -> ST RealWorld b
forall a b. ST RealWorld a -> ST RealWorld b -> ST RealWorld a
`onException` UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a
UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a
b -> ST RealWorld b
forall a. a -> ST RealWorld a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
data HalfUnlifted a b = HalfUnlifted !(Box (Unlifted a)) b
modifyUnliftedMVar
:: forall a b. PrimUnlifted a
=> UnliftedMVar RealWorld a -> (a -> ST RealWorld (a, b)) -> ST RealWorld b
{-# INLINE modifyUnliftedMVar #-}
modifyUnliftedMVar :: forall a b.
PrimUnlifted a =>
UnliftedMVar RealWorld a
-> (a -> ST RealWorld (a, b)) -> ST RealWorld b
modifyUnliftedMVar UnliftedMVar RealWorld a
m a -> ST RealWorld (a, b)
st =
((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b
forall b.
((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b
mask (((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b)
-> ((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b
forall a b. (a -> b) -> a -> b
$ \forall a. ST RealWorld a -> ST RealWorld a
restore -> do
Box (Unlifted a)
a <- UnliftedMVar RealWorld a -> ST RealWorld (Box (Unlifted a))
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
takeUnliftedMVarBox UnliftedMVar RealWorld a
m
HalfUnlifted Box (Unlifted a)
a' b
b :: HalfUnlifted a b <- ST RealWorld (HalfUnlifted a b) -> ST RealWorld (HalfUnlifted a b)
forall a. ST RealWorld a -> ST RealWorld a
restore
(do
(a
a', b
b) <- a -> ST RealWorld (a, b)
st (Box (Unlifted a) -> a
forall a. PrimUnlifted a => Box (Unlifted a) -> a
fromBox Box (Unlifted a)
a)
HalfUnlifted a b -> ST RealWorld (HalfUnlifted a b)
forall a. a -> ST RealWorld a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HalfUnlifted a b -> ST RealWorld (HalfUnlifted a b))
-> HalfUnlifted a b -> ST RealWorld (HalfUnlifted a b)
forall a b. (a -> b) -> a -> b
$! Box (Unlifted a) -> b -> HalfUnlifted a b
forall a b. Box (Unlifted a) -> b -> HalfUnlifted a b
HalfUnlifted (a -> Box (Unlifted a)
forall a. PrimUnlifted a => a -> Box (Unlifted a)
toBox a
a') b
b) ST RealWorld (HalfUnlifted a b)
-> ST RealWorld () -> ST RealWorld (HalfUnlifted a b)
forall a b. ST RealWorld a -> ST RealWorld b -> ST RealWorld a
`onException` UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a
UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a'
b -> ST RealWorld b
forall a. a -> ST RealWorld a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
modifyUnliftedMVar_
:: PrimUnlifted a
=> UnliftedMVar RealWorld a -> (a -> ST RealWorld a) -> ST RealWorld ()
{-# INLINE modifyUnliftedMVar_ #-}
modifyUnliftedMVar_ :: forall a.
PrimUnlifted a =>
UnliftedMVar RealWorld a
-> (a -> ST RealWorld a) -> ST RealWorld ()
modifyUnliftedMVar_ UnliftedMVar RealWorld a
m a -> ST RealWorld a
st =
((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld ())
-> ST RealWorld ()
forall b.
((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld b)
-> ST RealWorld b
mask (((forall a. ST RealWorld a -> ST RealWorld a) -> ST RealWorld ())
-> ST RealWorld ())
-> ((forall a. ST RealWorld a -> ST RealWorld a)
-> ST RealWorld ())
-> ST RealWorld ()
forall a b. (a -> b) -> a -> b
$ \forall a. ST RealWorld a -> ST RealWorld a
restore -> do
Box (Unlifted a)
a <- UnliftedMVar RealWorld a -> ST RealWorld (Box (Unlifted a))
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
takeUnliftedMVarBox UnliftedMVar RealWorld a
m
Box (Unlifted a)
a' <- ST RealWorld (Box (Unlifted a)) -> ST RealWorld (Box (Unlifted a))
forall a. ST RealWorld a -> ST RealWorld a
restore (a -> Box (Unlifted a)
forall a. PrimUnlifted a => a -> Box (Unlifted a)
toBox (a -> Box (Unlifted a))
-> ST RealWorld a -> ST RealWorld (Box (Unlifted a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ST RealWorld a
st (Box (Unlifted a) -> a
forall a. PrimUnlifted a => Box (Unlifted a) -> a
fromBox Box (Unlifted a)
a)) ST RealWorld (Box (Unlifted a))
-> ST RealWorld () -> ST RealWorld (Box (Unlifted a))
forall a b. ST RealWorld a -> ST RealWorld b -> ST RealWorld a
`onException` UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a
UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a'
modifyUnliftedMVarMasked
:: forall a b. PrimUnlifted a
=> UnliftedMVar RealWorld a -> (a -> ST RealWorld (a, b)) -> ST RealWorld b
{-# INLINE modifyUnliftedMVarMasked #-}
modifyUnliftedMVarMasked :: forall a b.
PrimUnlifted a =>
UnliftedMVar RealWorld a
-> (a -> ST RealWorld (a, b)) -> ST RealWorld b
modifyUnliftedMVarMasked UnliftedMVar RealWorld a
m a -> ST RealWorld (a, b)
st =
ST RealWorld b -> ST RealWorld b
forall a. ST RealWorld a -> ST RealWorld a
mask_ (ST RealWorld b -> ST RealWorld b)
-> ST RealWorld b -> ST RealWorld b
forall a b. (a -> b) -> a -> b
$ do
Box (Unlifted a)
a <- UnliftedMVar RealWorld a -> ST RealWorld (Box (Unlifted a))
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
takeUnliftedMVarBox UnliftedMVar RealWorld a
m
HalfUnlifted Box (Unlifted a)
a' b
b :: HalfUnlifted a b <-
(do
(a
a', b
b) <- a -> ST RealWorld (a, b)
st (Box (Unlifted a) -> a
forall a. PrimUnlifted a => Box (Unlifted a) -> a
fromBox Box (Unlifted a)
a)
HalfUnlifted a b -> ST RealWorld (HalfUnlifted a b)
forall a. a -> ST RealWorld a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HalfUnlifted a b -> ST RealWorld (HalfUnlifted a b))
-> HalfUnlifted a b -> ST RealWorld (HalfUnlifted a b)
forall a b. (a -> b) -> a -> b
$! Box (Unlifted a) -> b -> HalfUnlifted a b
forall a b. Box (Unlifted a) -> b -> HalfUnlifted a b
HalfUnlifted (a -> Box (Unlifted a)
forall a. PrimUnlifted a => a -> Box (Unlifted a)
toBox a
a') b
b) ST RealWorld (HalfUnlifted a b)
-> ST RealWorld () -> ST RealWorld (HalfUnlifted a b)
forall a b. ST RealWorld a -> ST RealWorld b -> ST RealWorld a
`onException` UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a
UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a'
b -> ST RealWorld b
forall a. a -> ST RealWorld a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
modifyUnliftedMVarMasked_
:: PrimUnlifted a
=> UnliftedMVar RealWorld a -> (a -> ST RealWorld a) -> ST RealWorld ()
{-# INLINE modifyUnliftedMVarMasked_ #-}
modifyUnliftedMVarMasked_ :: forall a.
PrimUnlifted a =>
UnliftedMVar RealWorld a
-> (a -> ST RealWorld a) -> ST RealWorld ()
modifyUnliftedMVarMasked_ UnliftedMVar RealWorld a
m a -> ST RealWorld a
st =
ST RealWorld () -> ST RealWorld ()
forall a. ST RealWorld a -> ST RealWorld a
mask_ (ST RealWorld () -> ST RealWorld ())
-> ST RealWorld () -> ST RealWorld ()
forall a b. (a -> b) -> a -> b
$ do
Box (Unlifted a)
a <- UnliftedMVar RealWorld a -> ST RealWorld (Box (Unlifted a))
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> ST s (Box unlifted_a)
takeUnliftedMVarBox UnliftedMVar RealWorld a
m
Box (Unlifted a)
a' <- (a -> Box (Unlifted a)
forall a. PrimUnlifted a => a -> Box (Unlifted a)
toBox (a -> Box (Unlifted a))
-> ST RealWorld a -> ST RealWorld (Box (Unlifted a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> ST RealWorld a
st (Box (Unlifted a) -> a
forall a. PrimUnlifted a => Box (Unlifted a) -> a
fromBox Box (Unlifted a)
a)) ST RealWorld (Box (Unlifted a))
-> ST RealWorld () -> ST RealWorld (Box (Unlifted a))
forall a b. ST RealWorld a -> ST RealWorld b -> ST RealWorld a
`onException` UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a
UnliftedMVar RealWorld a -> Box (Unlifted a) -> ST RealWorld ()
forall s x (unlifted_a :: UnliftedType).
UnliftedMVar_ s x unlifted_a -> Box unlifted_a -> ST s ()
putUnliftedMVarBox UnliftedMVar RealWorld a
m Box (Unlifted a)
a'