{-# language CPP #-}
-- | = Name
--
-- VK_AMDX_shader_enqueue - device extension
--
-- == VK_AMDX_shader_enqueue
--
-- [__Name String__]
--     @VK_AMDX_shader_enqueue@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     135
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Not 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>
--     and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_synchronization2 VK_KHR_synchronization2>
--     and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_pipeline_library VK_KHR_pipeline_library>
--     and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_spirv_1_4 VK_KHR_spirv_1_4>
--
--     -   __This is a /provisional/ extension and /must/ be used with
--         caution. See the
--         <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#boilerplate-provisional-header description>
--         of provisional header files for enablement and stability
--         details.__
--
-- [__Contact__]
--
--     -   Tobias Hector
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_AMDX_shader_enqueue] @tobski%0A*Here describe the issue or question you have about the VK_AMDX_shader_enqueue extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_AMDX_shader_enqueue.adoc VK_AMDX_shader_enqueue>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2021-07-22
--
-- [__Interactions and External Dependencies__]
--
--     -   This extension requires
--         <https://htmlpreview.github.io/?https://github.com/KhronosGroup/SPIRV-Registry/blob/master/extensions/AMD/SPV_AMDX_shader_enqueue.html SPV_AMDX_shader_enqueue>.
--
-- [__Provisional__]
--     __This extension is /provisional/ and /should/ not be used in
--     production applications. The functionality /may/ change in ways that
--     break backwards compatibility between revisions, and before final
--     release.__
--
-- [__Contributors__]
--
--     -   Tobias Hector, AMD
--
--     -   Matthaeus Chajdas, AMD
--
--     -   Maciej Jesionowski, AMD
--
--     -   Robert Martin, AMD
--
--     -   Qun Lin, AMD
--
--     -   Rex Xu, AMD
--
--     -   Dominik Witczak, AMD
--
--     -   Karthik Srinivasan, AMD
--
--     -   Nicolai Haehnle, AMD
--
--     -   Stuart Smith, AMD
--
-- == Description
--
-- This extension adds the ability for developers to enqueue compute shader
-- workgroups from other compute shaders.
--
-- == New Commands
--
-- -   'cmdDispatchGraphAMDX'
--
-- -   'cmdDispatchGraphIndirectAMDX'
--
-- -   'cmdDispatchGraphIndirectCountAMDX'
--
-- -   'cmdInitializeGraphScratchMemoryAMDX'
--
-- -   'createExecutionGraphPipelinesAMDX'
--
-- -   'getExecutionGraphPipelineNodeIndexAMDX'
--
-- -   'getExecutionGraphPipelineScratchSizeAMDX'
--
-- == New Structures
--
-- -   'DispatchGraphCountInfoAMDX'
--
-- -   'DispatchGraphInfoAMDX'
--
-- -   'ExecutionGraphPipelineCreateInfoAMDX'
--
-- -   'ExecutionGraphPipelineScratchSizeAMDX'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceShaderEnqueueFeaturesAMDX'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceShaderEnqueuePropertiesAMDX'
--
-- -   Extending 'Vulkan.Core10.Pipeline.PipelineShaderStageCreateInfo':
--
--     -   'PipelineShaderStageNodeCreateInfoAMDX'
--
-- == New Unions
--
-- -   'DeviceOrHostAddressConstAMDX'
--
-- == New Enum Constants
--
-- -   'AMDX_SHADER_ENQUEUE_EXTENSION_NAME'
--
-- -   'AMDX_SHADER_ENQUEUE_SPEC_VERSION'
--
-- -   'Vulkan.Core10.APIConstants.SHADER_INDEX_UNUSED_AMDX'
--
-- -   Extending
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BufferUsageFlagBits':
--
--     -   'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_EXECUTION_GRAPH_SCRATCH_BIT_AMDX'
--
-- -   Extending 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint':
--
--     -   'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_EXECUTION_GRAPH_AMDX'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_EXECUTION_GRAPH_PIPELINE_CREATE_INFO_AMDX'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_EXECUTION_GRAPH_PIPELINE_SCRATCH_SIZE_AMDX'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_ENQUEUE_FEATURES_AMDX'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_ENQUEUE_PROPERTIES_AMDX'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_NODE_CREATE_INFO_AMDX'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_maintenance5 VK_KHR_maintenance5>
-- is supported:
--
-- -   Extending 'BufferUsageFlagBits2KHR':
--
--     -   'BUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX'
--
-- == Version History
--
-- -   Revision 1, 2021-07-22 (Tobias Hector)
--
--     -   Initial revision
--
-- == See Also
--
-- 'Vulkan.Core10.APIConstants.SHADER_INDEX_UNUSED_AMDX',
-- 'DeviceOrHostAddressConstAMDX', 'DispatchGraphCountInfoAMDX',
-- 'DispatchGraphInfoAMDX', 'ExecutionGraphPipelineCreateInfoAMDX',
-- 'ExecutionGraphPipelineScratchSizeAMDX',
-- 'PhysicalDeviceShaderEnqueueFeaturesAMDX',
-- 'PhysicalDeviceShaderEnqueuePropertiesAMDX',
-- 'PipelineShaderStageNodeCreateInfoAMDX', 'cmdDispatchGraphAMDX',
-- 'cmdDispatchGraphIndirectAMDX', 'cmdDispatchGraphIndirectCountAMDX',
-- 'cmdInitializeGraphScratchMemoryAMDX',
-- 'createExecutionGraphPipelinesAMDX',
-- 'getExecutionGraphPipelineNodeIndexAMDX',
-- 'getExecutionGraphPipelineScratchSizeAMDX'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_AMDX_shader_enqueue Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_AMDX_shader_enqueue  ( getExecutionGraphPipelineScratchSizeAMDX
                                                 , getExecutionGraphPipelineNodeIndexAMDX
                                                 , createExecutionGraphPipelinesAMDX
                                                 , cmdInitializeGraphScratchMemoryAMDX
                                                 , cmdDispatchGraphAMDX
                                                 , cmdDispatchGraphIndirectAMDX
                                                 , cmdDispatchGraphIndirectCountAMDX
                                                 , PhysicalDeviceShaderEnqueuePropertiesAMDX(..)
                                                 , PhysicalDeviceShaderEnqueueFeaturesAMDX(..)
                                                 , ExecutionGraphPipelineCreateInfoAMDX(..)
                                                 , PipelineShaderStageNodeCreateInfoAMDX(..)
                                                 , ExecutionGraphPipelineScratchSizeAMDX(..)
                                                 , DispatchGraphInfoAMDX(..)
                                                 , DispatchGraphCountInfoAMDX(..)
                                                 , DeviceOrHostAddressConstAMDX(..)
                                                 , BufferUsageFlags2KHR
                                                 , BufferUsageFlagBits2KHR( BUFFER_USAGE_2_TRANSFER_SRC_BIT_KHR
                                                                          , BUFFER_USAGE_2_TRANSFER_DST_BIT_KHR
                                                                          , BUFFER_USAGE_2_UNIFORM_TEXEL_BUFFER_BIT_KHR
                                                                          , BUFFER_USAGE_2_STORAGE_TEXEL_BUFFER_BIT_KHR
                                                                          , BUFFER_USAGE_2_UNIFORM_BUFFER_BIT_KHR
                                                                          , BUFFER_USAGE_2_STORAGE_BUFFER_BIT_KHR
                                                                          , BUFFER_USAGE_2_INDEX_BUFFER_BIT_KHR
                                                                          , BUFFER_USAGE_2_VERTEX_BUFFER_BIT_KHR
                                                                          , BUFFER_USAGE_2_INDIRECT_BUFFER_BIT_KHR
                                                                          , BUFFER_USAGE_2_MICROMAP_STORAGE_BIT_EXT
                                                                          , BUFFER_USAGE_2_MICROMAP_BUILD_INPUT_READ_ONLY_BIT_EXT
                                                                          , BUFFER_USAGE_2_PUSH_DESCRIPTORS_DESCRIPTOR_BUFFER_BIT_EXT
                                                                          , BUFFER_USAGE_2_RESOURCE_DESCRIPTOR_BUFFER_BIT_EXT
                                                                          , BUFFER_USAGE_2_SAMPLER_DESCRIPTOR_BUFFER_BIT_EXT
                                                                          , BUFFER_USAGE_2_ACCELERATION_STRUCTURE_STORAGE_BIT_KHR
                                                                          , BUFFER_USAGE_2_ACCELERATION_STRUCTURE_BUILD_INPUT_READ_ONLY_BIT_KHR
                                                                          , BUFFER_USAGE_2_SHADER_DEVICE_ADDRESS_BIT_KHR
                                                                          , BUFFER_USAGE_2_VIDEO_ENCODE_SRC_BIT_KHR
                                                                          , BUFFER_USAGE_2_VIDEO_ENCODE_DST_BIT_KHR
                                                                          , BUFFER_USAGE_2_VIDEO_DECODE_DST_BIT_KHR
                                                                          , BUFFER_USAGE_2_VIDEO_DECODE_SRC_BIT_KHR
                                                                          , BUFFER_USAGE_2_TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT
                                                                          , BUFFER_USAGE_2_TRANSFORM_FEEDBACK_BUFFER_BIT_EXT
                                                                          , BUFFER_USAGE_2_SHADER_BINDING_TABLE_BIT_KHR
                                                                          , BUFFER_USAGE_2_CONDITIONAL_RENDERING_BIT_EXT
                                                                          , BUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX
                                                                          , ..
                                                                          )
                                                 , AMDX_SHADER_ENQUEUE_SPEC_VERSION
                                                 , pattern AMDX_SHADER_ENQUEUE_SPEC_VERSION
                                                 , AMDX_SHADER_ENQUEUE_EXTENSION_NAME
                                                 , pattern AMDX_SHADER_ENQUEUE_EXTENSION_NAME
                                                 , PipelineLibraryCreateInfoKHR(..)
                                                 , SHADER_INDEX_UNUSED_AMDX
                                                 , pattern SHADER_INDEX_UNUSED_AMDX
                                                 ) where

import Data.Bits (Bits)
import Data.Bits (FiniteBits)
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 Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (maybePeek)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showString)
import Numeric (showHex)
import Data.ByteString (packCString)
import Data.ByteString (useAsCString)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Control.Monad.Trans.Cont (runContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import qualified Data.Vector (null)
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.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
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.Word (Word64)
import Data.ByteString (ByteString)
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.CStruct.Extends (forgetExtensions)
import Vulkan.CStruct.Extends (peekSomeCStruct)
import Vulkan.CStruct.Extends (pokeSomeCStruct)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Core10.FundamentalTypes (DeviceAddress)
import Vulkan.Dynamic (DeviceCmds(pVkCmdDispatchGraphAMDX))
import Vulkan.Dynamic (DeviceCmds(pVkCmdDispatchGraphIndirectAMDX))
import Vulkan.Dynamic (DeviceCmds(pVkCmdDispatchGraphIndirectCountAMDX))
import Vulkan.Dynamic (DeviceCmds(pVkCmdInitializeGraphScratchMemoryAMDX))
import Vulkan.Dynamic (DeviceCmds(pVkCreateExecutionGraphPipelinesAMDX))
import Vulkan.Dynamic (DeviceCmds(pVkGetExecutionGraphPipelineNodeIndexAMDX))
import Vulkan.Dynamic (DeviceCmds(pVkGetExecutionGraphPipelineScratchSizeAMDX))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.FundamentalTypes (Flags64)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Handles (Pipeline)
import Vulkan.Core10.Handles (Pipeline(..))
import Vulkan.Core10.Handles (PipelineCache)
import Vulkan.Core10.Handles (PipelineCache(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_AMD_pipeline_compiler_control (PipelineCompilerControlCreateInfoAMD)
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlags)
import {-# SOURCE #-} Vulkan.Core13.Promoted_From_VK_EXT_pipeline_creation_feedback (PipelineCreationFeedbackCreateInfo)
import Vulkan.Core10.Handles (PipelineLayout)
import Vulkan.Extensions.VK_KHR_pipeline_library (PipelineLibraryCreateInfoKHR)
import Vulkan.Core10.Pipeline (PipelineShaderStageCreateInfo)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EXECUTION_GRAPH_PIPELINE_CREATE_INFO_AMDX))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_EXECUTION_GRAPH_PIPELINE_SCRATCH_SIZE_AMDX))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_ENQUEUE_FEATURES_AMDX))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_ENQUEUE_PROPERTIES_AMDX))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_NODE_CREATE_INFO_AMDX))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.VK_KHR_pipeline_library (PipelineLibraryCreateInfoKHR(..))
import Vulkan.Core10.APIConstants (SHADER_INDEX_UNUSED_AMDX)
import Vulkan.Core10.APIConstants (pattern SHADER_INDEX_UNUSED_AMDX)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetExecutionGraphPipelineScratchSizeAMDX
  :: FunPtr (Ptr Device_T -> Pipeline -> Ptr ExecutionGraphPipelineScratchSizeAMDX -> IO Result) -> Ptr Device_T -> Pipeline -> Ptr ExecutionGraphPipelineScratchSizeAMDX -> IO Result

-- | vkGetExecutionGraphPipelineScratchSizeAMDX - Query scratch space
-- required to dispatch an execution graph
--
-- = Description
--
-- After this function returns, information about the scratch space
-- required will be returned in @pSizeInfo@.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<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'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.Handles.Device', 'ExecutionGraphPipelineScratchSizeAMDX',
-- 'Vulkan.Core10.Handles.Pipeline'
getExecutionGraphPipelineScratchSizeAMDX :: forall io
                                          . (MonadIO io)
                                         => -- | @device@ is the that @executionGraph@ was created on.
                                            --
                                            -- #VUID-vkGetExecutionGraphPipelineScratchSizeAMDX-device-parameter#
                                            -- @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                                            Device
                                         -> -- | @executionGraph@ is the execution graph pipeline to query the scratch
                                            -- space for.
                                            --
                                            -- #VUID-vkGetExecutionGraphPipelineScratchSizeAMDX-executionGraph-parameter#
                                            -- @executionGraph@ /must/ be a valid 'Vulkan.Core10.Handles.Pipeline'
                                            -- handle
                                            --
                                            -- #VUID-vkGetExecutionGraphPipelineScratchSizeAMDX-executionGraph-parent#
                                            -- @executionGraph@ /must/ have been created, allocated, or retrieved from
                                            -- @device@
                                            ("executionGraph" ::: Pipeline)
                                         -> io (("sizeInfo" ::: ExecutionGraphPipelineScratchSizeAMDX))
getExecutionGraphPipelineScratchSizeAMDX :: forall (io :: * -> *).
MonadIO io =>
Device
-> ("executionGraph" ::: Pipeline)
-> io ExecutionGraphPipelineScratchSizeAMDX
getExecutionGraphPipelineScratchSizeAMDX Device
device
                                           "executionGraph" ::: Pipeline
executionGraph = 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 vkGetExecutionGraphPipelineScratchSizeAMDXPtr :: FunPtr
  (Ptr Device_T
   -> ("executionGraph" ::: Pipeline)
   -> ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
   -> IO Result)
vkGetExecutionGraphPipelineScratchSizeAMDXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("executionGraph" ::: Pipeline)
      -> ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
      -> IO Result)
pVkGetExecutionGraphPipelineScratchSizeAMDX (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  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 Device_T
   -> ("executionGraph" ::: Pipeline)
   -> ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
   -> IO Result)
vkGetExecutionGraphPipelineScratchSizeAMDXPtr 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 vkGetExecutionGraphPipelineScratchSizeAMDX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetExecutionGraphPipelineScratchSizeAMDX' :: Ptr Device_T
-> ("executionGraph" ::: Pipeline)
-> ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
-> IO Result
vkGetExecutionGraphPipelineScratchSizeAMDX' = FunPtr
  (Ptr Device_T
   -> ("executionGraph" ::: Pipeline)
   -> ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
   -> IO Result)
-> Ptr Device_T
-> ("executionGraph" ::: Pipeline)
-> ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
-> IO Result
mkVkGetExecutionGraphPipelineScratchSizeAMDX FunPtr
  (Ptr Device_T
   -> ("executionGraph" ::: Pipeline)
   -> ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
   -> IO Result)
vkGetExecutionGraphPipelineScratchSizeAMDXPtr
  "pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
pPSizeInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ExecutionGraphPipelineScratchSizeAMDX)
  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
"vkGetExecutionGraphPipelineScratchSizeAMDX" (Ptr Device_T
-> ("executionGraph" ::: Pipeline)
-> ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
-> IO Result
vkGetExecutionGraphPipelineScratchSizeAMDX'
                                                                               (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                               ("executionGraph" ::: Pipeline
executionGraph)
                                                                               ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
pPSizeInfo))
  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))
  ExecutionGraphPipelineScratchSizeAMDX
pSizeInfo <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ExecutionGraphPipelineScratchSizeAMDX "pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
pPSizeInfo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (ExecutionGraphPipelineScratchSizeAMDX
pSizeInfo)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetExecutionGraphPipelineNodeIndexAMDX
  :: FunPtr (Ptr Device_T -> Pipeline -> Ptr PipelineShaderStageNodeCreateInfoAMDX -> Ptr Word32 -> IO Result) -> Ptr Device_T -> Pipeline -> Ptr PipelineShaderStageNodeCreateInfoAMDX -> Ptr Word32 -> IO Result

-- | vkGetExecutionGraphPipelineNodeIndexAMDX - Query internal id of a node
-- in an execution graph
--
-- = Description
--
-- Once this function returns, the contents of @pNodeIndex@ contain the
-- internal node index of the identified node.
--
-- == Valid Usage
--
-- -   #VUID-vkGetExecutionGraphPipelineNodeIndexAMDX-pNodeInfo-09140#
--     @pNodeInfo->pName@ /must/ not be @NULL@
--
-- -   #VUID-vkGetExecutionGraphPipelineNodeIndexAMDX-pNodeInfo-09141#
--     @pNodeInfo->index@ /must/ not be
--     'Vulkan.Core10.APIConstants.SHADER_INDEX_UNUSED_AMDX'
--
-- -   #VUID-vkGetExecutionGraphPipelineNodeIndexAMDX-executionGraph-09142#
--     There /must/ be a node in @executionGraph@ with a shader name and
--     index equal to @pNodeInfo->pName@ and @pNodeInfo->index@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetExecutionGraphPipelineNodeIndexAMDX-device-parameter#
--     @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetExecutionGraphPipelineNodeIndexAMDX-executionGraph-parameter#
--     @executionGraph@ /must/ be a valid 'Vulkan.Core10.Handles.Pipeline'
--     handle
--
-- -   #VUID-vkGetExecutionGraphPipelineNodeIndexAMDX-pNodeInfo-parameter#
--     @pNodeInfo@ /must/ be a valid pointer to a valid
--     'PipelineShaderStageNodeCreateInfoAMDX' structure
--
-- -   #VUID-vkGetExecutionGraphPipelineNodeIndexAMDX-pNodeIndex-parameter#
--     @pNodeIndex@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetExecutionGraphPipelineNodeIndexAMDX-executionGraph-parent#
--     @executionGraph@ /must/ have been created, allocated, or retrieved
--     from @device@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<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'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Pipeline',
-- 'PipelineShaderStageNodeCreateInfoAMDX'
getExecutionGraphPipelineNodeIndexAMDX :: forall io
                                        . (MonadIO io)
                                       => -- | @device@ is the that @executionGraph@ was created on.
                                          Device
                                       -> -- | @executionGraph@ is the execution graph pipeline to query the internal
                                          -- node index for.
                                          ("executionGraph" ::: Pipeline)
                                       -> -- | @pNodeInfo@ is a pointer to a 'PipelineShaderStageNodeCreateInfoAMDX'
                                          -- structure identifying the name and index of the node to query.
                                          ("nodeInfo" ::: PipelineShaderStageNodeCreateInfoAMDX)
                                       -> io (("nodeIndex" ::: Word32))
getExecutionGraphPipelineNodeIndexAMDX :: forall (io :: * -> *).
MonadIO io =>
Device
-> ("executionGraph" ::: Pipeline)
-> PipelineShaderStageNodeCreateInfoAMDX
-> io ("nodeIndex" ::: Word32)
getExecutionGraphPipelineNodeIndexAMDX Device
device
                                         "executionGraph" ::: Pipeline
executionGraph
                                         PipelineShaderStageNodeCreateInfoAMDX
