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

module Data.SpirV.Enum.FPOperationMode where

import Data.Word (Word32)
import Foreign.Storable (Storable)

newtype FPOperationMode = FPOperationMode Word32
  deriving newtype (FPOperationMode -> FPOperationMode -> Bool
(FPOperationMode -> FPOperationMode -> Bool)
-> (FPOperationMode -> FPOperationMode -> Bool)
-> Eq FPOperationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FPOperationMode -> FPOperationMode -> Bool
== :: FPOperationMode -> FPOperationMode -> Bool
$c/= :: FPOperationMode -> FPOperationMode -> Bool
/= :: FPOperationMode -> FPOperationMode -> Bool
Eq, Eq FPOperationMode
Eq FPOperationMode =>
(FPOperationMode -> FPOperationMode -> Ordering)
-> (FPOperationMode -> FPOperationMode -> Bool)
-> (FPOperationMode -> FPOperationMode -> Bool)
-> (FPOperationMode -> FPOperationMode -> Bool)
-> (FPOperationMode -> FPOperationMode -> Bool)
-> (FPOperationMode -> FPOperationMode -> FPOperationMode)
-> (FPOperationMode -> FPOperationMode -> FPOperationMode)
-> Ord FPOperationMode
FPOperationMode -> FPOperationMode -> Bool
FPOperationMode -> FPOperationMode -> Ordering
FPOperationMode -> FPOperationMode -> FPOperationMode
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 :: FPOperationMode -> FPOperationMode -> Ordering
compare :: FPOperationMode -> FPOperationMode -> Ordering
$c< :: FPOperationMode -> FPOperationMode -> Bool
< :: FPOperationMode -> FPOperationMode -> Bool
$c<= :: FPOperationMode -> FPOperationMode -> Bool
<= :: FPOperationMode -> FPOperationMode -> Bool
$c> :: FPOperationMode -> FPOperationMode -> Bool
> :: FPOperationMode -> FPOperationMode -> Bool
$c>= :: FPOperationMode -> FPOperationMode -> Bool
>= :: FPOperationMode -> FPOperationMode -> Bool
$cmax :: FPOperationMode -> FPOperationMode -> FPOperationMode
max :: FPOperationMode -> FPOperationMode -> FPOperationMode
$cmin :: FPOperationMode -> FPOperationMode -> FPOperationMode
min :: FPOperationMode -> FPOperationMode -> FPOperationMode
Ord, Ptr FPOperationMode -> IO FPOperationMode
Ptr FPOperationMode -> Int -> IO FPOperationMode
Ptr FPOperationMode -> Int -> FPOperationMode -> IO ()
Ptr FPOperationMode -> FPOperationMode -> IO ()
FPOperationMode -> Int
(FPOperationMode -> Int)
-> (FPOperationMode -> Int)
-> (Ptr FPOperationMode -> Int -> IO FPOperationMode)
-> (Ptr FPOperationMode -> Int -> FPOperationMode -> IO ())
-> (forall b. Ptr b -> Int -> IO FPOperationMode)
-> (forall b. Ptr b -> Int -> FPOperationMode -> IO ())
-> (Ptr FPOperationMode -> IO FPOperationMode)
-> (Ptr FPOperationMode -> FPOperationMode -> IO ())
-> Storable FPOperationMode
forall b. Ptr b -> Int -> IO FPOperationMode
forall b. Ptr b -> Int -> FPOperationMode -> 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 :: FPOperationMode -> Int
sizeOf :: FPOperationMode -> Int
$calignment :: FPOperationMode -> Int
alignment :: FPOperationMode -> Int
$cpeekElemOff :: Ptr FPOperationMode -> Int -> IO FPOperationMode
peekElemOff :: Ptr FPOperationMode -> Int -> IO FPOperationMode
$cpokeElemOff :: Ptr FPOperationMode -> Int -> FPOperationMode -> IO ()
pokeElemOff :: Ptr FPOperationMode -> Int -> FPOperationMode -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO FPOperationMode
peekByteOff :: forall b. Ptr b -> Int -> IO FPOperationMode
$cpokeByteOff :: forall b. Ptr b -> Int -> FPOperationMode -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> FPOperationMode -> IO ()
$cpeek :: Ptr FPOperationMode -> IO FPOperationMode
peek :: Ptr FPOperationMode -> IO FPOperationMode
$cpoke :: Ptr FPOperationMode -> FPOperationMode -> IO ()
poke :: Ptr FPOperationMode -> FPOperationMode -> IO ()
Storable)

instance Show FPOperationMode where
  showsPrec :: Int -> FPOperationMode -> ShowS
showsPrec Int
p (FPOperationMode Word32
v) = case Word32
v of
    Word32
0 -> String -> ShowS
showString String
"IEEE"
    Word32
1 -> String -> ShowS
showString String
"ALT"
    Word32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"FPOperationMode " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word32
x

pattern IEEE :: FPOperationMode
pattern $mIEEE :: forall {r}. FPOperationMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bIEEE :: FPOperationMode
IEEE = FPOperationMode 0

pattern ALT :: FPOperationMode
pattern $mALT :: forall {r}. FPOperationMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bALT :: FPOperationMode
ALT = FPOperationMode 1