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

module Data.SpirV.Enum.FPRoundingMode where

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

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

instance Show FPRoundingMode where
  showsPrec :: Int -> FPRoundingMode -> ShowS
showsPrec Int
p (FPRoundingMode Word32
v) = case Word32
v of
    Word32
0 -> String -> ShowS
showString String
"RTE"
    Word32
1 -> String -> ShowS
showString String
"RTZ"
    Word32
2 -> String -> ShowS
showString String
"RTP"
    Word32
3 -> String -> ShowS
showString String
"RTN"
    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
"FPRoundingMode " 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 RTE :: FPRoundingMode
pattern $mRTE :: forall {r}. FPRoundingMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bRTE :: FPRoundingMode
RTE = FPRoundingMode 0

pattern RTZ :: FPRoundingMode
pattern $mRTZ :: forall {r}. FPRoundingMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bRTZ :: FPRoundingMode
RTZ = FPRoundingMode 1

pattern RTP :: FPRoundingMode
pattern $mRTP :: forall {r}. FPRoundingMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bRTP :: FPRoundingMode
RTP = FPRoundingMode 2

pattern RTN :: FPRoundingMode
pattern $mRTN :: forall {r}. FPRoundingMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bRTN :: FPRoundingMode
RTN = FPRoundingMode 3