nodeInfo = 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 vkGetExecutionGraphPipelineNodeIndexAMDXPtr :: FunPtr
  (Ptr Device_T
   -> ("executionGraph" ::: Pipeline)
   -> ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
   -> ("pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32))
   -> IO Result)
vkGetExecutionGraphPipelineNodeIndexAMDXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("executionGraph" ::: Pipeline)
      -> ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
      -> ("pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32))
      -> IO Result)
pVkGetExecutionGraphPipelineNodeIndexAMDX (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  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 Device_T
   -> ("executionGraph" ::: Pipeline)
   -> ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
   -> ("pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32))
   -> IO Result)
vkGetExecutionGraphPipelineNodeIndexAMDXPtr 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 vkGetExecutionGraphPipelineNodeIndexAMDX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetExecutionGraphPipelineNodeIndexAMDX' :: Ptr Device_T
-> ("executionGraph" ::: Pipeline)
-> ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
-> ("pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32))
-> IO Result
vkGetExecutionGraphPipelineNodeIndexAMDX' = FunPtr
  (Ptr Device_T
   -> ("executionGraph" ::: Pipeline)
   -> ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
   -> ("pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32))
   -> IO Result)
-> Ptr Device_T
-> ("executionGraph" ::: Pipeline)
-> ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
-> ("pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32))
-> IO Result
mkVkGetExecutionGraphPipelineNodeIndexAMDX FunPtr
  (Ptr Device_T
   -> ("executionGraph" ::: Pipeline)
   -> ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
   -> ("pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32))
   -> IO Result)
vkGetExecutionGraphPipelineNodeIndexAMDXPtr
  "pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
pNodeInfo <- 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 => a -> (Ptr a -> IO b) -> IO b
withCStruct (PipelineShaderStageNodeCreateInfoAMDX
nodeInfo)
  "pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32)
pPNodeIndex <- 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
"vkGetExecutionGraphPipelineNodeIndexAMDX" (Ptr Device_T
-> ("executionGraph" ::: Pipeline)
-> ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
-> ("pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32))
-> IO Result
vkGetExecutionGraphPipelineNodeIndexAMDX'
                                                                             (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                             ("executionGraph" ::: Pipeline
executionGraph)
                                                                             "pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
pNodeInfo
                                                                             ("pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32)
pPNodeIndex))
  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))
  "nodeIndex" ::: Word32
pNodeIndex <- 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 "pNodeIndex" ::: Ptr ("nodeIndex" ::: Word32)
pPNodeIndex
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ("nodeIndex" ::: Word32
pNodeIndex)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateExecutionGraphPipelinesAMDX
  :: FunPtr (Ptr Device_T -> PipelineCache -> Word32 -> Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX) -> Ptr AllocationCallbacks -> Ptr Pipeline -> IO Result) -> Ptr Device_T -> PipelineCache -> Word32 -> Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX) -> Ptr AllocationCallbacks -> Ptr Pipeline -> IO Result

-- | vkCreateExecutionGraphPipelinesAMDX - Creates a new execution graph
-- pipeline object
--
-- = Description
--
-- The implementation will create a pipeline in each element of
-- @pPipelines@ from the corresponding element of @pCreateInfos@. If
-- creation of any pipeline fails, that pipeline will be set to
-- 'Vulkan.Core10.APIConstants.NULL_HANDLE'.
--
-- If creation fails for a pipeline create info with a
-- 'ExecutionGraphPipelineCreateInfoAMDX'::@flags@ value that included
-- 'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_EARLY_RETURN_ON_FAILURE_BIT',
-- all pipelines at a greater index all automatically fail.
--
-- == Valid Usage
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-shaderEnqueue-09124# The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-shaderEnqueue shaderEnqueue feature>
--     /must/ be enabled
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-flags-09125# If the
--     @flags@ member of any element of @pCreateInfos@ contains the
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DERIVATIVE_BIT'
--     flag, and the @basePipelineIndex@ member of that same element is not
--     @-1@, @basePipelineIndex@ /must/ be less than the index into
--     @pCreateInfos@ that corresponds to that element
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-flags-09126# If the
--     @flags@ member of any element of @pCreateInfos@ contains the
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DERIVATIVE_BIT'
--     flag, the base pipeline /must/ have been created with the
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT'
--     flag set
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-pipelineCache-09127# If
--     @pipelineCache@ was created with
--     'Vulkan.Core10.Enums.PipelineCacheCreateFlagBits.PIPELINE_CACHE_CREATE_EXTERNALLY_SYNCHRONIZED_BIT',
--     host access to @pipelineCache@ /must/ be
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#fundamentals-threadingbehavior externally synchronized>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-device-parameter# @device@
--     /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-pipelineCache-parameter#
--     If @pipelineCache@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @pipelineCache@ /must/ be a valid
--     'Vulkan.Core10.Handles.PipelineCache' handle
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-pCreateInfos-parameter#
--     @pCreateInfos@ /must/ be a valid pointer to an array of
--     @createInfoCount@ valid 'ExecutionGraphPipelineCreateInfoAMDX'
--     structures
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-pAllocator-parameter# If
--     @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid pointer
--     to a valid 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks'
--     structure
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-pPipelines-parameter#
--     @pPipelines@ /must/ be a valid pointer to an array of
--     @createInfoCount@ 'Vulkan.Core10.Handles.Pipeline' handles
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-createInfoCount-arraylength#
--     @createInfoCount@ /must/ be greater than @0@
--
-- -   #VUID-vkCreateExecutionGraphPipelinesAMDX-pipelineCache-parent# If
--     @pipelineCache@ is a valid handle, it /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Extensions.VK_EXT_pipeline_creation_cache_control.PIPELINE_COMPILE_REQUIRED_EXT'
--
-- [<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_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'ExecutionGraphPipelineCreateInfoAMDX',
-- 'Vulkan.Core10.Handles.Pipeline', 'Vulkan.Core10.Handles.PipelineCache'
createExecutionGraphPipelinesAMDX :: forall io
                                   . (MonadIO io)
                                  => -- | @device@ is the logical device that creates the execution graph
                                     -- pipelines.
                                     Device
                                  -> -- | @pipelineCache@ is either 'Vulkan.Core10.APIConstants.NULL_HANDLE',
                                     -- indicating that pipeline caching is disabled; or the handle of a valid
                                     -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#pipelines-cache pipeline cache>
                                     -- object, in which case use of that cache is enabled for the duration of
                                     -- the command.
                                     PipelineCache
                                  -> -- | @pCreateInfos@ is a pointer to an array of
                                     -- 'ExecutionGraphPipelineCreateInfoAMDX' structures.
                                     ("createInfos" ::: Vector (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
                                  -> -- | @pAllocator@ controls host memory allocation as described in the
                                     -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                                     -- chapter.
                                     ("allocator" ::: Maybe AllocationCallbacks)
                                  -> io (Result, ("pipelines" ::: Vector Pipeline))
createExecutionGraphPipelinesAMDX :: forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineCache
-> ("createInfos"
    ::: Vector (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io
     (Result, "pipelines" ::: Vector ("executionGraph" ::: Pipeline))
createExecutionGraphPipelinesAMDX Device
device
                                    PipelineCache
pipelineCache
                                    "createInfos"
::: Vector (SomeStruct ExecutionGraphPipelineCreateInfoAMDX)
createInfos
                                    "allocator" ::: Maybe AllocationCallbacks
allocator = 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 vkCreateExecutionGraphPipelinesAMDXPtr :: FunPtr
  (Ptr Device_T
   -> PipelineCache
   -> ("nodeIndex" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline))
   -> IO Result)
vkCreateExecutionGraphPipelinesAMDXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> PipelineCache
      -> ("nodeIndex" ::: Word32)
      -> ("pCreateInfos"
          ::: Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline))
      -> IO Result)
pVkCreateExecutionGraphPipelinesAMDX (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  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 Device_T
   -> PipelineCache
   -> ("nodeIndex" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline))
   -> IO Result)
vkCreateExecutionGraphPipelinesAMDXPtr 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 vkCreateExecutionGraphPipelinesAMDX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCreateExecutionGraphPipelinesAMDX' :: Ptr Device_T
-> PipelineCache
-> ("nodeIndex" ::: Word32)
-> ("pCreateInfos"
    ::: Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline))
-> IO Result
vkCreateExecutionGraphPipelinesAMDX' = FunPtr
  (Ptr Device_T
   -> PipelineCache
   -> ("nodeIndex" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline))
   -> IO Result)
-> Ptr Device_T
-> PipelineCache
-> ("nodeIndex" ::: Word32)
-> ("pCreateInfos"
    ::: Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline))
-> IO Result
mkVkCreateExecutionGraphPipelinesAMDX FunPtr
  (Ptr Device_T
   -> PipelineCache
   -> ("nodeIndex" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline))
   -> IO Result)
vkCreateExecutionGraphPipelinesAMDXPtr
  Ptr (ExecutionGraphPipelineCreateInfoAMDX Any)
pPCreateInfos <- 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. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(ExecutionGraphPipelineCreateInfoAMDX _) ((forall a. Vector a -> Int
Data.Vector.length ("createInfos"
::: Vector (SomeStruct ExecutionGraphPipelineCreateInfoAMDX)
createInfos)) forall a. Num a => a -> a -> a
* Int
64)
  forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct ExecutionGraphPipelineCreateInfoAMDX
e -> 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.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (ExecutionGraphPipelineCreateInfoAMDX Any)
pPCreateInfos forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
64 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (ExecutionGraphPipelineCreateInfoAMDX _))) (SomeStruct ExecutionGraphPipelineCreateInfoAMDX
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) ("createInfos"
::: Vector (SomeStruct ExecutionGraphPipelineCreateInfoAMDX)
createInfos)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> 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 => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pPipelines" ::: Ptr ("executionGraph" ::: Pipeline)
pPPipelines <- 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 @Pipeline ((forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ ("createInfos"
::: Vector (SomeStruct ExecutionGraphPipelineCreateInfoAMDX)
createInfos)) :: Word32))) forall a. Num a => a -> a -> a
* Int
8)) 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
"vkCreateExecutionGraphPipelinesAMDX" (Ptr Device_T
-> PipelineCache
-> ("nodeIndex" ::: Word32)
-> ("pCreateInfos"
    ::: Ptr (SomeStruct ExecutionGraphPipelineCreateInfoAMDX))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline))
-> IO Result
vkCreateExecutionGraphPipelinesAMDX'
                                                                        (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                        (PipelineCache
pipelineCache)
                                                                        ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ ("createInfos"
::: Vector (SomeStruct ExecutionGraphPipelineCreateInfoAMDX)
createInfos)) :: Word32))
                                                                        (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (ExecutionGraphPipelineCreateInfoAMDX Any)
pPCreateInfos))
                                                                        "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                                        ("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline)
pPPipelines))
  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))
  "pipelines" ::: Vector ("executionGraph" ::: Pipeline)
pPipelines <- 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 ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ ("createInfos"
::: Vector (SomeStruct ExecutionGraphPipelineCreateInfoAMDX)
createInfos)) :: Word32))) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pPipelines" ::: Ptr ("executionGraph" ::: Pipeline)
pPPipelines forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Pipeline)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Result
r, "pipelines" ::: Vector ("executionGraph" ::: Pipeline)
pPipelines)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdInitializeGraphScratchMemoryAMDX
  :: FunPtr (Ptr CommandBuffer_T -> DeviceAddress -> IO ()) -> Ptr CommandBuffer_T -> DeviceAddress -> IO ()

-- | vkCmdInitializeGraphScratchMemoryAMDX - Initialize scratch memory for an
-- execution graph
--
-- = Description
--
-- This command /must/ be called before using @scratch@ to dispatch the
-- currently bound execution graph pipeline.
--
-- Execution of this command /may/ modify any memory locations in the range
-- [@scratch@,@scratch@ + @size@), where @size@ is the value returned in
-- 'ExecutionGraphPipelineScratchSizeAMDX'::@size@ by
-- 'ExecutionGraphPipelineScratchSizeAMDX' for the currently bound
-- execution graph pipeline. Accesses to this memory range are performed in
-- the
-- 'Vulkan.Core13.Enums.PipelineStageFlags2.PIPELINE_STAGE_2_COMPUTE_SHADER_BIT'
-- pipeline stage with the
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_READ_BIT' and
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_WRITE_BIT'
-- access flags.
--
-- If any portion of @scratch@ is modified by any command other than
-- 'cmdDispatchGraphAMDX', 'cmdDispatchGraphIndirectAMDX',
-- 'cmdDispatchGraphIndirectCountAMDX', or
-- 'cmdInitializeGraphScratchMemoryAMDX' with the same execution graph, it
-- /must/ be reinitialized for the execution graph again before dispatching
-- against it.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdInitializeGraphScratchMemoryAMDX-scratch-09143# @scratch@
--     /must/ be the device address of an allocated memory range at least
--     as large as the value of
--     'ExecutionGraphPipelineScratchSizeAMDX'::@size@ returned by
--     'ExecutionGraphPipelineScratchSizeAMDX' for the currently bound
--     execution graph pipeline.
--
-- -   #VUID-vkCmdInitializeGraphScratchMemoryAMDX-scratch-09144# @scratch@
--     /must/ be a multiple of 64
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdInitializeGraphScratchMemoryAMDX-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdInitializeGraphScratchMemoryAMDX-commandBuffer-recording#
--     @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdInitializeGraphScratchMemoryAMDX-commandBuffer-cmdpool#
--     The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics, or compute operations
--
-- -   #VUID-vkCmdInitializeGraphScratchMemoryAMDX-renderpass# This command
--     /must/ only be called outside of a render pass instance
--
-- -   #VUID-vkCmdInitializeGraphScratchMemoryAMDX-videocoding# This
--     command /must/ only be called outside of a video coding scope
--
-- -   #VUID-vkCmdInitializeGraphScratchMemoryAMDX-bufferlevel#
--     @commandBuffer@ /must/ be a primary
--     'Vulkan.Core10.Handles.CommandBuffer'
--
-- == Host Synchronization
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Graphics                                                                                                              | Action                                                                                                                                 |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress'
cmdInitializeGraphScratchMemoryAMDX :: forall io
                                     . (MonadIO io)
                                    => -- | @commandBuffer@ is the command buffer into which the command will be
                                       -- recorded.
                                       CommandBuffer
                                    -> -- | @scratch@ is a pointer to the scratch memory to be initialized.
                                       ("scratch" ::: DeviceAddress)
                                    -> io ()
cmdInitializeGraphScratchMemoryAMDX :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> Flags64 -> io ()
cmdInitializeGraphScratchMemoryAMDX CommandBuffer
commandBuffer Flags64
scratch = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  let vkCmdInitializeGraphScratchMemoryAMDXPtr :: FunPtr (Ptr CommandBuffer_T -> Flags64 -> IO ())
vkCmdInitializeGraphScratchMemoryAMDXPtr = DeviceCmds -> FunPtr (Ptr CommandBuffer_T -> Flags64 -> IO ())
pVkCmdInitializeGraphScratchMemoryAMDX (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr CommandBuffer_T -> Flags64 -> IO ())
vkCmdInitializeGraphScratchMemoryAMDXPtr 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 vkCmdInitializeGraphScratchMemoryAMDX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCmdInitializeGraphScratchMemoryAMDX' :: Ptr CommandBuffer_T -> Flags64 -> IO ()
vkCmdInitializeGraphScratchMemoryAMDX' = FunPtr (Ptr CommandBuffer_T -> Flags64 -> IO ())
-> Ptr CommandBuffer_T -> Flags64 -> IO ()
mkVkCmdInitializeGraphScratchMemoryAMDX FunPtr (Ptr CommandBuffer_T -> Flags64 -> IO ())
vkCmdInitializeGraphScratchMemoryAMDXPtr
  forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdInitializeGraphScratchMemoryAMDX" (Ptr CommandBuffer_T -> Flags64 -> IO ()
vkCmdInitializeGraphScratchMemoryAMDX'
                                                              (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                              (Flags64
scratch))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdDispatchGraphAMDX
  :: FunPtr (Ptr CommandBuffer_T -> DeviceAddress -> Ptr DispatchGraphCountInfoAMDX -> IO ()) -> Ptr CommandBuffer_T -> DeviceAddress -> Ptr DispatchGraphCountInfoAMDX -> IO ()

