{-# 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