module Data.SpirV.Enum.MemorySemantics where

import Data.Bits (Bits)
import Data.String (IsString(..))
import Data.Word (Word32)
import Foreign (Storable(..))
import GHC.Read (Read(..))
import Text.ParserCombinators.ReadPrec (pfail)
import qualified GHC.Read as Read
import qualified Text.Read.Lex as Lex

newtype MemorySemantics = MemorySemantics Word32
  deriving (MemorySemantics -> MemorySemantics -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemorySemantics -> MemorySemantics -> Bool
$c/= :: MemorySemantics -> MemorySemantics -> Bool
== :: MemorySemantics -> MemorySemantics -> Bool
$c== :: MemorySemantics -> MemorySemantics -> Bool
Eq, Eq MemorySemantics
MemorySemantics -> MemorySemantics -> Bool
MemorySemantics -> MemorySemantics -> Ordering
MemorySemantics -> MemorySemantics -> MemorySemantics
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
min :: MemorySemantics -> MemorySemantics -> MemorySemantics
$cmin :: MemorySemantics -> MemorySemantics -> MemorySemantics
max :: MemorySemantics -> MemorySemantics -> MemorySemantics
$cmax :: MemorySemantics -> MemorySemantics -> MemorySemantics
>= :: MemorySemantics -> MemorySemantics -> Bool
$c>= :: MemorySemantics -> MemorySemantics -> Bool
> :: MemorySemantics -> MemorySemantics -> Bool
$c> :: MemorySemantics -> MemorySemantics -> Bool
<= :: MemorySemantics -> MemorySemantics -> Bool
$c<= :: MemorySemantics -> MemorySemantics -> Bool
< :: MemorySemantics -> MemorySemantics -> Bool
$c< :: MemorySemantics -> MemorySemantics -> Bool
compare :: MemorySemantics -> MemorySemantics -> Ordering
$ccompare :: MemorySemantics -> MemorySemantics -> Ordering
Ord, Ptr MemorySemantics -> IO MemorySemantics
Ptr MemorySemantics -> Int -> IO MemorySemantics
Ptr MemorySemantics -> Int -> MemorySemantics -> IO ()
Ptr MemorySemantics -> MemorySemantics -> IO ()
MemorySemantics -> Int
forall b. Ptr b -> Int -> IO MemorySemantics
forall b. Ptr b -> Int -> MemorySemantics -> 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
poke :: Ptr MemorySemantics -> MemorySemantics -> IO ()
$cpoke :: Ptr MemorySemantics -> MemorySemantics -> IO ()
peek :: Ptr MemorySemantics -> IO MemorySemantics
$cpeek :: Ptr MemorySemantics -> IO MemorySemantics
pokeByteOff :: forall b. Ptr b -> Int -> MemorySemantics -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> MemorySemantics -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO MemorySemantics
$cpeekByteOff :: forall b. Ptr b -> Int -> IO MemorySemantics
pokeElemOff :: Ptr MemorySemantics -> Int -> MemorySemantics -> IO ()
$cpokeElemOff :: Ptr MemorySemantics -> Int -> MemorySemantics -> IO ()
peekElemOff :: Ptr MemorySemantics -> Int -> IO MemorySemantics
$cpeekElemOff :: Ptr MemorySemantics -> Int -> IO MemorySemantics
alignment :: MemorySemantics -> Int
$calignment :: MemorySemantics -> Int
sizeOf :: MemorySemantics -> Int
$csizeOf :: MemorySemantics -> Int
Storable, Eq MemorySemantics
MemorySemantics
Int -> MemorySemantics
MemorySemantics -> Bool
MemorySemantics -> Int
MemorySemantics -> Maybe Int
MemorySemantics -> MemorySemantics
MemorySemantics -> Int -> Bool
MemorySemantics -> Int -> MemorySemantics
MemorySemantics -> MemorySemantics -> MemorySemantics
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
popCount :: MemorySemantics -> Int
$cpopCount :: MemorySemantics -> Int
rotateR :: MemorySemantics -> Int -> MemorySemantics
$crotateR :: MemorySemantics -> Int -> MemorySemantics
rotateL :: MemorySemantics -> Int -> MemorySemantics
$crotateL :: MemorySemantics -> Int -> MemorySemantics
unsafeShiftR :: MemorySemantics -> Int -> MemorySemantics
$cunsafeShiftR :: MemorySemantics -> Int -> MemorySemantics
shiftR :: MemorySemantics -> Int -> MemorySemantics
$cshiftR :: MemorySemantics -> Int -> MemorySemantics
unsafeShiftL :: MemorySemantics -> Int -> MemorySemantics
$cunsafeShiftL :: MemorySemantics -> Int -> MemorySemantics
shiftL :: MemorySemantics -> Int -> MemorySemantics
$cshiftL :: MemorySemantics -> Int -> MemorySemantics
isSigned :: MemorySemantics -> Bool
$cisSigned :: MemorySemantics -> Bool
bitSize :: MemorySemantics -> Int
$cbitSize :: MemorySemantics -> Int
bitSizeMaybe :: MemorySemantics -> Maybe Int
$cbitSizeMaybe :: MemorySemantics -> Maybe Int
testBit :: MemorySemantics -> Int -> Bool
$ctestBit :: MemorySemantics -> Int -> Bool
complementBit :: MemorySemantics -> Int -> MemorySemantics
$ccomplementBit :: MemorySemantics -> Int -> MemorySemantics
clearBit :: MemorySemantics -> Int -> MemorySemantics
$cclearBit :: MemorySemantics -> Int -> MemorySemantics
setBit :: MemorySemantics -> Int -> MemorySemantics
$csetBit :: MemorySemantics -> Int -> MemorySemantics
bit :: Int -> MemorySemantics
$cbit :: Int -> MemorySemantics
zeroBits :: MemorySemantics
$czeroBits :: MemorySemantics
rotate :: MemorySemantics -> Int -> MemorySemantics
$crotate :: MemorySemantics -> Int -> MemorySemantics
shift :: MemorySemantics -> Int -> MemorySemantics
$cshift :: MemorySemantics -> Int -> MemorySemantics
complement :: MemorySemantics -> MemorySemantics
$ccomplement :: MemorySemantics -> MemorySemantics
xor :: MemorySemantics -> MemorySemantics -> MemorySemantics
$cxor :: MemorySemantics -> MemorySemantics -> MemorySemantics
.|. :: MemorySemantics -> MemorySemantics -> MemorySemantics
$c.|. :: MemorySemantics -> MemorySemantics -> MemorySemantics
.&. :: MemorySemantics -> MemorySemantics -> MemorySemantics
$c.&. :: MemorySemantics -> MemorySemantics -> MemorySemantics
Bits)