-- | vkCmdDispatchGraphAMDX - Dispatch an execution graph
--
-- = Description
--
-- When this command is executed, the nodes specified in @pCountInfo@ are
-- executed. Nodes executed as part of this command are not implicitly
-- synchronized in any way against each other once they are dispatched.
--
-- For this command, all device\/host pointers in substructures are treated
-- as host pointers and read only during host execution of this command.
-- Once this command returns, no reference to the original pointers is
-- retained.
--
-- Execution of this command /may/ modify any memory locations in the range
-- [@scratch@,@scratch@ + @size@), where @size@ is the value returned in
-- 'ExecutionGraphPipelineScratchSizeAMDX'::@size@ by
-- 'ExecutionGraphPipelineScratchSizeAMDX' for the currently bound
-- execution graph pipeline Accesses to this memory range are performed in
-- the
-- 'Vulkan.Core13.Enums.PipelineStageFlags2.PIPELINE_STAGE_2_COMPUTE_SHADER_BIT'
-- pipeline stage with the
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_READ_BIT' and
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_WRITE_BIT'
-- access flags.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdDispatchGraphAMDX-magFilter-04553# If a
--     'Vulkan.Core10.Handles.Sampler' created with @magFilter@ or
--     @minFilter@ equal to 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' and
--     @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE' is
--     used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-mipmapMode-04770# If a
--     'Vulkan.Core10.Handles.Sampler' created with @mipmapMode@ equal to
--     'Vulkan.Core10.Enums.SamplerMipmapMode.SAMPLER_MIPMAP_MODE_LINEAR'
--     and @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE'
--     is used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-06479# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-depth-compare-operation depth comparison>,
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_SAMPLED_IMAGE_DEPTH_COMPARISON_BIT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-02691# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed using atomic
--     operations as a result of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_IMAGE_ATOMIC_BIT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-07888# If a
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER'
--     descriptor is accessed using atomic operations as a result of this
--     command, then the storage texel buffer’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-buffer-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_TEXEL_BUFFER_ATOMIC_BIT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-02692# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as a result of this
--     command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_CUBIC_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-02693# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_filter_cubic VK_EXT_filter_cubic>
--     extension is not enabled and any 'Vulkan.Core10.Handles.ImageView'
--     is sampled with 'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as a
--     result of this command, it /must/ not have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' of
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE', or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-filterCubic-02694# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as a result of this
--     command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering, as specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubic@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-filterCubicMinmax-02695# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' with a reduction mode
--     of either
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MIN'
--     or
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MAX'
--     as a result of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering together with minmax filtering, as
--     specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubicMinmax@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-cubicRangeClamp-09212# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-filter-cubic-range-clamp cubicRangeClamp>
--     feature is not enabled, then any 'Vulkan.Core10.Handles.ImageView'
--     being sampled with 'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as
--     a result of this command /must/ not have a
--     'Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax.SamplerReductionModeCreateInfo'::@reductionMode@
--     equal to
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_WEIGHTED_AVERAGE_RANGECLAMP_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-reductionMode-09213# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with a
--     'Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax.SamplerReductionModeCreateInfo'::@reductionMode@
--     equal to
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_WEIGHTED_AVERAGE_RANGECLAMP_QCOM'
--     as a result of this command /must/ sample with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-selectableCubicWeights-09214# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-filter-cubic-weight-selection selectableCubicWeights>
--     feature is not enabled, then any 'Vulkan.Core10.Handles.ImageView'
--     being sampled with 'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as
--     a result of this command /must/ have
--     'Vulkan.Extensions.VK_QCOM_filter_cubic_weights.SamplerCubicWeightsCreateInfoQCOM'::@cubicWeights@
--     equal to
--     'Vulkan.Extensions.VK_QCOM_filter_cubic_weights.CUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-flags-02696# Any
--     'Vulkan.Core10.Handles.Image' created with a
--     'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CORNER_SAMPLED_BIT_NV'
--     sampled as a result of this command /must/ only be sampled using a
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' of
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpTypeImage-07027# For any
--     'Vulkan.Core10.Handles.ImageView' being written as a storage image
--     where the image format field of the @OpTypeImage@ is @Unknown@, the
--     view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_WRITE_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpTypeImage-07028# For any
--     'Vulkan.Core10.Handles.ImageView' being read as a storage image
--     where the image format field of the @OpTypeImage@ is @Unknown@, the
--     view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_READ_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpTypeImage-07029# For any
--     'Vulkan.Core10.Handles.BufferView' being written as a storage texel
--     buffer where the image format field of the @OpTypeImage@ is
--     @Unknown@, the view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkFormatProperties3 buffer features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_WRITE_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpTypeImage-07030# Any
--     'Vulkan.Core10.Handles.BufferView' being read as a storage texel
--     buffer where the image format field of the @OpTypeImage@ is
--     @Unknown@ then the view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkFormatProperties3 buffer features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_READ_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08600# For each set /n/ that is
--     statically used by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>,
--     a descriptor set /must/ have been bound to /n/ at the same pipeline
--     bind point, with a 'Vulkan.Core10.Handles.PipelineLayout' that is
--     compatible for set /n/, with the
--     'Vulkan.Core10.Handles.PipelineLayout' or
--     'Vulkan.Core10.Handles.DescriptorSetLayout' array that was used to
--     create the current 'Vulkan.Core10.Handles.Pipeline' or
--     'Vulkan.Extensions.Handles.ShaderEXT', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08601# For each push constant that
--     is statically used by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>,
--     a push constant value /must/ have been set for the same pipeline
--     bind point, with a 'Vulkan.Core10.Handles.PipelineLayout' that is
--     compatible for push constants, with the
--     'Vulkan.Core10.Handles.PipelineLayout' or
--     'Vulkan.Core10.Handles.DescriptorSetLayout' and
--     'Vulkan.Core10.PipelineLayout.PushConstantRange' arrays used to
--     create the current 'Vulkan.Core10.Handles.Pipeline' or
--     'Vulkan.Extensions.Handles.ShaderEXT', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDispatchGraphAMDX-maintenance4-08602# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-maintenance4 maintenance4>
--     feature is not enabled, then for each push constant that is
--     statically used by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>,
--     a push constant value /must/ have been set for the same pipeline
--     bind point, with a 'Vulkan.Core10.Handles.PipelineLayout' that is
--     compatible for push constants, with the
--     'Vulkan.Core10.Handles.PipelineLayout' or
--     'Vulkan.Core10.Handles.DescriptorSetLayout' and
--     'Vulkan.Core10.PipelineLayout.PushConstantRange' arrays used to
--     create the current 'Vulkan.Core10.Handles.Pipeline' or
--     'Vulkan.Extensions.Handles.ShaderEXT', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08114# Descriptors in each bound
--     descriptor set, specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', /must/
--     be valid if they are statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command and the bound 'Vulkan.Core10.Handles.Pipeline'
--     was not created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08115# If the descriptors used by
--     the 'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind
--     point were specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', the
--     bound 'Vulkan.Core10.Handles.Pipeline' /must/ have been created
--     without
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08116# Descriptors in bound
--     descriptor buffers, specified via
--     'Vulkan.Extensions.VK_EXT_descriptor_buffer.cmdSetDescriptorBufferOffsetsEXT',
--     /must/ be valid if they are dynamically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command and the bound 'Vulkan.Core10.Handles.Pipeline'
--     was created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08604# Descriptors in bound
--     descriptor buffers, specified via
--     'Vulkan.Extensions.VK_EXT_descriptor_buffer.cmdSetDescriptorBufferOffsetsEXT',
--     /must/ be valid if they are dynamically used by any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08117# If the descriptors used by
--     the 'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind
--     point were specified via
--     'Vulkan.Extensions.VK_EXT_descriptor_buffer.cmdSetDescriptorBufferOffsetsEXT',
--     the bound 'Vulkan.Core10.Handles.Pipeline' /must/ have been created
--     with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08119# If a descriptor is
--     dynamically used with a 'Vulkan.Core10.Handles.Pipeline' created
--     with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT',
--     the descriptor memory /must/ be resident
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08605# If a descriptor is
--     dynamically used with a 'Vulkan.Extensions.Handles.ShaderEXT'
--     created with a 'Vulkan.Core10.Handles.DescriptorSetLayout' that was
--     created with
--     'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_DESCRIPTOR_BUFFER_BIT_EXT',
--     the descriptor memory /must/ be resident
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08606# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderObject shaderObject>
--     feature is not enabled, a valid pipeline /must/ be bound to the
--     pipeline bind point used by this command
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08607# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderObject shaderObject>
--     is enabled, either a valid pipeline /must/ be bound to the pipeline
--     bind point used by this command, or a valid combination of valid and
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' shader objects /must/ be
--     bound to every supported shader stage corresponding to the pipeline
--     bind point used by this command
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08608# If a pipeline is bound to
--     the pipeline bind point used by this command, there /must/ not have
--     been any calls to dynamic state setting commands for any state not
--     specified as dynamic in the 'Vulkan.Core10.Handles.Pipeline' object
--     bound to the pipeline bind point used by this command, since that
--     pipeline was bound
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08609# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command or any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used to sample from any
--     'Vulkan.Core10.Handles.Image' with a
--     'Vulkan.Core10.Handles.ImageView' of the type
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D_ARRAY',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY', in
--     any shader stage
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08610# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command or any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions with
--     @ImplicitLod@, @Dref@ or @Proj@ in their name, in any shader stage
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08611# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command or any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions that
--     includes a LOD bias or any offset values, in any shader stage
--
-- -   #VUID-vkCmdDispatchGraphAMDX-uniformBuffers-06935# If any stage of
--     the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command accesses a uniform buffer, and that
--     stage was created without enabling either
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_EXT'
--     or
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_2_EXT'
--     for @uniformBuffers@, and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, that stage /must/ not access values outside
--     of the range of the buffer as specified in the descriptor set bound
--     to the same pipeline bind point
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08612# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, and any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a uniform
--     buffer, it /must/ not access values outside of the range of the
--     buffer as specified in the descriptor set bound to the same pipeline
--     bind point
--
-- -   #VUID-vkCmdDispatchGraphAMDX-storageBuffers-06936# If any stage of
--     the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command accesses a storage buffer, and that
--     stage was created without enabling either
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_EXT'
--     or
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_2_EXT'
--     for @storageBuffers@, and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, that stage /must/ not access values outside
--     of the range of the buffer as specified in the descriptor set bound
--     to the same pipeline bind point
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-08613# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, and any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a storage
--     buffer, it /must/ not access values outside of the range of the
--     buffer as specified in the descriptor set bound to the same pipeline
--     bind point
--
-- -   #VUID-vkCmdDispatchGraphAMDX-commandBuffer-02707# If @commandBuffer@
--     is an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, any resource accessed by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding bound shaders>
--     /must/ not be a protected resource
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-06550# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>
--     accesses a 'Vulkan.Core10.Handles.Sampler' or
--     'Vulkan.Core10.Handles.ImageView' object that enables
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>,
--     that object /must/ only be used with @OpImageSample*@ or
--     @OpImageSparseSample*@ instructions
--
-- -   #VUID-vkCmdDispatchGraphAMDX-ConstOffset-06551# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>
--     accesses a 'Vulkan.Core10.Handles.Sampler' or
--     'Vulkan.Core10.Handles.ImageView' object that enables
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>,
--     that object /must/ not use the @ConstOffset@ and @Offset@ operands
--
-- -   #VUID-vkCmdDispatchGraphAMDX-viewType-07752# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed as a result of this
--     command, then the image view’s @viewType@ /must/ match the @Dim@
--     operand of the @OpTypeImage@ as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-operation-validation ???>
--
-- -   #VUID-vkCmdDispatchGraphAMDX-format-07753# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed as a result of this
--     command, then the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-numericformat numeric type>
--     of the image view’s @format@ and the @Sampled@ @Type@ operand of the
--     @OpTypeImage@ /must/ match
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageWrite-08795# If a
--     'Vulkan.Core10.Handles.ImageView' created with a format other than
--     'Vulkan.Core10.Enums.Format.FORMAT_A8_UNORM_KHR' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have at least as many
--     components as the image view’s format
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageWrite-08796# If a
--     'Vulkan.Core10.Handles.ImageView' created with the format
--     'Vulkan.Core10.Enums.Format.FORMAT_A8_UNORM_KHR' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have four components
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageWrite-04469# If a
--     'Vulkan.Core10.Handles.BufferView' is accessed using @OpImageWrite@
--     as a result of this command, then the @Type@ of the @Texel@ operand
--     of that instruction /must/ have at least as many components as the
--     buffer view’s format
--
-- -   #VUID-vkCmdDispatchGraphAMDX-SampledType-04470# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdDispatchGraphAMDX-SampledType-04471# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdDispatchGraphAMDX-SampledType-04472# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdDispatchGraphAMDX-SampledType-04473# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdDispatchGraphAMDX-sparseImageInt64Atomics-04474# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Image' objects
--     created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdDispatchGraphAMDX-sparseImageInt64Atomics-04475# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Buffer' objects
--     created with the
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageWeightedSampleQCOM-06971# If
--     @OpImageWeightedSampleQCOM@ is used to sample a
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_WEIGHT_SAMPLED_IMAGE_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageWeightedSampleQCOM-06972# If
--     @OpImageWeightedSampleQCOM@ uses a 'Vulkan.Core10.Handles.ImageView'
--     as a sample weight image as a result of this command, then the image
--     view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_WEIGHT_IMAGE_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageBoxFilterQCOM-06973# If
--     @OpImageBoxFilterQCOM@ is used to sample a
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BOX_FILTER_SAMPLED_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageBlockMatchSSDQCOM-06974# If
--     @OpImageBlockMatchSSDQCOM@ is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BLOCK_MATCHING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageBlockMatchSADQCOM-06975# If
--     @OpImageBlockMatchSADQCOM@ is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BLOCK_MATCHING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageBlockMatchSADQCOM-06976# If
--     @OpImageBlockMatchSADQCOM@ or OpImageBlockMatchSSDQCOM is used to
--     read from a reference image as result of this command, then the
--     specified reference coordinates /must/ not fail
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-integer-coordinate-validation integer texel coordinate validation>
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageWeightedSampleQCOM-06977# If
--     @OpImageWeightedSampleQCOM@, @OpImageBoxFilterQCOM@,
--     @OpImageBlockMatchWindowSSDQCOM@, @OpImageBlockMatchWindowSADQCOM@,
--     @OpImageBlockMatchGatherSSDQCOM@, @OpImageBlockMatchGatherSADQCOM@,
--     @OpImageBlockMatchSSDQCOM@, or @OpImageBlockMatchSADQCOM@ uses a
--     'Vulkan.Core10.Handles.Sampler' as a result of this command, then
--     the sampler /must/ have been created with
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_IMAGE_PROCESSING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageWeightedSampleQCOM-06978# If any
--     command other than @OpImageWeightedSampleQCOM@,
--     @OpImageBoxFilterQCOM@, @OpImageBlockMatchWindowSSDQCOM@,
--     @OpImageBlockMatchWindowSADQCOM@, @OpImageBlockMatchGatherSSDQCOM@,
--     @OpImageBlockMatchGatherSADQCOM@, @OpImageBlockMatchSSDQCOM@, or
--     @OpImageBlockMatchSADQCOM@ uses a 'Vulkan.Core10.Handles.Sampler' as
--     a result of this command, then the sampler /must/ not have been
--     created with
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_IMAGE_PROCESSING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageBlockMatchWindow-09215# If a
--     @OpImageBlockMatchWindow*QCOM@ or @OpImageBlockMatchGather*QCOM@
--     instruction is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BLOCK_MATCHING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageBlockMatchWindow-09216# If a
--     @OpImageBlockMatchWindow*QCOM@ or @OpImageBlockMatchGather*QCOM@
--     instruction is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s format /must/ be a single-component format.
--
-- -   #VUID-vkCmdDispatchGraphAMDX-OpImageBlockMatchWindow-09217# If a
--     @OpImageBlockMatchWindow*QCOM@ or @OpImageBlockMatchGather*QCOM@
--     read from a reference image as result of this command, then the
--     specified reference coordinates /must/ not fail
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-integer-coordinate-validation integer texel coordinate validation>
--
-- -   #VUID-vkCmdDispatchGraphAMDX-None-07288# Any shader invocation
--     executed by this command /must/
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-termination terminate>
--
-- -   #VUID-vkCmdDispatchGraphAMDX-commandBuffer-09181# @commandBuffer@
--     /must/ not be a protected command buffer
--
-- -   #VUID-vkCmdDispatchGraphAMDX-commandBuffer-09182# @commandBuffer@
--     /must/ be a primary command buffer
--
-- -   #VUID-vkCmdDispatchGraphAMDX-scratch-09183# @scratch@ /must/ be the
--     device address of an allocated memory range at least as large as the
--     value of 'ExecutionGraphPipelineScratchSizeAMDX'::@size@ returned by
--     'ExecutionGraphPipelineScratchSizeAMDX' for the currently bound
--     execution graph pipeline
--
-- -   #VUID-vkCmdDispatchGraphAMDX-scratch-09184# @scratch@ /must/ be a
--     device address within a 'Vulkan.Core10.Handles.Buffer' created with
--     the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_EXECUTION_GRAPH_SCRATCH_BIT_AMDX'
--     or 'BUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX' flag
--
-- -   #VUID-vkCmdDispatchGraphAMDX-scratch-09185# Device memory in the
--     range [@scratch@,@scratch@
--     'ExecutionGraphPipelineScratchSizeAMDX'::@size@) /must/ have been
--     initialized with 'cmdInitializeGraphScratchMemoryAMDX' using the
--     currently bound execution graph pipeline, and not modified after
--     that by anything other than another execution graph dispatch command
--
-- -   #VUID-vkCmdDispatchGraphAMDX-maxComputeWorkGroupCount-09186#
--     Execution of this command /must/ not cause a node to be dispatched
--     with a larger number of workgroups than that specified by either a
--     @MaxNumWorkgroupsAMDX@ decoration in the dispatched node or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxComputeWorkGroupCount maxComputeWorkGroupCount>
--
-- -   #VUID-vkCmdDispatchGraphAMDX-maxExecutionGraphShaderPayloadCount-09187#
--     Execution of this command /must/ not cause any shader to initialize
--     more than
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxExecutionGraphShaderPayloadCount maxExecutionGraphShaderPayloadCount>
--     output payloads
--
-- -   #VUID-vkCmdDispatchGraphAMDX-NodeMaxPayloadsAMDX-09188# Execution of
--     this command /must/ not cause any shader that declares
--     @NodeMaxPayloadsAMDX@ to initialize more output payloads than
--     specified by the max number of payloads for that decoration. This
--     requirement applies to each @NodeMaxPayloadsAMDX@ decoration
--     separately
--
-- -   #VUID-vkCmdDispatchGraphAMDX-pCountInfo-09145# @pCountInfo->infos@
--     /must/ be a host pointer to a memory allocation at least as large as
--     the product of @count@ and @stride@
--
-- -   #VUID-vkCmdDispatchGraphAMDX-infos-09146# Host memory locations at
--     indexes in the range [@infos@, @infos@ + (@count@*@stride@)), at a
--     granularity of @stride@ /must/ contain valid 'DispatchGraphInfoAMDX'
--     structures in the first 24 bytes
--
-- -   #VUID-vkCmdDispatchGraphAMDX-pCountInfo-09147# For each
--     'DispatchGraphInfoAMDX' structure in @pCountInfo->infos@, @payloads@
--     /must/ be a host pointer to a memory allocation at least as large as
--     the product of @payloadCount@ and @payloadStride@
--
-- -   #VUID-vkCmdDispatchGraphAMDX-pCountInfo-09148# For each
--     'DispatchGraphInfoAMDX' structure in @pCountInfo->infos@,
--     @nodeIndex@ /must/ be a valid node index in the currently bound
--     execution graph pipeline, as returned by
--     'getExecutionGraphPipelineNodeIndexAMDX'
--
-- -   #VUID-vkCmdDispatchGraphAMDX-pCountInfo-09149# For each
--     'DispatchGraphInfoAMDX' structure in @pCountInfo->infos@, host
--     memory locations at indexes in the range [@payloads@, @payloads@ +
--     (@payloadCount@ * @payloadStride@)), at a granularity of
--     @payloadStride@ /must/ contain a payload matching the size of the
--     input payload expected by the node in @nodeIndex@ in the first bytes
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdDispatchGraphAMDX-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdDispatchGraphAMDX-pCountInfo-parameter# @pCountInfo@
--     /must/ be a valid pointer to a valid 'DispatchGraphCountInfoAMDX'
--     structure
--
-- -   #VUID-vkCmdDispatchGraphAMDX-commandBuffer-recording#
--     @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdDispatchGraphAMDX-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics, or compute operations
--
-- -   #VUID-vkCmdDispatchGraphAMDX-renderpass# This command /must/ only be
--     called outside of a render pass instance
--
-- -   #VUID-vkCmdDispatchGraphAMDX-videocoding# This command /must/ only
--     be called outside of a video coding scope
--
-- -   #VUID-vkCmdDispatchGraphAMDX-bufferlevel# @commandBuffer@ /must/ be
--     a primary 'Vulkan.Core10.Handles.CommandBuffer'
--
-- == Host Synchronization
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Graphics                                                                                                              | Action                                                                                                                                 |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress',
-- 'DispatchGraphCountInfoAMDX'
cmdDispatchGraphAMDX :: forall io
                      . (MonadIO io)
                     => -- | @commandBuffer@ is the command buffer into which the command will be
                        -- recorded.
                        CommandBuffer
                     -> -- | @scratch@ is a pointer to the scratch memory to be used.
                        ("scratch" ::: DeviceAddress)
                     -> -- | @pCountInfo@ is a host pointer to a 'DispatchGraphCountInfoAMDX'
                        -- structure defining the nodes which will be initially executed.
                        DispatchGraphCountInfoAMDX
                     -> io ()
cmdDispatchGraphAMDX :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> Flags64 -> DispatchGraphCountInfoAMDX -> io ()
cmdDispatchGraphAMDX CommandBuffer
commandBuffer Flags64
scratch DispatchGraphCountInfoAMDX
countInfo = 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 vkCmdDispatchGraphAMDXPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> Flags64
   -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
   -> IO ())
vkCmdDispatchGraphAMDXPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> Flags64
      -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
      -> IO ())
pVkCmdDispatchGraphAMDX (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  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 CommandBuffer_T
   -> Flags64
   -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
   -> IO ())
vkCmdDispatchGraphAMDXPtr 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 vkCmdDispatchGraphAMDX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCmdDispatchGraphAMDX' :: Ptr CommandBuffer_T
-> Flags64
-> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
-> IO ()
vkCmdDispatchGraphAMDX' = FunPtr
  (Ptr CommandBuffer_T
   -> Flags64
   -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
   -> IO ())
-> Ptr CommandBuffer_T
-> Flags64
-> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
-> IO ()
mkVkCmdDispatchGraphAMDX FunPtr
  (Ptr CommandBuffer_T
   -> Flags64
   -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
   -> IO ())
vkCmdDispatchGraphAMDXPtr
  "pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
pCountInfo <- 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 => a -> (Ptr a -> IO b) -> IO b
withCStruct (DispatchGraphCountInfoAMDX
countInfo)
  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
