{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeSynonymInstances #-} module Data.SpirV.Enum.MemorySemantics where import Data.Bits (Bits, FiniteBits, (.|.)) import Data.Word (Word32) import Foreign.Storable (Storable) type MemorySemantics = MemorySemanticsBits newtype MemorySemanticsBits = MemorySemanticsBits Word32 deriving newtype (MemorySemanticsBits -> MemorySemanticsBits -> Bool (MemorySemanticsBits -> MemorySemanticsBits -> Bool) -> (MemorySemanticsBits -> MemorySemanticsBits -> Bool) -> Eq MemorySemanticsBits forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: MemorySemanticsBits -> MemorySemanticsBits -> Bool == :: MemorySemanticsBits -> MemorySemanticsBits -> Bool $c/= :: MemorySemanticsBits -> MemorySemanticsBits -> Bool /= :: MemorySemanticsBits -> MemorySemanticsBits -> Bool Eq, Eq MemorySemanticsBits Eq MemorySemanticsBits => (MemorySemanticsBits -> MemorySemanticsBits -> Ordering) -> (MemorySemanticsBits -> MemorySemanticsBits -> Bool) -> (MemorySemanticsBits -> MemorySemanticsBits -> Bool) -> (MemorySemanticsBits -> MemorySemanticsBits -> Bool) -> (MemorySemanticsBits -> MemorySemanticsBits -> Bool) -> (MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits) -> (MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits) -> Ord MemorySemanticsBits MemorySemanticsBits -> MemorySemanticsBits -> Bool MemorySemanticsBits -> MemorySemanticsBits -> Ordering MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a $ccompare :: MemorySemanticsBits -> MemorySemanticsBits -> Ordering compare :: MemorySemanticsBits -> MemorySemanticsBits -> Ordering $c< :: MemorySemanticsBits -> MemorySemanticsBits -> Bool < :: MemorySemanticsBits -> MemorySemanticsBits -> Bool $c<= :: MemorySemanticsBits -> MemorySemanticsBits -> Bool <= :: MemorySemanticsBits -> MemorySemanticsBits -> Bool $c> :: MemorySemanticsBits -> MemorySemanticsBits -> Bool > :: MemorySemanticsBits -> MemorySemanticsBits -> Bool $c>= :: MemorySemanticsBits -> MemorySemanticsBits -> Bool >= :: MemorySemanticsBits -> MemorySemanticsBits -> Bool $cmax :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits max :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits $cmin :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits min :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits Ord, Ptr MemorySemanticsBits -> IO MemorySemanticsBits Ptr MemorySemanticsBits -> Int -> IO MemorySemanticsBits Ptr MemorySemanticsBits -> Int -> MemorySemanticsBits -> IO () Ptr MemorySemanticsBits -> MemorySemanticsBits -> IO () MemorySemanticsBits -> Int (MemorySemanticsBits -> Int) -> (MemorySemanticsBits -> Int) -> (Ptr MemorySemanticsBits -> Int -> IO MemorySemanticsBits) -> (Ptr MemorySemanticsBits -> Int -> MemorySemanticsBits -> IO ()) -> (forall b. Ptr b -> Int -> IO MemorySemanticsBits) -> (forall b. Ptr b -> Int -> MemorySemanticsBits -> IO ()) -> (Ptr MemorySemanticsBits -> IO MemorySemanticsBits) -> (Ptr MemorySemanticsBits -> MemorySemanticsBits -> IO ()) -> Storable MemorySemanticsBits forall b. Ptr b -> Int -> IO MemorySemanticsBits forall b. Ptr b -> Int -> MemorySemanticsBits -> IO () forall a. (a -> Int) -> (a -> Int) -> (Ptr a -> Int -> IO a) -> (Ptr a -> Int -> a -> IO ()) -> (forall b. Ptr b -> Int -> IO a) -> (forall b. Ptr b -> Int -> a -> IO ()) -> (Ptr a -> IO a) -> (Ptr a -> a -> IO ()) -> Storable a $csizeOf :: MemorySemanticsBits -> Int sizeOf :: MemorySemanticsBits -> Int $calignment :: MemorySemanticsBits -> Int alignment :: MemorySemanticsBits -> Int $cpeekElemOff :: Ptr MemorySemanticsBits -> Int -> IO MemorySemanticsBits peekElemOff :: Ptr MemorySemanticsBits -> Int -> IO MemorySemanticsBits $cpokeElemOff :: Ptr MemorySemanticsBits -> Int -> MemorySemanticsBits -> IO () pokeElemOff :: Ptr MemorySemanticsBits -> Int -> MemorySemanticsBits -> IO () $cpeekByteOff :: forall b. Ptr b -> Int -> IO MemorySemanticsBits peekByteOff :: forall b. Ptr b -> Int -> IO MemorySemanticsBits $cpokeByteOff :: forall b. Ptr b -> Int -> MemorySemanticsBits -> IO () pokeByteOff :: forall b. Ptr b -> Int -> MemorySemanticsBits -> IO () $cpeek :: Ptr MemorySemanticsBits -> IO MemorySemanticsBits peek :: Ptr MemorySemanticsBits -> IO MemorySemanticsBits $cpoke :: Ptr MemorySemanticsBits -> MemorySemanticsBits -> IO () poke :: Ptr MemorySemanticsBits -> MemorySemanticsBits -> IO () Storable, Eq MemorySemanticsBits MemorySemanticsBits Eq MemorySemanticsBits => (MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits) -> (MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits) -> (MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits) -> (MemorySemanticsBits -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> MemorySemanticsBits -> (Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> Bool) -> (MemorySemanticsBits -> Maybe Int) -> (MemorySemanticsBits -> Int) -> (MemorySemanticsBits -> Bool) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int -> MemorySemanticsBits) -> (MemorySemanticsBits -> Int) -> Bits MemorySemanticsBits Int -> MemorySemanticsBits MemorySemanticsBits -> Bool MemorySemanticsBits -> Int MemorySemanticsBits -> Maybe Int MemorySemanticsBits -> MemorySemanticsBits MemorySemanticsBits -> Int -> Bool MemorySemanticsBits -> Int -> MemorySemanticsBits MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits forall a. Eq a => (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> (a -> Int -> a) -> (a -> Int -> a) -> a -> (Int -> a) -> (a -> Int -> a) -> (a -> Int -> a) -> (a -> Int -> a) -> (a -> Int -> Bool) -> (a -> Maybe Int) -> (a -> Int) -> (a -> Bool) -> (a -> Int -> a) -> (a -> Int -> a) -> (a -> Int -> a) -> (a -> Int -> a) -> (a -> Int -> a) -> (a -> Int -> a) -> (a -> Int) -> Bits a $c.&. :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits .&. :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits $c.|. :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits .|. :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits $cxor :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits xor :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits $ccomplement :: MemorySemanticsBits -> MemorySemanticsBits complement :: MemorySemanticsBits -> MemorySemanticsBits $cshift :: MemorySemanticsBits -> Int -> MemorySemanticsBits shift :: MemorySemanticsBits -> Int -> MemorySemanticsBits $crotate :: MemorySemanticsBits -> Int -> MemorySemanticsBits rotate :: MemorySemanticsBits -> Int -> MemorySemanticsBits $czeroBits :: MemorySemanticsBits zeroBits :: MemorySemanticsBits $cbit :: Int -> MemorySemanticsBits bit :: Int -> MemorySemanticsBits $csetBit :: MemorySemanticsBits -> Int -> MemorySemanticsBits setBit :: MemorySemanticsBits -> Int -> MemorySemanticsBits $cclearBit :: MemorySemanticsBits -> Int -> MemorySemanticsBits clearBit :: MemorySemanticsBits -> Int -> MemorySemanticsBits $ccomplementBit :: MemorySemanticsBits -> Int -> MemorySemanticsBits complementBit :: MemorySemanticsBits -> Int -> MemorySemanticsBits $ctestBit :: MemorySemanticsBits -> Int -> Bool testBit :: MemorySemanticsBits -> Int -> Bool $cbitSizeMaybe :: MemorySemanticsBits -> Maybe Int bitSizeMaybe :: MemorySemanticsBits -> Maybe Int $cbitSize :: MemorySemanticsBits -> Int bitSize :: MemorySemanticsBits -> Int $cisSigned :: MemorySemanticsBits -> Bool isSigned :: MemorySemanticsBits -> Bool $cshiftL :: MemorySemanticsBits -> Int -> MemorySemanticsBits shiftL :: MemorySemanticsBits -> Int -> MemorySemanticsBits $cunsafeShiftL :: MemorySemanticsBits -> Int -> MemorySemanticsBits unsafeShiftL :: MemorySemanticsBits -> Int -> MemorySemanticsBits $cshiftR :: MemorySemanticsBits -> Int -> MemorySemanticsBits shiftR :: MemorySemanticsBits -> Int -> MemorySemanticsBits $cunsafeShiftR :: MemorySemanticsBits -> Int -> MemorySemanticsBits unsafeShiftR :: MemorySemanticsBits -> Int -> MemorySemanticsBits $crotateL :: MemorySemanticsBits -> Int -> MemorySemanticsBits rotateL :: MemorySemanticsBits -> Int -> MemorySemanticsBits $crotateR :: MemorySemanticsBits -> Int -> MemorySemanticsBits rotateR :: MemorySemanticsBits -> Int -> MemorySemanticsBits $cpopCount :: MemorySemanticsBits -> Int popCount :: MemorySemanticsBits -> Int Bits, Bits MemorySemanticsBits Bits MemorySemanticsBits => (MemorySemanticsBits -> Int) -> (MemorySemanticsBits -> Int) -> (MemorySemanticsBits -> Int) -> FiniteBits MemorySemanticsBits MemorySemanticsBits -> Int forall b. Bits b => (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b $cfiniteBitSize :: MemorySemanticsBits -> Int finiteBitSize :: MemorySemanticsBits -> Int $ccountLeadingZeros :: MemorySemanticsBits -> Int countLeadingZeros :: MemorySemanticsBits -> Int $ccountTrailingZeros :: MemorySemanticsBits -> Int countTrailingZeros :: MemorySemanticsBits -> Int FiniteBits) instance Semigroup MemorySemantics where (MemorySemanticsBits Word32 a) <> :: MemorySemanticsBits -> MemorySemanticsBits -> MemorySemanticsBits <> (MemorySemanticsBits Word32 b) = Word32 -> MemorySemanticsBits MemorySemanticsBits (Word32 a Word32 -> Word32 -> Word32 forall a. Bits a => a -> a -> a .|. Word32 b) instance Monoid MemorySemantics where mempty :: MemorySemanticsBits mempty = Word32 -> MemorySemanticsBits MemorySemanticsBits Word32 0 pattern Acquire :: MemorySemanticsBits pattern $mAcquire :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bAcquire :: MemorySemanticsBits Acquire = MemorySemanticsBits 0x00000002 pattern Release :: MemorySemanticsBits pattern $mRelease :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bRelease :: MemorySemanticsBits Release = MemorySemanticsBits 0x00000004 pattern AcquireRelease :: MemorySemanticsBits pattern $mAcquireRelease :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bAcquireRelease :: MemorySemanticsBits AcquireRelease = MemorySemanticsBits 0x00000008 pattern SequentiallyConsistent :: MemorySemanticsBits pattern $mSequentiallyConsistent :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bSequentiallyConsistent :: MemorySemanticsBits SequentiallyConsistent = MemorySemanticsBits 0x00000010 pattern UniformMemory :: MemorySemanticsBits pattern $mUniformMemory :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bUniformMemory :: MemorySemanticsBits UniformMemory = MemorySemanticsBits 0x00000040 pattern SubgroupMemory :: MemorySemanticsBits pattern $mSubgroupMemory :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bSubgroupMemory :: MemorySemanticsBits SubgroupMemory = MemorySemanticsBits 0x00000080 pattern WorkgroupMemory :: MemorySemanticsBits pattern $mWorkgroupMemory :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bWorkgroupMemory :: MemorySemanticsBits WorkgroupMemory = MemorySemanticsBits 0x00000100 pattern CrossWorkgroupMemory :: MemorySemanticsBits pattern $mCrossWorkgroupMemory :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bCrossWorkgroupMemory :: MemorySemanticsBits CrossWorkgroupMemory = MemorySemanticsBits 0x00000200 pattern AtomicCounterMemory :: MemorySemanticsBits pattern $mAtomicCounterMemory :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bAtomicCounterMemory :: MemorySemanticsBits AtomicCounterMemory = MemorySemanticsBits 0x00000400 pattern ImageMemory :: MemorySemanticsBits pattern $mImageMemory :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bImageMemory :: MemorySemanticsBits ImageMemory = MemorySemanticsBits 0x00000800 pattern OutputMemory :: MemorySemanticsBits pattern $mOutputMemory :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bOutputMemory :: MemorySemanticsBits OutputMemory = MemorySemanticsBits 0x00001000 pattern OutputMemoryKHR :: MemorySemanticsBits pattern $mOutputMemoryKHR :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bOutputMemoryKHR :: MemorySemanticsBits OutputMemoryKHR = MemorySemanticsBits 0x00001000 pattern MakeAvailable :: MemorySemanticsBits pattern $mMakeAvailable :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bMakeAvailable :: MemorySemanticsBits MakeAvailable = MemorySemanticsBits 0x00002000 pattern MakeAvailableKHR :: MemorySemanticsBits pattern $mMakeAvailableKHR :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bMakeAvailableKHR :: MemorySemanticsBits MakeAvailableKHR = MemorySemanticsBits 0x00002000 pattern MakeVisible :: MemorySemanticsBits pattern $mMakeVisible :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bMakeVisible :: MemorySemanticsBits MakeVisible = MemorySemanticsBits 0x00004000 pattern MakeVisibleKHR :: MemorySemanticsBits pattern $mMakeVisibleKHR :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bMakeVisibleKHR :: MemorySemanticsBits MakeVisibleKHR = MemorySemanticsBits 0x00004000 pattern Volatile :: MemorySemanticsBits pattern $mVolatile :: forall {r}. MemorySemanticsBits -> ((# #) -> r) -> ((# #) -> r) -> r $bVolatile :: MemorySemanticsBits Volatile = MemorySemanticsBits 0x00008000