{-# language CPP #-}
-- | = Name
--
-- VK_KHR_cooperative_matrix - device extension
--
-- == VK_KHR_cooperative_matrix
--
-- [__Name String__]
--     @VK_KHR_cooperative_matrix@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     507
--
-- [__Revision__]
--     2
--
-- [__Ratification Status__]
--     Ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_get_physical_device_properties2 VK_KHR_get_physical_device_properties2>
--
-- [__SPIR-V Dependencies__]
--
--     -   <https://htmlpreview.github.io/?https://github.com/KhronosGroup/SPIRV-Registry/blob/master/extensions/KHR/SPV_KHR_cooperative_matrix.html SPV_KHR_cooperative_matrix>
--
-- [__Contact__]
--
--     -   Kevin Petit
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_cooperative_matrix] @kpet%0A*Here describe the issue or question you have about the VK_KHR_cooperative_matrix extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-05-03
--
-- [__Interactions and External Dependencies__]
--
--     -   This extension provides API support for
--         <https://github.com/KhronosGroup/GLSL/blob/master/extensions/khr/GLSL_KHR_cooperative_matrix.txt GLSL_KHR_cooperative_matrix>
--
-- [__Contributors__]
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Markus Tavenrath, NVIDIA
--
--     -   Daniel Koch, NVIDIA
--
--     -   Kevin Petit, Arm Ltd.
--
--     -   Boris Zanin, AMD
--
-- == Description
--
-- This extension adds support for using cooperative matrix types in
-- SPIR-V. Cooperative matrix types are medium-sized matrices that are
-- primarily supported in compute shaders, where the storage for the matrix
-- is spread across all invocations in some scope (usually a subgroup) and
-- those invocations cooperate to efficiently perform matrix multiplies.
--
-- Cooperative matrix types are defined by the
-- <https://htmlpreview.github.io/?https://github.com/KhronosGroup/SPIRV-Registry/blob/master/extensions/KHR/SPV_KHR_cooperative_matrix.html SPV_KHR_cooperative_matrix>
-- SPIR-V extension and can be used with the
-- <https://github.com/KhronosGroup/GLSL/blob/master/extensions/khr/GLSL_KHR_cooperative_matrix.txt GLSL_KHR_cooperative_matrix>
-- GLSL extension.
--
-- This extension includes support for enumerating the matrix types and
-- dimensions that are supported by the implementation.
--
-- == New Commands
--
-- -   'getPhysicalDeviceCooperativeMatrixPropertiesKHR'
--
-- == New Structures
--
-- -   'CooperativeMatrixPropertiesKHR'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceCooperativeMatrixFeaturesKHR'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceCooperativeMatrixPropertiesKHR'
--
-- == New Enums
--
-- -   'ComponentTypeKHR'
--
-- -   'ScopeKHR'
--
-- == New Enum Constants
--
-- -   'KHR_COOPERATIVE_MATRIX_EXTENSION_NAME'
--
-- -   'KHR_COOPERATIVE_MATRIX_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COOPERATIVE_MATRIX_PROPERTIES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_FEATURES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_PROPERTIES_KHR'
--
-- == New SPIR-V Capabilities
--
-- -   <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-capabilities-table-CooperativeMatrixKHR CooperativeMatrixKHR>
--
-- == Version History
--
-- -   Revision 2, 2023-05-03 (Kevin Petit)
--
--     -   First KHR revision
--
-- -   Revision 1, 2019-02-05 (Jeff Bolz)
--
--     -   NVIDIA vendor extension
--
-- == See Also
--
-- 'ComponentTypeKHR', 'CooperativeMatrixPropertiesKHR',
-- 'PhysicalDeviceCooperativeMatrixFeaturesKHR',
-- 'PhysicalDeviceCooperativeMatrixPropertiesKHR', 'ScopeKHR',
-- 'getPhysicalDeviceCooperativeMatrixPropertiesKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_KHR_cooperative_matrix Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
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

-- | vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR - Returns properties
-- describing what cooperative matrix types are supported
--
-- = Description
--
-- If @pProperties@ is @NULL@, then the number of cooperative matrix
-- properties available is returned in @pPropertyCount@. Otherwise,
-- @pPropertyCount@ /must/ point to a variable set by the user to the
-- number of elements in the @pProperties@ array, and on return the
-- variable is overwritten with the number of structures actually written
-- to @pProperties@. If @pPropertyCount@ is less than the number of
-- cooperative matrix properties available, at most @pPropertyCount@
-- structures will be written, and 'Vulkan.Core10.Enums.Result.INCOMPLETE'
-- will be returned instead of 'Vulkan.Core10.Enums.Result.SUCCESS', to
-- indicate that not all the available cooperative matrix properties were
-- returned.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR-pPropertyCount-parameter#
--     @pPropertyCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR-pProperties-parameter#
--     If the value referenced by @pPropertyCount@ is not @0@, and
--     @pProperties@ is not @NULL@, @pProperties@ /must/ be a valid pointer
--     to an array of @pPropertyCount@ 'CooperativeMatrixPropertiesKHR'
--     structures
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_cooperative_matrix VK_KHR_cooperative_matrix>,
-- 'CooperativeMatrixPropertiesKHR', 'Vulkan.Core10.Handles.PhysicalDevice'
getPhysicalDeviceCooperativeMatrixPropertiesKHR :: forall io
                                                 . (MonadIO io)
                                                => -- | @physicalDevice@ is the physical device.
                                                   PhysicalDevice
                                                -> io (Result, ("properties" ::: Vector CooperativeMatrixPropertiesKHR))