"vkCmdDispatchGraphAMDX" (Ptr CommandBuffer_T
-> Flags64
-> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
-> IO ()
vkCmdDispatchGraphAMDX'
                                                      (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                      (Flags64
scratch)
                                                      "pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
pCountInfo)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdDispatchGraphIndirectAMDX
  :: FunPtr (Ptr CommandBuffer_T -> DeviceAddress -> Ptr DispatchGraphCountInfoAMDX -> IO ()) -> Ptr CommandBuffer_T -> DeviceAddress -> Ptr DispatchGraphCountInfoAMDX -> IO ()

-- | vkCmdDispatchGraphIndirectAMDX - Dispatch an execution graph with node
-- and payload parameters read on the device
--
-- = Description
--
-- When this command is executed, the nodes specified in @pCountInfo@ are
-- executed. Nodes executed as part of this command are not implicitly
-- synchronized in any way against each other once they are dispatched.
--
-- For this command, all device\/host pointers in substructures are treated
-- as device pointers and read during device execution of this command. The
-- allocation and contents of these pointers only needs to be valid during
-- device execution. All of these addresses will be read in the
-- 'Vulkan.Core13.Enums.PipelineStageFlags2.PIPELINE_STAGE_2_COMPUTE_SHADER_BIT'
-- pipeline stage with the
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_READ_BIT'
-- access flag.
--
-- Execution of this command /may/ modify any memory locations in the range
-- [@scratch@,@scratch@ + @size@), where @size@ is the value returned in
-- 'ExecutionGraphPipelineScratchSizeAMDX'::@size@ by
-- 'ExecutionGraphPipelineScratchSizeAMDX' for the currently bound
-- execution graph pipeline. Accesses to this memory range are performed in
-- the
-- 'Vulkan.Core13.Enums.PipelineStageFlags2.PIPELINE_STAGE_2_COMPUTE_SHADER_BIT'
-- pipeline stage with the
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_READ_BIT' and
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_WRITE_BIT'
-- access flags.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-magFilter-04553# If a
--     'Vulkan.Core10.Handles.Sampler' created with @magFilter@ or
--     @minFilter@ equal to 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' and
--     @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE' is
--     used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-mipmapMode-04770# If a
--     'Vulkan.Core10.Handles.Sampler' created with @mipmapMode@ equal to
--     'Vulkan.Core10.Enums.SamplerMipmapMode.SAMPLER_MIPMAP_MODE_LINEAR'
--     and @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE'
--     is used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-06479# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-depth-compare-operation depth comparison>,
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_SAMPLED_IMAGE_DEPTH_COMPARISON_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-02691# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed using atomic
--     operations as a result of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_IMAGE_ATOMIC_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-07888# If a
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER'
--     descriptor is accessed using atomic operations as a result of this
--     command, then the storage texel buffer’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-buffer-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_TEXEL_BUFFER_ATOMIC_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-02692# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as a result of this
--     command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_CUBIC_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-02693# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_filter_cubic VK_EXT_filter_cubic>
--     extension is not enabled and any 'Vulkan.Core10.Handles.ImageView'
--     is sampled with 'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as a
--     result of this command, it /must/ not have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' of
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE', or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-filterCubic-02694# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as a result of this
--     command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering, as specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubic@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-filterCubicMinmax-02695# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' with a reduction mode
--     of either
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MIN'
--     or
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MAX'
--     as a result of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering together with minmax filtering, as
--     specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubicMinmax@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-cubicRangeClamp-09212# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-filter-cubic-range-clamp cubicRangeClamp>
--     feature is not enabled, then any 'Vulkan.Core10.Handles.ImageView'
--     being sampled with 'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as
--     a result of this command /must/ not have a
--     'Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax.SamplerReductionModeCreateInfo'::@reductionMode@
--     equal to
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_WEIGHTED_AVERAGE_RANGECLAMP_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-reductionMode-09213# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with a
--     'Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax.SamplerReductionModeCreateInfo'::@reductionMode@
--     equal to
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_WEIGHTED_AVERAGE_RANGECLAMP_QCOM'
--     as a result of this command /must/ sample with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-selectableCubicWeights-09214#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-filter-cubic-weight-selection selectableCubicWeights>
--     feature is not enabled, then any 'Vulkan.Core10.Handles.ImageView'
--     being sampled with 'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as
--     a result of this command /must/ have
--     'Vulkan.Extensions.VK_QCOM_filter_cubic_weights.SamplerCubicWeightsCreateInfoQCOM'::@cubicWeights@
--     equal to
--     'Vulkan.Extensions.VK_QCOM_filter_cubic_weights.CUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-flags-02696# Any
--     'Vulkan.Core10.Handles.Image' created with a
--     'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CORNER_SAMPLED_BIT_NV'
--     sampled as a result of this command /must/ only be sampled using a
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' of
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpTypeImage-07027# For any
--     'Vulkan.Core10.Handles.ImageView' being written as a storage image
--     where the image format field of the @OpTypeImage@ is @Unknown@, the
--     view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_WRITE_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpTypeImage-07028# For any
--     'Vulkan.Core10.Handles.ImageView' being read as a storage image
--     where the image format field of the @OpTypeImage@ is @Unknown@, the
--     view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_READ_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpTypeImage-07029# For any
--     'Vulkan.Core10.Handles.BufferView' being written as a storage texel
--     buffer where the image format field of the @OpTypeImage@ is
--     @Unknown@, the view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkFormatProperties3 buffer features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_WRITE_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpTypeImage-07030# Any
--     'Vulkan.Core10.Handles.BufferView' being read as a storage texel
--     buffer where the image format field of the @OpTypeImage@ is
--     @Unknown@ then the view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkFormatProperties3 buffer features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_READ_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08600# For each set /n/
--     that is statically used by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>,
--     a descriptor set /must/ have been bound to /n/ at the same pipeline
--     bind point, with a 'Vulkan.Core10.Handles.PipelineLayout' that is
--     compatible for set /n/, with the
--     'Vulkan.Core10.Handles.PipelineLayout' or
--     'Vulkan.Core10.Handles.DescriptorSetLayout' array that was used to
--     create the current 'Vulkan.Core10.Handles.Pipeline' or
--     'Vulkan.Extensions.Handles.ShaderEXT', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08601# For each push
--     constant that is statically used by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>,
--     a push constant value /must/ have been set for the same pipeline
--     bind point, with a 'Vulkan.Core10.Handles.PipelineLayout' that is
--     compatible for push constants, with the
--     'Vulkan.Core10.Handles.PipelineLayout' or
--     'Vulkan.Core10.Handles.DescriptorSetLayout' and
--     'Vulkan.Core10.PipelineLayout.PushConstantRange' arrays used to
--     create the current 'Vulkan.Core10.Handles.Pipeline' or
--     'Vulkan.Extensions.Handles.ShaderEXT', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-maintenance4-08602# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-maintenance4 maintenance4>
--     feature is not enabled, then for each push constant that is
--     statically used by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>,
--     a push constant value /must/ have been set for the same pipeline
--     bind point, with a 'Vulkan.Core10.Handles.PipelineLayout' that is
--     compatible for push constants, with the
--     'Vulkan.Core10.Handles.PipelineLayout' or
--     'Vulkan.Core10.Handles.DescriptorSetLayout' and
--     'Vulkan.Core10.PipelineLayout.PushConstantRange' arrays used to
--     create the current 'Vulkan.Core10.Handles.Pipeline' or
--     'Vulkan.Extensions.Handles.ShaderEXT', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08114# Descriptors in each
--     bound descriptor set, specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', /must/
--     be valid if they are statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command and the bound 'Vulkan.Core10.Handles.Pipeline'
--     was not created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08115# If the descriptors
--     used by the 'Vulkan.Core10.Handles.Pipeline' bound to the pipeline
--     bind point were specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', the
--     bound 'Vulkan.Core10.Handles.Pipeline' /must/ have been created
--     without
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08116# Descriptors in
--     bound descriptor buffers, specified via
--     'Vulkan.Extensions.VK_EXT_descriptor_buffer.cmdSetDescriptorBufferOffsetsEXT',
--     /must/ be valid if they are dynamically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command and the bound 'Vulkan.Core10.Handles.Pipeline'
--     was created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08604# Descriptors in
--     bound descriptor buffers, specified via
--     'Vulkan.Extensions.VK_EXT_descriptor_buffer.cmdSetDescriptorBufferOffsetsEXT',
--     /must/ be valid if they are dynamically used by any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08117# If the descriptors
--     used by the 'Vulkan.Core10.Handles.Pipeline' bound to the pipeline
--     bind point were specified via
--     'Vulkan.Extensions.VK_EXT_descriptor_buffer.cmdSetDescriptorBufferOffsetsEXT',
--     the bound 'Vulkan.Core10.Handles.Pipeline' /must/ have been created
--     with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08119# If a descriptor is
--     dynamically used with a 'Vulkan.Core10.Handles.Pipeline' created
--     with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT',
--     the descriptor memory /must/ be resident
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08605# If a descriptor is
--     dynamically used with a 'Vulkan.Extensions.Handles.ShaderEXT'
--     created with a 'Vulkan.Core10.Handles.DescriptorSetLayout' that was
--     created with
--     'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_DESCRIPTOR_BUFFER_BIT_EXT',
--     the descriptor memory /must/ be resident
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08606# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderObject shaderObject>
--     feature is not enabled, a valid pipeline /must/ be bound to the
--     pipeline bind point used by this command
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08607# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderObject shaderObject>
--     is enabled, either a valid pipeline /must/ be bound to the pipeline
--     bind point used by this command, or a valid combination of valid and
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' shader objects /must/ be
--     bound to every supported shader stage corresponding to the pipeline
--     bind point used by this command
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08608# If a pipeline is
--     bound to the pipeline bind point used by this command, there /must/
--     not have been any calls to dynamic state setting commands for any
--     state not specified as dynamic in the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command, since that pipeline was bound
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08609# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command or any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used to sample from any
--     'Vulkan.Core10.Handles.Image' with a
--     'Vulkan.Core10.Handles.ImageView' of the type
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D_ARRAY',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY', in
--     any shader stage
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08610# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command or any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions with
--     @ImplicitLod@, @Dref@ or @Proj@ in their name, in any shader stage
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08611# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command or any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions that
--     includes a LOD bias or any offset values, in any shader stage
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-uniformBuffers-06935# If any
--     stage of the 'Vulkan.Core10.Handles.Pipeline' object bound to the
--     pipeline bind point used by this command accesses a uniform buffer,
--     and that stage was created without enabling either
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_EXT'
--     or
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_2_EXT'
--     for @uniformBuffers@, and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, that stage /must/ not access values outside
--     of the range of the buffer as specified in the descriptor set bound
--     to the same pipeline bind point
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08612# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, and any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a uniform
--     buffer, it /must/ not access values outside of the range of the
--     buffer as specified in the descriptor set bound to the same pipeline
--     bind point
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-storageBuffers-06936# If any
--     stage of the 'Vulkan.Core10.Handles.Pipeline' object bound to the
--     pipeline bind point used by this command accesses a storage buffer,
--     and that stage was created without enabling either
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_EXT'
--     or
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_2_EXT'
--     for @storageBuffers@, and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, that stage /must/ not access values outside
--     of the range of the buffer as specified in the descriptor set bound
--     to the same pipeline bind point
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-08613# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, and any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a storage
--     buffer, it /must/ not access values outside of the range of the
--     buffer as specified in the descriptor set bound to the same pipeline
--     bind point
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-commandBuffer-02707# If
--     @commandBuffer@ is an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, any resource accessed by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding bound shaders>
--     /must/ not be a protected resource
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-06550# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>
--     accesses a 'Vulkan.Core10.Handles.Sampler' or
--     'Vulkan.Core10.Handles.ImageView' object that enables
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>,
--     that object /must/ only be used with @OpImageSample*@ or
--     @OpImageSparseSample*@ instructions
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-ConstOffset-06551# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>
--     accesses a 'Vulkan.Core10.Handles.Sampler' or
--     'Vulkan.Core10.Handles.ImageView' object that enables
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>,
--     that object /must/ not use the @ConstOffset@ and @Offset@ operands
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-viewType-07752# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed as a result of this
--     command, then the image view’s @viewType@ /must/ match the @Dim@
--     operand of the @OpTypeImage@ as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-operation-validation ???>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-format-07753# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed as a result of this
--     command, then the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-numericformat numeric type>
--     of the image view’s @format@ and the @Sampled@ @Type@ operand of the
--     @OpTypeImage@ /must/ match
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageWrite-08795# If a
--     'Vulkan.Core10.Handles.ImageView' created with a format other than
--     'Vulkan.Core10.Enums.Format.FORMAT_A8_UNORM_KHR' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have at least as many
--     components as the image view’s format
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageWrite-08796# If a
--     'Vulkan.Core10.Handles.ImageView' created with the format
--     'Vulkan.Core10.Enums.Format.FORMAT_A8_UNORM_KHR' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have four components
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageWrite-04469# If a
--     'Vulkan.Core10.Handles.BufferView' is accessed using @OpImageWrite@
--     as a result of this command, then the @Type@ of the @Texel@ operand
--     of that instruction /must/ have at least as many components as the
--     buffer view’s format
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-SampledType-04470# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-SampledType-04471# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-SampledType-04472# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-SampledType-04473# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-sparseImageInt64Atomics-04474#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Image' objects
--     created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-sparseImageInt64Atomics-04475#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Buffer' objects
--     created with the
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageWeightedSampleQCOM-06971#
--     If @OpImageWeightedSampleQCOM@ is used to sample a
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_WEIGHT_SAMPLED_IMAGE_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageWeightedSampleQCOM-06972#
--     If @OpImageWeightedSampleQCOM@ uses a
--     'Vulkan.Core10.Handles.ImageView' as a sample weight image as a
--     result of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_WEIGHT_IMAGE_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageBoxFilterQCOM-06973# If
--     @OpImageBoxFilterQCOM@ is used to sample a
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BOX_FILTER_SAMPLED_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageBlockMatchSSDQCOM-06974#
--     If @OpImageBlockMatchSSDQCOM@ is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BLOCK_MATCHING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageBlockMatchSADQCOM-06975#
--     If @OpImageBlockMatchSADQCOM@ is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BLOCK_MATCHING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageBlockMatchSADQCOM-06976#
--     If @OpImageBlockMatchSADQCOM@ or OpImageBlockMatchSSDQCOM is used to
--     read from a reference image as result of this command, then the
--     specified reference coordinates /must/ not fail
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-integer-coordinate-validation integer texel coordinate validation>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageWeightedSampleQCOM-06977#
--     If @OpImageWeightedSampleQCOM@, @OpImageBoxFilterQCOM@,
--     @OpImageBlockMatchWindowSSDQCOM@, @OpImageBlockMatchWindowSADQCOM@,
--     @OpImageBlockMatchGatherSSDQCOM@, @OpImageBlockMatchGatherSADQCOM@,
--     @OpImageBlockMatchSSDQCOM@, or @OpImageBlockMatchSADQCOM@ uses a
--     'Vulkan.Core10.Handles.Sampler' as a result of this command, then
--     the sampler /must/ have been created with
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_IMAGE_PROCESSING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageWeightedSampleQCOM-06978#
--     If any command other than @OpImageWeightedSampleQCOM@,
--     @OpImageBoxFilterQCOM@, @OpImageBlockMatchWindowSSDQCOM@,
--     @OpImageBlockMatchWindowSADQCOM@, @OpImageBlockMatchGatherSSDQCOM@,
--     @OpImageBlockMatchGatherSADQCOM@, @OpImageBlockMatchSSDQCOM@, or
--     @OpImageBlockMatchSADQCOM@ uses a 'Vulkan.Core10.Handles.Sampler' as
--     a result of this command, then the sampler /must/ not have been
--     created with
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_IMAGE_PROCESSING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageBlockMatchWindow-09215#
--     If a @OpImageBlockMatchWindow*QCOM@ or
--     @OpImageBlockMatchGather*QCOM@ instruction is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BLOCK_MATCHING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageBlockMatchWindow-09216#
--     If a @OpImageBlockMatchWindow*QCOM@ or
--     @OpImageBlockMatchGather*QCOM@ instruction is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s format /must/ be a single-component format.
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-OpImageBlockMatchWindow-09217#
--     If a @OpImageBlockMatchWindow*QCOM@ or
--     @OpImageBlockMatchGather*QCOM@ read from a reference image as result
--     of this command, then the specified reference coordinates /must/ not
--     fail
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-integer-coordinate-validation integer texel coordinate validation>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-None-07288# Any shader
--     invocation executed by this command /must/
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-termination terminate>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-commandBuffer-09181#
--     @commandBuffer@ /must/ not be a protected command buffer
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-commandBuffer-09182#
--     @commandBuffer@ /must/ be a primary command buffer
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-scratch-09183# @scratch@ /must/
--     be the device address of an allocated memory range at least as large
--     as the value of 'ExecutionGraphPipelineScratchSizeAMDX'::@size@
--     returned by 'ExecutionGraphPipelineScratchSizeAMDX' for the
--     currently bound execution graph pipeline
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-scratch-09184# @scratch@ /must/
--     be a device address within a 'Vulkan.Core10.Handles.Buffer' created
--     with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_EXECUTION_GRAPH_SCRATCH_BIT_AMDX'
--     or 'BUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX' flag
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-scratch-09185# Device memory in
--     the range [@scratch@,@scratch@
--     'ExecutionGraphPipelineScratchSizeAMDX'::@size@) /must/ have been
--     initialized with 'cmdInitializeGraphScratchMemoryAMDX' using the
--     currently bound execution graph pipeline, and not modified after
--     that by anything other than another execution graph dispatch command
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-maxComputeWorkGroupCount-09186#
--     Execution of this command /must/ not cause a node to be dispatched
--     with a larger number of workgroups than that specified by either a
--     @MaxNumWorkgroupsAMDX@ decoration in the dispatched node or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxComputeWorkGroupCount maxComputeWorkGroupCount>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-maxExecutionGraphShaderPayloadCount-09187#
--     Execution of this command /must/ not cause any shader to initialize
--     more than
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxExecutionGraphShaderPayloadCount maxExecutionGraphShaderPayloadCount>
--     output payloads
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-NodeMaxPayloadsAMDX-09188#
--     Execution of this command /must/ not cause any shader that declares
--     @NodeMaxPayloadsAMDX@ to initialize more output payloads than
--     specified by the max number of payloads for that decoration. This
--     requirement applies to each @NodeMaxPayloadsAMDX@ decoration
--     separately
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-pCountInfo-09150#
--     @pCountInfo->infos@ /must/ be a device pointer to a memory
--     allocation at least as large as the product of @count@ and @stride@
--     when this command is executed on the device
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-pCountInfo-09151#
--     @pCountInfo->infos@ /must/ be a device address within a
--     'Vulkan.Core10.Handles.Buffer' created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_INDIRECT_BUFFER_BIT'
--     flag
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-pCountInfo-09152#
--     @pCountInfo->infos@ /must/ be a multiple of
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-executionGraphDispatchAddressAlignment executionGraphDispatchAddressAlignment>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-infos-09153# Device memory
--     locations at indexes in the range [@infos@, @infos@ +
--     (@count@*@stride@)), at a granularity of @stride@ /must/ contain
--     valid 'DispatchGraphInfoAMDX' structures in the first 24 bytes when
--     this command is executed on the device
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-pCountInfo-09154# For each
--     'DispatchGraphInfoAMDX' structure in @pCountInfo->infos@, @payloads@
--     /must/ be a device pointer to a memory allocation at least as large
--     as the product of @payloadCount@ and @payloadStride@ when this
--     command is executed on the device
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-pCountInfo-09155# For each
--     'DispatchGraphInfoAMDX' structure in @pCountInfo->infos@, @payloads@
--     /must/ be a device address within a 'Vulkan.Core10.Handles.Buffer'
--     created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_INDIRECT_BUFFER_BIT'
--     flag
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-pCountInfo-09156# For each
--     'DispatchGraphInfoAMDX' structure in @pCountInfo->infos@, @payloads@
--     /must/ be a multiple of
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-executionGraphDispatchAddressAlignment executionGraphDispatchAddressAlignment>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-pCountInfo-09157# For each
--     'DispatchGraphInfoAMDX' structure in @pCountInfo->infos@,
--     @nodeIndex@ /must/ be a valid node index in the currently bound
--     execution graph pipeline, as returned by
--     'getExecutionGraphPipelineNodeIndexAMDX' when this command is
--     executed on the device
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-pCountInfo-09158# For each
--     'DispatchGraphInfoAMDX' structure in @pCountInfo->infos@, device
--     memory locations at indexes in the range [@payloads@, @payloads@ +
--     (@payloadCount@ * @payloadStride@)), at a granularity of
--     @payloadStride@ /must/ contain a payload matching the size of the
--     input payload expected by the node in @nodeIndex@ in the first bytes
--     when this command is executed on the device
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-pCountInfo-parameter#
--     @pCountInfo@ /must/ be a valid pointer to a valid
--     'DispatchGraphCountInfoAMDX' structure
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-commandBuffer-recording#
--     @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics, or compute operations
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-renderpass# This command /must/
--     only be called outside of a render pass instance
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-videocoding# This command
--     /must/ only be called outside of a video coding scope
--
-- -   #VUID-vkCmdDispatchGraphIndirectAMDX-bufferlevel# @commandBuffer@
--     /must/ be a primary 'Vulkan.Core10.Handles.CommandBuffer'
--
-- == Host Synchronization
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Graphics                                                                                                              | Action                                                                                                                                 |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress',
-- 'DispatchGraphCountInfoAMDX'
cmdDispatchGraphIndirectAMDX :: forall io
                              . (MonadIO io)
                             => -- | @commandBuffer@ is the command buffer into which the command will be
                                -- recorded.
                                CommandBuffer
                             -> -- | @scratch@ is a pointer to the scratch memory to be used.
                                ("scratch" ::: DeviceAddress)
                             -> -- | @pCountInfo@ is a host pointer to a 'DispatchGraphCountInfoAMDX'
                                -- structure defining the nodes which will be initially executed.
                                DispatchGraphCountInfoAMDX
                             -> io ()
cmdDispatchGraphIndirectAMDX :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> Flags64 -> DispatchGraphCountInfoAMDX -> io ()
cmdDispatchGraphIndirectAMDX CommandBuffer
commandBuffer
                               Flags64
scratch
                               DispatchGraphCountInfoAMDX
countInfo = 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 vkCmdDispatchGraphIndirectAMDXPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> Flags64
   -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
   -> IO ())
vkCmdDispatchGraphIndirectAMDXPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> Flags64
      -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
      -> IO ())
pVkCmdDispatchGraphIndirectAMDX (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  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 CommandBuffer_T
   -> Flags64
   -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
   -> IO ())
vkCmdDispatchGraphIndirectAMDXPtr 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 vkCmdDispatchGraphIndirectAMDX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCmdDispatchGraphIndirectAMDX' :: Ptr CommandBuffer_T
-> Flags64
-> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
-> IO ()
vkCmdDispatchGraphIndirectAMDX' = FunPtr
  (Ptr CommandBuffer_T
   -> Flags64
   -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
   -> IO ())
-> Ptr CommandBuffer_T
-> Flags64
-> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
-> IO ()
mkVkCmdDispatchGraphIndirectAMDX FunPtr
  (Ptr CommandBuffer_T
   -> Flags64
   -> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
   -> IO ())
vkCmdDispatchGraphIndirectAMDXPtr
  "pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
pCountInfo <- 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 => a -> (Ptr a -> IO b) -> IO b
withCStruct (DispatchGraphCountInfoAMDX
countInfo)
  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
