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

module Data.SpirV.Enum.CooperativeMatrixLayout where

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

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

instance Show CooperativeMatrixLayout where
  showsPrec :: Int -> CooperativeMatrixLayout -> ShowS
showsPrec Int
p (CooperativeMatrixLayout Word32
v) = case Word32
v of
    Word32
0 -> String -> ShowS
showString String
"RowMajorKHR"
    Word32
1 -> String -> ShowS
showString String
"ColumnMajorKHR"
    Word32
4202 -> String -> ShowS
showString String
"RowBlockedInterleavedARM"
    Word32
4203 -> String -> ShowS
showString String
"ColumnBlockedInterleavedARM"
    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
"CooperativeMatrixLayout " 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 RowMajorKHR :: CooperativeMatrixLayout
pattern $mRowMajorKHR :: forall {r}.
CooperativeMatrixLayout -> ((# #) -> r) -> ((# #) -> r) -> r
$bRowMajorKHR :: CooperativeMatrixLayout
RowMajorKHR = CooperativeMatrixLayout 0

pattern ColumnMajorKHR :: CooperativeMatrixLayout
pattern $mColumnMajorKHR :: forall {r}.
CooperativeMatrixLayout -> ((# #) -> r) -> ((# #) -> r) -> r
$bColumnMajorKHR :: CooperativeMatrixLayout
ColumnMajorKHR = CooperativeMatrixLayout 1

pattern RowBlockedInterleavedARM :: CooperativeMatrixLayout
pattern $mRowBlockedInterleavedARM :: forall {r}.
CooperativeMatrixLayout -> ((# #) -> r) -> ((# #) -> r) -> r
$bRowBlockedInterleavedARM :: CooperativeMatrixLayout
RowBlockedInterleavedARM = CooperativeMatrixLayout 4202

pattern ColumnBlockedInterleavedARM :: CooperativeMatrixLayout
pattern $mColumnBlockedInterleavedARM :: forall {r}.
CooperativeMatrixLayout -> ((# #) -> r) -> ((# #) -> r) -> r
$bColumnBlockedInterleavedARM :: CooperativeMatrixLayout
ColumnBlockedInterleavedARM = CooperativeMatrixLayout 4203