{-# language CPP #-}
module Vulkan.Extensions.VK_KHR_cooperative_matrix ( getPhysicalDeviceCooperativeMatrixPropertiesKHR
, PhysicalDeviceCooperativeMatrixFeaturesKHR(..)
, CooperativeMatrixPropertiesKHR(..)
, PhysicalDeviceCooperativeMatrixPropertiesKHR(..)
, ScopeKHR( SCOPE_DEVICE_KHR
, SCOPE_WORKGROUP_KHR
, SCOPE_SUBGROUP_KHR
, SCOPE_QUEUE_FAMILY_KHR
, ..
)
, ComponentTypeKHR( COMPONENT_TYPE_FLOAT16_KHR
, COMPONENT_TYPE_FLOAT32_KHR
, COMPONENT_TYPE_FLOAT64_KHR
, COMPONENT_TYPE_SINT8_KHR
, COMPONENT_TYPE_SINT16_KHR
, COMPONENT_TYPE_SINT32_KHR
, COMPONENT_TYPE_SINT64_KHR
, COMPONENT_TYPE_UINT8_KHR
, COMPONENT_TYPE_UINT16_KHR
, COMPONENT_TYPE_UINT32_KHR
, COMPONENT_TYPE_UINT64_KHR
, ..
)
, KHR_COOPERATIVE_MATRIX_SPEC_VERSION
, pattern KHR_COOPERATIVE_MATRIX_SPEC_VERSION
, KHR_COOPERATIVE_MATRIX_EXTENSION_NAME
, pattern KHR_COOPERATIVE_MATRIX_EXTENSION_NAME
) where
import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showsPrec)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceCooperativeMatrixPropertiesKHR))
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COOPERATIVE_MATRIX_PROPERTIES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_FEATURES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_PROPERTIES_KHR))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPhysicalDeviceCooperativeMatrixPropertiesKHR
:: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result
getPhysicalDeviceCooperativeMatrixPropertiesKHR :: forall io
. (MonadIO io)
=>
PhysicalDevice
-> io (Result, ("properties" ::: Vector CooperativeMatrixPropertiesKHR))
getPhysicalDeviceCooperativeMatrixPropertiesKHR :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> io
(Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
getPhysicalDeviceCooperativeMatrixPropertiesKHR PhysicalDevice
physicalDevice = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPhysicalDeviceCooperativeMatrixPropertiesKHRPtr :: FunPtr
(Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO Result)
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHRPtr = InstanceCmds
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO Result)
pVkGetPhysicalDeviceCooperativeMatrixPropertiesKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO Result)
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHRPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR' :: Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO Result
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR' = FunPtr
(Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO Result)
-> Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO Result
mkVkGetPhysicalDeviceCooperativeMatrixPropertiesKHR FunPtr
(Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO Result)
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHRPtr
let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
"pPropertyCount" ::: Ptr Word32
pPPropertyCount <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR" (Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO Result
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR'
Ptr PhysicalDevice_T
physicalDevice'
("pPropertyCount" ::: Ptr Word32
pPPropertyCount)
(forall a. Ptr a
nullPtr))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Word32
pPropertyCount <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
"pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
pPProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @CooperativeMatrixPropertiesKHR ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) forall a. Num a => a -> a -> a
* Int
56)) forall a. Ptr a -> IO ()
free
[()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
pPProperties forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
56) :: Ptr CooperativeMatrixPropertiesKHR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) forall a. Num a => a -> a -> a
- Int
1]
Result
r' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR" (Ptr PhysicalDevice_T
-> ("pPropertyCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO Result
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR'
Ptr PhysicalDevice_T
physicalDevice'
("pPropertyCount" ::: Ptr Word32
pPPropertyCount)
(("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
pPProperties)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
Word32
pPropertyCount' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertyCount" ::: Ptr Word32
pPPropertyCount
"properties" ::: Vector CooperativeMatrixPropertiesKHR
pProperties' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @CooperativeMatrixPropertiesKHR ((("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
pPProperties) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
56 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr CooperativeMatrixPropertiesKHR)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "properties" ::: Vector CooperativeMatrixPropertiesKHR
pProperties')
data PhysicalDeviceCooperativeMatrixFeaturesKHR = PhysicalDeviceCooperativeMatrixFeaturesKHR
{
PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
cooperativeMatrix :: Bool
,
PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
cooperativeMatrixRobustBufferAccess :: Bool
}
deriving (Typeable, PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
$c/= :: PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
== :: PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
$c== :: PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCooperativeMatrixFeaturesKHR)
#endif
deriving instance Show PhysicalDeviceCooperativeMatrixFeaturesKHR
instance ToCStruct PhysicalDeviceCooperativeMatrixFeaturesKHR where
withCStruct :: forall b.
PhysicalDeviceCooperativeMatrixFeaturesKHR
-> (Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b) -> IO b
withCStruct PhysicalDeviceCooperativeMatrixFeaturesKHR
x Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p PhysicalDeviceCooperativeMatrixFeaturesKHR
x (Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b
f Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p PhysicalDeviceCooperativeMatrixFeaturesKHR{Bool
cooperativeMatrixRobustBufferAccess :: Bool
cooperativeMatrix :: Bool
$sel:cooperativeMatrixRobustBufferAccess:PhysicalDeviceCooperativeMatrixFeaturesKHR :: PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
$sel:cooperativeMatrix:PhysicalDeviceCooperativeMatrixFeaturesKHR :: PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_FEATURES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
cooperativeMatrix))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
cooperativeMatrixRobustBufferAccess))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_FEATURES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceCooperativeMatrixFeaturesKHR where
peekCStruct :: Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> IO PhysicalDeviceCooperativeMatrixFeaturesKHR
peekCStruct Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p = do
Bool32
cooperativeMatrix <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
Bool32
cooperativeMatrixRobustBufferAccess <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> PhysicalDeviceCooperativeMatrixFeaturesKHR
PhysicalDeviceCooperativeMatrixFeaturesKHR
(Bool32 -> Bool
bool32ToBool Bool32
cooperativeMatrix)
(Bool32 -> Bool
bool32ToBool Bool32
cooperativeMatrixRobustBufferAccess)
instance Storable PhysicalDeviceCooperativeMatrixFeaturesKHR where
sizeOf :: PhysicalDeviceCooperativeMatrixFeaturesKHR -> Int
sizeOf ~PhysicalDeviceCooperativeMatrixFeaturesKHR
_ = Int
24
alignment :: PhysicalDeviceCooperativeMatrixFeaturesKHR -> Int
alignment ~PhysicalDeviceCooperativeMatrixFeaturesKHR
_ = Int
8
peek :: Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> IO PhysicalDeviceCooperativeMatrixFeaturesKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO ()
poke Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceCooperativeMatrixFeaturesKHR where
zero :: PhysicalDeviceCooperativeMatrixFeaturesKHR
zero = Bool -> Bool -> PhysicalDeviceCooperativeMatrixFeaturesKHR
PhysicalDeviceCooperativeMatrixFeaturesKHR
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data CooperativeMatrixPropertiesKHR = CooperativeMatrixPropertiesKHR
{
CooperativeMatrixPropertiesKHR -> Word32
mSize :: Word32
,
CooperativeMatrixPropertiesKHR -> Word32
nSize :: Word32
,
CooperativeMatrixPropertiesKHR -> Word32
kSize :: Word32
,
CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
aType :: ComponentTypeKHR
,
CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
bType :: ComponentTypeKHR
,
CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
cType :: ComponentTypeKHR
,
CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
resultType :: ComponentTypeKHR
,
CooperativeMatrixPropertiesKHR -> Bool
saturatingAccumulation :: Bool
,
CooperativeMatrixPropertiesKHR -> ScopeKHR
scope :: ScopeKHR
}
deriving (Typeable, CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> Bool
$c/= :: CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> Bool
== :: CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> Bool
$c== :: CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CooperativeMatrixPropertiesKHR)
#endif
deriving instance Show CooperativeMatrixPropertiesKHR
instance ToCStruct CooperativeMatrixPropertiesKHR where
withCStruct :: forall b.
CooperativeMatrixPropertiesKHR
-> (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR) -> IO b)
-> IO b
withCStruct CooperativeMatrixPropertiesKHR
x ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p CooperativeMatrixPropertiesKHR
x (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR) -> IO b
f "pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p)
pokeCStruct :: forall b.
("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> CooperativeMatrixPropertiesKHR -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p CooperativeMatrixPropertiesKHR{Bool
Word32
ComponentTypeKHR
ScopeKHR
scope :: ScopeKHR
saturatingAccumulation :: Bool
resultType :: ComponentTypeKHR
cType :: ComponentTypeKHR
bType :: ComponentTypeKHR
aType :: ComponentTypeKHR
kSize :: Word32
nSize :: Word32
mSize :: Word32
$sel:scope:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ScopeKHR
$sel:saturatingAccumulation:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> Bool
$sel:resultType:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
$sel:cType:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
$sel:bType:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
$sel:aType:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
$sel:kSize:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> Word32
$sel:nSize:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> Word32
$sel:mSize:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> Word32
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COOPERATIVE_MATRIX_PROPERTIES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
mSize)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
nSize)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
kSize)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
aType)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
bType)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
cType)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
resultType)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
saturatingAccumulation))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ScopeKHR)) (ScopeKHR
scope)
IO b
f
cStructSize :: Int
cStructSize = Int
56
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COOPERATIVE_MATRIX_PROPERTIES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ComponentTypeKHR)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ComponentTypeKHR)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr ComponentTypeKHR)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ComponentTypeKHR)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ScopeKHR)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct CooperativeMatrixPropertiesKHR where
peekCStruct :: ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO CooperativeMatrixPropertiesKHR
peekCStruct "pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p = do
Word32
mSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
Word32
nSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
Word32
kSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
ComponentTypeKHR
aType <- forall a. Storable a => Ptr a -> IO a
peek @ComponentTypeKHR (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ComponentTypeKHR))
ComponentTypeKHR
bType <- forall a. Storable a => Ptr a -> IO a
peek @ComponentTypeKHR (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ComponentTypeKHR))
ComponentTypeKHR
cType <- forall a. Storable a => Ptr a -> IO a
peek @ComponentTypeKHR (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr ComponentTypeKHR))
ComponentTypeKHR
resultType <- forall a. Storable a => Ptr a -> IO a
peek @ComponentTypeKHR (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ComponentTypeKHR))
Bool32
saturatingAccumulation <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32))
ScopeKHR
scope <- forall a. Storable a => Ptr a -> IO a
peek @ScopeKHR (("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ScopeKHR))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Word32
-> ComponentTypeKHR
-> ComponentTypeKHR
-> ComponentTypeKHR
-> ComponentTypeKHR
-> Bool
-> ScopeKHR
-> CooperativeMatrixPropertiesKHR
CooperativeMatrixPropertiesKHR
Word32
mSize
Word32
nSize
Word32
kSize
ComponentTypeKHR
aType
ComponentTypeKHR
bType
ComponentTypeKHR
cType
ComponentTypeKHR
resultType
(Bool32 -> Bool
bool32ToBool Bool32
saturatingAccumulation)
ScopeKHR
scope
instance Storable CooperativeMatrixPropertiesKHR where
sizeOf :: CooperativeMatrixPropertiesKHR -> Int
sizeOf ~CooperativeMatrixPropertiesKHR
_ = Int
56
alignment :: CooperativeMatrixPropertiesKHR -> Int
alignment ~CooperativeMatrixPropertiesKHR
_ = Int
8
peek :: ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> IO CooperativeMatrixPropertiesKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pProperties" ::: Ptr CooperativeMatrixPropertiesKHR)
-> CooperativeMatrixPropertiesKHR -> IO ()
poke "pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
ptr CooperativeMatrixPropertiesKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr CooperativeMatrixPropertiesKHR
ptr CooperativeMatrixPropertiesKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero CooperativeMatrixPropertiesKHR where
zero :: CooperativeMatrixPropertiesKHR
zero = Word32
-> Word32
-> Word32
-> ComponentTypeKHR
-> ComponentTypeKHR
-> ComponentTypeKHR
-> ComponentTypeKHR
-> Bool
-> ScopeKHR
-> CooperativeMatrixPropertiesKHR
CooperativeMatrixPropertiesKHR
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PhysicalDeviceCooperativeMatrixPropertiesKHR = PhysicalDeviceCooperativeMatrixPropertiesKHR
{
PhysicalDeviceCooperativeMatrixPropertiesKHR -> ShaderStageFlags
cooperativeMatrixSupportedStages :: ShaderStageFlags }
deriving (Typeable, PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool
$c/= :: PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool
== :: PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool
$c== :: PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCooperativeMatrixPropertiesKHR)
#endif
deriving instance Show PhysicalDeviceCooperativeMatrixPropertiesKHR
instance ToCStruct PhysicalDeviceCooperativeMatrixPropertiesKHR where
withCStruct :: forall b.
PhysicalDeviceCooperativeMatrixPropertiesKHR
-> (Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b)
-> IO b
withCStruct PhysicalDeviceCooperativeMatrixPropertiesKHR
x Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p PhysicalDeviceCooperativeMatrixPropertiesKHR
x (Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b
f Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p PhysicalDeviceCooperativeMatrixPropertiesKHR{ShaderStageFlags
cooperativeMatrixSupportedStages :: ShaderStageFlags
$sel:cooperativeMatrixSupportedStages:PhysicalDeviceCooperativeMatrixPropertiesKHR :: PhysicalDeviceCooperativeMatrixPropertiesKHR -> ShaderStageFlags
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_PROPERTIES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags)) (ShaderStageFlags
cooperativeMatrixSupportedStages)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_PROPERTIES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDeviceCooperativeMatrixPropertiesKHR where
peekCStruct :: Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> IO PhysicalDeviceCooperativeMatrixPropertiesKHR
peekCStruct Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p = do
ShaderStageFlags
cooperativeMatrixSupportedStages <- forall a. Storable a => Ptr a -> IO a
peek @ShaderStageFlags ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ShaderStageFlags -> PhysicalDeviceCooperativeMatrixPropertiesKHR
PhysicalDeviceCooperativeMatrixPropertiesKHR
ShaderStageFlags
cooperativeMatrixSupportedStages
instance Storable PhysicalDeviceCooperativeMatrixPropertiesKHR where
sizeOf :: PhysicalDeviceCooperativeMatrixPropertiesKHR -> Int
sizeOf ~PhysicalDeviceCooperativeMatrixPropertiesKHR
_ = Int
24
alignment :: PhysicalDeviceCooperativeMatrixPropertiesKHR -> Int
alignment ~PhysicalDeviceCooperativeMatrixPropertiesKHR
_ = Int
8
peek :: Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> IO PhysicalDeviceCooperativeMatrixPropertiesKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO ()
poke Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceCooperativeMatrixPropertiesKHR where
zero :: PhysicalDeviceCooperativeMatrixPropertiesKHR
zero = ShaderStageFlags -> PhysicalDeviceCooperativeMatrixPropertiesKHR
PhysicalDeviceCooperativeMatrixPropertiesKHR
forall a. Zero a => a
zero
newtype ScopeKHR = ScopeKHR Int32
deriving newtype (ScopeKHR -> ScopeKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopeKHR -> ScopeKHR -> Bool
$c/= :: ScopeKHR -> ScopeKHR -> Bool
== :: ScopeKHR -> ScopeKHR -> Bool
$c== :: ScopeKHR -> ScopeKHR -> Bool
Eq, Eq ScopeKHR
ScopeKHR -> ScopeKHR -> Bool
ScopeKHR -> ScopeKHR -> Ordering
ScopeKHR -> ScopeKHR -> ScopeKHR
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 :: ScopeKHR -> ScopeKHR -> ScopeKHR
$cmin :: ScopeKHR -> ScopeKHR -> ScopeKHR
max :: ScopeKHR -> ScopeKHR -> ScopeKHR
$cmax :: ScopeKHR -> ScopeKHR -> ScopeKHR
>= :: ScopeKHR -> ScopeKHR -> Bool
$c>= :: ScopeKHR -> ScopeKHR -> Bool
> :: ScopeKHR -> ScopeKHR -> Bool
$c> :: ScopeKHR -> ScopeKHR -> Bool
<= :: ScopeKHR -> ScopeKHR -> Bool
$c<= :: ScopeKHR -> ScopeKHR -> Bool
< :: ScopeKHR -> ScopeKHR -> Bool
$c< :: ScopeKHR -> ScopeKHR -> Bool
compare :: ScopeKHR -> ScopeKHR -> Ordering
$ccompare :: ScopeKHR -> ScopeKHR -> Ordering
Ord, Ptr ScopeKHR -> IO ScopeKHR
Ptr ScopeKHR -> Int -> IO ScopeKHR
Ptr ScopeKHR -> Int -> ScopeKHR -> IO ()
Ptr ScopeKHR -> ScopeKHR -> IO ()
ScopeKHR -> Int
forall b. Ptr b -> Int -> IO ScopeKHR
forall b. Ptr b -> Int -> ScopeKHR -> 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 ScopeKHR -> ScopeKHR -> IO ()
$cpoke :: Ptr ScopeKHR -> ScopeKHR -> IO ()
peek :: Ptr ScopeKHR -> IO ScopeKHR
$cpeek :: Ptr ScopeKHR -> IO ScopeKHR
pokeByteOff :: forall b. Ptr b -> Int -> ScopeKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ScopeKHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO ScopeKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ScopeKHR
pokeElemOff :: Ptr ScopeKHR -> Int -> ScopeKHR -> IO ()
$cpokeElemOff :: Ptr ScopeKHR -> Int -> ScopeKHR -> IO ()
peekElemOff :: Ptr ScopeKHR -> Int -> IO ScopeKHR
$cpeekElemOff :: Ptr ScopeKHR -> Int -> IO ScopeKHR
alignment :: ScopeKHR -> Int
$calignment :: ScopeKHR -> Int
sizeOf :: ScopeKHR -> Int
$csizeOf :: ScopeKHR -> Int
Storable, ScopeKHR
forall a. a -> Zero a
zero :: ScopeKHR
$czero :: ScopeKHR
Zero)
pattern $bSCOPE_DEVICE_KHR :: ScopeKHR
$mSCOPE_DEVICE_KHR :: forall {r}. ScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
SCOPE_DEVICE_KHR = ScopeKHR 1
pattern $bSCOPE_WORKGROUP_KHR :: ScopeKHR
$mSCOPE_WORKGROUP_KHR :: forall {r}. ScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
SCOPE_WORKGROUP_KHR = ScopeKHR 2
pattern $bSCOPE_SUBGROUP_KHR :: ScopeKHR
$mSCOPE_SUBGROUP_KHR :: forall {r}. ScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
SCOPE_SUBGROUP_KHR = ScopeKHR 3
pattern $bSCOPE_QUEUE_FAMILY_KHR :: ScopeKHR
$mSCOPE_QUEUE_FAMILY_KHR :: forall {r}. ScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
SCOPE_QUEUE_FAMILY_KHR = ScopeKHR 5
{-# COMPLETE
SCOPE_DEVICE_KHR
, SCOPE_WORKGROUP_KHR
, SCOPE_SUBGROUP_KHR
, SCOPE_QUEUE_FAMILY_KHR ::
ScopeKHR
#-}
conNameScopeKHR :: String
conNameScopeKHR :: String
conNameScopeKHR = String
"ScopeKHR"
enumPrefixScopeKHR :: String
enumPrefixScopeKHR :: String
enumPrefixScopeKHR = String
"SCOPE_"
showTableScopeKHR :: [(ScopeKHR, String)]
showTableScopeKHR :: [(ScopeKHR, String)]
showTableScopeKHR =
[ (ScopeKHR
SCOPE_DEVICE_KHR, String
"DEVICE_KHR")
, (ScopeKHR
SCOPE_WORKGROUP_KHR, String
"WORKGROUP_KHR")
, (ScopeKHR
SCOPE_SUBGROUP_KHR, String
"SUBGROUP_KHR")
, (ScopeKHR
SCOPE_QUEUE_FAMILY_KHR, String
"QUEUE_FAMILY_KHR")
]
instance Show ScopeKHR where
showsPrec :: Int -> ScopeKHR -> ShowS
showsPrec =
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
String
enumPrefixScopeKHR
[(ScopeKHR, String)]
showTableScopeKHR
String
conNameScopeKHR
(\(ScopeKHR Int32
x) -> Int32
x)
(forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)
instance Read ScopeKHR where
readPrec :: ReadPrec ScopeKHR
readPrec =
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
String
enumPrefixScopeKHR
[(ScopeKHR, String)]
showTableScopeKHR
String
conNameScopeKHR
Int32 -> ScopeKHR
ScopeKHR
newtype ComponentTypeKHR = ComponentTypeKHR Int32
deriving newtype (ComponentTypeKHR -> ComponentTypeKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
$c/= :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
== :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
$c== :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
Eq, Eq ComponentTypeKHR
ComponentTypeKHR -> ComponentTypeKHR -> Bool
ComponentTypeKHR -> ComponentTypeKHR -> Ordering
ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR
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 :: ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR
$cmin :: ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR
max :: ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR
$cmax :: ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR
>= :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
$c>= :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
> :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
$c> :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
<= :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
$c<= :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
< :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
$c< :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
compare :: ComponentTypeKHR -> ComponentTypeKHR -> Ordering
$ccompare :: ComponentTypeKHR -> ComponentTypeKHR -> Ordering
Ord, Ptr ComponentTypeKHR -> IO ComponentTypeKHR
Ptr ComponentTypeKHR -> Int -> IO ComponentTypeKHR
Ptr ComponentTypeKHR -> Int -> ComponentTypeKHR -> IO ()
Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
ComponentTypeKHR -> Int
forall b. Ptr b -> Int -> IO ComponentTypeKHR
forall b. Ptr b -> Int -> ComponentTypeKHR -> 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 ComponentTypeKHR -> ComponentTypeKHR -> IO ()
$cpoke :: Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
peek :: Ptr ComponentTypeKHR -> IO ComponentTypeKHR
$cpeek :: Ptr ComponentTypeKHR -> IO ComponentTypeKHR
pokeByteOff :: forall b. Ptr b -> Int -> ComponentTypeKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ComponentTypeKHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO ComponentTypeKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ComponentTypeKHR
pokeElemOff :: Ptr ComponentTypeKHR -> Int -> ComponentTypeKHR -> IO ()
$cpokeElemOff :: Ptr ComponentTypeKHR -> Int -> ComponentTypeKHR -> IO ()
peekElemOff :: Ptr ComponentTypeKHR -> Int -> IO ComponentTypeKHR
$cpeekElemOff :: Ptr ComponentTypeKHR -> Int -> IO ComponentTypeKHR
alignment :: ComponentTypeKHR -> Int
$calignment :: ComponentTypeKHR -> Int
sizeOf :: ComponentTypeKHR -> Int
$csizeOf :: ComponentTypeKHR -> Int
Storable, ComponentTypeKHR
forall a. a -> Zero a
zero :: ComponentTypeKHR
$czero :: ComponentTypeKHR
Zero)
pattern $bCOMPONENT_TYPE_FLOAT16_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_FLOAT16_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_FLOAT16_KHR = ComponentTypeKHR 0
pattern $bCOMPONENT_TYPE_FLOAT32_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_FLOAT32_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_FLOAT32_KHR = ComponentTypeKHR 1
pattern $bCOMPONENT_TYPE_FLOAT64_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_FLOAT64_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_FLOAT64_KHR = ComponentTypeKHR 2
pattern $bCOMPONENT_TYPE_SINT8_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_SINT8_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_SINT8_KHR = ComponentTypeKHR 3
pattern $bCOMPONENT_TYPE_SINT16_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_SINT16_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_SINT16_KHR = ComponentTypeKHR 4
pattern $bCOMPONENT_TYPE_SINT32_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_SINT32_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_SINT32_KHR = ComponentTypeKHR 5
pattern $bCOMPONENT_TYPE_SINT64_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_SINT64_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_SINT64_KHR = ComponentTypeKHR 6
pattern $bCOMPONENT_TYPE_UINT8_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_UINT8_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_UINT8_KHR = ComponentTypeKHR 7
pattern $bCOMPONENT_TYPE_UINT16_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_UINT16_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_UINT16_KHR = ComponentTypeKHR 8
pattern $bCOMPONENT_TYPE_UINT32_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_UINT32_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_UINT32_KHR = ComponentTypeKHR 9
pattern $bCOMPONENT_TYPE_UINT64_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_UINT64_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_UINT64_KHR = ComponentTypeKHR 10
{-# COMPLETE
COMPONENT_TYPE_FLOAT16_KHR
, COMPONENT_TYPE_FLOAT32_KHR
, COMPONENT_TYPE_FLOAT64_KHR
, COMPONENT_TYPE_SINT8_KHR
, COMPONENT_TYPE_SINT16_KHR
, COMPONENT_TYPE_SINT32_KHR
, COMPONENT_TYPE_SINT64_KHR
, COMPONENT_TYPE_UINT8_KHR
, COMPONENT_TYPE_UINT16_KHR
, COMPONENT_TYPE_UINT32_KHR
, COMPONENT_TYPE_UINT64_KHR ::
ComponentTypeKHR
#-}
conNameComponentTypeKHR :: String
conNameComponentTypeKHR :: String
conNameComponentTypeKHR = String
"ComponentTypeKHR"
enumPrefixComponentTypeKHR :: String
enumPrefixComponentTypeKHR :: String
enumPrefixComponentTypeKHR = String
"COMPONENT_TYPE_"
showTableComponentTypeKHR :: [(ComponentTypeKHR, String)]
showTableComponentTypeKHR :: [(ComponentTypeKHR, String)]
showTableComponentTypeKHR =
[ (ComponentTypeKHR
COMPONENT_TYPE_FLOAT16_KHR, String
"FLOAT16_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_FLOAT32_KHR, String
"FLOAT32_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_FLOAT64_KHR, String
"FLOAT64_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_SINT8_KHR, String
"SINT8_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_SINT16_KHR, String
"SINT16_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_SINT32_KHR, String
"SINT32_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_SINT64_KHR, String
"SINT64_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_UINT8_KHR, String
"UINT8_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_UINT16_KHR, String
"UINT16_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_UINT32_KHR, String
"UINT32_KHR")
, (ComponentTypeKHR
COMPONENT_TYPE_UINT64_KHR, String
"UINT64_KHR")
]
instance Show ComponentTypeKHR where
showsPrec :: Int -> ComponentTypeKHR -> ShowS
showsPrec =
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
String
enumPrefixComponentTypeKHR
[(ComponentTypeKHR, String)]
showTableComponentTypeKHR
String
conNameComponentTypeKHR
(\(ComponentTypeKHR Int32
x) -> Int32
x)
(forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)
instance Read ComponentTypeKHR where
readPrec :: ReadPrec ComponentTypeKHR
readPrec =
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
String
enumPrefixComponentTypeKHR
[(ComponentTypeKHR, String)]
showTableComponentTypeKHR
String
conNameComponentTypeKHR
Int32 -> ComponentTypeKHR
ComponentTypeKHR
type KHR_COOPERATIVE_MATRIX_SPEC_VERSION = 2
pattern KHR_COOPERATIVE_MATRIX_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_COOPERATIVE_MATRIX_SPEC_VERSION :: forall a. Integral a => a
$mKHR_COOPERATIVE_MATRIX_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_COOPERATIVE_MATRIX_SPEC_VERSION = 2
type KHR_COOPERATIVE_MATRIX_EXTENSION_NAME = "VK_KHR_cooperative_matrix"
pattern KHR_COOPERATIVE_MATRIX_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_COOPERATIVE_MATRIX_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mKHR_COOPERATIVE_MATRIX_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_COOPERATIVE_MATRIX_EXTENSION_NAME = "VK_KHR_cooperative_matrix"