{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.SpirV.Enum.FPFastMathMode where

import Data.Bits (Bits, FiniteBits, (.|.))
import Data.Word (Word32)
import Foreign.Storable (Storable)

type FPFastMathMode = FPFastMathModeBits

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

instance Semigroup FPFastMathMode where
  (FPFastMathModeBits Word32
a) <> :: FPFastMathModeBits -> FPFastMathModeBits -> FPFastMathModeBits
<> (FPFastMathModeBits Word32
b) = Word32 -> FPFastMathModeBits
FPFastMathModeBits (Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
b)

instance Monoid FPFastMathMode where
  mempty :: FPFastMathModeBits
mempty = Word32 -> FPFastMathModeBits
FPFastMathModeBits Word32
0

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

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

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

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

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

pattern AllowContract :: FPFastMathModeBits
pattern $mAllowContract :: forall {r}. FPFastMathModeBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bAllowContract :: FPFastMathModeBits
AllowContract = FPFastMathModeBits 0x00010000

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

pattern AllowReassoc :: FPFastMathModeBits
pattern $mAllowReassoc :: forall {r}. FPFastMathModeBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bAllowReassoc :: FPFastMathModeBits
AllowReassoc = FPFastMathModeBits 0x00020000

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

pattern AllowTransform :: FPFastMathModeBits
pattern $mAllowTransform :: forall {r}. FPFastMathModeBits -> ((# #) -> r) -> ((# #) -> r) -> r
$bAllowTransform :: FPFastMathModeBits
AllowTransform = FPFastMathModeBits 0x00040000