{-# language RoleAnnotations #-}
{-# language ScopedTypeVariables #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language TypeFamilies #-}

module Data.Primitive.Unlifted.MutVar.ST
  ( UnliftedMutVar_ (..)
  , UnliftedMutVar
  , newUnliftedMutVar
  , readUnliftedMutVar
  , writeUnliftedMutVar
  , modifyUnliftedMutVar
  , modifyUnliftedMutVar'
  , casUnliftedMutVar
  , atomicSwapUnliftedMutVar
  ) where
import Data.Primitive.Unlifted.MutVar.Primops
import Data.Primitive.Unlifted.Class (PrimUnlifted (..))
import GHC.ST (ST (..))
import GHC.Exts (isTrue#, State#)

data UnliftedMutVar_ s a unlifted_a = UnliftedMutVar (UnliftedMutVar# s unlifted_a)
type role UnliftedMutVar_ nominal phantom representational

type UnliftedMutVar s a = UnliftedMutVar_ s a (Unlifted a)

instance (unlifted_a ~ Unlifted a) => PrimUnlifted (UnliftedMutVar_ s a unlifted_a) where
  {-# INLINE toUnlifted# #-}
  {-# INLINE fromUnlifted# #-}
  type Unlifted (UnliftedMutVar_ s a unlifted_a) = UnliftedMutVar# s unlifted_a
  toUnlifted# :: UnliftedMutVar_ s a unlifted_a
-> Unlifted (UnliftedMutVar_ s a unlifted_a)
toUnlifted# (UnliftedMutVar UnliftedMutVar# s unlifted_a
m) = Unlifted (UnliftedMutVar_ s a unlifted_a)
UnliftedMutVar# s unlifted_a
m
  fromUnlifted# :: Unlifted (UnliftedMutVar_ s a unlifted_a)
-> UnliftedMutVar_ s a unlifted_a
fromUnlifted# Unlifted (UnliftedMutVar_ s a unlifted_a)
m = UnliftedMutVar# s unlifted_a -> UnliftedMutVar_ s a unlifted_a
forall s a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedMutVar# s unlifted_a -> UnliftedMutVar_ s a unlifted_a
UnliftedMutVar Unlifted (UnliftedMutVar_ s a unlifted_a)
UnliftedMutVar# s unlifted_a
m

instance (unlifted_a ~ Unlifted a) => Eq (UnliftedMutVar_ s a unlifted_a) where
  {-# INLINE (==) #-}
  UnliftedMutVar UnliftedMutVar# s unlifted_a
m1 == :: UnliftedMutVar_ s a unlifted_a
-> UnliftedMutVar_ s a unlifted_a -> Bool
== UnliftedMutVar UnliftedMutVar# s unlifted_a
m2
    = Int# -> Bool
isTrue# (UnliftedMutVar# s unlifted_a
-> UnliftedMutVar# s unlifted_a -> Int#
forall s (a :: TYPE 'UnliftedRep).
UnliftedMutVar# s a -> UnliftedMutVar# s a -> Int#
sameUnliftedMutVar# UnliftedMutVar# s unlifted_a
m1 UnliftedMutVar# s unlifted_a
m2)

primitive_ :: (State# s -> State# s) -> ST s ()
{-# INLINE primitive_ #-}
primitive_ :: (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 (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s -> (# State# s -> State# s
f State# s
s, () #)

newUnliftedMutVar
  :: PrimUnlifted a
  => a -> ST s (UnliftedMutVar s a)
{-# INLINE newUnliftedMutVar #-}
newUnliftedMutVar :: a -> ST s (UnliftedMutVar s a)
newUnliftedMutVar a
a
  = STRep s (UnliftedMutVar s a) -> ST s (UnliftedMutVar s a)
forall s a. STRep s a -> ST s a
ST (STRep s (UnliftedMutVar s a) -> ST s (UnliftedMutVar s a))
-> STRep s (UnliftedMutVar s a) -> ST s (UnliftedMutVar s a)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case Unlifted a
-> State# s -> (# State# s, UnliftedMutVar# s (Unlifted a) #)
forall (a :: TYPE 'UnliftedRep) s.
a -> State# s -> (# State# s, UnliftedMutVar# s a #)
newUnliftedMutVar# (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
a) State# s
s of
      (# State# s
s', UnliftedMutVar# s (Unlifted a)
mv #) -> (# State# s
s', UnliftedMutVar# s (Unlifted a) -> UnliftedMutVar s a
forall s a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedMutVar# s unlifted_a -> UnliftedMutVar_ s a unlifted_a
UnliftedMutVar UnliftedMutVar# s (Unlifted a)
mv #)

readUnliftedMutVar
  :: PrimUnlifted a
  => UnliftedMutVar s a -> ST s a
{-# INLINE readUnliftedMutVar #-}
readUnliftedMutVar :: UnliftedMutVar s a -> ST s a
readUnliftedMutVar (UnliftedMutVar UnliftedMutVar# 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 UnliftedMutVar# s (Unlifted a)
-> State# s -> (# State# s, Unlifted a #)
forall s (a :: TYPE 'UnliftedRep).
UnliftedMutVar# s a -> State# s -> (# State# s, a #)
readUnliftedMutVar# UnliftedMutVar# 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 #)

writeUnliftedMutVar
  :: PrimUnlifted a
  => UnliftedMutVar s a -> a -> ST s ()
{-# INLINE writeUnliftedMutVar #-}
writeUnliftedMutVar :: UnliftedMutVar s a -> a -> ST s ()
writeUnliftedMutVar (UnliftedMutVar UnliftedMutVar# 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
$ UnliftedMutVar# s (Unlifted a)
-> Unlifted a -> State# s -> State# s
forall s (a :: TYPE 'UnliftedRep).
UnliftedMutVar# s a -> a -> State# s -> State# s
writeUnliftedMutVar# UnliftedMutVar# s (Unlifted a)
mv (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
a)

modifyUnliftedMutVar
  :: PrimUnlifted a
  => UnliftedMutVar s a -> (a -> a) -> ST s ()
{-# INLINE modifyUnliftedMutVar #-}
modifyUnliftedMutVar :: UnliftedMutVar s a -> (a -> a) -> ST s ()
modifyUnliftedMutVar UnliftedMutVar s a
mv a -> a
f = do
  a
a <- UnliftedMutVar s a -> ST s a
forall a s. PrimUnlifted a => UnliftedMutVar s a -> ST s a
readUnliftedMutVar UnliftedMutVar s a
mv
  UnliftedMutVar s a -> a -> ST s ()
forall a s. PrimUnlifted a => UnliftedMutVar s a -> a -> ST s ()
writeUnliftedMutVar UnliftedMutVar s a
mv (a -> a
f a
a)

modifyUnliftedMutVar'
  :: PrimUnlifted a
  => UnliftedMutVar s a -> (a -> a) -> ST s ()
{-# INLINE modifyUnliftedMutVar' #-}
modifyUnliftedMutVar' :: UnliftedMutVar s a -> (a -> a) -> ST s ()
modifyUnliftedMutVar' UnliftedMutVar s a
mv a -> a
f = do
  a
a <- UnliftedMutVar s a -> ST s a
forall a s. PrimUnlifted a => UnliftedMutVar s a -> ST s a
readUnliftedMutVar UnliftedMutVar s a
mv
  UnliftedMutVar s a -> a -> ST s ()
forall a s. PrimUnlifted a => UnliftedMutVar s a -> a -> ST s ()
writeUnliftedMutVar UnliftedMutVar s a
mv (a -> ST s ()) -> a -> ST s ()
forall a b. (a -> b) -> a -> b
$! a -> a
f a
a

casUnliftedMutVar
  :: PrimUnlifted a
  => UnliftedMutVar s a   -- ^ The 'UnliftedMutVar' on which to operate
  -> a -- ^ The expected value
  -> a -- ^ The new value to install if the 'UnliftedMutVar contains the expected value
  -> ST s (Bool, a)
{-# INLINE casUnliftedMutVar #-}
casUnliftedMutVar :: UnliftedMutVar s a -> a -> a -> ST s (Bool, a)
casUnliftedMutVar (UnliftedMutVar UnliftedMutVar# s (Unlifted a)
mv) a
old a
new = STRep s (Bool, a) -> ST s (Bool, a)
forall s a. STRep s a -> ST s a
ST (STRep s (Bool, a) -> ST s (Bool, a))
-> STRep s (Bool, a) -> ST s (Bool, a)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case UnliftedMutVar# s (Unlifted a)
-> Unlifted a
-> Unlifted a
-> State# s
-> (# State# s, Int#, Unlifted a #)
forall s (a :: TYPE 'UnliftedRep).
UnliftedMutVar# s a
-> a -> a -> State# s -> (# State# s, Int#, a #)
casUnliftedMutVar# UnliftedMutVar# s (Unlifted a)
mv (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
old) (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
new) State# s
s of
    (# State# s
s', Int#
0#, Unlifted a
latest #) -> (# State# s
s', (Bool
False, Unlifted a -> a
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# Unlifted a
latest) #)
    (# State# s
s', Int#
_, Unlifted a
latest #) -> (# State# s
s', (Bool
True, Unlifted a -> a
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# Unlifted a
latest) #)

atomicSwapUnliftedMutVar
  :: PrimUnlifted a
  => UnliftedMutVar s a
  -> a
  -> ST s a
{-# INLINE atomicSwapUnliftedMutVar #-}
atomicSwapUnliftedMutVar :: UnliftedMutVar s a -> a -> ST s a
atomicSwapUnliftedMutVar (UnliftedMutVar UnliftedMutVar# s (Unlifted a)
mv) a
a
  = 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 UnliftedMutVar# s (Unlifted a)
-> Unlifted a -> State# s -> (# State# s, Unlifted a #)
forall s (a :: TYPE 'UnliftedRep).
UnliftedMutVar# s a -> a -> State# s -> (# State# s, a #)
atomicSwapUnliftedMutVar# UnliftedMutVar# s (Unlifted a)
mv (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
a) State# s
s of
      (# State# s
s', Unlifted a
old #) -> (# State# s
s', Unlifted a -> a
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# Unlifted a
old #)