{-# 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 (MVar#, State#, Int#, newMVar#, takeMVar#, tryTakeMVar#, putMVar#, tryPutMVar#, readMVar#, tryReadMVar#, reallyUnsafePtrEquality#, isEmptyMVar#) import Data.Primitive.Unlifted.Type newtype UnliftedMVar# s (a :: UnliftedType) = UnliftedMVar# (MVar# s a) type role UnliftedMVar# nominal representational newUnliftedMVar# :: State# s -> (# State# s, UnliftedMVar# s a #) {-# INLINE newUnliftedMVar# #-} newUnliftedMVar# :: forall s (a :: UnliftedType). State# s -> (# State# s, UnliftedMVar# s a #) newUnliftedMVar# 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 mv #) -> (# State# s s', MVar# s a -> UnliftedMVar# s a forall s (a :: UnliftedType). MVar# s a -> UnliftedMVar# s a UnliftedMVar# MVar# s a mv #) takeUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, a #) {-# INLINE takeUnliftedMVar# #-} takeUnliftedMVar# :: forall s (a :: UnliftedType). UnliftedMVar# s a -> State# s -> (# State# s, a #) takeUnliftedMVar# (UnliftedMVar# MVar# s a mv) 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 mv State# s s tryTakeUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, (# (##) | a #) #) {-# INLINE tryTakeUnliftedMVar# #-} tryTakeUnliftedMVar# :: forall s (a :: UnliftedType). UnliftedMVar# s a -> State# s -> (# State# s, (# (# #) | a #) #) tryTakeUnliftedMVar# (UnliftedMVar# MVar# s a mv) 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 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 {-# INLINE putUnliftedMVar# #-} putUnliftedMVar# :: forall s (a :: UnliftedType). UnliftedMVar# s a -> a -> State# s -> State# s putUnliftedMVar# (UnliftedMVar# MVar# s a mv) a a State# s s = MVar# s a -> a -> State# s -> State# s forall d a. MVar# d a -> a -> State# d -> State# d putMVar# MVar# s a mv a a State# s s tryPutUnliftedMVar# :: UnliftedMVar# s a -> a -> State# s -> (# State# s, Int# #) {-# INLINE tryPutUnliftedMVar# #-} tryPutUnliftedMVar# :: forall s (a :: UnliftedType). UnliftedMVar# s a -> a -> State# s -> (# State# s, Int# #) tryPutUnliftedMVar# (UnliftedMVar# MVar# s a mv) a a State# s s = 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 mv a a State# s s readUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, a #) {-# INLINE readUnliftedMVar# #-} readUnliftedMVar# :: forall s (a :: UnliftedType). UnliftedMVar# s a -> State# s -> (# State# s, a #) readUnliftedMVar# (UnliftedMVar# MVar# s a mv) State# s s = MVar# s a -> State# s -> (# State# s, a #) forall d a. MVar# d a -> State# d -> (# State# d, a #) readMVar# MVar# s a mv State# s s tryReadUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, (# (##) | a #) #) {-# INLINE tryReadUnliftedMVar# #-} tryReadUnliftedMVar# :: forall s (a :: UnliftedType). UnliftedMVar# s a -> State# s -> (# State# s, (# (# #) | a #) #) tryReadUnliftedMVar# (UnliftedMVar# MVar# s a mv) 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 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# :: forall s (a :: UnliftedType). UnliftedMVar# s a -> UnliftedMVar# s a -> Int# sameUnliftedMVar# (UnliftedMVar# MVar# s a mv1) (UnliftedMVar# MVar# s a mv2) = MVar# s a -> MVar# s a -> Int# forall a b. a -> b -> Int# reallyUnsafePtrEquality# MVar# s a mv1 MVar# s a mv2 isEmptyUnliftedMVar# :: UnliftedMVar# s a -> State# s -> (# State# s, Int# #) {-# INLINE isEmptyUnliftedMVar# #-} isEmptyUnliftedMVar# :: forall s (a :: UnliftedType). UnliftedMVar# s a -> State# s -> (# State# s, Int# #) isEmptyUnliftedMVar# (UnliftedMVar# MVar# s a mv) State# s s = MVar# s a -> State# s -> (# State# s, Int# #) forall d a. MVar# d a -> State# d -> (# State# d, Int# #) isEmptyMVar# MVar# s a mv State# s s