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

pattern Unroll :: LoopControl
pattern $bUnroll :: LoopControl
$mUnroll :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
Unroll = LoopControl 0x1

pattern DontUnroll :: LoopControl
pattern $bDontUnroll :: LoopControl
$mDontUnroll :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
DontUnroll = LoopControl 0x2

pattern DependencyInfinite :: LoopControl
pattern $bDependencyInfinite :: LoopControl
$mDependencyInfinite :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
DependencyInfinite = LoopControl 0x4

pattern DependencyLength :: LoopControl
pattern $bDependencyLength :: LoopControl
$mDependencyLength :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
DependencyLength = LoopControl 0x8

pattern MinIterations :: LoopControl
pattern $bMinIterations :: LoopControl
$mMinIterations :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
MinIterations = LoopControl 0x10

pattern MaxIterations :: LoopControl
pattern $bMaxIterations :: LoopControl
$mMaxIterations :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
MaxIterations = LoopControl 0x20

pattern IterationMultiple :: LoopControl
pattern $bIterationMultiple :: LoopControl
$mIterationMultiple :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
IterationMultiple = LoopControl 0x40

pattern PeelCount :: LoopControl
pattern $bPeelCount :: LoopControl
$mPeelCount :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
PeelCount = LoopControl 0x80

pattern PartialCount :: LoopControl
pattern $bPartialCount :: LoopControl
$mPartialCount :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
PartialCount = LoopControl 0x100

pattern InitiationIntervalINTEL :: LoopControl
pattern $bInitiationIntervalINTEL :: LoopControl
$mInitiationIntervalINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
InitiationIntervalINTEL = LoopControl 0x10000

pattern MaxConcurrencyINTEL :: LoopControl
pattern $bMaxConcurrencyINTEL :: LoopControl
$mMaxConcurrencyINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
MaxConcurrencyINTEL = LoopControl 0x20000

pattern DependencyArrayINTEL :: LoopControl
pattern $bDependencyArrayINTEL :: LoopControl
$mDependencyArrayINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
DependencyArrayINTEL = LoopControl 0x40000

pattern PipelineEnableINTEL :: LoopControl
pattern $bPipelineEnableINTEL :: LoopControl
$mPipelineEnableINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
PipelineEnableINTEL = LoopControl 0x80000

pattern LoopCoalesceINTEL :: LoopControl
pattern $bLoopCoalesceINTEL :: LoopControl
$mLoopCoalesceINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
LoopCoalesceINTEL = LoopControl 0x100000

pattern MaxInterleavingINTEL :: LoopControl
pattern $bMaxInterleavingINTEL :: LoopControl
$mMaxInterleavingINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
MaxInterleavingINTEL = LoopControl 0x200000

pattern SpeculatedIterationsINTEL :: LoopControl
pattern $bSpeculatedIterationsINTEL :: LoopControl
$mSpeculatedIterationsINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
SpeculatedIterationsINTEL = LoopControl 0x400000

pattern NoFusionINTEL :: LoopControl
pattern $bNoFusionINTEL :: LoopControl
$mNoFusionINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
NoFusionINTEL = LoopControl 0x800000

pattern LoopCountINTEL :: LoopControl
pattern $bLoopCountINTEL :: LoopControl
$mLoopCountINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
LoopCountINTEL = LoopControl 0x1000000

