{-# language ScopedTypeVariables #-}
{-# language MagicHash #-}
{-# language KindSignatures #-}
{-# language UnboxedTuples #-}
{-# language UnboxedSums #-}
{-# language UnliftedNewtypes #-}
{-# language RoleAnnotations #-}
{-# language DataKinds #-}

module Data.Primitive.Unlifted.MVar.Primops
  ( UnliftedMVar#
  , newUnliftedMVar#
  , takeUnliftedMVar#
  , tryTakeUnliftedMVar#
  , putUnliftedMVar#
  , tryPutUnliftedMVar#
  , readUnliftedMVar#
  , tryReadUnliftedMVar#
  , sameUnliftedMVar#
  , isEmptyUnliftedMVar#
  ) where
import GHC.Exts

newtype UnliftedMVar# s (a :: TYPE 'UnliftedRep) = UnliftedMVar# (MVar# s Any)
type role UnliftedMVar# nominal representational

newUnliftedMVar# :: State# s -> (# State# s, UnliftedMVar# s a #)
{-# INLINE newUnliftedMVar# #-}
newUnliftedMVar# :: State# s -> (# State# s, UnliftedMVar# s a #)
newUnliftedMVar# State# s
s = case State# s -> (# State# s, MVar# s Any #)
forall d a. State# d -> (# State# d, MVar# d a #)
newMVar# State# s
s of
  (# State# s
s', MVar# s Any
mv #) -> (# State# s
s', MVar# s Any -> UnliftedMVar# s a
forall s (a :: TYPE 'UnliftedRep). MVar# s Any -> UnliftedMVar# s a
UnliftedMVar# MVar# s Any
mv #)

takeUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, a #)
{-# NOINLINE takeUnliftedMVar# #-}
takeUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, a #)
takeUnliftedMVar# (UnliftedMVar# MVar# s Any
mv) State# s
s = (# State# s, Any #) -> (# State# s, a #)
unsafeCoerce# (MVar# s Any -> State# s -> (# State# s, Any #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
takeMVar# MVar# s Any
mv State# s
s)

tryTakeUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, (# (##) | a #) #)
{-# NOINLINE tryTakeUnliftedMVar# #-}
tryTakeUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, (# (# #) | a #) #)
tryTakeUnliftedMVar# (UnliftedMVar# MVar# s Any
mv) State# s
s =
  case (# State# s, Int#, Any #) -> (# State# s, Int#, a #)
unsafeCoerce# (MVar# s Any -> State# s -> (# State# s, Int#, Any #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryTakeMVar# MVar# s Any
mv State# s
s) of
    (# State# s
s', Int#
0#, a
_ #) -> (# State# s
s', (#(##)| #)#)
    (# State# s
s', Int#
_, a
a #) -> (# State# s
s', (#|a
a #) #)

putUnliftedMVar# :: UnliftedMVar# s a -> a -> State# s -> State# s
{-# NOINLINE putUnliftedMVar# #-}
putUnliftedMVar# :: UnliftedMVar# s a -> a -> State# s -> State# s
putUnliftedMVar# (UnliftedMVar# MVar# s Any
mv) a
a State# s
s
  = MVar# s Any -> Any -> State# s -> State# s
forall d a. MVar# d a -> a -> State# d -> State# d
putMVar# MVar# s Any
mv (a -> Any
unsafeCoerce# a
a) State# s
s

tryPutUnliftedMVar# :: UnliftedMVar# s a -> a -> State# s -> (# State# s, Int# #)
{-# NOINLINE tryPutUnliftedMVar# #-}
tryPutUnliftedMVar# :: UnliftedMVar# s a -> a -> State# s -> (# State# s, Int# #)
tryPutUnliftedMVar# (UnliftedMVar# MVar# s Any
mv) a
a State# s
s
  = MVar# s Any -> Any -> State# s -> (# State# s, Int# #)
forall d a. MVar# d a -> a -> State# d -> (# State# d, Int# #)
tryPutMVar# MVar# s Any
mv (a -> Any
unsafeCoerce# a
a) State# s
s

readUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, a #)
{-# NOINLINE readUnliftedMVar# #-}
readUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, a #)
readUnliftedMVar# (UnliftedMVar# MVar# s Any
mv) State# s
s = (# State# s, Any #) -> (# State# s, a #)
unsafeCoerce# (MVar# s Any -> State# s -> (# State# s, Any #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
readMVar# MVar# s Any
mv State# s
s)

tryReadUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, (# (##) | a #) #)
{-# NOINLINE tryReadUnliftedMVar# #-}
tryReadUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, (# (# #) | a #) #)
tryReadUnliftedMVar# (UnliftedMVar# MVar# s Any
mv) State# s
s =
  case (# State# s, Int#, Any #) -> (# State# s, Int#, a #)
unsafeCoerce# (MVar# s Any -> State# s -> (# State# s, Int#, Any #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryReadMVar# MVar# s Any
mv State# s
s) of
    (# State# s
s', Int#
0#, a
_ #) -> (# State# s
s', (#(##)| #)#)
    (# State# s
s', Int#
_, a
a #) -> (# State# s
s', (#|a
a #) #)

sameUnliftedMVar# :: UnliftedMVar# s a -> UnliftedMVar# s a -> Int#
{-# INLINE sameUnliftedMVar# #-}
sameUnliftedMVar# :: UnliftedMVar# s a -> UnliftedMVar# s a -> Int#
sameUnliftedMVar# (UnliftedMVar# MVar# s Any
mv1) (UnliftedMVar# MVar# s Any
mv2)
  = MVar# s Any -> MVar# s Any -> Int#
forall d a. MVar# d a -> MVar# d a -> Int#
sameMVar# MVar# s Any
mv1 MVar# s Any
mv2

isEmptyUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, Int# #)
{-# INLINE isEmptyUnliftedMVar# #-}
isEmptyUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, Int# #)
isEmptyUnliftedMVar# (UnliftedMVar# MVar# s Any
mv) State# s
s
  = MVar# s Any -> State# s -> (# State# s, Int# #)
forall d a. MVar# d a -> State# d -> (# State# d, Int# #)
isEmptyMVar# MVar# s Any
mv State# s
s