"vkCmdDispatchGraphIndirectAMDX" (Ptr CommandBuffer_T
-> Flags64
-> ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
-> IO ()
vkCmdDispatchGraphIndirectAMDX'
                                                              (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                              (Flags64
scratch)
                                                              "pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
pCountInfo)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdDispatchGraphIndirectCountAMDX
  :: FunPtr (Ptr CommandBuffer_T -> DeviceAddress -> DeviceAddress -> IO ()) -> Ptr CommandBuffer_T -> DeviceAddress -> DeviceAddress -> IO ()

-- | vkCmdDispatchGraphIndirectCountAMDX - Dispatch an execution graph with
-- all parameters read on the device
--
-- = Description
--
-- When this command is executed, the nodes specified in @countInfo@ are
-- executed. Nodes executed as part of this command are not implicitly
-- synchronized in any way against each other once they are dispatched.
--
-- For this command, all pointers in substructures are treated as device
-- pointers and read during device execution of this command. The
-- allocation and contents of these pointers only needs to be valid during
-- device execution. All of these addresses will be read in the
-- 'Vulkan.Core13.Enums.PipelineStageFlags2.PIPELINE_STAGE_2_COMPUTE_SHADER_BIT'
-- pipeline stage with the
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_READ_BIT'
-- access flag.
--
-- Execution of this command /may/ modify any memory locations in the range
-- [@scratch@,@scratch@ + @size@), where @size@ is the value returned in
-- 'ExecutionGraphPipelineScratchSizeAMDX'::@size@ by
-- 'ExecutionGraphPipelineScratchSizeAMDX' for the currently bound
-- execution graph pipeline. Accesses to this memory range are performed in
-- the
-- 'Vulkan.Core13.Enums.PipelineStageFlags2.PIPELINE_STAGE_2_COMPUTE_SHADER_BIT'
-- pipeline stage with the
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_READ_BIT' and
-- 'Vulkan.Core13.Enums.AccessFlags2.ACCESS_2_SHADER_STORAGE_WRITE_BIT'
-- access flags.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-magFilter-04553# If a
--     'Vulkan.Core10.Handles.Sampler' created with @magFilter@ or
--     @minFilter@ equal to 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' and
--     @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE' is
--     used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-mipmapMode-04770# If a
--     'Vulkan.Core10.Handles.Sampler' created with @mipmapMode@ equal to
--     'Vulkan.Core10.Enums.SamplerMipmapMode.SAMPLER_MIPMAP_MODE_LINEAR'
--     and @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE'
--     is used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-06479# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-depth-compare-operation depth comparison>,
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_SAMPLED_IMAGE_DEPTH_COMPARISON_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-02691# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed using atomic
--     operations as a result of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_IMAGE_ATOMIC_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-07888# If a
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER'
--     descriptor is accessed using atomic operations as a result of this
--     command, then the storage texel buffer’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-buffer-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_TEXEL_BUFFER_ATOMIC_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-02692# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as a result of this
--     command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_CUBIC_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-02693# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_filter_cubic VK_EXT_filter_cubic>
--     extension is not enabled and any 'Vulkan.Core10.Handles.ImageView'
--     is sampled with 'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as a
--     result of this command, it /must/ not have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' of
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE', or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-filterCubic-02694# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as a result of this
--     command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering, as specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubic@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-filterCubicMinmax-02695#
--     Any 'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' with a reduction mode
--     of either
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MIN'
--     or
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MAX'
--     as a result of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering together with minmax filtering, as
--     specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubicMinmax@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-cubicRangeClamp-09212# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-filter-cubic-range-clamp cubicRangeClamp>
--     feature is not enabled, then any 'Vulkan.Core10.Handles.ImageView'
--     being sampled with 'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as
--     a result of this command /must/ not have a
--     'Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax.SamplerReductionModeCreateInfo'::@reductionMode@
--     equal to
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_WEIGHTED_AVERAGE_RANGECLAMP_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-reductionMode-09213# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with a
--     'Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax.SamplerReductionModeCreateInfo'::@reductionMode@
--     equal to
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_WEIGHTED_AVERAGE_RANGECLAMP_QCOM'
--     as a result of this command /must/ sample with
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-selectableCubicWeights-09214#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-filter-cubic-weight-selection selectableCubicWeights>
--     feature is not enabled, then any 'Vulkan.Core10.Handles.ImageView'
--     being sampled with 'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT' as
--     a result of this command /must/ have
--     'Vulkan.Extensions.VK_QCOM_filter_cubic_weights.SamplerCubicWeightsCreateInfoQCOM'::@cubicWeights@
--     equal to
--     'Vulkan.Extensions.VK_QCOM_filter_cubic_weights.CUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-flags-02696# Any
--     'Vulkan.Core10.Handles.Image' created with a
--     'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CORNER_SAMPLED_BIT_NV'
--     sampled as a result of this command /must/ only be sampled using a
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' of
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpTypeImage-07027# For any
--     'Vulkan.Core10.Handles.ImageView' being written as a storage image
--     where the image format field of the @OpTypeImage@ is @Unknown@, the
--     view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_WRITE_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpTypeImage-07028# For any
--     'Vulkan.Core10.Handles.ImageView' being read as a storage image
--     where the image format field of the @OpTypeImage@ is @Unknown@, the
--     view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_READ_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpTypeImage-07029# For any
--     'Vulkan.Core10.Handles.BufferView' being written as a storage texel
--     buffer where the image format field of the @OpTypeImage@ is
--     @Unknown@, the view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkFormatProperties3 buffer features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_WRITE_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpTypeImage-07030# Any
--     'Vulkan.Core10.Handles.BufferView' being read as a storage texel
--     buffer where the image format field of the @OpTypeImage@ is
--     @Unknown@ then the view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkFormatProperties3 buffer features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_STORAGE_READ_WITHOUT_FORMAT_BIT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08600# For each set
--     /n/ that is statically used by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>,
--     a descriptor set /must/ have been bound to /n/ at the same pipeline
--     bind point, with a 'Vulkan.Core10.Handles.PipelineLayout' that is
--     compatible for set /n/, with the
--     'Vulkan.Core10.Handles.PipelineLayout' or
--     'Vulkan.Core10.Handles.DescriptorSetLayout' array that was used to
--     create the current 'Vulkan.Core10.Handles.Pipeline' or
--     'Vulkan.Extensions.Handles.ShaderEXT', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08601# For each push
--     constant that is statically used by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>,
--     a push constant value /must/ have been set for the same pipeline
--     bind point, with a 'Vulkan.Core10.Handles.PipelineLayout' that is
--     compatible for push constants, with the
--     'Vulkan.Core10.Handles.PipelineLayout' or
--     'Vulkan.Core10.Handles.DescriptorSetLayout' and
--     'Vulkan.Core10.PipelineLayout.PushConstantRange' arrays used to
--     create the current 'Vulkan.Core10.Handles.Pipeline' or
--     'Vulkan.Extensions.Handles.ShaderEXT', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-maintenance4-08602# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-maintenance4 maintenance4>
--     feature is not enabled, then for each push constant that is
--     statically used by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>,
--     a push constant value /must/ have been set for the same pipeline
--     bind point, with a 'Vulkan.Core10.Handles.PipelineLayout' that is
--     compatible for push constants, with the
--     'Vulkan.Core10.Handles.PipelineLayout' or
--     'Vulkan.Core10.Handles.DescriptorSetLayout' and
--     'Vulkan.Core10.PipelineLayout.PushConstantRange' arrays used to
--     create the current 'Vulkan.Core10.Handles.Pipeline' or
--     'Vulkan.Extensions.Handles.ShaderEXT', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08114# Descriptors in
--     each bound descriptor set, specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', /must/
--     be valid if they are statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command and the bound 'Vulkan.Core10.Handles.Pipeline'
--     was not created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08115# If the
--     descriptors used by the 'Vulkan.Core10.Handles.Pipeline' bound to
--     the pipeline bind point were specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', the
--     bound 'Vulkan.Core10.Handles.Pipeline' /must/ have been created
--     without
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08116# Descriptors in
--     bound descriptor buffers, specified via
--     'Vulkan.Extensions.VK_EXT_descriptor_buffer.cmdSetDescriptorBufferOffsetsEXT',
--     /must/ be valid if they are dynamically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command and the bound 'Vulkan.Core10.Handles.Pipeline'
--     was created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08604# Descriptors in
--     bound descriptor buffers, specified via
--     'Vulkan.Extensions.VK_EXT_descriptor_buffer.cmdSetDescriptorBufferOffsetsEXT',
--     /must/ be valid if they are dynamically used by any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08117# If the
--     descriptors used by the 'Vulkan.Core10.Handles.Pipeline' bound to
--     the pipeline bind point were specified via
--     'Vulkan.Extensions.VK_EXT_descriptor_buffer.cmdSetDescriptorBufferOffsetsEXT',
--     the bound 'Vulkan.Core10.Handles.Pipeline' /must/ have been created
--     with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08119# If a
--     descriptor is dynamically used with a
--     'Vulkan.Core10.Handles.Pipeline' created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DESCRIPTOR_BUFFER_BIT_EXT',
--     the descriptor memory /must/ be resident
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08605# If a
--     descriptor is dynamically used with a
--     'Vulkan.Extensions.Handles.ShaderEXT' created with a
--     'Vulkan.Core10.Handles.DescriptorSetLayout' that was created with
--     'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_DESCRIPTOR_BUFFER_BIT_EXT',
--     the descriptor memory /must/ be resident
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08606# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderObject shaderObject>
--     feature is not enabled, a valid pipeline /must/ be bound to the
--     pipeline bind point used by this command
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08607# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderObject shaderObject>
--     is enabled, either a valid pipeline /must/ be bound to the pipeline
--     bind point used by this command, or a valid combination of valid and
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' shader objects /must/ be
--     bound to every supported shader stage corresponding to the pipeline
--     bind point used by this command
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08608# If a pipeline
--     is bound to the pipeline bind point used by this command, there
--     /must/ not have been any calls to dynamic state setting commands for
--     any state not specified as dynamic in the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command, since that pipeline was bound
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08609# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command or any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used to sample from any
--     'Vulkan.Core10.Handles.Image' with a
--     'Vulkan.Core10.Handles.ImageView' of the type
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D_ARRAY',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY', in
--     any shader stage
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08610# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command or any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions with
--     @ImplicitLod@, @Dref@ or @Proj@ in their name, in any shader stage
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08611# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command or any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions that
--     includes a LOD bias or any offset values, in any shader stage
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-uniformBuffers-06935# If
--     any stage of the 'Vulkan.Core10.Handles.Pipeline' object bound to
--     the pipeline bind point used by this command accesses a uniform
--     buffer, and that stage was created without enabling either
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_EXT'
--     or
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_2_EXT'
--     for @uniformBuffers@, and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, that stage /must/ not access values outside
--     of the range of the buffer as specified in the descriptor set bound
--     to the same pipeline bind point
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08612# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, and any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a uniform
--     buffer, it /must/ not access values outside of the range of the
--     buffer as specified in the descriptor set bound to the same pipeline
--     bind point
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-storageBuffers-06936# If
--     any stage of the 'Vulkan.Core10.Handles.Pipeline' object bound to
--     the pipeline bind point used by this command accesses a storage
--     buffer, and that stage was created without enabling either
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_EXT'
--     or
--     'Vulkan.Extensions.VK_EXT_pipeline_robustness.PIPELINE_ROBUSTNESS_BUFFER_BEHAVIOR_ROBUST_BUFFER_ACCESS_2_EXT'
--     for @storageBuffers@, and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, that stage /must/ not access values outside
--     of the range of the buffer as specified in the descriptor set bound
--     to the same pipeline bind point
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-08613# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robustBufferAccess>
--     feature is not enabled, and any
--     'Vulkan.Extensions.Handles.ShaderEXT' bound to a stage corresponding
--     to the pipeline bind point used by this command accesses a storage
--     buffer, it /must/ not access values outside of the range of the
--     buffer as specified in the descriptor set bound to the same pipeline
--     bind point
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-commandBuffer-02707# If
--     @commandBuffer@ is an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, any resource accessed by
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding bound shaders>
--     /must/ not be a protected resource
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-06550# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>
--     accesses a 'Vulkan.Core10.Handles.Sampler' or
--     'Vulkan.Core10.Handles.ImageView' object that enables
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>,
--     that object /must/ only be used with @OpImageSample*@ or
--     @OpImageSparseSample*@ instructions
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-ConstOffset-06551# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-binding a bound shader>
--     accesses a 'Vulkan.Core10.Handles.Sampler' or
--     'Vulkan.Core10.Handles.ImageView' object that enables
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-YCbCr-conversion sampler Y′CBCR conversion>,
--     that object /must/ not use the @ConstOffset@ and @Offset@ operands
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-viewType-07752# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed as a result of this
--     command, then the image view’s @viewType@ /must/ match the @Dim@
--     operand of the @OpTypeImage@ as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-operation-validation ???>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-format-07753# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed as a result of this
--     command, then the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-numericformat numeric type>
--     of the image view’s @format@ and the @Sampled@ @Type@ operand of the
--     @OpTypeImage@ /must/ match
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageWrite-08795# If a
--     'Vulkan.Core10.Handles.ImageView' created with a format other than
--     'Vulkan.Core10.Enums.Format.FORMAT_A8_UNORM_KHR' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have at least as many
--     components as the image view’s format
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageWrite-08796# If a
--     'Vulkan.Core10.Handles.ImageView' created with the format
--     'Vulkan.Core10.Enums.Format.FORMAT_A8_UNORM_KHR' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have four components
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageWrite-04469# If a
--     'Vulkan.Core10.Handles.BufferView' is accessed using @OpImageWrite@
--     as a result of this command, then the @Type@ of the @Texel@ operand
--     of that instruction /must/ have at least as many components as the
--     buffer view’s format
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-SampledType-04470# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-SampledType-04471# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-SampledType-04472# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-SampledType-04473# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-sparseImageInt64Atomics-04474#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Image' objects
--     created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-sparseImageInt64Atomics-04475#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Buffer' objects
--     created with the
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageWeightedSampleQCOM-06971#
--     If @OpImageWeightedSampleQCOM@ is used to sample a
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_WEIGHT_SAMPLED_IMAGE_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageWeightedSampleQCOM-06972#
--     If @OpImageWeightedSampleQCOM@ uses a
--     'Vulkan.Core10.Handles.ImageView' as a sample weight image as a
--     result of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_WEIGHT_IMAGE_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageBoxFilterQCOM-06973#
--     If @OpImageBoxFilterQCOM@ is used to sample a
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BOX_FILTER_SAMPLED_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageBlockMatchSSDQCOM-06974#
--     If @OpImageBlockMatchSSDQCOM@ is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BLOCK_MATCHING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageBlockMatchSADQCOM-06975#
--     If @OpImageBlockMatchSADQCOM@ is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BLOCK_MATCHING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageBlockMatchSADQCOM-06976#
--     If @OpImageBlockMatchSADQCOM@ or OpImageBlockMatchSSDQCOM is used to
--     read from a reference image as result of this command, then the
--     specified reference coordinates /must/ not fail
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-integer-coordinate-validation integer texel coordinate validation>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageWeightedSampleQCOM-06977#
--     If @OpImageWeightedSampleQCOM@, @OpImageBoxFilterQCOM@,
--     @OpImageBlockMatchWindowSSDQCOM@, @OpImageBlockMatchWindowSADQCOM@,
--     @OpImageBlockMatchGatherSSDQCOM@, @OpImageBlockMatchGatherSADQCOM@,
--     @OpImageBlockMatchSSDQCOM@, or @OpImageBlockMatchSADQCOM@ uses a
--     'Vulkan.Core10.Handles.Sampler' as a result of this command, then
--     the sampler /must/ have been created with
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_IMAGE_PROCESSING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageWeightedSampleQCOM-06978#
--     If any command other than @OpImageWeightedSampleQCOM@,
--     @OpImageBoxFilterQCOM@, @OpImageBlockMatchWindowSSDQCOM@,
--     @OpImageBlockMatchWindowSADQCOM@, @OpImageBlockMatchGatherSSDQCOM@,
--     @OpImageBlockMatchGatherSADQCOM@, @OpImageBlockMatchSSDQCOM@, or
--     @OpImageBlockMatchSADQCOM@ uses a 'Vulkan.Core10.Handles.Sampler' as
--     a result of this command, then the sampler /must/ not have been
--     created with
--     'Vulkan.Core10.Enums.SamplerCreateFlagBits.SAMPLER_CREATE_IMAGE_PROCESSING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageBlockMatchWindow-09215#
--     If a @OpImageBlockMatchWindow*QCOM@ or
--     @OpImageBlockMatchGather*QCOM@ instruction is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_BLOCK_MATCHING_BIT_QCOM'
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageBlockMatchWindow-09216#
--     If a @OpImageBlockMatchWindow*QCOM@ or
--     @OpImageBlockMatchGather*QCOM@ instruction is used to read from an
--     'Vulkan.Core10.Handles.ImageView' as a result of this command, then
--     the image view’s format /must/ be a single-component format.
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-OpImageBlockMatchWindow-09217#
--     If a @OpImageBlockMatchWindow*QCOM@ or
--     @OpImageBlockMatchGather*QCOM@ read from a reference image as result
--     of this command, then the specified reference coordinates /must/ not
--     fail
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-integer-coordinate-validation integer texel coordinate validation>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-None-07288# Any shader
--     invocation executed by this command /must/
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#shaders-termination terminate>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-commandBuffer-09181#
--     @commandBuffer@ /must/ not be a protected command buffer
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-commandBuffer-09182#
--     @commandBuffer@ /must/ be a primary command buffer
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-scratch-09183# @scratch@
--     /must/ be the device address of an allocated memory range at least
--     as large as the value of
--     'ExecutionGraphPipelineScratchSizeAMDX'::@size@ returned by
--     'ExecutionGraphPipelineScratchSizeAMDX' for the currently bound
--     execution graph pipeline
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-scratch-09184# @scratch@
--     /must/ be a device address within a 'Vulkan.Core10.Handles.Buffer'
--     created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_EXECUTION_GRAPH_SCRATCH_BIT_AMDX'
--     or 'BUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX' flag
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-scratch-09185# Device
--     memory in the range [@scratch@,@scratch@
--     'ExecutionGraphPipelineScratchSizeAMDX'::@size@) /must/ have been
--     initialized with 'cmdInitializeGraphScratchMemoryAMDX' using the
--     currently bound execution graph pipeline, and not modified after
--     that by anything other than another execution graph dispatch command
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-maxComputeWorkGroupCount-09186#
--     Execution of this command /must/ not cause a node to be dispatched
--     with a larger number of workgroups than that specified by either a
--     @MaxNumWorkgroupsAMDX@ decoration in the dispatched node or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxComputeWorkGroupCount maxComputeWorkGroupCount>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-maxExecutionGraphShaderPayloadCount-09187#
--     Execution of this command /must/ not cause any shader to initialize
--     more than
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxExecutionGraphShaderPayloadCount maxExecutionGraphShaderPayloadCount>
--     output payloads
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-NodeMaxPayloadsAMDX-09188#
--     Execution of this command /must/ not cause any shader that declares
--     @NodeMaxPayloadsAMDX@ to initialize more output payloads than
--     specified by the max number of payloads for that decoration. This
--     requirement applies to each @NodeMaxPayloadsAMDX@ decoration
--     separately
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09159#
--     @countInfo@ /must/ be a device pointer to a memory allocation
--     containing a valid 'DispatchGraphCountInfoAMDX' structure when this
--     command is executed on the device
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09160#
--     @countInfo@ /must/ be a device address within a
--     'Vulkan.Core10.Handles.Buffer' created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_INDIRECT_BUFFER_BIT'
--     flag
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09161#
--     @countInfo@ /must/ be a multiple of
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-executionGraphDispatchAddressAlignment executionGraphDispatchAddressAlignment>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09162#
--     @countInfo->infos@ /must/ be a device pointer to a memory allocation
--     at least as large as the product of @count@ and @stride@ when this
--     command is executed on the device
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09163#
--     @countInfo->infos@ /must/ be a device address within a
--     'Vulkan.Core10.Handles.Buffer' created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_INDIRECT_BUFFER_BIT'
--     flag
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09164#
--     @countInfo->infos@ /must/ be a multiple of
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-executionGraphDispatchAddressAlignment executionGraphDispatchAddressAlignment>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-infos-09165# Device memory
--     locations at indexes in the range [@infos@, @infos@ +
--     (@count@*@stride@)), at a granularity of @stride@ /must/ contain
--     valid 'DispatchGraphInfoAMDX' structures in the first 24 bytes when
--     this command is executed on the device
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09166# For each
--     'DispatchGraphInfoAMDX' structure in @countInfo->infos@, @payloads@
--     /must/ be a device pointer to a memory allocation at least as large
--     as the product of @payloadCount@ and @payloadStride@ when this
--     command is executed on the device
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09167# For each
--     'DispatchGraphInfoAMDX' structure in @countInfo->infos@, @payloads@
--     /must/ be a device address within a 'Vulkan.Core10.Handles.Buffer'
--     created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_INDIRECT_BUFFER_BIT'
--     flag
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09168# For each
--     'DispatchGraphInfoAMDX' structure in @countInfo->infos@, @payloads@
--     /must/ be a multiple of
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-executionGraphDispatchAddressAlignment executionGraphDispatchAddressAlignment>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09169# For each
--     'DispatchGraphInfoAMDX' structure in @countInfo->infos@, @nodeIndex@
--     /must/ be a valid node index in the currently bound execution graph
--     pipeline, as returned by 'getExecutionGraphPipelineNodeIndexAMDX'
--     when this command is executed on the device
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-countInfo-09170# For each
--     'DispatchGraphInfoAMDX' structure in @countInfo->infos@, device
--     memory locations at indexes in the range [@payloads@, @payloads@ +
--     (@payloadCount@ * @payloadStride@)), at a granularity of
--     @payloadStride@ /must/ contain a payload matching the size of the
--     input payload expected by the node in @nodeIndex@ in the first bytes
--     when this command is executed on the device
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-commandBuffer-recording#
--     @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics, or compute operations
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-renderpass# This command
--     /must/ only be called outside of a render pass instance
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-videocoding# This command
--     /must/ only be called outside of a video coding scope
--
-- -   #VUID-vkCmdDispatchGraphIndirectCountAMDX-bufferlevel#
--     @commandBuffer@ /must/ be a primary
--     'Vulkan.Core10.Handles.CommandBuffer'
--
-- == Host Synchronization
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Graphics                                                                                                              | Action                                                                                                                                 |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress'
cmdDispatchGraphIndirectCountAMDX :: forall io
                                   . (MonadIO io)
                                  => -- | @commandBuffer@ is the command buffer into which the command will be
                                     -- recorded.
                                     CommandBuffer
                                  -> -- | @scratch@ is a pointer to the scratch memory to be used.
                                     ("scratch" ::: DeviceAddress)
                                  -> -- | @countInfo@ is a device address of a 'DispatchGraphCountInfoAMDX'
                                     -- structure defining the nodes which will be initially executed.
                                     ("countInfo" ::: DeviceAddress)
                                  -> io ()
cmdDispatchGraphIndirectCountAMDX :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> Flags64 -> Flags64 -> io ()
cmdDispatchGraphIndirectCountAMDX CommandBuffer
commandBuffer Flags64
scratch Flags64
countInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  let vkCmdDispatchGraphIndirectCountAMDXPtr :: FunPtr (Ptr CommandBuffer_T -> Flags64 -> Flags64 -> IO ())
vkCmdDispatchGraphIndirectCountAMDXPtr = DeviceCmds
-> FunPtr (Ptr CommandBuffer_T -> Flags64 -> Flags64 -> IO ())
pVkCmdDispatchGraphIndirectCountAMDX (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr CommandBuffer_T -> Flags64 -> Flags64 -> IO ())
vkCmdDispatchGraphIndirectCountAMDXPtr 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 vkCmdDispatchGraphIndirectCountAMDX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCmdDispatchGraphIndirectCountAMDX' :: Ptr CommandBuffer_T -> Flags64 -> Flags64 -> IO ()
vkCmdDispatchGraphIndirectCountAMDX' = FunPtr (Ptr CommandBuffer_T -> Flags64 -> Flags64 -> IO ())
-> Ptr CommandBuffer_T -> Flags64 -> Flags64 -> IO ()
mkVkCmdDispatchGraphIndirectCountAMDX FunPtr (Ptr CommandBuffer_T -> Flags64 -> Flags64 -> IO ())
vkCmdDispatchGraphIndirectCountAMDXPtr
  forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdDispatchGraphIndirectCountAMDX" (Ptr CommandBuffer_T -> Flags64 -> Flags64 -> IO ()
vkCmdDispatchGraphIndirectCountAMDX'
                                                            (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                            (Flags64
scratch)
                                                            (Flags64
countInfo))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


-- | VkPhysicalDeviceShaderEnqueuePropertiesAMDX - Structure describing
-- shader enqueue limits of an implementation
--
-- = Members
--
-- The members of the 'PhysicalDeviceShaderEnqueuePropertiesAMDX' structure
-- describe the following limits:
--
-- = Description
--
-- If the 'PhysicalDeviceShaderEnqueuePropertiesAMDX' 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_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceShaderEnqueuePropertiesAMDX = PhysicalDeviceShaderEnqueuePropertiesAMDX
  { -- | #limits-maxExecutionGraphDepth# @maxExecutionGraphDepth@ defines the
    -- maximum node chain depth in the graph. The dispatched node is at depth 1
    -- and the node enqueued by it is at depth 2, and so on. If a node enqueues
    -- itself, each recursive enqueue increases the depth by 1 as well.
    PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
maxExecutionGraphDepth :: Word32
  , -- | #limits-maxExecutionGraphShaderOutputNodes#
    -- @maxExecutionGraphShaderOutputNodes@ specifies the maximum number of
    -- unique nodes that can be dispatched from a single shader, and must be at
    -- least 256.
    PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
maxExecutionGraphShaderOutputNodes :: Word32
  , -- | #limits-maxExecutionGraphShaderPayloadSize#
    -- @maxExecutionGraphShaderPayloadSize@ specifies the maximum total size of
    -- payload declarations in a shader. For any payload declarations that
    -- share resources, indicated by @NodeSharesPayloadLimitsWithAMDX@
    -- decorations, the maximum size of each set of shared payload declarations
    -- is taken. The sum of each shared set’s maximum size and the size of each
    -- unshared payload is counted against this limit.
    PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadSize :: Word32
  , -- | #limits-maxExecutionGraphShaderPayloadCount#
    -- @maxExecutionGraphShaderPayloadCount@ specifies the maximum number of
    -- output payloads that can be initialized in a single workgroup.
    PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadCount :: Word32
  , -- | #limits-executionGraphDispatchAddressAlignment#
    -- @executionGraphDispatchAddressAlignment@ specifies the alignment of
    -- non-scratch 'Vulkan.Core10.FundamentalTypes.DeviceAddress' arguments
    -- consumed by graph dispatch commands.
    PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
executionGraphDispatchAddressAlignment :: Word32
  }
  deriving (Typeable, PhysicalDeviceShaderEnqueuePropertiesAMDX
-> PhysicalDeviceShaderEnqueuePropertiesAMDX -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceShaderEnqueuePropertiesAMDX
-> PhysicalDeviceShaderEnqueuePropertiesAMDX -> Bool
$c/= :: PhysicalDeviceShaderEnqueuePropertiesAMDX
-> PhysicalDeviceShaderEnqueuePropertiesAMDX -> Bool
== :: PhysicalDeviceShaderEnqueuePropertiesAMDX
-> PhysicalDeviceShaderEnqueuePropertiesAMDX -> Bool
$c== :: PhysicalDeviceShaderEnqueuePropertiesAMDX
-> PhysicalDeviceShaderEnqueuePropertiesAMDX -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceShaderEnqueuePropertiesAMDX)
#endif
deriving instance Show PhysicalDeviceShaderEnqueuePropertiesAMDX

instance ToCStruct PhysicalDeviceShaderEnqueuePropertiesAMDX where
  withCStruct :: forall b.
PhysicalDeviceShaderEnqueuePropertiesAMDX
-> (Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX -> IO b) -> IO b
withCStruct PhysicalDeviceShaderEnqueuePropertiesAMDX
x Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p PhysicalDeviceShaderEnqueuePropertiesAMDX
x (Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX -> IO b
f Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
-> PhysicalDeviceShaderEnqueuePropertiesAMDX -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p PhysicalDeviceShaderEnqueuePropertiesAMDX{"nodeIndex" ::: Word32
executionGraphDispatchAddressAlignment :: "nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadCount :: "nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadSize :: "nodeIndex" ::: Word32
maxExecutionGraphShaderOutputNodes :: "nodeIndex" ::: Word32
maxExecutionGraphDepth :: "nodeIndex" ::: Word32
$sel:executionGraphDispatchAddressAlignment:PhysicalDeviceShaderEnqueuePropertiesAMDX :: PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
$sel:maxExecutionGraphShaderPayloadCount:PhysicalDeviceShaderEnqueuePropertiesAMDX :: PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
$sel:maxExecutionGraphShaderPayloadSize:PhysicalDeviceShaderEnqueuePropertiesAMDX :: PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
$sel:maxExecutionGraphShaderOutputNodes:PhysicalDeviceShaderEnqueuePropertiesAMDX :: PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
$sel:maxExecutionGraphDepth:PhysicalDeviceShaderEnqueuePropertiesAMDX :: PhysicalDeviceShaderEnqueuePropertiesAMDX -> "nodeIndex" ::: Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_ENQUEUE_PROPERTIES_AMDX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
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 PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("nodeIndex" ::: Word32
maxExecutionGraphDepth)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("nodeIndex" ::: Word32
maxExecutionGraphShaderOutputNodes)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) ("nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadSize)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) ("nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadCount)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) ("nodeIndex" ::: Word32
executionGraphDispatchAddressAlignment)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_ENQUEUE_PROPERTIES_AMDX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
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 PhysicalDeviceShaderEnqueuePropertiesAMDX
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 ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
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 ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
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 ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PhysicalDeviceShaderEnqueuePropertiesAMDX where
  peekCStruct :: Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
-> IO PhysicalDeviceShaderEnqueuePropertiesAMDX
peekCStruct Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p = do
    "nodeIndex" ::: Word32
maxExecutionGraphDepth <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    "nodeIndex" ::: Word32
maxExecutionGraphShaderOutputNodes <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    "nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    "nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    "nodeIndex" ::: Word32
executionGraphDispatchAddressAlignment <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ("nodeIndex" ::: Word32)
-> ("nodeIndex" ::: Word32)
-> ("nodeIndex" ::: Word32)
-> ("nodeIndex" ::: Word32)
-> ("nodeIndex" ::: Word32)
-> PhysicalDeviceShaderEnqueuePropertiesAMDX
PhysicalDeviceShaderEnqueuePropertiesAMDX
             "nodeIndex" ::: Word32
maxExecutionGraphDepth
             "nodeIndex" ::: Word32
maxExecutionGraphShaderOutputNodes
             "nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadSize
             "nodeIndex" ::: Word32
maxExecutionGraphShaderPayloadCount
             "nodeIndex" ::: Word32
executionGraphDispatchAddressAlignment

instance Storable PhysicalDeviceShaderEnqueuePropertiesAMDX where
  sizeOf :: PhysicalDeviceShaderEnqueuePropertiesAMDX -> Int
sizeOf ~PhysicalDeviceShaderEnqueuePropertiesAMDX
_ = Int
40
  alignment :: PhysicalDeviceShaderEnqueuePropertiesAMDX -> Int
alignment ~PhysicalDeviceShaderEnqueuePropertiesAMDX
_ = Int
8
  peek :: Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
-> IO PhysicalDeviceShaderEnqueuePropertiesAMDX
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
-> PhysicalDeviceShaderEnqueuePropertiesAMDX -> IO ()
poke Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
ptr PhysicalDeviceShaderEnqueuePropertiesAMDX
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceShaderEnqueuePropertiesAMDX where
  zero :: PhysicalDeviceShaderEnqueuePropertiesAMDX
zero = ("nodeIndex" ::: Word32)
-> ("nodeIndex" ::: Word32)
-> ("nodeIndex" ::: Word32)
-> ("nodeIndex" ::: Word32)
-> ("nodeIndex" ::: Word32)
-> PhysicalDeviceShaderEnqueuePropertiesAMDX
PhysicalDeviceShaderEnqueuePropertiesAMDX
           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


-- | VkPhysicalDeviceShaderEnqueueFeaturesAMDX - Structure describing whether
-- shader enqueue within execution graphs are supported by the
-- implementation
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceShaderEnqueueFeaturesAMDX' 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. 'PhysicalDeviceShaderEnqueueFeaturesAMDX' /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_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceShaderEnqueueFeaturesAMDX = PhysicalDeviceShaderEnqueueFeaturesAMDX
  { -- | #features-shaderEnqueue# @shaderEnqueue@ indicates whether the
    -- implementation supports
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#executiongraphs execution graphs>.
    PhysicalDeviceShaderEnqueueFeaturesAMDX -> Bool
shaderEnqueue :: Bool }
  deriving (Typeable, PhysicalDeviceShaderEnqueueFeaturesAMDX
-> PhysicalDeviceShaderEnqueueFeaturesAMDX -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceShaderEnqueueFeaturesAMDX
-> PhysicalDeviceShaderEnqueueFeaturesAMDX -> Bool
$c/= :: PhysicalDeviceShaderEnqueueFeaturesAMDX
-> PhysicalDeviceShaderEnqueueFeaturesAMDX -> Bool
== :: PhysicalDeviceShaderEnqueueFeaturesAMDX
-> PhysicalDeviceShaderEnqueueFeaturesAMDX -> Bool
$c== :: PhysicalDeviceShaderEnqueueFeaturesAMDX
-> PhysicalDeviceShaderEnqueueFeaturesAMDX -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceShaderEnqueueFeaturesAMDX)
#endif
deriving instance Show PhysicalDeviceShaderEnqueueFeaturesAMDX

instance ToCStruct PhysicalDeviceShaderEnqueueFeaturesAMDX where
  withCStruct :: forall b.
PhysicalDeviceShaderEnqueueFeaturesAMDX
-> (Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX -> IO b) -> IO b
withCStruct PhysicalDeviceShaderEnqueueFeaturesAMDX
x Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
p PhysicalDeviceShaderEnqueueFeaturesAMDX
x (Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX -> IO b
f Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
-> PhysicalDeviceShaderEnqueueFeaturesAMDX -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
p PhysicalDeviceShaderEnqueueFeaturesAMDX{Bool
shaderEnqueue :: Bool
$sel:shaderEnqueue:PhysicalDeviceShaderEnqueueFeaturesAMDX :: PhysicalDeviceShaderEnqueueFeaturesAMDX -> Bool
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_ENQUEUE_FEATURES_AMDX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
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 PhysicalDeviceShaderEnqueueFeaturesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderEnqueue))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_ENQUEUE_FEATURES_AMDX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
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 PhysicalDeviceShaderEnqueueFeaturesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceShaderEnqueueFeaturesAMDX where
  peekCStruct :: Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
-> IO PhysicalDeviceShaderEnqueueFeaturesAMDX
peekCStruct Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
p = do
    Bool32
shaderEnqueue <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceShaderEnqueueFeaturesAMDX
PhysicalDeviceShaderEnqueueFeaturesAMDX
             (Bool32 -> Bool
bool32ToBool Bool32
shaderEnqueue)

instance Storable PhysicalDeviceShaderEnqueueFeaturesAMDX where
  sizeOf :: PhysicalDeviceShaderEnqueueFeaturesAMDX -> Int
sizeOf ~PhysicalDeviceShaderEnqueueFeaturesAMDX
_ = Int
24
  alignment :: PhysicalDeviceShaderEnqueueFeaturesAMDX -> Int
alignment ~PhysicalDeviceShaderEnqueueFeaturesAMDX
_ = Int
8
  peek :: Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
-> IO PhysicalDeviceShaderEnqueueFeaturesAMDX
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
-> PhysicalDeviceShaderEnqueueFeaturesAMDX -> IO ()
poke Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
ptr PhysicalDeviceShaderEnqueueFeaturesAMDX
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

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


-- | VkExecutionGraphPipelineCreateInfoAMDX - Structure specifying parameters
-- of a newly created execution graph pipeline
--
-- = Description
--
-- The parameters @basePipelineHandle@ and @basePipelineIndex@ are
-- described in more detail in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#pipelines-pipeline-derivatives Pipeline Derivatives>.
--
-- Each shader stage provided when creating an execution graph pipeline
-- (including those in libraries) is associated with a name and an index,
-- determined by the inclusion or omission of a
-- 'PipelineShaderStageNodeCreateInfoAMDX' structure in its @pNext@ chain.
--
-- In addition to the shader name and index, an internal \"node index\" is
-- also generated for each node, which can be queried with
-- 'getExecutionGraphPipelineNodeIndexAMDX', and is used exclusively for
-- initial dispatch of an execution graph.
--
-- == Valid Usage
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-07984# If @flags@
--     contains the
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DERIVATIVE_BIT'
--     flag, and @basePipelineIndex@ is -1, @basePipelineHandle@ /must/ be
--     a valid execution graph 'Vulkan.Core10.Handles.Pipeline' handle
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-07985# If @flags@
--     contains the
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DERIVATIVE_BIT'
--     flag, and @basePipelineHandle@ is
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @basePipelineIndex@ /must/
--     be a valid index into the calling command’s @pCreateInfos@ parameter
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-07986# If @flags@
--     contains the
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DERIVATIVE_BIT'
--     flag, @basePipelineIndex@ /must/ be -1 or @basePipelineHandle@
--     /must/ be 'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-layout-07987# If a push
--     constant block is declared in a shader, a push constant range in
--     @layout@ /must/ match both the shader stage and range
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-layout-07988# If a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#interfaces-resources resource variables>
--     is declared in a shader, a descriptor slot in @layout@ /must/ match
--     the shader stage
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-layout-07990# If a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#interfaces-resources resource variables>
--     is declared in a shader, and the descriptor type is not
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT', a
--     descriptor slot in @layout@ /must/ match the descriptor type
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-layout-07991# If a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#interfaces-resources resource variables>
--     is declared in a shader as an array, a descriptor slot in @layout@
--     /must/ match the descriptor count
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-03365# @flags@
--     /must/ not include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_ANY_HIT_SHADERS_BIT_KHR'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-03366# @flags@
--     /must/ not include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_CLOSEST_HIT_SHADERS_BIT_KHR'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-03367# @flags@
--     /must/ not include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_MISS_SHADERS_BIT_KHR'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-03368# @flags@
--     /must/ not include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_INTERSECTION_SHADERS_BIT_KHR'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-03369# @flags@
--     /must/ not include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_SKIP_TRIANGLES_BIT_KHR'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-03370# @flags@
--     /must/ not include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_SKIP_AABBS_BIT_KHR'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-03576# @flags@
--     /must/ not include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_SHADER_GROUP_HANDLE_CAPTURE_REPLAY_BIT_KHR'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-04945# @flags@
--     /must/ not include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_ALLOW_MOTION_BIT_NV'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-09007# If @flags@
--     includes
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_INDIRECT_BINDABLE_BIT_NV',
--     then the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-deviceGeneratedComputePipelines ::deviceGeneratedComputePipelines>
--     feature /must/ be enabled
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-09008# If @flags@
--     includes
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_INDIRECT_BINDABLE_BIT_NV',
--     then the @pNext@ chain /must/ include a pointer to a valid instance
--     of
--     'Vulkan.Extensions.VK_NV_device_generated_commands_compute.ComputePipelineIndirectBufferInfoNV'
--     specifying the address where the pipeline’s metadata will be saved
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-pipelineCreationCacheControl-02875#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-pipelineCreationCacheControl pipelineCreationCacheControl>
--     feature is not enabled, @flags@ /must/ not include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_FAIL_ON_PIPELINE_COMPILE_REQUIRED_BIT'
--     or
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_EARLY_RETURN_ON_FAILURE_BIT'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-stage-09128# The
--     @stage@ member of any element of @pStages@ /must/ be
--     'Vulkan.Core10.Enums.ShaderStageFlagBits.SHADER_STAGE_COMPUTE_BIT'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-pStages-09129# The
--     shader code for the entry point identified by each element of
--     @pStages@ and the rest of the state identified by this structure
--     /must/ adhere to the pipeline linking rules described in the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#interfaces Shader Interfaces>
--     chapter
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-layout-09130# @layout@
--     /must/ be
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#descriptorsets-pipelinelayout-consistency consistent>
--     with the layout of the shaders specified in @pStages@
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-pLibraryInfo-09131# If
--     @pLibraryInfo@ is not @NULL@, each element of its @pLibraries@
--     member /must/ have been created with a @layout@ that is compatible
--     with the @layout@ in this pipeline
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-layout-09132# The
--     number of resources in @layout@ accessible to each shader stage that
--     is used by the pipeline /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxPerStageResources@
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-pLibraryInfo-09133# If
--     @pLibraryInfo@ is not @NULL@, each element of
--     @pLibraryInfo->libraries@ /must/ be either a compute pipeline or an
--     execution graph pipeline
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-None-09134# There
--     /must/ be no two nodes in the pipeline that share both the same
--     shader name and index, as specified by
--     'PipelineShaderStageNodeCreateInfoAMDX'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-None-09135# There
--     /must/ be no two nodes in the pipeline that share the same shader
--     name and have input payload declarations with different sizes
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-None-09136# There
--     /must/ be no two nodes in the pipeline that share the same name but
--     have different execution models
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-CoalescedInputCountAMDX-09137#
--     There /must/ be no two nodes in the pipeline that share the same
--     name where one includes @CoalescedInputCountAMDX@ and the other does
--     not
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-StaticNumWorkgroupsAMDX-09138#
--     There /must/ be no two nodes in the pipeline that share the same
--     name where one includes @StaticNumWorkgroupsAMDX@ and the other does
--     not
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-PayloadNodeNameAMDX-09139#
--     If an output payload declared in any shader in the pipeline has a
--     @PayloadNodeNameAMDX@ decoration with a @Node@ @Name@ that matches
--     the shader name of any other node in the graph, the size of the
--     output payload /must/ match the size of the input payload in the
--     matching node
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_EXECUTION_GRAPH_PIPELINE_CREATE_INFO_AMDX'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-pNext-pNext# Each
--     @pNext@ member of any structure (including this one) in the @pNext@
--     chain /must/ be either @NULL@ or a pointer to a valid instance of
--     'Vulkan.Extensions.VK_AMD_pipeline_compiler_control.PipelineCompilerControlCreateInfoAMD'
--     or
--     'Vulkan.Core13.Promoted_From_VK_EXT_pipeline_creation_feedback.PipelineCreationFeedbackCreateInfo'
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-sType-unique# The
--     @sType@ value of each struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-flags-parameter#
--     @flags@ /must/ be a valid combination of
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PipelineCreateFlagBits'
--     values
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-pStages-parameter# If
--     @stageCount@ is not @0@, and @pStages@ is not @NULL@, @pStages@
--     /must/ be a valid pointer to an array of @stageCount@ valid
--     'Vulkan.Core10.Pipeline.PipelineShaderStageCreateInfo' structures
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-pLibraryInfo-parameter#
--     If @pLibraryInfo@ is not @NULL@, @pLibraryInfo@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Extensions.VK_KHR_pipeline_library.PipelineLibraryCreateInfoKHR'
--     structure
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-layout-parameter#
--     @layout@ /must/ be a valid 'Vulkan.Core10.Handles.PipelineLayout'
--     handle
--
-- -   #VUID-VkExecutionGraphPipelineCreateInfoAMDX-commonparent# Both of
--     @basePipelineHandle@, and @layout@ that are valid handles of
--     non-ignored parameters /must/ have been created, allocated, or
--     retrieved from the same 'Vulkan.Core10.Handles.Device'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.Handles.Pipeline',
-- 'Vulkan.Core10.Enums.PipelineCreateFlagBits.PipelineCreateFlags',
-- 'Vulkan.Core10.Handles.PipelineLayout',
-- 'Vulkan.Extensions.VK_KHR_pipeline_library.PipelineLibraryCreateInfoKHR',
-- 'Vulkan.Core10.Pipeline.PipelineShaderStageCreateInfo',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'createExecutionGraphPipelinesAMDX'
data ExecutionGraphPipelineCreateInfoAMDX (es :: [Type]) = ExecutionGraphPipelineCreateInfoAMDX
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.PipelineCreateFlagBits.PipelineCreateFlagBits'
    -- specifying how the pipeline will be generated.
    forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> PipelineCreateFlags
flags :: PipelineCreateFlags
  , -- | @stageCount@ is the number of entries in the @pStages@ array.
    forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> "nodeIndex" ::: Word32
stageCount :: Word32
  , -- | @pStages@ is a pointer to an array of @stageCount@
    -- 'Vulkan.Core10.Pipeline.PipelineShaderStageCreateInfo' structures
    -- describing the set of the shader stages to be included in the execution
    -- graph pipeline.
    forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> Vector (SomeStruct PipelineShaderStageCreateInfo)
stages :: Vector (SomeStruct PipelineShaderStageCreateInfo)
  , -- | @pLibraryInfo@ is a pointer to a
    -- 'Vulkan.Extensions.VK_KHR_pipeline_library.PipelineLibraryCreateInfoKHR'
    -- structure defining pipeline libraries to include.
    forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> Maybe PipelineLibraryCreateInfoKHR
libraryInfo :: Maybe PipelineLibraryCreateInfoKHR
  , -- | @layout@ is the description of binding locations used by both the
    -- pipeline and descriptor sets used with the pipeline.
    forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> PipelineLayout
layout :: PipelineLayout
  , -- | @basePipelineHandle@ is a pipeline to derive from
    forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> "executionGraph" ::: Pipeline
basePipelineHandle :: Pipeline
  , -- | @basePipelineIndex@ is an index into the @pCreateInfos@ parameter to use
    -- as a pipeline to derive from
    forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> Int32
basePipelineIndex :: Int32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ExecutionGraphPipelineCreateInfoAMDX (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (ExecutionGraphPipelineCreateInfoAMDX es)

instance Extensible ExecutionGraphPipelineCreateInfoAMDX where
  extensibleTypeName :: String
extensibleTypeName = String
"ExecutionGraphPipelineCreateInfoAMDX"
  setNext :: forall (ds :: [*]) (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX ds
-> Chain es -> ExecutionGraphPipelineCreateInfoAMDX es
setNext ExecutionGraphPipelineCreateInfoAMDX{Int32
Maybe PipelineLibraryCreateInfoKHR
"nodeIndex" ::: Word32
Vector (SomeStruct PipelineShaderStageCreateInfo)
Chain ds
PipelineLayout
"executionGraph" ::: Pipeline
PipelineCreateFlags
basePipelineIndex :: Int32
basePipelineHandle :: "executionGraph" ::: Pipeline
layout :: PipelineLayout
libraryInfo :: Maybe PipelineLibraryCreateInfoKHR
stages :: Vector (SomeStruct PipelineShaderStageCreateInfo)
stageCount :: "nodeIndex" ::: Word32
flags :: PipelineCreateFlags
next :: Chain ds
$sel:basePipelineIndex:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> Int32
$sel:basePipelineHandle:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> "executionGraph" ::: Pipeline
$sel:layout:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> PipelineLayout
$sel:libraryInfo:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> Maybe PipelineLibraryCreateInfoKHR
$sel:stages:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> Vector (SomeStruct PipelineShaderStageCreateInfo)
$sel:stageCount:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> "nodeIndex" ::: Word32
$sel:flags:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> PipelineCreateFlags
$sel:next:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> Chain es
..} Chain es
next' = ExecutionGraphPipelineCreateInfoAMDX{$sel:next:ExecutionGraphPipelineCreateInfoAMDX :: Chain es
next = Chain es
next', Int32
Maybe PipelineLibraryCreateInfoKHR
"nodeIndex" ::: Word32
Vector (SomeStruct PipelineShaderStageCreateInfo)
PipelineLayout
"executionGraph" ::: Pipeline
PipelineCreateFlags
basePipelineIndex :: Int32
basePipelineHandle :: "executionGraph" ::: Pipeline
layout :: PipelineLayout
libraryInfo :: Maybe PipelineLibraryCreateInfoKHR
stages :: Vector (SomeStruct PipelineShaderStageCreateInfo)
stageCount :: "nodeIndex" ::: Word32
flags :: PipelineCreateFlags
$sel:basePipelineIndex:ExecutionGraphPipelineCreateInfoAMDX :: Int32
$sel:basePipelineHandle:ExecutionGraphPipelineCreateInfoAMDX :: "executionGraph" ::: Pipeline
$sel:layout:ExecutionGraphPipelineCreateInfoAMDX :: PipelineLayout
$sel:libraryInfo:ExecutionGraphPipelineCreateInfoAMDX :: Maybe PipelineLibraryCreateInfoKHR
$sel:stages:ExecutionGraphPipelineCreateInfoAMDX :: Vector (SomeStruct PipelineShaderStageCreateInfo)
$sel:stageCount:ExecutionGraphPipelineCreateInfoAMDX :: "nodeIndex" ::: Word32
$sel:flags:ExecutionGraphPipelineCreateInfoAMDX :: PipelineCreateFlags
..}
  getNext :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> Chain es
getNext ExecutionGraphPipelineCreateInfoAMDX{Int32
Maybe PipelineLibraryCreateInfoKHR
"nodeIndex" ::: Word32
Vector (SomeStruct PipelineShaderStageCreateInfo)
Chain es
PipelineLayout
"executionGraph" ::: Pipeline
PipelineCreateFlags
basePipelineIndex :: Int32
basePipelineHandle :: "executionGraph" ::: Pipeline
layout :: PipelineLayout
libraryInfo :: Maybe PipelineLibraryCreateInfoKHR
stages :: Vector (SomeStruct PipelineShaderStageCreateInfo)
stageCount :: "nodeIndex" ::: Word32
flags :: PipelineCreateFlags
next :: Chain es
$sel:basePipelineIndex:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> Int32
$sel:basePipelineHandle:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> "executionGraph" ::: Pipeline
$sel:layout:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> PipelineLayout
$sel:libraryInfo:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> Maybe PipelineLibraryCreateInfoKHR
$sel:stages:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> Vector (SomeStruct PipelineShaderStageCreateInfo)
$sel:stageCount:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> "nodeIndex" ::: Word32
$sel:flags:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> PipelineCreateFlags
$sel:next:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends ExecutionGraphPipelineCreateInfoAMDX e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e
-> (Extends ExecutionGraphPipelineCreateInfoAMDX e => b) -> Maybe b
extends proxy e
_ Extends ExecutionGraphPipelineCreateInfoAMDX e => b
f
    | Just e :~: PipelineCompilerControlCreateInfoAMD
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineCompilerControlCreateInfoAMD = forall a. a -> Maybe a
Just Extends ExecutionGraphPipelineCreateInfoAMDX e => b
f
    | Just e :~: PipelineCreationFeedbackCreateInfo
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineCreationFeedbackCreateInfo = forall a. a -> Maybe a
Just Extends ExecutionGraphPipelineCreateInfoAMDX e => b
f
    | Bool
otherwise = forall a. Maybe a
Nothing

instance ( Extendss ExecutionGraphPipelineCreateInfoAMDX es
         , PokeChain es ) => ToCStruct (ExecutionGraphPipelineCreateInfoAMDX es) where
  withCStruct :: forall b.
ExecutionGraphPipelineCreateInfoAMDX es
-> (Ptr (ExecutionGraphPipelineCreateInfoAMDX es) -> IO b) -> IO b
withCStruct ExecutionGraphPipelineCreateInfoAMDX es
x Ptr (ExecutionGraphPipelineCreateInfoAMDX es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 forall a b. (a -> b) -> a -> b
$ \Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p ExecutionGraphPipelineCreateInfoAMDX es
x (Ptr (ExecutionGraphPipelineCreateInfoAMDX es) -> IO b
f Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p)
  pokeCStruct :: forall b.
Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
-> ExecutionGraphPipelineCreateInfoAMDX es -> IO b -> IO b
pokeCStruct Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p ExecutionGraphPipelineCreateInfoAMDX{Int32
Maybe PipelineLibraryCreateInfoKHR
"nodeIndex" ::: Word32
Vector (SomeStruct PipelineShaderStageCreateInfo)
Chain es
PipelineLayout
"executionGraph" ::: Pipeline
PipelineCreateFlags
basePipelineIndex :: Int32
basePipelineHandle :: "executionGraph" ::: Pipeline
layout :: PipelineLayout
libraryInfo :: Maybe PipelineLibraryCreateInfoKHR
stages :: Vector (SomeStruct PipelineShaderStageCreateInfo)
stageCount :: "nodeIndex" ::: Word32
flags :: PipelineCreateFlags
next :: Chain es
$sel:basePipelineIndex:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> Int32
$sel:basePipelineHandle:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> "executionGraph" ::: Pipeline
$sel:layout:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> PipelineLayout
$sel:libraryInfo:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> Maybe PipelineLibraryCreateInfoKHR
$sel:stages:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es
-> Vector (SomeStruct PipelineShaderStageCreateInfo)
$sel:stageCount:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> "nodeIndex" ::: Word32
$sel:flags:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> PipelineCreateFlags
$sel:next:ExecutionGraphPipelineCreateInfoAMDX :: forall (es :: [*]).
ExecutionGraphPipelineCreateInfoAMDX es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXECUTION_GRAPH_PIPELINE_CREATE_INFO_AMDX)
    Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineCreateFlags)) (PipelineCreateFlags
flags)
    let pStagesLength :: Int
pStagesLength = forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct PipelineShaderStageCreateInfo)
stages)
    "nodeIndex" ::: Word32
