{-# language UnboxedTuples #-}
{-# language MagicHash #-}
{-# language UnliftedNewtypes #-}
{-# language ScopedTypeVariables #-}
{-# language RoleAnnotations #-}
{-# language KindSignatures #-}
{-# language DataKinds #-}
module Data.Primitive.Unlifted.MutVar.Primops
( UnliftedMutVar#
, newUnliftedMutVar#
, readUnliftedMutVar#
, writeUnliftedMutVar#
, sameUnliftedMutVar#
, casUnliftedMutVar#
, atomicSwapUnliftedMutVar#
) where
import GHC.Exts (MutVar#, State#, Int#, newMutVar#, readMutVar#, writeMutVar#, reallyUnsafePtrEquality#, casMutVar#)
import Data.Primitive.Unlifted.Type
import Data.Coerce
newtype UnliftedMutVar# s (a :: UnliftedType) = UnliftedMutVar# (MutVar# s a)
type role UnliftedMutVar# nominal representational
newUnliftedMutVar# :: a -> State# s -> (# State# s, UnliftedMutVar# s a #)
{-# INLINE newUnliftedMutVar# #-}
newUnliftedMutVar# :: forall (a :: UnliftedType) s.
a -> State# s -> (# State# s, UnliftedMutVar# s a #)
newUnliftedMutVar# a
a State# s
s = (# State# s, MutVar# s a #) -> (# State# s, UnliftedMutVar# s a #)
forall a b. Coercible a b => a -> b
coerce (a -> State# s -> (# State# s, MutVar# s a #)
forall a d. a -> State# d -> (# State# d, MutVar# d a #)
newMutVar# a
a State# s
s)
readUnliftedMutVar# :: UnliftedMutVar# s a -> State# s -> (# State# s, a #)
{-# INLINE readUnliftedMutVar# #-}
readUnliftedMutVar# :: forall s (a :: UnliftedType).
UnliftedMutVar# s a -> State# s -> (# State# s, a #)
readUnliftedMutVar# (UnliftedMutVar# MutVar# s a
mv) State# s
s = MutVar# s a -> State# s -> (# State# s, a #)
forall d a. MutVar# d a -> State# d -> (# State# d, a #)
readMutVar# MutVar# s a
mv State# s
s
writeUnliftedMutVar# :: UnliftedMutVar# s a -> a -> State# s -> State# s
{-# INLINE writeUnliftedMutVar# #-}
writeUnliftedMutVar# :: forall s (a :: UnliftedType).
UnliftedMutVar# s a -> a -> State# s -> State# s
writeUnliftedMutVar# (UnliftedMutVar# MutVar# s a
mv) a
a State# s
s
= MutVar# s a -> a -> State# s -> State# s
forall d a. MutVar# d a -> a -> State# d -> State# d
writeMutVar# MutVar# s a
mv a
a State# s
s
sameUnliftedMutVar# :: UnliftedMutVar# s a -> UnliftedMutVar# s a -> Int#
{-# INLINE sameUnliftedMutVar# #-}
sameUnliftedMutVar# :: forall s (a :: UnliftedType).
UnliftedMutVar# s a -> UnliftedMutVar# s a -> Int#
sameUnliftedMutVar# (UnliftedMutVar# MutVar# s a
mv1) (UnliftedMutVar# MutVar# s a
mv2)
= MutVar# s a -> MutVar# s a -> Int#
forall a b. a -> b -> Int#
reallyUnsafePtrEquality# MutVar# s a
mv1 MutVar# s a
mv2
casUnliftedMutVar#
:: UnliftedMutVar# s a
-> a
-> a
-> State# s -> (# State# s, Int#, a #)
{-# INLINE casUnliftedMutVar# #-}
casUnliftedMutVar# :: forall s (a :: UnliftedType).
UnliftedMutVar# s a
-> a -> a -> State# s -> (# State# s, Int#, a #)
casUnliftedMutVar# (UnliftedMutVar# MutVar# s a
mv) a
old a
new State# s
s
= (# State# s, Int#, a #) -> (# State# s, Int#, a #)
forall a b. Coercible a b => a -> b
coerce (MutVar# s a -> a -> a -> State# s -> (# State# s, Int#, a #)
forall d a.
MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casMutVar# MutVar# s a
mv a
old a
new State# s
s)
atomicSwapUnliftedMutVar#
:: UnliftedMutVar# s a -> a -> State# s -> (# State# s, a #)
{-# INLINE atomicSwapUnliftedMutVar# #-}
atomicSwapUnliftedMutVar# :: forall s (a :: UnliftedType).
UnliftedMutVar# s a -> a -> State# s -> (# State# s, a #)
atomicSwapUnliftedMutVar# (UnliftedMutVar# MutVar# s a
mv) a
a State# s
s
= MutVar# s a -> a -> State# s -> (# State# s, a #)
forall s (a :: UnliftedType).
MutVar# s a -> a -> State# s -> (# State# s, a #)
atomicSwapMutVar# MutVar# s a
mv a
a State# s
s
atomicSwapMutVar#
:: forall s (a :: UnliftedType). MutVar# s a -> a -> State# s -> (# State# s, a #)
atomicSwapMutVar# :: forall s (a :: UnliftedType).
MutVar# s a -> a -> State# s -> (# State# s, a #)
atomicSwapMutVar# MutVar# s a
mv a
a State# s
s
= case MutVar# s a -> State# s -> (# State# s, a #)
forall d a. MutVar# d a -> State# d -> (# State# d, a #)
readMutVar# MutVar# s a
mv State# s
s of { (# State# s
s', a
old #) ->
case MutVar# s a -> a -> a -> State# s -> (# State# s, Int#, a #)
forall d a.
MutVar# d a -> a -> a -> State# d -> (# State# d, Int#, a #)
casMutVar# MutVar# s a
mv a
old a
a State# s
s' of
(# State# s
s'', Int#
0#, a
_ #) -> MutVar# s a -> a -> State# s -> (# State# s, a #)
forall s (a :: UnliftedType).
MutVar# s a -> a -> State# s -> (# State# s, a #)
atomicSwapMutVar# MutVar# s a
mv a
a State# s
s''
(# State# s
s'', Int#
_, a
_ #) -> (# State# s
s'', a
old #) }