pattern Acquire :: MemorySemantics
pattern $bAcquire :: MemorySemantics
$mAcquire :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
Acquire = MemorySemantics 0x2

pattern Release :: MemorySemantics
pattern $bRelease :: MemorySemantics
$mRelease :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
Release = MemorySemantics 0x4

pattern AcquireRelease :: MemorySemantics
pattern $bAcquireRelease :: MemorySemantics
$mAcquireRelease :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
AcquireRelease = MemorySemantics 0x8

pattern SequentiallyConsistent :: MemorySemantics
pattern $bSequentiallyConsistent :: MemorySemantics
$mSequentiallyConsistent :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
SequentiallyConsistent = MemorySemantics 0x10

pattern UniformMemory :: MemorySemantics
pattern $bUniformMemory :: MemorySemantics
$mUniformMemory :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
UniformMemory = MemorySemantics 0x40

pattern SubgroupMemory :: MemorySemantics
pattern $bSubgroupMemory :: MemorySemantics
$mSubgroupMemory :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
SubgroupMemory = MemorySemantics 0x80

pattern WorkgroupMemory :: MemorySemantics
pattern $bWorkgroupMemory :: MemorySemantics
$mWorkgroupMemory :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
WorkgroupMemory = MemorySemantics 0x100

pattern CrossWorkgroupMemory :: MemorySemantics
pattern $bCrossWorkgroupMemory :: MemorySemantics
$mCrossWorkgroupMemory :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
CrossWorkgroupMemory = MemorySemantics 0x200

pattern AtomicCounterMemory :: MemorySemantics
pattern $bAtomicCounterMemory :: MemorySemantics
$mAtomicCounterMemory :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
AtomicCounterMemory = MemorySemantics 0x400

pattern ImageMemory :: MemorySemantics
pattern $bImageMemory :: MemorySemantics
$mImageMemory :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
ImageMemory = MemorySemantics 0x800

pattern OutputMemory :: MemorySemantics
pattern $bOutputMemory :: MemorySemantics
$mOutputMemory :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
OutputMemory = MemorySemantics 0x1000

pattern OutputMemoryKHR :: MemorySemantics
pattern $bOutputMemoryKHR :: MemorySemantics
$mOutputMemoryKHR :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
OutputMemoryKHR = MemorySemantics 0x1000

pattern MakeAvailable :: MemorySemantics
pattern $bMakeAvailable :: MemorySemantics
$mMakeAvailable :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
MakeAvailable = MemorySemantics 0x2000

pattern MakeAvailableKHR :: MemorySemantics
pattern $bMakeAvailableKHR :: MemorySemantics
$mMakeAvailableKHR :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
MakeAvailableKHR = MemorySemantics 0x2000

pattern MakeVisible :: MemorySemantics
pattern $bMakeVisible :: MemorySemantics
$mMakeVisible :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
MakeVisible = MemorySemantics 0x4000