stageCount'' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ if ("nodeIndex" ::: Word32
stageCount) forall a. Eq a => a -> a -> Bool
== "nodeIndex" ::: Word32
0
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pStagesLength
      else do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pStagesLength forall a. Eq a => a -> a -> Bool
== ("nodeIndex" ::: Word32
stageCount) Bool -> Bool -> Bool
|| Int
pStagesLength forall a. Eq a => a -> a -> Bool
== Int
0) 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
"pStages must be empty or have 'stageCount' elements" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ("nodeIndex" ::: Word32
stageCount)
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("nodeIndex" ::: Word32
stageCount'')
    Ptr (PipelineShaderStageCreateInfo Any)
pStages'' <- if forall a. Vector a -> Bool
Data.Vector.null (Vector (SomeStruct PipelineShaderStageCreateInfo)
stages)
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
      else do
        Ptr (PipelineShaderStageCreateInfo Any)
pPStages <- 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. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(PipelineShaderStageCreateInfo _) (((forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct PipelineShaderStageCreateInfo)
stages))) forall a. Num a => a -> a -> a
* Int
48)
        forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct PipelineShaderStageCreateInfo
e -> 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.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (PipelineShaderStageCreateInfo Any)
pPStages forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
48 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (PipelineShaderStageCreateInfo _))) (SomeStruct PipelineShaderStageCreateInfo
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) ((Vector (SomeStruct PipelineShaderStageCreateInfo)
stages))
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr (PipelineShaderStageCreateInfo Any)
pPStages
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr (PipelineShaderStageCreateInfo _)))) Ptr (PipelineShaderStageCreateInfo Any)
pStages''
    Ptr PipelineLibraryCreateInfoKHR
pLibraryInfo'' <- case (Maybe PipelineLibraryCreateInfoKHR
libraryInfo) of
      Maybe PipelineLibraryCreateInfoKHR
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
      Just PipelineLibraryCreateInfoKHR
j -> 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 => a -> (Ptr a -> IO b) -> IO b
withCStruct (PipelineLibraryCreateInfoKHR
j)
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr PipelineLibraryCreateInfoKHR))) Ptr PipelineLibraryCreateInfoKHR
pLibraryInfo''
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr PipelineLayout)) (PipelineLayout
layout)
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Pipeline)) ("executionGraph" ::: Pipeline
basePipelineHandle)
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Int32)) (Int32
basePipelineIndex)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
64
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr (ExecutionGraphPipelineCreateInfoAMDX es) -> IO b -> IO b
pokeZeroCStruct Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXECUTION_GRAPH_PIPELINE_CREATE_INFO_AMDX)
    Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr PipelineLayout)) (forall a. Zero a => a
zero)
    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 -> a -> IO ()
poke ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Int32)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f

instance ( Extendss ExecutionGraphPipelineCreateInfoAMDX es
         , PeekChain es ) => FromCStruct (ExecutionGraphPipelineCreateInfoAMDX es) where
  peekCStruct :: Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
-> IO (ExecutionGraphPipelineCreateInfoAMDX es)
peekCStruct Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    PipelineCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @PipelineCreateFlags ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineCreateFlags))
    "nodeIndex" ::: Word32
stageCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    Ptr (PipelineShaderStageCreateInfo Any)
pStages <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (PipelineShaderStageCreateInfo _)) ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr (PipelineShaderStageCreateInfo _))))
    let pStagesLength :: Int
pStagesLength = if Ptr (PipelineShaderStageCreateInfo Any)
pStages forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then Int
0 else (forall a b. (Integral a, Num b) => a -> b
fromIntegral "nodeIndex" ::: Word32
stageCount)
    Vector (SomeStruct PipelineShaderStageCreateInfo)
pStages' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
pStagesLength (\Int
i -> forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (PipelineShaderStageCreateInfo Any)
pStages forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
48 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (PipelineShaderStageCreateInfo _)))))
    Ptr PipelineLibraryCreateInfoKHR
pLibraryInfo <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr PipelineLibraryCreateInfoKHR) ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr PipelineLibraryCreateInfoKHR)))
    Maybe PipelineLibraryCreateInfoKHR
