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

pattern NotNaN :: FPFastMathMode
pattern $bNotNaN :: FPFastMathMode
$mNotNaN :: forall {r}. FPFastMathMode -> ((# #) -> r) -> ((# #) -> r) -> r
NotNaN = FPFastMathMode 0x1

pattern NotInf :: FPFastMathMode
pattern $bNotInf :: FPFastMathMode
$mNotInf :: forall {r}. FPFastMathMode -> ((# #) -> r) -> ((# #) -> r) -> r
NotInf = FPFastMathMode 0x2

pattern NSZ :: FPFastMathMode
pattern $bNSZ :: FPFastMathMode
$mNSZ :: forall {r}. FPFastMathMode -> ((# #) -> r) -> ((# #) -> r) -> r
NSZ = FPFastMathMode 0x4

pattern AllowRecip :: FPFastMathMode
pattern $bAllowRecip :: FPFastMathMode
$mAllowRecip :: forall {r}. FPFastMathMode -> ((# #) -> r) -> ((# #) -> r) -> r
AllowRecip = FPFastMathMode 0x8

pattern Fast :: FPFastMathMode
pattern $bFast :: FPFastMathMode
$mFast :: forall {r}. FPFastMathMode -> ((# #) -> r) -> ((# #) -> r) -> r
Fast = FPFastMathMode 0x10

pattern AllowContractFastINTEL :: FPFastMathMode
pattern $bAllowContractFastINTEL :: FPFastMathMode
$mAllowContractFastINTEL :: forall {r}. FPFastMathMode -> ((# #) -> r) -> ((# #) -> r) -> r
AllowContractFastINTEL = FPFastMathMode 0x10000

pattern AllowReassocINTEL :: FPFastMathMode
pattern $bAllowReassocINTEL :: FPFastMathMode
$mAllowReassocINTEL :: forall {r}. FPFastMathMode -> ((# #) -> r) -> ((# #) -> r) -> r
AllowReassocINTEL = FPFastMathMode 0x20000

toName :: IsString a => FPFastMathMode -> a
toName :: forall a. IsString a => FPFastMathMode -> a
toName FPFastMathMode
x = case FPFastMathMode
x of
  FPFastMathMode
NotNaN -> a
"NotNaN"
  FPFastMathMode
NotInf -> a
"NotInf"
  FPFastMathMode
NSZ -> a
"NSZ"
  FPFastMathMode
AllowRecip -> a
"AllowRecip"
  FPFastMathMode
Fast -> a
"Fast"
  FPFastMathMode
AllowContractFastINTEL -> a
"AllowContractFastINTEL"
  FPFastMathMode
AllowReassocINTEL -> a
"AllowReassocINTEL"
  FPFastMathMode
unknown -> forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"FPFastMathMode " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FPFastMathMode
unknown

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

fromName :: (IsString a, Eq a) => a -> Maybe FPFastMathMode
fromName :: forall a. (IsString a, Eq a) => a -> Maybe FPFastMathMode
fromName a
x = case a
x of
  a
"NotNaN" -> forall a. a -> Maybe a
Just FPFastMathMode
NotNaN
  a
"NotInf" -> forall a. a -> Maybe a
Just FPFastMathMode
NotInf
  a
"NSZ" -> forall a. a -> Maybe a
Just FPFastMathMode
NSZ
  a
"AllowRecip" -> forall a. a -> Maybe a
Just FPFastMathMode
AllowRecip
  a
"Fast" -> forall a. a -> Maybe a
Just FPFastMathMode
Fast
  a
"AllowContractFastINTEL" -> forall a. a -> Maybe a
Just FPFastMathMode
AllowContractFastINTEL
  a
"AllowReassocINTEL" -> forall a. a -> Maybe a
Just FPFastMathMode
AllowReassocINTEL
  a
_unknown -> forall a. Maybe a
Nothing

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