pattern MakeVisibleKHR :: MemorySemantics
pattern $bMakeVisibleKHR :: MemorySemantics
$mMakeVisibleKHR :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
MakeVisibleKHR = MemorySemantics 0x4000

pattern Volatile :: MemorySemantics
pattern $bVolatile :: MemorySemantics
$mVolatile :: forall {r}. MemorySemantics -> ((# #) -> r) -> ((# #) -> r) -> r
Volatile = MemorySemantics 0x8000

toName :: IsString a => MemorySemantics -> a
toName :: forall a. IsString a => MemorySemantics -> a
toName MemorySemantics
x = case MemorySemantics
x of
  MemorySemantics
Acquire -> a
"Acquire"
  MemorySemantics
Release -> a
"Release"
  MemorySemantics
AcquireRelease -> a
"AcquireRelease"
  MemorySemantics
SequentiallyConsistent -> a
"SequentiallyConsistent"
  MemorySemantics
UniformMemory -> a
"UniformMemory"
  MemorySemantics
SubgroupMemory -> a
"SubgroupMemory"
  MemorySemantics
WorkgroupMemory -> a
"WorkgroupMemory"
  MemorySemantics
CrossWorkgroupMemory -> a
"CrossWorkgroupMemory"
  MemorySemantics
AtomicCounterMemory -> a
"AtomicCounterMemory"
  MemorySemantics
ImageMemory -> a
"ImageMemory"
  MemorySemantics
OutputMemory -> a
"OutputMemory"
  MemorySemantics
OutputMemoryKHR -> a
"OutputMemoryKHR"
  MemorySemantics
MakeAvailable -> a
"MakeAvailable"
  MemorySemantics
MakeAvailableKHR -> a
"MakeAvailableKHR"
  MemorySemantics
MakeVisible -> a
"MakeVisible"
  MemorySemantics
MakeVisibleKHR -> a
"MakeVisibleKHR"
  MemorySemantics
Volatile -> a
"Volatile"
  MemorySemantics
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"MemorySemantics " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show MemorySemantics
unknown

instance Show MemorySemantics where
  show :: MemorySemantics -> [Char]
show = forall a. IsString a => MemorySemantics -> a
toName

fromName :: (IsString a, Eq a) => a -> Maybe MemorySemantics
fromName :: forall a. (IsString a, Eq a) => a -> Maybe MemorySemantics
fromName a
x = case a
x of
  a
"Acquire" -> forall a. a -> Maybe a
Just MemorySemantics
Acquire
  a
"Release" -> forall a. a -> Maybe a
Just MemorySemantics
Release
  a
"AcquireRelease" -> forall a. a -> Maybe a
Just MemorySemantics
AcquireRelease
  a
"SequentiallyConsistent" -> forall a. a -> Maybe a
Just MemorySemantics
SequentiallyConsistent
  a
"UniformMemory" -> forall a. a -> Maybe a
Just MemorySemantics
UniformMemory
  a
"SubgroupMemory" -> forall a. a -> Maybe a
Just MemorySemantics
SubgroupMemory
  a
"WorkgroupMemory" -> forall a. a -> Maybe a
Just MemorySemantics
WorkgroupMemory
  a
"CrossWorkgroupMemory" -> forall a. a -> Maybe a
Just MemorySemantics
CrossWorkgroupMemory
  a
"AtomicCounterMemory" -> forall a. a -> Maybe a
Just MemorySemantics
AtomicCounterMemory
  a
"ImageMemory" -> forall a. a -> Maybe a
Just MemorySemantics
ImageMemory
  a
"OutputMemory" -> forall a. a -> Maybe a
Just MemorySemantics
OutputMemory
  a
"OutputMemoryKHR" -> forall a. a -> Maybe a
Just MemorySemantics
OutputMemoryKHR
  a
"MakeAvailable" -> forall a. a -> Maybe a
Just MemorySemantics
MakeAvailable
  a
"MakeAvailableKHR" -> forall a. a -> Maybe a
Just MemorySemantics
MakeAvailableKHR
  a
"MakeVisible" -> forall a. a -> Maybe a
Just MemorySemantics
MakeVisible
  a
"MakeVisibleKHR" -> forall a. a -> Maybe a
Just MemorySemantics
MakeVisibleKHR
  a
"Volatile" -> forall a. a -> Maybe a
Just MemorySemantics
Volatile
  a
_unknown -> forall a. Maybe a
Nothing

instance Read MemorySemantics where
  readPrec :: ReadPrec MemorySemantics
readPrec = forall a. ReadPrec a -> ReadPrec a
Read.parens do
    Lex.Ident [Char]
s <- ReadPrec Lexeme
Read.lexP
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
pfail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (IsString a, Eq a) => a -> Maybe MemorySemantics
fromName [Char]
s