pLibraryInfo' <- forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\Ptr PipelineLibraryCreateInfoKHR
j -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PipelineLibraryCreateInfoKHR (Ptr PipelineLibraryCreateInfoKHR
j)) Ptr PipelineLibraryCreateInfoKHR
pLibraryInfo
    PipelineLayout
layout <- forall a. Storable a => Ptr a -> IO a
peek @PipelineLayout ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr PipelineLayout))
    "executionGraph" ::: Pipeline
basePipelineHandle <- forall a. Storable a => Ptr a -> IO a
peek @Pipeline ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Pipeline))
    Int32
basePipelineIndex <- forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr (ExecutionGraphPipelineCreateInfoAMDX es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Int32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es
-> PipelineCreateFlags
-> ("nodeIndex" ::: Word32)
-> Vector (SomeStruct PipelineShaderStageCreateInfo)
-> Maybe PipelineLibraryCreateInfoKHR
-> PipelineLayout
-> ("executionGraph" ::: Pipeline)
-> Int32
-> ExecutionGraphPipelineCreateInfoAMDX es
ExecutionGraphPipelineCreateInfoAMDX
             Chain es
next
             PipelineCreateFlags
flags
             "nodeIndex" ::: Word32
stageCount
             Vector (SomeStruct PipelineShaderStageCreateInfo)
pStages'
             Maybe PipelineLibraryCreateInfoKHR
pLibraryInfo'
             PipelineLayout
layout
             "executionGraph" ::: Pipeline
basePipelineHandle
             Int32
basePipelineIndex

instance es ~ '[] => Zero (ExecutionGraphPipelineCreateInfoAMDX es) where
  zero :: ExecutionGraphPipelineCreateInfoAMDX es
zero = forall (es :: [*]).
Chain es
-> PipelineCreateFlags
-> ("nodeIndex" ::: Word32)
-> Vector (SomeStruct PipelineShaderStageCreateInfo)
-> Maybe PipelineLibraryCreateInfoKHR
-> PipelineLayout
-> ("executionGraph" ::: Pipeline)
-> Int32
-> ExecutionGraphPipelineCreateInfoAMDX es
ExecutionGraphPipelineCreateInfoAMDX
           ()
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty
           forall a. Maybe a
Nothing
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkPipelineShaderStageNodeCreateInfoAMDX - Structure specifying the
-- shader name and index with an execution graph
--
-- = Description
--
-- When included in the @pNext@ chain of a
-- 'Vulkan.Core10.Pipeline.PipelineShaderStageCreateInfo' structure, this
-- structure specifies the shader name and shader index of a node when
-- creating an execution graph pipeline. If this structure is omitted, the
-- shader name is set to the name of the entry point in SPIR-V and the
-- shader index is set to @0@.
--
-- When dispatching a node from another shader, the name is fixed at
-- pipeline creation, but the index /can/ be set dynamically. By
-- associating multiple shaders with the same name but different indexes,
-- applications can dynamically select different nodes to execute.
-- Applications /must/ ensure each node has a unique name and index.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPipelineShaderStageNodeCreateInfoAMDX-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_NODE_CREATE_INFO_AMDX'
--
-- -   #VUID-VkPipelineShaderStageNodeCreateInfoAMDX-pName-parameter# If
--     @pName@ is not @NULL@, @pName@ /must/ be a null-terminated UTF-8
--     string
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getExecutionGraphPipelineNodeIndexAMDX'
data PipelineShaderStageNodeCreateInfoAMDX = PipelineShaderStageNodeCreateInfoAMDX
  { -- | @pName@ is the shader name to use when creating a node in an execution
    -- graph. If @pName@ is @NULL@, the name of the entry point specified in
    -- SPIR-V is used as the shader name.
    PipelineShaderStageNodeCreateInfoAMDX -> Maybe ByteString
name :: Maybe ByteString
  , -- | @index@ is the shader index to use when creating a node in an execution
    -- graph. If @index@ is
    -- 'Vulkan.Core10.APIConstants.SHADER_INDEX_UNUSED_AMDX' then the original
    -- index is used, either as specified by the @ShaderIndexAMDX@ execution
    -- mode, or @0@ if that too is not specified.
    PipelineShaderStageNodeCreateInfoAMDX -> "nodeIndex" ::: Word32
index :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineShaderStageNodeCreateInfoAMDX)
#endif
deriving instance Show PipelineShaderStageNodeCreateInfoAMDX

instance ToCStruct PipelineShaderStageNodeCreateInfoAMDX where
  withCStruct :: forall b.
PipelineShaderStageNodeCreateInfoAMDX
-> (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
    -> IO b)
-> IO b
withCStruct PipelineShaderStageNodeCreateInfoAMDX
x ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p PipelineShaderStageNodeCreateInfoAMDX
x (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX) -> IO b
f "pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p)
  pokeCStruct :: forall b.
("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
-> PipelineShaderStageNodeCreateInfoAMDX -> IO b -> IO b
pokeCStruct "pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p PipelineShaderStageNodeCreateInfoAMDX{Maybe ByteString
"nodeIndex" ::: Word32
index :: "nodeIndex" ::: Word32
name :: Maybe ByteString
$sel:index:PipelineShaderStageNodeCreateInfoAMDX :: PipelineShaderStageNodeCreateInfoAMDX -> "nodeIndex" ::: Word32
$sel:name:PipelineShaderStageNodeCreateInfoAMDX :: PipelineShaderStageNodeCreateInfoAMDX -> Maybe ByteString
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    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 -> a -> IO ()
poke (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_NODE_CREATE_INFO_AMDX)
    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 -> a -> IO ()
poke (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    Ptr CChar
pName'' <- case (Maybe ByteString
name) of
      Maybe ByteString
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
      Just ByteString
j -> 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. ByteString -> (Ptr CChar -> IO a) -> IO a
useAsCString (ByteString
j)
    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 -> a -> IO ()
poke (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr CChar))) Ptr CChar
pName''
    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 -> a -> IO ()
poke (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) ("nodeIndex" ::: Word32
index)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
-> IO b -> IO b
pokeZeroCStruct "pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_NODE_CREATE_INFO_AMDX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
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 (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PipelineShaderStageNodeCreateInfoAMDX where
  peekCStruct :: ("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX)
-> IO PipelineShaderStageNodeCreateInfoAMDX
peekCStruct "pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p = do
    Ptr CChar
pName <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr CChar) (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr CChar)))
    Maybe ByteString
pName' <- forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\Ptr CChar
j -> Ptr CChar -> IO ByteString
packCString (Ptr CChar
j)) Ptr CChar
pName
    "nodeIndex" ::: Word32
index <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pNodeInfo" ::: Ptr PipelineShaderStageNodeCreateInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe ByteString
-> ("nodeIndex" ::: Word32)
-> PipelineShaderStageNodeCreateInfoAMDX
PipelineShaderStageNodeCreateInfoAMDX
             Maybe ByteString
pName' "nodeIndex" ::: Word32
index

instance Zero PipelineShaderStageNodeCreateInfoAMDX where
  zero :: PipelineShaderStageNodeCreateInfoAMDX
zero = Maybe ByteString
-> ("nodeIndex" ::: Word32)
-> PipelineShaderStageNodeCreateInfoAMDX
PipelineShaderStageNodeCreateInfoAMDX
           forall a. Maybe a
Nothing
           forall a. Zero a => a
zero


-- | VkExecutionGraphPipelineScratchSizeAMDX - Structure describing the
-- scratch space required to dispatch an execution graph
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getExecutionGraphPipelineScratchSizeAMDX'
data ExecutionGraphPipelineScratchSizeAMDX = ExecutionGraphPipelineScratchSizeAMDX
  { -- | @size@ indicates the scratch space required for dispatch the queried
    -- execution graph.
    ExecutionGraphPipelineScratchSizeAMDX -> Flags64
size :: DeviceSize }
  deriving (Typeable, ExecutionGraphPipelineScratchSizeAMDX
-> ExecutionGraphPipelineScratchSizeAMDX -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutionGraphPipelineScratchSizeAMDX
-> ExecutionGraphPipelineScratchSizeAMDX -> Bool
$c/= :: ExecutionGraphPipelineScratchSizeAMDX
-> ExecutionGraphPipelineScratchSizeAMDX -> Bool
== :: ExecutionGraphPipelineScratchSizeAMDX
-> ExecutionGraphPipelineScratchSizeAMDX -> Bool
$c== :: ExecutionGraphPipelineScratchSizeAMDX
-> ExecutionGraphPipelineScratchSizeAMDX -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ExecutionGraphPipelineScratchSizeAMDX)
#endif
deriving instance Show ExecutionGraphPipelineScratchSizeAMDX

instance ToCStruct ExecutionGraphPipelineScratchSizeAMDX where
  withCStruct :: forall b.