getPhysicalDeviceCooperativeMatrixPropertiesKHR :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> io
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
getPhysicalDeviceCooperativeMatrixPropertiesKHR PhysicalDevice
physicalDevice = IO (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
-> io
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
 -> io
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> (ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
    -> IO
         (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
-> io
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
  IO
  (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
-> IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
   IO
   (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
 -> io
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
-> io
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceCooperativeMatrixPropertiesKHRPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result)
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHRPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result)
pVkGetPhysicalDeviceCooperativeMatrixPropertiesKHR (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO ()
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result)
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHRPtr FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR' :: Ptr PhysicalDevice_T
-> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR' = FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result)
-> Ptr PhysicalDevice_T
-> Ptr Word32
-> Ptr CooperativeMatrixPropertiesKHR
-> IO Result
mkVkGetPhysicalDeviceCooperativeMatrixPropertiesKHR FunPtr
  (Ptr PhysicalDevice_T
   -> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result)
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHRPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  Ptr Word32
pPPropertyCount <- ((Ptr Word32
  -> IO
       (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
 -> IO
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     (Ptr Word32)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32
   -> IO
        (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
  -> IO
       (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      (Ptr Word32))
-> ((Ptr Word32
     -> IO
          (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
    -> IO
         (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Word32)
-> (Ptr Word32 -> IO ())
-> (Ptr Word32
    -> IO
         (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
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) Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     Result
forall (m :: * -> *) a.
Monad m =>
m a
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR" (Ptr PhysicalDevice_T
-> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR'
                                                                                      Ptr PhysicalDevice_T
physicalDevice'
                                                                                      (Ptr Word32
pPPropertyCount)
                                                                                      (Ptr CooperativeMatrixPropertiesKHR
forall a. Ptr a
nullPtr))
  IO ()
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Word32
pPropertyCount <- IO Word32
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     Word32
forall (m :: * -> *) a.
Monad m =>
m a
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr Word32
pPPropertyCount
  Ptr CooperativeMatrixPropertiesKHR
pPProperties <- ((Ptr CooperativeMatrixPropertiesKHR
  -> IO
       (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
 -> IO
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     (Ptr CooperativeMatrixPropertiesKHR)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CooperativeMatrixPropertiesKHR
   -> IO
        (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
  -> IO
       (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      (Ptr CooperativeMatrixPropertiesKHR))
-> ((Ptr CooperativeMatrixPropertiesKHR
     -> IO
          (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
    -> IO
         (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     (Ptr CooperativeMatrixPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ IO (Ptr CooperativeMatrixPropertiesKHR)
-> (Ptr CooperativeMatrixPropertiesKHR -> IO ())
-> (Ptr CooperativeMatrixPropertiesKHR
    -> IO
         (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @CooperativeMatrixPropertiesKHR ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
56)) Ptr CooperativeMatrixPropertiesKHR -> IO ()
forall a. Ptr a -> IO ()
free
  [()]
_ <- (Int
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      ())
-> [Int]
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\Int
i -> ((()
  -> IO
       (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
 -> IO
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((()
   -> IO
        (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
  -> IO
       (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      ())
-> ((()
     -> IO
          (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
    -> IO
         (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ()
forall a b. (a -> b) -> a -> b
$ Ptr CooperativeMatrixPropertiesKHR
-> IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
-> IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall b. Ptr CooperativeMatrixPropertiesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct (Ptr CooperativeMatrixPropertiesKHR
pPProperties Ptr CooperativeMatrixPropertiesKHR
-> Int -> Ptr CooperativeMatrixPropertiesKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
56) :: Ptr CooperativeMatrixPropertiesKHR) (IO
   (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
 -> IO
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ((()
     -> IO
          (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
    -> IO
         (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> (()
    -> IO
         (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((()
 -> IO
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> ()
-> IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  Result
r' <- IO Result
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     Result
forall (m :: * -> *) a.
Monad m =>
m a
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR" (Ptr PhysicalDevice_T
-> Ptr Word32 -> Ptr CooperativeMatrixPropertiesKHR -> IO Result
vkGetPhysicalDeviceCooperativeMatrixPropertiesKHR'
                                                                                       Ptr PhysicalDevice_T
physicalDevice'
                                                                                       (Ptr Word32
pPPropertyCount)
                                                                                       ((Ptr CooperativeMatrixPropertiesKHR
pPProperties)))
  IO ()
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      ())
-> IO ()
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
  Word32
pPropertyCount' <- IO Word32
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     Word32
forall (m :: * -> *) a.
Monad m =>
m a
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     Word32
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr Word32
pPPropertyCount
  "properties" ::: Vector CooperativeMatrixPropertiesKHR
pProperties' <- IO ("properties" ::: Vector CooperativeMatrixPropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ("properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall (m :: * -> *) a.
Monad m =>
m a
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("properties" ::: Vector CooperativeMatrixPropertiesKHR)
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      ("properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> IO ("properties" ::: Vector CooperativeMatrixPropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     ("properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO CooperativeMatrixPropertiesKHR)
-> IO ("properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @CooperativeMatrixPropertiesKHR (((Ptr CooperativeMatrixPropertiesKHR
pPProperties) Ptr CooperativeMatrixPropertiesKHR
-> Int -> Ptr CooperativeMatrixPropertiesKHR
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
56 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr CooperativeMatrixPropertiesKHR)))
  (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall a.
a
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
 -> ContT
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
      IO
      (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR))
-> (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
-> ContT
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
     IO
     (Result, "properties" ::: Vector CooperativeMatrixPropertiesKHR)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "properties" ::: Vector CooperativeMatrixPropertiesKHR
pProperties')


-- | VkPhysicalDeviceCooperativeMatrixFeaturesKHR - Structure describing
-- cooperative matrix features that can be supported by an implementation
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceCooperativeMatrixFeaturesKHR' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceCooperativeMatrixFeaturesKHR' /can/ also be
-- used in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_cooperative_matrix VK_KHR_cooperative_matrix>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceCooperativeMatrixFeaturesKHR = PhysicalDeviceCooperativeMatrixFeaturesKHR
  { -- | #features-cooperativeMatrix# @cooperativeMatrix@ indicates that the
    -- implementation supports the @CooperativeMatrixKHR@ SPIR-V capability.
    PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
cooperativeMatrix :: Bool
  , -- | #features-cooperativeMatrixRobustBufferAccess#
    -- @cooperativeMatrixRobustBufferAccess@ indicates that the implementation
    -- supports robust buffer access for SPIR-V @OpCooperativeMatrixLoadKHR@
    -- and @OpCooperativeMatrixStoreKHR@ instructions.
    PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
cooperativeMatrixRobustBufferAccess :: Bool
  }
  deriving (Typeable, PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
(PhysicalDeviceCooperativeMatrixFeaturesKHR
 -> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool)
-> (PhysicalDeviceCooperativeMatrixFeaturesKHR
    -> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool)
-> Eq PhysicalDeviceCooperativeMatrixFeaturesKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
== :: PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
$c/= :: PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
/= :: 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 = Int
-> (Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b) -> IO b)
-> (Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p -> Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b -> IO b
forall b.
Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b -> IO b
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
$sel:cooperativeMatrix:PhysicalDeviceCooperativeMatrixFeaturesKHR :: PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
$sel:cooperativeMatrixRobustBufferAccess:PhysicalDeviceCooperativeMatrixFeaturesKHR :: PhysicalDeviceCooperativeMatrixFeaturesKHR -> Bool
cooperativeMatrix :: Bool
cooperativeMatrixRobustBufferAccess :: Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_FEATURES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
cooperativeMatrix))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> Int -> Ptr Bool32
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
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_FEATURES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
p Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
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 Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> Int -> Ptr Bool32
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 Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
    PhysicalDeviceCooperativeMatrixFeaturesKHR
-> IO PhysicalDeviceCooperativeMatrixFeaturesKHR
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceCooperativeMatrixFeaturesKHR
 -> IO PhysicalDeviceCooperativeMatrixFeaturesKHR)
-> PhysicalDeviceCooperativeMatrixFeaturesKHR
-> IO PhysicalDeviceCooperativeMatrixFeaturesKHR
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 = Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> IO PhysicalDeviceCooperativeMatrixFeaturesKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO ()
poke Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
poked = Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO () -> IO ()
forall b.
Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
-> PhysicalDeviceCooperativeMatrixFeaturesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
ptr PhysicalDeviceCooperativeMatrixFeaturesKHR
poked (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceCooperativeMatrixFeaturesKHR where
  zero :: PhysicalDeviceCooperativeMatrixFeaturesKHR
zero = Bool -> Bool -> PhysicalDeviceCooperativeMatrixFeaturesKHR
PhysicalDeviceCooperativeMatrixFeaturesKHR
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | VkCooperativeMatrixPropertiesKHR - Structure specifying cooperative
-- matrix properties
--
-- = Description
--
-- If some types are preferred over other types (e.g. for performance),
-- they /should/ appear earlier in the list enumerated by
-- 'getPhysicalDeviceCooperativeMatrixPropertiesKHR'.
--
-- At least one entry in the list /must/ have power of two values for all
-- of @MSize@, @KSize@, and @NSize@.
--
-- @scope@ /must/ be 'SCOPE_SUBGROUP_KHR'.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_cooperative_matrix VK_KHR_cooperative_matrix>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32', 'ComponentTypeKHR', 'ScopeKHR',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPhysicalDeviceCooperativeMatrixPropertiesKHR'
data CooperativeMatrixPropertiesKHR = CooperativeMatrixPropertiesKHR
  { -- | @MSize@ is the number of rows in matrices @A@, @C@, and
    -- 'Vulkan.Core10.Enums.Result.Result'.
    CooperativeMatrixPropertiesKHR -> Word32
mSize :: Word32
  , -- | @NSize@ is the number of columns in matrices @B@, @C@,
    -- 'Vulkan.Core10.Enums.Result.Result'.
    CooperativeMatrixPropertiesKHR -> Word32
nSize :: Word32
  , -- | @KSize@ is the number of columns in matrix @A@ and rows in matrix @B@.
    CooperativeMatrixPropertiesKHR -> Word32
kSize :: Word32
  , -- | @AType@ is the component type of matrix @A@, of type 'ComponentTypeKHR'.
    --
    -- #VUID-VkCooperativeMatrixPropertiesKHR-AType-parameter# @AType@ /must/
    -- be a valid 'ComponentTypeKHR' value
    CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
aType :: ComponentTypeKHR
  , -- | @BType@ is the component type of matrix @B@, of type 'ComponentTypeKHR'.
    --
    -- #VUID-VkCooperativeMatrixPropertiesKHR-BType-parameter# @BType@ /must/
    -- be a valid 'ComponentTypeKHR' value
    CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
bType :: ComponentTypeKHR
  , -- | @CType@ is the component type of matrix @C@, of type 'ComponentTypeKHR'.
    --
    -- #VUID-VkCooperativeMatrixPropertiesKHR-CType-parameter# @CType@ /must/
    -- be a valid 'ComponentTypeKHR' value
    CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
cType :: ComponentTypeKHR
  , -- | @ResultType@ is the component type of matrix
    -- 'Vulkan.Core10.Enums.Result.Result', of type 'ComponentTypeKHR'.
    --
    -- #VUID-VkCooperativeMatrixPropertiesKHR-ResultType-parameter#
    -- @ResultType@ /must/ be a valid 'ComponentTypeKHR' value
    CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
resultType :: ComponentTypeKHR
  , -- | @saturatingAccumulation@ indicates whether the @SaturatingAccumulation@
    -- operand to @OpCooperativeMatrixMulAddKHR@ /must/ be present.
    CooperativeMatrixPropertiesKHR -> Bool
saturatingAccumulation :: Bool
  , -- | @scope@ is the scope of all the matrix types, of type 'ScopeKHR'.
    --
    -- #VUID-VkCooperativeMatrixPropertiesKHR-scope-parameter# @scope@ /must/
    -- be a valid 'ScopeKHR' value
    CooperativeMatrixPropertiesKHR -> ScopeKHR
scope :: ScopeKHR
  }
  deriving (Typeable, CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> Bool
(CooperativeMatrixPropertiesKHR
 -> CooperativeMatrixPropertiesKHR -> Bool)
-> (CooperativeMatrixPropertiesKHR
    -> CooperativeMatrixPropertiesKHR -> Bool)
-> Eq CooperativeMatrixPropertiesKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> Bool
== :: CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> Bool
$c/= :: CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> Bool
/= :: 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
-> (Ptr CooperativeMatrixPropertiesKHR -> IO b) -> IO b
withCStruct CooperativeMatrixPropertiesKHR
x Ptr CooperativeMatrixPropertiesKHR -> IO b
f = Int -> (Ptr CooperativeMatrixPropertiesKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((Ptr CooperativeMatrixPropertiesKHR -> IO b) -> IO b)
-> (Ptr CooperativeMatrixPropertiesKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr CooperativeMatrixPropertiesKHR
p -> Ptr CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> IO b -> IO b
forall b.
Ptr CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CooperativeMatrixPropertiesKHR
p CooperativeMatrixPropertiesKHR
x (Ptr CooperativeMatrixPropertiesKHR -> IO b
f Ptr CooperativeMatrixPropertiesKHR
p)
  pokeCStruct :: forall b.
Ptr CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> IO b -> IO b
pokeCStruct Ptr CooperativeMatrixPropertiesKHR
p CooperativeMatrixPropertiesKHR{Bool
Word32
ComponentTypeKHR
ScopeKHR
$sel:mSize:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> Word32
$sel:nSize:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> Word32
$sel:kSize:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> Word32
$sel:aType:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
$sel:bType:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
$sel:cType:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
$sel:resultType:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ComponentTypeKHR
$sel:saturatingAccumulation:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> Bool
$sel:scope:CooperativeMatrixPropertiesKHR :: CooperativeMatrixPropertiesKHR -> ScopeKHR
mSize :: Word32
nSize :: Word32
kSize :: Word32
aType :: ComponentTypeKHR
bType :: ComponentTypeKHR
cType :: ComponentTypeKHR
resultType :: ComponentTypeKHR
saturatingAccumulation :: Bool
scope :: ScopeKHR
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COOPERATIVE_MATRIX_PROPERTIES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
mSize)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
nSize)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
kSize)
    Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
aType)
    Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
bType)
    Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
cType)
    Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
resultType)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
saturatingAccumulation))
    Ptr ScopeKHR -> ScopeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ScopeKHR
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. Ptr CooperativeMatrixPropertiesKHR -> IO b -> IO b
pokeZeroCStruct Ptr CooperativeMatrixPropertiesKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COOPERATIVE_MATRIX_PROPERTIES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
forall a. Zero a => a
zero)
    Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
forall a. Zero a => a
zero)
    Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
forall a. Zero a => a
zero)
    Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ComponentTypeKHR)) (ComponentTypeKHR
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr ScopeKHR -> ScopeKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ScopeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ScopeKHR)) (ScopeKHR
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CooperativeMatrixPropertiesKHR where
  peekCStruct :: Ptr CooperativeMatrixPropertiesKHR
-> IO CooperativeMatrixPropertiesKHR
peekCStruct Ptr CooperativeMatrixPropertiesKHR
p = do
    Word32
mSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Word32
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 ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Word32
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 ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Word32
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 ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
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 ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
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 ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
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 ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ComponentTypeKHR
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 ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr Bool32
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 ((Ptr CooperativeMatrixPropertiesKHR
p Ptr CooperativeMatrixPropertiesKHR -> Int -> Ptr ScopeKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ScopeKHR))
    CooperativeMatrixPropertiesKHR -> IO CooperativeMatrixPropertiesKHR
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CooperativeMatrixPropertiesKHR
 -> IO CooperativeMatrixPropertiesKHR)
-> CooperativeMatrixPropertiesKHR
-> IO CooperativeMatrixPropertiesKHR
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 :: Ptr CooperativeMatrixPropertiesKHR
-> IO CooperativeMatrixPropertiesKHR
peek = Ptr CooperativeMatrixPropertiesKHR
-> IO CooperativeMatrixPropertiesKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> IO ()
poke Ptr CooperativeMatrixPropertiesKHR
ptr CooperativeMatrixPropertiesKHR
poked = Ptr CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> IO () -> IO ()
forall b.
Ptr CooperativeMatrixPropertiesKHR
-> CooperativeMatrixPropertiesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CooperativeMatrixPropertiesKHR
ptr CooperativeMatrixPropertiesKHR
poked (() -> IO ()
forall a. a -> IO a
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
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           ComponentTypeKHR
forall a. Zero a => a
zero
           ComponentTypeKHR
forall a. Zero a => a
zero
           ComponentTypeKHR
forall a. Zero a => a
zero
           ComponentTypeKHR
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           ScopeKHR
forall a. Zero a => a
zero


-- | VkPhysicalDeviceCooperativeMatrixPropertiesKHR - Structure describing
-- cooperative matrix properties supported by an implementation
--
-- = Description
--
-- @cooperativeMatrixSupportedStages@ /must/ not have any bits other than
-- 'Vulkan.Core10.Enums.ShaderStageFlagBits.SHADER_STAGE_COMPUTE_BIT' set.
--
-- If the 'PhysicalDeviceCooperativeMatrixPropertiesKHR' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2',
-- it is filled in with each corresponding implementation-dependent
-- property.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_cooperative_matrix VK_KHR_cooperative_matrix>,
-- 'Vulkan.Core10.Enums.ShaderStageFlagBits.ShaderStageFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceCooperativeMatrixPropertiesKHR = PhysicalDeviceCooperativeMatrixPropertiesKHR
  { -- | #limits-cooperativeMatrixSupportedStages#
    -- @cooperativeMatrixSupportedStages@ is a bitfield of
    -- 'Vulkan.Core10.Enums.ShaderStageFlagBits.ShaderStageFlagBits' describing
    -- the shader stages that cooperative matrix instructions are supported in.
    -- @cooperativeMatrixSupportedStages@ will have the
    -- 'Vulkan.Core10.Enums.ShaderStageFlagBits.SHADER_STAGE_COMPUTE_BIT' bit
    -- set if any of the physical device’s queues support
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_COMPUTE_BIT'.
    PhysicalDeviceCooperativeMatrixPropertiesKHR -> ShaderStageFlags
cooperativeMatrixSupportedStages :: ShaderStageFlags }
  deriving (Typeable, PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool
(PhysicalDeviceCooperativeMatrixPropertiesKHR
 -> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool)
-> (PhysicalDeviceCooperativeMatrixPropertiesKHR
    -> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool)
-> Eq PhysicalDeviceCooperativeMatrixPropertiesKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool
== :: PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool
$c/= :: PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> Bool
/= :: 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 = Int
-> (Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p -> Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b -> IO b
forall b.
Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b -> IO b
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
$sel:cooperativeMatrixSupportedStages:PhysicalDeviceCooperativeMatrixPropertiesKHR :: PhysicalDeviceCooperativeMatrixPropertiesKHR -> ShaderStageFlags
cooperativeMatrixSupportedStages :: ShaderStageFlags
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_PROPERTIES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ShaderStageFlags -> ShaderStageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> Int -> Ptr ShaderStageFlags
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
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COOPERATIVE_MATRIX_PROPERTIES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ShaderStageFlags -> ShaderStageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
p Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> Int -> Ptr ShaderStageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags)) (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 Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> Int -> Ptr ShaderStageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags))
    PhysicalDeviceCooperativeMatrixPropertiesKHR
-> IO PhysicalDeviceCooperativeMatrixPropertiesKHR
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceCooperativeMatrixPropertiesKHR
 -> IO PhysicalDeviceCooperativeMatrixPropertiesKHR)
-> PhysicalDeviceCooperativeMatrixPropertiesKHR
-> IO PhysicalDeviceCooperativeMatrixPropertiesKHR
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 = Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> IO PhysicalDeviceCooperativeMatrixPropertiesKHR
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO ()
poke Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
poked = Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO () -> IO ()
forall b.
Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
-> PhysicalDeviceCooperativeMatrixPropertiesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
ptr PhysicalDeviceCooperativeMatrixPropertiesKHR
poked (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceCooperativeMatrixPropertiesKHR where
  zero :: PhysicalDeviceCooperativeMatrixPropertiesKHR
zero = ShaderStageFlags -> PhysicalDeviceCooperativeMatrixPropertiesKHR
PhysicalDeviceCooperativeMatrixPropertiesKHR
           ShaderStageFlags
forall a. Zero a => a
zero


-- | VkScopeKHR - Specify SPIR-V scope
--
-- = Description
--
-- All enum values match the corresponding SPIR-V value.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_cooperative_matrix VK_KHR_cooperative_matrix>,
-- 'CooperativeMatrixPropertiesKHR'
newtype ScopeKHR = ScopeKHR Int32
  deriving newtype (ScopeKHR -> ScopeKHR -> Bool
(ScopeKHR -> ScopeKHR -> Bool)
-> (ScopeKHR -> ScopeKHR -> Bool) -> Eq ScopeKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScopeKHR -> ScopeKHR -> Bool
== :: ScopeKHR -> ScopeKHR -> Bool
$c/= :: ScopeKHR -> ScopeKHR -> Bool
/= :: ScopeKHR -> ScopeKHR -> Bool
Eq, Eq ScopeKHR
Eq ScopeKHR =>
(ScopeKHR -> ScopeKHR -> Ordering)
-> (ScopeKHR -> ScopeKHR -> Bool)
-> (ScopeKHR -> ScopeKHR -> Bool)
-> (ScopeKHR -> ScopeKHR -> Bool)
-> (ScopeKHR -> ScopeKHR -> Bool)
-> (ScopeKHR -> ScopeKHR -> ScopeKHR)
-> (ScopeKHR -> ScopeKHR -> ScopeKHR)
-> Ord 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
$ccompare :: ScopeKHR -> ScopeKHR -> Ordering
compare :: ScopeKHR -> ScopeKHR -> Ordering
$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
>= :: ScopeKHR -> ScopeKHR -> Bool
$cmax :: ScopeKHR -> ScopeKHR -> ScopeKHR
max :: ScopeKHR -> ScopeKHR -> ScopeKHR
$cmin :: ScopeKHR -> ScopeKHR -> ScopeKHR
min :: ScopeKHR -> ScopeKHR -> ScopeKHR
Ord, Ptr ScopeKHR -> IO ScopeKHR
Ptr ScopeKHR -> Int -> IO ScopeKHR
Ptr ScopeKHR -> Int -> ScopeKHR -> IO ()
Ptr ScopeKHR -> ScopeKHR -> IO ()
ScopeKHR -> Int
(ScopeKHR -> Int)
-> (ScopeKHR -> Int)
-> (Ptr ScopeKHR -> Int -> IO ScopeKHR)
-> (Ptr ScopeKHR -> Int -> ScopeKHR -> IO ())
-> (forall b. Ptr b -> Int -> IO ScopeKHR)
-> (forall b. Ptr b -> Int -> ScopeKHR -> IO ())
-> (Ptr ScopeKHR -> IO ScopeKHR)
-> (Ptr ScopeKHR -> ScopeKHR -> IO ())
-> Storable ScopeKHR
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
$csizeOf :: ScopeKHR -> Int
sizeOf :: ScopeKHR -> Int
$calignment :: ScopeKHR -> Int
alignment :: ScopeKHR -> Int
$cpeekElemOff :: Ptr ScopeKHR -> Int -> IO ScopeKHR
peekElemOff :: Ptr ScopeKHR -> Int -> IO ScopeKHR
$cpokeElemOff :: Ptr ScopeKHR -> Int -> ScopeKHR -> IO ()
pokeElemOff :: Ptr ScopeKHR -> Int -> ScopeKHR -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ScopeKHR
peekByteOff :: forall b. Ptr b -> Int -> IO ScopeKHR
$cpokeByteOff :: forall b. Ptr b -> Int -> ScopeKHR -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ScopeKHR -> IO ()
$cpeek :: Ptr ScopeKHR -> IO ScopeKHR
peek :: Ptr ScopeKHR -> IO ScopeKHR
$cpoke :: Ptr ScopeKHR -> ScopeKHR -> IO ()
poke :: Ptr ScopeKHR -> ScopeKHR -> IO ()
Storable, ScopeKHR
ScopeKHR -> Zero ScopeKHR
forall a. a -> Zero a
$czero :: ScopeKHR
zero :: ScopeKHR
Zero)

-- Note that the zero instance does not produce a valid value, passing 'zero' to Vulkan will result in an error

-- | 'SCOPE_DEVICE_KHR' corresponds to SPIR-V 'Vulkan.Core10.Handles.Device'
-- scope.
pattern $bSCOPE_DEVICE_KHR :: ScopeKHR
$mSCOPE_DEVICE_KHR :: forall {r}. ScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
SCOPE_DEVICE_KHR = ScopeKHR 1

-- | 'SCOPE_WORKGROUP_KHR' corresponds to SPIR-V @Workgroup@ scope.
pattern $bSCOPE_WORKGROUP_KHR :: ScopeKHR
$mSCOPE_WORKGROUP_KHR :: forall {r}. ScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
SCOPE_WORKGROUP_KHR = ScopeKHR 2

-- | 'SCOPE_SUBGROUP_KHR' corresponds to SPIR-V @Subgroup@ scope.
pattern $bSCOPE_SUBGROUP_KHR :: ScopeKHR
$mSCOPE_SUBGROUP_KHR :: forall {r}. ScopeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
SCOPE_SUBGROUP_KHR = ScopeKHR 3

-- | 'SCOPE_QUEUE_FAMILY_KHR' corresponds to SPIR-V @QueueFamily@ scope.
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 =
    String
-> [(ScopeKHR, String)]
-> String
-> (ScopeKHR -> Int32)
-> (Int32 -> ShowS)
-> Int
-> ScopeKHR
-> ShowS
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)
      (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read ScopeKHR where
  readPrec :: ReadPrec ScopeKHR
readPrec =
    String
-> [(ScopeKHR, String)]
-> String
-> (Int32 -> ScopeKHR)
-> ReadPrec ScopeKHR
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixScopeKHR
      [(ScopeKHR, String)]
showTableScopeKHR
      String
conNameScopeKHR
      Int32 -> ScopeKHR
ScopeKHR

-- | VkComponentTypeKHR - Specify SPIR-V cooperative matrix component type
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_cooperative_matrix VK_KHR_cooperative_matrix>,
-- 'CooperativeMatrixPropertiesKHR'
newtype ComponentTypeKHR = ComponentTypeKHR Int32
  deriving newtype (ComponentTypeKHR -> ComponentTypeKHR -> Bool
(ComponentTypeKHR -> ComponentTypeKHR -> Bool)
-> (ComponentTypeKHR -> ComponentTypeKHR -> Bool)
-> Eq ComponentTypeKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
== :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
$c/= :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
/= :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
Eq, Eq ComponentTypeKHR
Eq ComponentTypeKHR =>
(ComponentTypeKHR -> ComponentTypeKHR -> Ordering)
-> (ComponentTypeKHR -> ComponentTypeKHR -> Bool)
-> (ComponentTypeKHR -> ComponentTypeKHR -> Bool)
-> (ComponentTypeKHR -> ComponentTypeKHR -> Bool)
-> (ComponentTypeKHR -> ComponentTypeKHR -> Bool)
-> (ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR)
-> (ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR)
-> Ord 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
$ccompare :: ComponentTypeKHR -> ComponentTypeKHR -> Ordering
compare :: ComponentTypeKHR -> ComponentTypeKHR -> Ordering
$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
>= :: ComponentTypeKHR -> ComponentTypeKHR -> Bool
$cmax :: ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR
max :: ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR
$cmin :: ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR
min :: ComponentTypeKHR -> ComponentTypeKHR -> ComponentTypeKHR
Ord, Ptr ComponentTypeKHR -> IO ComponentTypeKHR
Ptr ComponentTypeKHR -> Int -> IO ComponentTypeKHR
Ptr ComponentTypeKHR -> Int -> ComponentTypeKHR -> IO ()
Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
ComponentTypeKHR -> Int
(ComponentTypeKHR -> Int)
-> (ComponentTypeKHR -> Int)
-> (Ptr ComponentTypeKHR -> Int -> IO ComponentTypeKHR)
-> (Ptr ComponentTypeKHR -> Int -> ComponentTypeKHR -> IO ())
-> (forall b. Ptr b -> Int -> IO ComponentTypeKHR)
-> (forall b. Ptr b -> Int -> ComponentTypeKHR -> IO ())
-> (Ptr ComponentTypeKHR -> IO ComponentTypeKHR)
-> (Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ())
-> Storable ComponentTypeKHR
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
$csizeOf :: ComponentTypeKHR -> Int
sizeOf :: ComponentTypeKHR -> Int
$calignment :: ComponentTypeKHR -> Int
alignment :: ComponentTypeKHR -> Int
$cpeekElemOff :: Ptr ComponentTypeKHR -> Int -> IO ComponentTypeKHR
peekElemOff :: Ptr ComponentTypeKHR -> Int -> IO ComponentTypeKHR
$cpokeElemOff :: Ptr ComponentTypeKHR -> Int -> ComponentTypeKHR -> IO ()
pokeElemOff :: Ptr ComponentTypeKHR -> Int -> ComponentTypeKHR -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ComponentTypeKHR
peekByteOff :: forall b. Ptr b -> Int -> IO ComponentTypeKHR
$cpokeByteOff :: forall b. Ptr b -> Int -> ComponentTypeKHR -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ComponentTypeKHR -> IO ()
$cpeek :: Ptr ComponentTypeKHR -> IO ComponentTypeKHR
peek :: Ptr ComponentTypeKHR -> IO ComponentTypeKHR
$cpoke :: Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
poke :: Ptr ComponentTypeKHR -> ComponentTypeKHR -> IO ()
Storable, ComponentTypeKHR
ComponentTypeKHR -> Zero ComponentTypeKHR
forall a. a -> Zero a
$czero :: ComponentTypeKHR
zero :: ComponentTypeKHR
Zero)

-- | 'COMPONENT_TYPE_FLOAT16_KHR' corresponds to SPIR-V @OpTypeFloat@ 16.
pattern $bCOMPONENT_TYPE_FLOAT16_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_FLOAT16_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_FLOAT16_KHR = ComponentTypeKHR 0

-- | 'COMPONENT_TYPE_FLOAT32_KHR' corresponds to SPIR-V @OpTypeFloat@ 32.
pattern $bCOMPONENT_TYPE_FLOAT32_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_FLOAT32_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_FLOAT32_KHR = ComponentTypeKHR 1

-- | 'COMPONENT_TYPE_FLOAT64_KHR' corresponds to SPIR-V @OpTypeFloat@ 64.
pattern $bCOMPONENT_TYPE_FLOAT64_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_FLOAT64_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_FLOAT64_KHR = ComponentTypeKHR 2

-- | 'COMPONENT_TYPE_SINT8_KHR' corresponds to SPIR-V @OpTypeInt@ 8 1.
pattern $bCOMPONENT_TYPE_SINT8_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_SINT8_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_SINT8_KHR = ComponentTypeKHR 3

-- | 'COMPONENT_TYPE_SINT16_KHR' corresponds to SPIR-V @OpTypeInt@ 16 1.
pattern $bCOMPONENT_TYPE_SINT16_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_SINT16_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_SINT16_KHR = ComponentTypeKHR 4

-- | 'COMPONENT_TYPE_SINT32_KHR' corresponds to SPIR-V @OpTypeInt@ 32 1.
pattern $bCOMPONENT_TYPE_SINT32_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_SINT32_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_SINT32_KHR = ComponentTypeKHR 5

-- | 'COMPONENT_TYPE_SINT64_KHR' corresponds to SPIR-V @OpTypeInt@ 64 1.
pattern $bCOMPONENT_TYPE_SINT64_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_SINT64_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_SINT64_KHR = ComponentTypeKHR 6

-- | 'COMPONENT_TYPE_UINT8_KHR' corresponds to SPIR-V @OpTypeInt@ 8 0.
pattern $bCOMPONENT_TYPE_UINT8_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_UINT8_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_UINT8_KHR = ComponentTypeKHR 7

-- | 'COMPONENT_TYPE_UINT16_KHR' corresponds to SPIR-V @OpTypeInt@ 16 0.
pattern $bCOMPONENT_TYPE_UINT16_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_UINT16_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_UINT16_KHR = ComponentTypeKHR 8

-- | 'COMPONENT_TYPE_UINT32_KHR' corresponds to SPIR-V @OpTypeInt@ 32 0.
pattern $bCOMPONENT_TYPE_UINT32_KHR :: ComponentTypeKHR
$mCOMPONENT_TYPE_UINT32_KHR :: forall {r}. ComponentTypeKHR -> ((# #) -> r) -> ((# #) -> r) -> r
COMPONENT_TYPE_UINT32_KHR = ComponentTypeKHR 9

-- | 'COMPONENT_TYPE_UINT64_KHR' corresponds to SPIR-V @OpTypeInt@ 64 0.
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 =
    String
-> [(ComponentTypeKHR, String)]
-> String
-> (ComponentTypeKHR -> Int32)
-> (Int32 -> ShowS)
-> Int
-> ComponentTypeKHR
-> ShowS
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)
      (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read ComponentTypeKHR where
  readPrec :: ReadPrec ComponentTypeKHR
readPrec =
    String
-> [(ComponentTypeKHR, String)]
-> String
-> (Int32 -> ComponentTypeKHR)
-> ReadPrec ComponentTypeKHR
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

-- No documentation found for TopLevel "VK_KHR_COOPERATIVE_MATRIX_SPEC_VERSION"
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"

-- No documentation found for TopLevel "VK_KHR_COOPERATIVE_MATRIX_EXTENSION_NAME"
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"