pattern MaxReinvocationDelayINTEL :: LoopControl
pattern $bMaxReinvocationDelayINTEL :: LoopControl
$mMaxReinvocationDelayINTEL :: forall {r}. LoopControl -> ((# #) -> r) -> ((# #) -> r) -> r
MaxReinvocationDelayINTEL = LoopControl 0x2000000

toName :: IsString a => LoopControl -> a
toName :: forall a. IsString a => LoopControl -> a
toName LoopControl
x = case LoopControl
x of
  LoopControl
Unroll -> a
"Unroll"
  LoopControl
DontUnroll -> a
"DontUnroll"
  LoopControl
DependencyInfinite -> a
"DependencyInfinite"
  LoopControl
DependencyLength -> a
"DependencyLength"
  LoopControl
MinIterations -> a
"MinIterations"
  LoopControl
MaxIterations -> a
"MaxIterations"
  LoopControl
IterationMultiple -> a
"IterationMultiple"
  LoopControl
PeelCount -> a
"PeelCount"
  LoopControl
PartialCount -> a
"PartialCount"
  LoopControl
InitiationIntervalINTEL -> a
"InitiationIntervalINTEL"
  LoopControl
MaxConcurrencyINTEL -> a
"MaxConcurrencyINTEL"
  LoopControl
DependencyArrayINTEL -> a
"DependencyArrayINTEL"
  LoopControl
PipelineEnableINTEL -> a
"PipelineEnableINTEL"
  LoopControl
LoopCoalesceINTEL -> a
"LoopCoalesceINTEL"
  LoopControl
MaxInterleavingINTEL -> a
"MaxInterleavingINTEL"
  LoopControl
SpeculatedIterationsINTEL -> a
"SpeculatedIterationsINTEL"
  LoopControl
NoFusionINTEL -> a
"NoFusionINTEL"
  LoopControl
LoopCountINTEL -> a
"LoopCountINTEL"
  LoopControl
MaxReinvocationDelayINTEL -> a
"MaxReinvocationDelayINTEL"
  LoopControl
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"LoopControl " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show LoopControl
unknown

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

fromName :: (IsString a, Eq a) => a -> Maybe LoopControl
fromName :: forall a. (IsString a, Eq a) => a -> Maybe LoopControl
fromName a
x = case a
x of
  a
"Unroll" -> forall a. a -> Maybe a
Just LoopControl
Unroll
  a
"DontUnroll" -> forall a. a -> Maybe a
Just LoopControl
DontUnroll
  a
"DependencyInfinite" -> forall a. a -> Maybe a
Just LoopControl
DependencyInfinite
  a
"DependencyLength" -> forall a. a -> Maybe a
Just LoopControl
DependencyLength
  a
"MinIterations" -> forall a. a -> Maybe a
Just LoopControl
MinIterations
  a
"MaxIterations" -> forall a. a -> Maybe a
Just LoopControl
MaxIterations
  a
"IterationMultiple" -> forall a. a -> Maybe a
Just LoopControl
IterationMultiple
  a
"PeelCount" -> forall a. a -> Maybe a
Just LoopControl
PeelCount
  a
"PartialCount" -> forall a. a -> Maybe a
Just LoopControl
PartialCount
  a
"InitiationIntervalINTEL" -> forall a. a -> Maybe a
Just LoopControl
InitiationIntervalINTEL
  a
"MaxConcurrencyINTEL" -> forall a. a -> Maybe a
Just LoopControl
MaxConcurrencyINTEL
  a
"DependencyArrayINTEL" -> forall a. a -> Maybe a
Just LoopControl
DependencyArrayINTEL
  a
"PipelineEnableINTEL" -> forall a. a -> Maybe a
Just LoopControl
PipelineEnableINTEL
  a
"LoopCoalesceINTEL" -> forall a. a -> Maybe a
Just LoopControl
LoopCoalesceINTEL
  a
"MaxInterleavingINTEL" -> forall a. a -> Maybe a
Just LoopControl
MaxInterleavingINTEL
  a
"SpeculatedIterationsINTEL" -> forall a. a -> Maybe a
Just LoopControl
SpeculatedIterationsINTEL
  a
"NoFusionINTEL" -> forall a. a -> Maybe a
Just LoopControl
NoFusionINTEL
  a
"LoopCountINTEL" -> forall a. a -> Maybe a
Just LoopControl
LoopCountINTEL
  a
"MaxReinvocationDelayINTEL" -> forall a. a -> Maybe a
Just LoopControl
MaxReinvocationDelayINTEL
  a
_unknown -> forall a. Maybe a
Nothing

instance Read LoopControl where
  readPrec :: ReadPrec LoopControl
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 LoopControl
fromName [Char]
s