ExecutionGraphPipelineScratchSizeAMDX
-> (("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
    -> IO b)
-> IO b
withCStruct ExecutionGraphPipelineScratchSizeAMDX
x ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p ExecutionGraphPipelineScratchSizeAMDX
x (("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX) -> IO b
f "pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p)
  pokeCStruct :: forall b.
("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
-> ExecutionGraphPipelineScratchSizeAMDX -> IO b -> IO b
pokeCStruct "pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p ExecutionGraphPipelineScratchSizeAMDX{Flags64
size :: Flags64
$sel:size:ExecutionGraphPipelineScratchSizeAMDX :: ExecutionGraphPipelineScratchSizeAMDX -> Flags64
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXECUTION_GRAPH_PIPELINE_SCRATCH_SIZE_AMDX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
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 (("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (Flags64
size)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
-> IO b -> IO b
pokeZeroCStruct "pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_EXECUTION_GRAPH_PIPELINE_SCRATCH_SIZE_AMDX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
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 (("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ExecutionGraphPipelineScratchSizeAMDX where
  peekCStruct :: ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
-> IO ExecutionGraphPipelineScratchSizeAMDX
peekCStruct "pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p = do
    Flags64
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize (("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Flags64 -> ExecutionGraphPipelineScratchSizeAMDX
ExecutionGraphPipelineScratchSizeAMDX
             Flags64
size

instance Storable ExecutionGraphPipelineScratchSizeAMDX where
  sizeOf :: ExecutionGraphPipelineScratchSizeAMDX -> Int
sizeOf ~ExecutionGraphPipelineScratchSizeAMDX
_ = Int
24
  alignment :: ExecutionGraphPipelineScratchSizeAMDX -> Int
alignment ~ExecutionGraphPipelineScratchSizeAMDX
_ = Int
8
  peek :: ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
-> IO ExecutionGraphPipelineScratchSizeAMDX
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX)
-> ExecutionGraphPipelineScratchSizeAMDX -> IO ()
poke "pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
ptr ExecutionGraphPipelineScratchSizeAMDX
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pSizeInfo" ::: Ptr ExecutionGraphPipelineScratchSizeAMDX
ptr ExecutionGraphPipelineScratchSizeAMDX
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ExecutionGraphPipelineScratchSizeAMDX where
  zero :: ExecutionGraphPipelineScratchSizeAMDX
zero = Flags64 -> ExecutionGraphPipelineScratchSizeAMDX
ExecutionGraphPipelineScratchSizeAMDX
           forall a. Zero a => a
zero


-- | VkDispatchGraphInfoAMDX - Structure specifying node parameters for
-- execution graph dispatch
--
-- = Description
--
-- Whether @payloads@ is consumed as a device or host pointer is defined by
-- the command this structure is used in.
--
-- == Valid Usage
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'DeviceOrHostAddressConstAMDX', 'DispatchGraphCountInfoAMDX'
data DispatchGraphInfoAMDX = DispatchGraphInfoAMDX
  { -- | @nodeIndex@ is the index of a node in an execution graph to be
    -- dispatched.
    DispatchGraphInfoAMDX -> "nodeIndex" ::: Word32
nodeIndex :: Word32
  , -- | @payloadCount@ is the number of payloads to dispatch for the specified
    -- node.
    --
    -- #VUID-VkDispatchGraphInfoAMDX-payloadCount-09171# @payloadCount@ /must/
    -- be no greater than
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-maxExecutionGraphShaderPayloadCount maxExecutionGraphShaderPayloadCount>
    DispatchGraphInfoAMDX -> "nodeIndex" ::: Word32
payloadCount :: Word32
  , -- | @payloads@ is a device or host address pointer to a flat array of
    -- payloads with size equal to the product of @payloadCount@ and
    -- @payloadStride@
    DispatchGraphInfoAMDX -> DeviceOrHostAddressConstAMDX
payloads :: DeviceOrHostAddressConstAMDX
  , -- | @payloadStride@ is the byte stride between successive payloads in
    -- @payloads@
    DispatchGraphInfoAMDX -> Flags64
payloadStride :: Word64
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DispatchGraphInfoAMDX)
#endif
deriving instance Show DispatchGraphInfoAMDX

instance ToCStruct DispatchGraphInfoAMDX where
  withCStruct :: forall b.
DispatchGraphInfoAMDX
-> (Ptr DispatchGraphInfoAMDX -> IO b) -> IO b
withCStruct DispatchGraphInfoAMDX
x Ptr DispatchGraphInfoAMDX -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr DispatchGraphInfoAMDX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DispatchGraphInfoAMDX
p DispatchGraphInfoAMDX
x (Ptr DispatchGraphInfoAMDX -> IO b
f Ptr DispatchGraphInfoAMDX
p)
  pokeCStruct :: forall b.
Ptr DispatchGraphInfoAMDX -> DispatchGraphInfoAMDX -> IO b -> IO b
pokeCStruct Ptr DispatchGraphInfoAMDX
p DispatchGraphInfoAMDX{"nodeIndex" ::: Word32
Flags64
DeviceOrHostAddressConstAMDX
payloadStride :: Flags64
payloads :: DeviceOrHostAddressConstAMDX
payloadCount :: "nodeIndex" ::: Word32
nodeIndex :: "nodeIndex" ::: Word32
$sel:payloadStride:DispatchGraphInfoAMDX :: DispatchGraphInfoAMDX -> Flags64
$sel:payloads:DispatchGraphInfoAMDX :: DispatchGraphInfoAMDX -> DeviceOrHostAddressConstAMDX
$sel:payloadCount:DispatchGraphInfoAMDX :: DispatchGraphInfoAMDX -> "nodeIndex" ::: Word32
$sel:nodeIndex:DispatchGraphInfoAMDX :: DispatchGraphInfoAMDX -> "nodeIndex" ::: Word32
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    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 -> a -> IO ()
poke ((Ptr DispatchGraphInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) ("nodeIndex" ::: Word32
nodeIndex)
    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 -> a -> IO ()
poke ((Ptr DispatchGraphInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) ("nodeIndex" ::: Word32
payloadCount)
    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 -> a -> IO b -> IO b
pokeCStruct ((Ptr DispatchGraphInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceOrHostAddressConstAMDX)) (DeviceOrHostAddressConstAMDX
payloads) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())
    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 -> a -> IO ()
poke ((Ptr DispatchGraphInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (Flags64
payloadStride)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr DispatchGraphInfoAMDX -> IO b -> IO b
pokeZeroCStruct Ptr DispatchGraphInfoAMDX
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    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 -> a -> IO ()
poke ((Ptr DispatchGraphInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
    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 -> a -> IO b -> IO b
pokeCStruct ((Ptr DispatchGraphInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceOrHostAddressConstAMDX)) (forall a. Zero a => a
zero) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())
    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 -> a -> IO ()
poke ((Ptr DispatchGraphInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f

instance Zero DispatchGraphInfoAMDX where
  zero :: DispatchGraphInfoAMDX
zero = ("nodeIndex" ::: Word32)
-> ("nodeIndex" ::: Word32)
-> DeviceOrHostAddressConstAMDX
-> Flags64
-> DispatchGraphInfoAMDX
DispatchGraphInfoAMDX
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkDispatchGraphCountInfoAMDX - Structure specifying count parameters for
-- execution graph dispatch
--
-- = Description
--
-- Whether @infos@ is consumed as a device or host pointer is defined by
-- the command this structure is used in.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMDX_shader_enqueue VK_AMDX_shader_enqueue>,
-- 'DeviceOrHostAddressConstAMDX', 'cmdDispatchGraphAMDX',
-- 'cmdDispatchGraphIndirectAMDX', 'cmdDispatchGraphIndirectCountAMDX'
data DispatchGraphCountInfoAMDX = DispatchGraphCountInfoAMDX
  { -- | @count@ is the number of dispatches to perform.
    DispatchGraphCountInfoAMDX -> "nodeIndex" ::: Word32
count :: Word32
  , -- | @infos@ is the device or host address of a flat array of
    -- 'DispatchGraphInfoAMDX' structures
    DispatchGraphCountInfoAMDX -> DeviceOrHostAddressConstAMDX
infos :: DeviceOrHostAddressConstAMDX
  , -- | @stride@ is the byte stride between successive 'DispatchGraphInfoAMDX'
    -- structures in @infos@
    DispatchGraphCountInfoAMDX -> Flags64
stride :: Word64
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DispatchGraphCountInfoAMDX)
#endif
deriving instance Show DispatchGraphCountInfoAMDX

instance ToCStruct DispatchGraphCountInfoAMDX where
  withCStruct :: forall b.
DispatchGraphCountInfoAMDX
-> (("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX) -> IO b)
-> IO b
withCStruct DispatchGraphCountInfoAMDX
x ("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p DispatchGraphCountInfoAMDX
x (("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX) -> IO b
f "pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p)
  pokeCStruct :: forall b.
("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX)
-> DispatchGraphCountInfoAMDX -> IO b -> IO b
pokeCStruct "pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p DispatchGraphCountInfoAMDX{"nodeIndex" ::: Word32
Flags64
DeviceOrHostAddressConstAMDX
stride :: Flags64
infos :: DeviceOrHostAddressConstAMDX
count :: "nodeIndex" ::: Word32
$sel:stride:DispatchGraphCountInfoAMDX :: DispatchGraphCountInfoAMDX -> Flags64
$sel:infos:DispatchGraphCountInfoAMDX :: DispatchGraphCountInfoAMDX -> DeviceOrHostAddressConstAMDX
$sel:count:DispatchGraphCountInfoAMDX :: DispatchGraphCountInfoAMDX -> "nodeIndex" ::: Word32
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    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 -> a -> IO ()
poke (("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) ("nodeIndex" ::: Word32
count)
    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 -> a -> IO b -> IO b
pokeCStruct (("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceOrHostAddressConstAMDX)) (DeviceOrHostAddressConstAMDX
infos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())
    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 -> a -> IO ()
poke (("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (Flags64
stride)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX) -> IO b -> IO b
pokeZeroCStruct "pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    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 -> a -> IO b -> IO b
pokeCStruct (("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceOrHostAddressConstAMDX)) (forall a. Zero a => a
zero) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())
    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 -> a -> IO ()
poke (("pCountInfo" ::: Ptr DispatchGraphCountInfoAMDX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word64)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f

instance Zero DispatchGraphCountInfoAMDX where
  zero :: DispatchGraphCountInfoAMDX
zero = ("nodeIndex" ::: Word32)
-> DeviceOrHostAddressConstAMDX
-> Flags64
-> DispatchGraphCountInfoAMDX
DispatchGraphCountInfoAMDX
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


data DeviceOrHostAddressConstAMDX
  = DeviceAddressConstAMDX DeviceAddress
  | HostAddressConstAMDX (Ptr ())
  deriving (Int -> DeviceOrHostAddressConstAMDX -> ShowS
[DeviceOrHostAddressConstAMDX] -> ShowS
DeviceOrHostAddressConstAMDX -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeviceOrHostAddressConstAMDX] -> ShowS
$cshowList :: [DeviceOrHostAddressConstAMDX] -> ShowS
show :: DeviceOrHostAddressConstAMDX -> String
$cshow :: DeviceOrHostAddressConstAMDX -> String
showsPrec :: Int -> DeviceOrHostAddressConstAMDX -> ShowS
$cshowsPrec :: Int -> DeviceOrHostAddressConstAMDX -> ShowS
Show)

instance ToCStruct DeviceOrHostAddressConstAMDX where
  withCStruct :: forall b.
DeviceOrHostAddressConstAMDX
-> (Ptr DeviceOrHostAddressConstAMDX -> IO b) -> IO b
withCStruct DeviceOrHostAddressConstAMDX
x Ptr DeviceOrHostAddressConstAMDX -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr DeviceOrHostAddressConstAMDX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceOrHostAddressConstAMDX
p DeviceOrHostAddressConstAMDX
x (Ptr DeviceOrHostAddressConstAMDX -> IO b
f Ptr DeviceOrHostAddressConstAMDX
p)
  pokeCStruct :: Ptr DeviceOrHostAddressConstAMDX -> DeviceOrHostAddressConstAMDX -> IO a -> IO a
  pokeCStruct :: forall b.
Ptr DeviceOrHostAddressConstAMDX
-> DeviceOrHostAddressConstAMDX -> IO b -> IO b
pokeCStruct Ptr DeviceOrHostAddressConstAMDX
p = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT forall b c a. (b -> c) -> (a -> b) -> a -> c
.  \case
    DeviceAddressConstAMDX Flags64
v -> 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 -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr @_ @DeviceAddress Ptr DeviceOrHostAddressConstAMDX
p) (Flags64
v)
    HostAddressConstAMDX Ptr ()
v -> 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 -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr @_ @(Ptr ()) Ptr DeviceOrHostAddressConstAMDX
p) (Ptr ()
v)
  pokeZeroCStruct :: Ptr DeviceOrHostAddressConstAMDX -> IO b -> IO b
  pokeZeroCStruct :: forall b. Ptr DeviceOrHostAddressConstAMDX -> IO b -> IO b
pokeZeroCStruct Ptr DeviceOrHostAddressConstAMDX
_ IO b
f = IO b
f
  cStructSize :: Int
cStructSize = Int
8
  cStructAlignment :: Int
cStructAlignment = Int
8

instance Zero DeviceOrHostAddressConstAMDX where
  zero :: DeviceOrHostAddressConstAMDX
zero = Flags64 -> DeviceOrHostAddressConstAMDX
DeviceAddressConstAMDX forall a. Zero a => a
zero


type BufferUsageFlags2KHR = BufferUsageFlagBits2KHR

-- | VkBufferUsageFlagBits2KHR - Bitmask controlling how a pipeline is
-- created
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_maintenance5 VK_KHR_maintenance5>
newtype BufferUsageFlagBits2KHR = BufferUsageFlagBits2KHR Flags64
  deriving newtype (BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
$c/= :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
== :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
$c== :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
Eq, Eq BufferUsageFlagBits2KHR
BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Ordering
BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
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 :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
$cmin :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
max :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
$cmax :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
>= :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
$c>= :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
> :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
$c> :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
<= :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
$c<= :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
< :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
$c< :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Bool
compare :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Ordering
$ccompare :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> Ordering
Ord, Ptr BufferUsageFlagBits2KHR -> IO BufferUsageFlagBits2KHR
Ptr BufferUsageFlagBits2KHR -> Int -> IO BufferUsageFlagBits2KHR
Ptr BufferUsageFlagBits2KHR
-> Int -> BufferUsageFlagBits2KHR -> IO ()
Ptr BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> IO ()
BufferUsageFlagBits2KHR -> Int
forall b. Ptr b -> Int -> IO BufferUsageFlagBits2KHR
forall b. Ptr b -> Int -> BufferUsageFlagBits2KHR -> 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 BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> IO ()
$cpoke :: Ptr BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR -> IO ()
peek :: Ptr BufferUsageFlagBits2KHR -> IO BufferUsageFlagBits2KHR
$cpeek :: Ptr BufferUsageFlagBits2KHR -> IO BufferUsageFlagBits2KHR
pokeByteOff :: forall b. Ptr b -> Int -> BufferUsageFlagBits2KHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> BufferUsageFlagBits2KHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO BufferUsageFlagBits2KHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO BufferUsageFlagBits2KHR
pokeElemOff :: Ptr BufferUsageFlagBits2KHR
-> Int -> BufferUsageFlagBits2KHR -> IO ()
$cpokeElemOff :: Ptr BufferUsageFlagBits2KHR
-> Int -> BufferUsageFlagBits2KHR -> IO ()
peekElemOff :: Ptr BufferUsageFlagBits2KHR -> Int -> IO BufferUsageFlagBits2KHR
$cpeekElemOff :: Ptr BufferUsageFlagBits2KHR -> Int -> IO BufferUsageFlagBits2KHR
alignment :: BufferUsageFlagBits2KHR -> Int
$calignment :: BufferUsageFlagBits2KHR -> Int
sizeOf :: BufferUsageFlagBits2KHR -> Int
$csizeOf :: BufferUsageFlagBits2KHR -> Int
Storable, BufferUsageFlagBits2KHR
forall a. a -> Zero a
zero :: BufferUsageFlagBits2KHR
$czero :: BufferUsageFlagBits2KHR
Zero, Eq BufferUsageFlagBits2KHR
BufferUsageFlagBits2KHR
Int -> BufferUsageFlagBits2KHR
BufferUsageFlagBits2KHR -> Bool
BufferUsageFlagBits2KHR -> Int
BufferUsageFlagBits2KHR -> Maybe Int
BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
BufferUsageFlagBits2KHR -> Int -> Bool
BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: BufferUsageFlagBits2KHR -> Int
$cpopCount :: BufferUsageFlagBits2KHR -> Int
rotateR :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$crotateR :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
rotateL :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$crotateL :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
unsafeShiftR :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$cunsafeShiftR :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
shiftR :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$cshiftR :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
unsafeShiftL :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$cunsafeShiftL :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
shiftL :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$cshiftL :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
isSigned :: BufferUsageFlagBits2KHR -> Bool
$cisSigned :: BufferUsageFlagBits2KHR -> Bool
bitSize :: BufferUsageFlagBits2KHR -> Int
$cbitSize :: BufferUsageFlagBits2KHR -> Int
bitSizeMaybe :: BufferUsageFlagBits2KHR -> Maybe Int
$cbitSizeMaybe :: BufferUsageFlagBits2KHR -> Maybe Int
testBit :: BufferUsageFlagBits2KHR -> Int -> Bool
$ctestBit :: BufferUsageFlagBits2KHR -> Int -> Bool
complementBit :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$ccomplementBit :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
clearBit :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$cclearBit :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
setBit :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$csetBit :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
bit :: Int -> BufferUsageFlagBits2KHR
$cbit :: Int -> BufferUsageFlagBits2KHR
zeroBits :: BufferUsageFlagBits2KHR
$czeroBits :: BufferUsageFlagBits2KHR
rotate :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$crotate :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
shift :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
$cshift :: BufferUsageFlagBits2KHR -> Int -> BufferUsageFlagBits2KHR
complement :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
$ccomplement :: BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
xor :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
$cxor :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
.|. :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
$c.|. :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
.&. :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
$c.&. :: BufferUsageFlagBits2KHR
-> BufferUsageFlagBits2KHR -> BufferUsageFlagBits2KHR
Bits, Bits BufferUsageFlagBits2KHR
BufferUsageFlagBits2KHR -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: BufferUsageFlagBits2KHR -> Int
$ccountTrailingZeros :: BufferUsageFlagBits2KHR -> Int
countLeadingZeros :: BufferUsageFlagBits2KHR -> Int
$ccountLeadingZeros :: BufferUsageFlagBits2KHR -> Int
finiteBitSize :: BufferUsageFlagBits2KHR -> Int
$cfiniteBitSize :: BufferUsageFlagBits2KHR -> Int
FiniteBits)

-- | 'BUFFER_USAGE_2_TRANSFER_SRC_BIT_KHR' specifies that the buffer /can/ be
-- used as the source of a /transfer command/ (see the definition of
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-pipeline-stages-transfer >).
pattern $bBUFFER_USAGE_2_TRANSFER_SRC_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_TRANSFER_SRC_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_TRANSFER_SRC_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000001

-- | 'BUFFER_USAGE_2_TRANSFER_DST_BIT_KHR' specifies that the buffer /can/ be
-- used as the destination of a transfer command.
pattern $bBUFFER_USAGE_2_TRANSFER_DST_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_TRANSFER_DST_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_TRANSFER_DST_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000002

-- | 'BUFFER_USAGE_2_UNIFORM_TEXEL_BUFFER_BIT_KHR' specifies that the buffer
-- /can/ be used to create a 'Vulkan.Core10.Handles.BufferView' suitable
-- for occupying a 'Vulkan.Core10.Handles.DescriptorSet' slot of type
-- 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER'.
pattern $bBUFFER_USAGE_2_UNIFORM_TEXEL_BUFFER_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_UNIFORM_TEXEL_BUFFER_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_UNIFORM_TEXEL_BUFFER_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000004

-- | 'BUFFER_USAGE_2_STORAGE_TEXEL_BUFFER_BIT_KHR' specifies that the buffer
-- /can/ be used to create a 'Vulkan.Core10.Handles.BufferView' suitable
-- for occupying a 'Vulkan.Core10.Handles.DescriptorSet' slot of type
-- 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER'.
pattern $bBUFFER_USAGE_2_STORAGE_TEXEL_BUFFER_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_STORAGE_TEXEL_BUFFER_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_STORAGE_TEXEL_BUFFER_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000008

-- | 'BUFFER_USAGE_2_UNIFORM_BUFFER_BIT_KHR' specifies that the buffer /can/
-- be used in a 'Vulkan.Core10.DescriptorSet.DescriptorBufferInfo' suitable
-- for occupying a 'Vulkan.Core10.Handles.DescriptorSet' slot either of
-- type 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_UNIFORM_BUFFER'
-- or
-- 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC'.
pattern $bBUFFER_USAGE_2_UNIFORM_BUFFER_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_UNIFORM_BUFFER_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_UNIFORM_BUFFER_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000010

-- | 'BUFFER_USAGE_2_STORAGE_BUFFER_BIT_KHR' specifies that the buffer /can/
-- be used in a 'Vulkan.Core10.DescriptorSet.DescriptorBufferInfo' suitable
-- for occupying a 'Vulkan.Core10.Handles.DescriptorSet' slot either of
-- type 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_BUFFER'
-- or
-- 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC'.
pattern $bBUFFER_USAGE_2_STORAGE_BUFFER_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_STORAGE_BUFFER_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_STORAGE_BUFFER_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000020

-- | 'BUFFER_USAGE_2_INDEX_BUFFER_BIT_KHR' specifies that the buffer is
-- suitable for passing as the @buffer@ parameter to
-- 'Vulkan.Extensions.VK_KHR_maintenance5.cmdBindIndexBuffer2KHR' and
-- 'Vulkan.Core10.CommandBufferBuilding.cmdBindIndexBuffer'.
pattern $bBUFFER_USAGE_2_INDEX_BUFFER_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_INDEX_BUFFER_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_INDEX_BUFFER_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000040

-- | 'BUFFER_USAGE_2_VERTEX_BUFFER_BIT_KHR' specifies that the buffer is
-- suitable for passing as an element of the @pBuffers@ array to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdBindVertexBuffers'.
pattern $bBUFFER_USAGE_2_VERTEX_BUFFER_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_VERTEX_BUFFER_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_VERTEX_BUFFER_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000080

-- | 'BUFFER_USAGE_2_INDIRECT_BUFFER_BIT_KHR' specifies that the buffer is
-- suitable for passing as the @buffer@ parameter to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdDrawIndirect',
-- 'Vulkan.Core10.CommandBufferBuilding.cmdDrawIndexedIndirect',
-- 'Vulkan.Extensions.VK_NV_mesh_shader.cmdDrawMeshTasksIndirectNV',
-- 'Vulkan.Extensions.VK_NV_mesh_shader.cmdDrawMeshTasksIndirectCountNV',
-- 'Vulkan.Extensions.VK_EXT_mesh_shader.cmdDrawMeshTasksIndirectEXT',
-- 'Vulkan.Extensions.VK_EXT_mesh_shader.cmdDrawMeshTasksIndirectCountEXT',
-- 'Vulkan.Extensions.VK_HUAWEI_cluster_culling_shader.cmdDrawClusterIndirectHUAWEI',
-- or 'Vulkan.Core10.CommandBufferBuilding.cmdDispatchIndirect'. It is also
-- suitable for passing as the @buffer@ member of
-- 'Vulkan.Extensions.VK_NV_device_generated_commands.IndirectCommandsStreamNV',
-- or @sequencesCountBuffer@ or @sequencesIndexBuffer@ or
-- @preprocessedBuffer@ member of
-- 'Vulkan.Extensions.VK_NV_device_generated_commands.GeneratedCommandsInfoNV'
pattern $bBUFFER_USAGE_2_INDIRECT_BUFFER_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_INDIRECT_BUFFER_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_INDIRECT_BUFFER_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000100

-- No documentation found for Nested "VkBufferUsageFlagBits2KHR" "VK_BUFFER_USAGE_2_MICROMAP_STORAGE_BIT_EXT"
pattern $bBUFFER_USAGE_2_MICROMAP_STORAGE_BIT_EXT :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_MICROMAP_STORAGE_BIT_EXT :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_MICROMAP_STORAGE_BIT_EXT = BufferUsageFlagBits2KHR 0x0000000001000000

-- No documentation found for Nested "VkBufferUsageFlagBits2KHR" "VK_BUFFER_USAGE_2_MICROMAP_BUILD_INPUT_READ_ONLY_BIT_EXT"
pattern $bBUFFER_USAGE_2_MICROMAP_BUILD_INPUT_READ_ONLY_BIT_EXT :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_MICROMAP_BUILD_INPUT_READ_ONLY_BIT_EXT :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_MICROMAP_BUILD_INPUT_READ_ONLY_BIT_EXT = BufferUsageFlagBits2KHR 0x0000000000800000

-- | 'BUFFER_USAGE_2_PUSH_DESCRIPTORS_DESCRIPTOR_BUFFER_BIT_EXT' specifies
-- that the buffer, when bound, /can/ be used by the implementation to
-- support push descriptors when using descriptor buffers.
pattern $bBUFFER_USAGE_2_PUSH_DESCRIPTORS_DESCRIPTOR_BUFFER_BIT_EXT :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_PUSH_DESCRIPTORS_DESCRIPTOR_BUFFER_BIT_EXT :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_PUSH_DESCRIPTORS_DESCRIPTOR_BUFFER_BIT_EXT = BufferUsageFlagBits2KHR 0x0000000004000000

-- | 'BUFFER_USAGE_2_RESOURCE_DESCRIPTOR_BUFFER_BIT_EXT' specifies that the
-- buffer is suitable to contain resource descriptors when bound as a
-- descriptor buffer.
pattern $bBUFFER_USAGE_2_RESOURCE_DESCRIPTOR_BUFFER_BIT_EXT :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_RESOURCE_DESCRIPTOR_BUFFER_BIT_EXT :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_RESOURCE_DESCRIPTOR_BUFFER_BIT_EXT = BufferUsageFlagBits2KHR 0x0000000000400000

-- | 'BUFFER_USAGE_2_SAMPLER_DESCRIPTOR_BUFFER_BIT_EXT' specifies that the
-- buffer is suitable to contain sampler and combined image sampler
-- descriptors when bound as a descriptor buffer. Buffers containing
-- combined image sampler descriptors /must/ also specify
-- 'BUFFER_USAGE_2_RESOURCE_DESCRIPTOR_BUFFER_BIT_EXT'.
pattern $bBUFFER_USAGE_2_SAMPLER_DESCRIPTOR_BUFFER_BIT_EXT :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_SAMPLER_DESCRIPTOR_BUFFER_BIT_EXT :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_SAMPLER_DESCRIPTOR_BUFFER_BIT_EXT = BufferUsageFlagBits2KHR 0x0000000000200000

-- | 'BUFFER_USAGE_2_ACCELERATION_STRUCTURE_STORAGE_BIT_KHR' specifies that
-- the buffer is suitable for storage space for a
-- 'Vulkan.Extensions.Handles.AccelerationStructureKHR'.
pattern $bBUFFER_USAGE_2_ACCELERATION_STRUCTURE_STORAGE_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_ACCELERATION_STRUCTURE_STORAGE_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_ACCELERATION_STRUCTURE_STORAGE_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000100000

-- | 'BUFFER_USAGE_2_ACCELERATION_STRUCTURE_BUILD_INPUT_READ_ONLY_BIT_KHR'
-- specifies that the buffer is suitable for use as a read-only input to an
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#acceleration-structure-building acceleration structure build>.
pattern $bBUFFER_USAGE_2_ACCELERATION_STRUCTURE_BUILD_INPUT_READ_ONLY_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_ACCELERATION_STRUCTURE_BUILD_INPUT_READ_ONLY_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_ACCELERATION_STRUCTURE_BUILD_INPUT_READ_ONLY_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000080000

-- | 'BUFFER_USAGE_2_SHADER_DEVICE_ADDRESS_BIT_KHR' specifies that the buffer
-- /can/ be used to retrieve a buffer device address via
-- 'Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address.getBufferDeviceAddress'
-- and use that address to access the buffer’s memory from a shader.
pattern $bBUFFER_USAGE_2_SHADER_DEVICE_ADDRESS_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_SHADER_DEVICE_ADDRESS_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_SHADER_DEVICE_ADDRESS_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000020000

-- | 'BUFFER_USAGE_2_VIDEO_ENCODE_SRC_BIT_KHR' is reserved for future use.
pattern $bBUFFER_USAGE_2_VIDEO_ENCODE_SRC_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_VIDEO_ENCODE_SRC_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_VIDEO_ENCODE_SRC_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000010000

-- | 'BUFFER_USAGE_2_VIDEO_ENCODE_DST_BIT_KHR' specifies that the buffer
-- /can/ be used as the destination video bitstream buffer in a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#video-encode-operations video encode operation>.
pattern $bBUFFER_USAGE_2_VIDEO_ENCODE_DST_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_VIDEO_ENCODE_DST_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_VIDEO_ENCODE_DST_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000008000

-- | 'BUFFER_USAGE_2_VIDEO_DECODE_DST_BIT_KHR' is reserved for future use.
pattern $bBUFFER_USAGE_2_VIDEO_DECODE_DST_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_VIDEO_DECODE_DST_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_VIDEO_DECODE_DST_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000004000

-- | 'BUFFER_USAGE_2_VIDEO_DECODE_SRC_BIT_KHR' specifies that the buffer
-- /can/ be used as the source video bitstream buffer in a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#video-decode-operations video decode operation>.
pattern $bBUFFER_USAGE_2_VIDEO_DECODE_SRC_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_VIDEO_DECODE_SRC_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_VIDEO_DECODE_SRC_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000002000

-- | 'BUFFER_USAGE_2_TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT' specifies
-- that the buffer is suitable for using as a counter buffer with
-- 'Vulkan.Extensions.VK_EXT_transform_feedback.cmdBeginTransformFeedbackEXT'
-- and
-- 'Vulkan.Extensions.VK_EXT_transform_feedback.cmdEndTransformFeedbackEXT'.
pattern $bBUFFER_USAGE_2_TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT = BufferUsageFlagBits2KHR 0x0000000000001000

-- | 'BUFFER_USAGE_2_TRANSFORM_FEEDBACK_BUFFER_BIT_EXT' specifies that the
-- buffer is suitable for using for binding as a transform feedback buffer
-- with
-- 'Vulkan.Extensions.VK_EXT_transform_feedback.cmdBindTransformFeedbackBuffersEXT'.
pattern $bBUFFER_USAGE_2_TRANSFORM_FEEDBACK_BUFFER_BIT_EXT :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_TRANSFORM_FEEDBACK_BUFFER_BIT_EXT :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_TRANSFORM_FEEDBACK_BUFFER_BIT_EXT = BufferUsageFlagBits2KHR 0x0000000000000800

-- | 'BUFFER_USAGE_2_SHADER_BINDING_TABLE_BIT_KHR' specifies that the buffer
-- is suitable for use as a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#shader-binding-table Shader Binding Table>.
pattern $bBUFFER_USAGE_2_SHADER_BINDING_TABLE_BIT_KHR :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_SHADER_BINDING_TABLE_BIT_KHR :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_SHADER_BINDING_TABLE_BIT_KHR = BufferUsageFlagBits2KHR 0x0000000000000400

-- | 'BUFFER_USAGE_2_CONDITIONAL_RENDERING_BIT_EXT' specifies that the buffer
-- is suitable for passing as the @buffer@ parameter to
-- 'Vulkan.Extensions.VK_EXT_conditional_rendering.cmdBeginConditionalRenderingEXT'.
pattern $bBUFFER_USAGE_2_CONDITIONAL_RENDERING_BIT_EXT :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_CONDITIONAL_RENDERING_BIT_EXT :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_CONDITIONAL_RENDERING_BIT_EXT = BufferUsageFlagBits2KHR 0x0000000000000200

-- | 'BUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX' specifies that the
-- buffer /can/ be used for as scratch memory for
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#executiongraphs execution graph dispatch>.
pattern $bBUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX :: BufferUsageFlagBits2KHR
$mBUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX :: forall {r}.
BufferUsageFlagBits2KHR -> ((# #) -> r) -> ((# #) -> r) -> r
BUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX = BufferUsageFlagBits2KHR 0x0000000002000000

conNameBufferUsageFlagBits2KHR :: String
conNameBufferUsageFlagBits2KHR :: String
conNameBufferUsageFlagBits2KHR = String
"BufferUsageFlagBits2KHR"

enumPrefixBufferUsageFlagBits2KHR :: String
enumPrefixBufferUsageFlagBits2KHR :: String
enumPrefixBufferUsageFlagBits2KHR = String
"BUFFER_USAGE_2_"

showTableBufferUsageFlagBits2KHR :: [(BufferUsageFlagBits2KHR, String)]
showTableBufferUsageFlagBits2KHR :: [(BufferUsageFlagBits2KHR, String)]
showTableBufferUsageFlagBits2KHR =
  [
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_TRANSFER_SRC_BIT_KHR
    , String
"TRANSFER_SRC_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_TRANSFER_DST_BIT_KHR
    , String
"TRANSFER_DST_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_UNIFORM_TEXEL_BUFFER_BIT_KHR
    , String
"UNIFORM_TEXEL_BUFFER_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_STORAGE_TEXEL_BUFFER_BIT_KHR
    , String
"STORAGE_TEXEL_BUFFER_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_UNIFORM_BUFFER_BIT_KHR
    , String
"UNIFORM_BUFFER_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_STORAGE_BUFFER_BIT_KHR
    , String
"STORAGE_BUFFER_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_INDEX_BUFFER_BIT_KHR
    , String
"INDEX_BUFFER_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_VERTEX_BUFFER_BIT_KHR
    , String
"VERTEX_BUFFER_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_INDIRECT_BUFFER_BIT_KHR
    , String
"INDIRECT_BUFFER_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_MICROMAP_STORAGE_BIT_EXT
    , String
"MICROMAP_STORAGE_BIT_EXT"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_MICROMAP_BUILD_INPUT_READ_ONLY_BIT_EXT
    , String
"MICROMAP_BUILD_INPUT_READ_ONLY_BIT_EXT"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_PUSH_DESCRIPTORS_DESCRIPTOR_BUFFER_BIT_EXT
    , String
"PUSH_DESCRIPTORS_DESCRIPTOR_BUFFER_BIT_EXT"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_RESOURCE_DESCRIPTOR_BUFFER_BIT_EXT
    , String
"RESOURCE_DESCRIPTOR_BUFFER_BIT_EXT"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_SAMPLER_DESCRIPTOR_BUFFER_BIT_EXT
    , String
"SAMPLER_DESCRIPTOR_BUFFER_BIT_EXT"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_ACCELERATION_STRUCTURE_STORAGE_BIT_KHR
    , String
"ACCELERATION_STRUCTURE_STORAGE_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_ACCELERATION_STRUCTURE_BUILD_INPUT_READ_ONLY_BIT_KHR
    , String
"ACCELERATION_STRUCTURE_BUILD_INPUT_READ_ONLY_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_SHADER_DEVICE_ADDRESS_BIT_KHR
    , String
"SHADER_DEVICE_ADDRESS_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_VIDEO_ENCODE_SRC_BIT_KHR
    , String
"VIDEO_ENCODE_SRC_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_VIDEO_ENCODE_DST_BIT_KHR
    , String
"VIDEO_ENCODE_DST_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_VIDEO_DECODE_DST_BIT_KHR
    , String
"VIDEO_DECODE_DST_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_VIDEO_DECODE_SRC_BIT_KHR
    , String
"VIDEO_DECODE_SRC_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT
    , String
"TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_TRANSFORM_FEEDBACK_BUFFER_BIT_EXT
    , String
"TRANSFORM_FEEDBACK_BUFFER_BIT_EXT"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_SHADER_BINDING_TABLE_BIT_KHR
    , String
"SHADER_BINDING_TABLE_BIT_KHR"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_CONDITIONAL_RENDERING_BIT_EXT
    , String
"CONDITIONAL_RENDERING_BIT_EXT"
    )
  ,
    ( BufferUsageFlagBits2KHR
BUFFER_USAGE_2_EXECUTION_GRAPH_SCRATCH_BIT_AMDX
    , String
"EXECUTION_GRAPH_SCRATCH_BIT_AMDX"
    )
  ]

instance Show BufferUsageFlagBits2KHR where
  showsPrec :: Int -> BufferUsageFlagBits2KHR -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixBufferUsageFlagBits2KHR
      [(BufferUsageFlagBits2KHR, String)]
showTableBufferUsageFlagBits2KHR
      String
conNameBufferUsageFlagBits2KHR
      (\(BufferUsageFlagBits2KHR Flags64
x) -> Flags64
x)
      (\Flags64
x -> String -> ShowS
showString String
"0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Flags64
x)

instance Read BufferUsageFlagBits2KHR where
  readPrec :: ReadPrec BufferUsageFlagBits2KHR
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixBufferUsageFlagBits2KHR
      [(BufferUsageFlagBits2KHR, String)]
showTableBufferUsageFlagBits2KHR
      String
conNameBufferUsageFlagBits2KHR
      Flags64 -> BufferUsageFlagBits2KHR
BufferUsageFlagBits2KHR

type AMDX_SHADER_ENQUEUE_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_AMDX_SHADER_ENQUEUE_SPEC_VERSION"
pattern AMDX_SHADER_ENQUEUE_SPEC_VERSION :: forall a . Integral a => a
pattern $bAMDX_SHADER_ENQUEUE_SPEC_VERSION :: forall a. Integral a => a
$mAMDX_SHADER_ENQUEUE_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
AMDX_SHADER_ENQUEUE_SPEC_VERSION = 1


type AMDX_SHADER_ENQUEUE_EXTENSION_NAME = "VK_AMDX_shader_enqueue"

-- No documentation found for TopLevel "VK_AMDX_SHADER_ENQUEUE_EXTENSION_NAME"
pattern AMDX_SHADER_ENQUEUE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bAMDX_SHADER_ENQUEUE_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mAMDX_SHADER_ENQUEUE_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
AMDX_SHADER_ENQUEUE_EXTENSION_NAME = "VK_AMDX_shader_enqueue"