{-# language CPP #-} -- | = Name -- -- VK_KHR_push_descriptor - device extension -- -- == VK_KHR_push_descriptor -- -- [__Name String__] -- @VK_KHR_push_descriptor@ -- -- [__Extension Type__] -- Device extension -- -- [__Registered Extension Number__] -- 81 -- -- [__Revision__] -- 2 -- -- [__Ratification Status__] -- Ratified -- -- [__Extension and Version Dependencies__] -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_get_physical_device_properties2 VK_KHR_get_physical_device_properties2> -- -- [__Contact__] -- -- - Jeff Bolz -- <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_push_descriptor] @jeffbolznv%0A*Here describe the issue or question you have about the VK_KHR_push_descriptor extension* > -- -- == Other Extension Metadata -- -- [__Last Modified Date__] -- 2017-09-12 -- -- [__IP Status__] -- No known IP claims. -- -- [__Contributors__] -- -- - Jeff Bolz, NVIDIA -- -- - Michael Worcester, Imagination Technologies -- -- == Description -- -- This extension allows descriptors to be written into the command buffer, -- while the implementation is responsible for managing their memory. Push -- descriptors may enable easier porting from older APIs and in some cases -- can be more efficient than writing descriptors into descriptor sets. -- -- == New Commands -- -- - 'cmdPushDescriptorSetKHR' -- -- If -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_descriptor_update_template VK_KHR_descriptor_update_template> -- is supported: -- -- - 'cmdPushDescriptorSetWithTemplateKHR' -- -- If -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#versions-1.1 Version 1.1> -- is supported: -- -- - 'cmdPushDescriptorSetWithTemplateKHR' -- -- == New Structures -- -- - Extending -- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2': -- -- - 'PhysicalDevicePushDescriptorPropertiesKHR' -- -- == New Enum Constants -- -- - 'KHR_PUSH_DESCRIPTOR_EXTENSION_NAME' -- -- - 'KHR_PUSH_DESCRIPTOR_SPEC_VERSION' -- -- - Extending -- 'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DescriptorSetLayoutCreateFlagBits': -- -- - 'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_PUSH_DESCRIPTOR_BIT_KHR' -- -- - Extending 'Vulkan.Core10.Enums.StructureType.StructureType': -- -- - 'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_PUSH_DESCRIPTOR_PROPERTIES_KHR' -- -- If -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_descriptor_update_template VK_KHR_descriptor_update_template> -- is supported: -- -- - Extending -- 'Vulkan.Core11.Enums.DescriptorUpdateTemplateType.DescriptorUpdateTemplateType': -- -- - 'Vulkan.Core11.Enums.DescriptorUpdateTemplateType.DESCRIPTOR_UPDATE_TEMPLATE_TYPE_PUSH_DESCRIPTORS_KHR' -- -- If -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#versions-1.1 Version 1.1> -- is supported: -- -- - Extending -- 'Vulkan.Core11.Enums.DescriptorUpdateTemplateType.DescriptorUpdateTemplateType': -- -- - 'Vulkan.Core11.Enums.DescriptorUpdateTemplateType.DESCRIPTOR_UPDATE_TEMPLATE_TYPE_PUSH_DESCRIPTORS_KHR' -- -- == Version History -- -- - Revision 1, 2016-10-15 (Jeff Bolz) -- -- - Internal revisions -- -- - Revision 2, 2017-09-12 (Tobias Hector) -- -- - Added interactions with Vulkan 1.1 -- -- == See Also -- -- 'PhysicalDevicePushDescriptorPropertiesKHR', 'cmdPushDescriptorSetKHR' -- -- == Document Notes -- -- For more information, see the -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_KHR_push_descriptor Vulkan Specification> -- -- This page is a generated document. Fixes and changes should be made to -- the generator scripts, not directly. module Vulkan.Extensions.VK_KHR_push_descriptor ( cmdPushDescriptorSetKHR , cmdPushDescriptorSetWithTemplateKHR , PhysicalDevicePushDescriptorPropertiesKHR(..) , KHR_PUSH_DESCRIPTOR_SPEC_VERSION , pattern KHR_PUSH_DESCRIPTOR_SPEC_VERSION , KHR_PUSH_DESCRIPTOR_EXTENSION_NAME , pattern KHR_PUSH_DESCRIPTOR_EXTENSION_NAME ) where import Vulkan.Internal.Utils (traceAroundEvent) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Foreign.Marshal.Alloc (allocaBytes) import GHC.IO (throwIO) import GHC.Ptr (nullFunPtr) import Foreign.Ptr (nullPtr) import Foreign.Ptr (plusPtr) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Cont (evalContT) import qualified Data.Vector (imapM_) import qualified Data.Vector (length) import Vulkan.CStruct (FromCStruct) import Vulkan.CStruct (FromCStruct(..)) import Vulkan.CStruct (ToCStruct) import Vulkan.CStruct (ToCStruct(..)) import Vulkan.Zero (Zero(..)) import Control.Monad.IO.Class (MonadIO) import Data.String (IsString) import Data.Typeable (Typeable) import Foreign.Storable (Storable) import Foreign.Storable (Storable(peek)) import Foreign.Storable (Storable(poke)) import qualified Foreign.Storable (Storable(..)) import GHC.Generics (Generic) import GHC.IO.Exception (IOErrorType(..)) import GHC.IO.Exception (IOException(..)) import Foreign.Ptr (FunPtr) import Foreign.Ptr (Ptr) import Data.Word (Word32) import Data.Kind (Type) import Control.Monad.Trans.Cont (ContT(..)) import Data.Vector (Vector) import Vulkan.CStruct.Extends (forgetExtensions) import Vulkan.CStruct.Extends (pokeSomeCStruct) import Vulkan.NamedType ((:::)) import Vulkan.Core10.Handles (CommandBuffer) import Vulkan.Core10.Handles (CommandBuffer(..)) import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer)) import Vulkan.Core10.Handles (CommandBuffer_T) import Vulkan.Core11.Handles (DescriptorUpdateTemplate) import Vulkan.Core11.Handles (DescriptorUpdateTemplate(..)) import Vulkan.Dynamic (DeviceCmds(pVkCmdPushDescriptorSetKHR)) import Vulkan.Dynamic (DeviceCmds(pVkCmdPushDescriptorSetWithTemplateKHR)) import Vulkan.Core10.Enums.PipelineBindPoint (PipelineBindPoint) import Vulkan.Core10.Enums.PipelineBindPoint (PipelineBindPoint(..)) import Vulkan.Core10.Handles (PipelineLayout) import Vulkan.Core10.Handles (PipelineLayout(..)) import Vulkan.CStruct.Extends (SomeStruct) import Vulkan.Core10.Enums.StructureType (StructureType) import Vulkan.Core10.DescriptorSet (WriteDescriptorSet) import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PUSH_DESCRIPTOR_PROPERTIES_KHR)) foreign import ccall #if !defined(SAFE_FOREIGN_CALLS) unsafe #endif "dynamic" mkVkCmdPushDescriptorSetKHR :: FunPtr (Ptr CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> Word32 -> Word32 -> Ptr (SomeStruct WriteDescriptorSet) -> IO ()) -> Ptr CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> Word32 -> Word32 -> Ptr (SomeStruct WriteDescriptorSet) -> IO () -- | vkCmdPushDescriptorSetKHR - Pushes descriptor updates into a command -- buffer -- -- = Description -- -- /Push descriptors/ are a small bank of descriptors whose storage is -- internally managed by the command buffer rather than being written into -- a descriptor set and later bound to a command buffer. Push descriptors -- allow for incremental updates of descriptors without managing the -- lifetime of descriptor sets. -- -- When a command buffer begins recording, all push descriptors are -- undefined. Push descriptors /can/ be updated incrementally and cause -- shaders to use the updated descriptors for subsequent -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#pipelines-bindpoint-commands bound pipeline commands> -- with the pipeline type set by @pipelineBindPoint@ until the descriptor -- is overwritten, or else until the set is disturbed as described in -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#descriptorsets-compatibility Pipeline Layout Compatibility>. -- When the set is disturbed or push descriptors with a different -- descriptor set layout are set, all push descriptors are undefined. -- -- Push descriptors that are -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#shaders-staticuse statically used> -- by a pipeline /must/ not be undefined at the time that a drawing or -- dispatching command is recorded to execute using that pipeline. This -- includes immutable sampler descriptors, which /must/ be pushed before -- they are accessed by a pipeline (the immutable samplers are pushed, -- rather than the samplers in @pDescriptorWrites@). Push descriptors that -- are not statically used /can/ remain undefined. -- -- Push descriptors do not use dynamic offsets. Instead, the corresponding -- non-dynamic descriptor types /can/ be used and the @offset@ member of -- 'Vulkan.Core10.DescriptorSet.DescriptorBufferInfo' /can/ be changed each -- time the descriptor is written. -- -- Each element of @pDescriptorWrites@ is interpreted as in -- 'Vulkan.Core10.DescriptorSet.WriteDescriptorSet', except the @dstSet@ -- member is ignored. -- -- To push an immutable sampler, use a -- 'Vulkan.Core10.DescriptorSet.WriteDescriptorSet' with @dstBinding@ and -- @dstArrayElement@ selecting the immutable sampler’s binding. If the -- descriptor type is -- 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_SAMPLER', the -- @pImageInfo@ parameter is ignored and the immutable sampler is taken -- from the push descriptor set layout in the pipeline layout. If the -- descriptor type is -- 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER', -- the @sampler@ member of the @pImageInfo@ parameter is ignored and the -- immutable sampler is taken from the push descriptor set layout in the -- pipeline layout. -- -- == Valid Usage -- -- - #VUID-vkCmdPushDescriptorSetKHR-pipelineBindPoint-00363# -- @pipelineBindPoint@ /must/ be supported by the @commandBuffer@’s -- parent 'Vulkan.Core10.Handles.CommandPool'’s queue family -- -- - #VUID-vkCmdPushDescriptorSetKHR-set-00364# @set@ /must/ be less than -- 'Vulkan.Core10.PipelineLayout.PipelineLayoutCreateInfo'::@setLayoutCount@ -- provided when @layout@ was created -- -- - #VUID-vkCmdPushDescriptorSetKHR-set-00365# @set@ /must/ be the -- unique set number in the pipeline layout that uses a descriptor set -- layout that was created with -- 'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_PUSH_DESCRIPTOR_BIT_KHR' -- -- - #VUID-vkCmdPushDescriptorSetKHR-pDescriptorWrites-06494# For each -- element i where @pDescriptorWrites@[i].@descriptorType@ is -- 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_SAMPLED_IMAGE', -- 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_IMAGE', -- or -- 'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_INPUT_ATTACHMENT', -- @pDescriptorWrites@[i].@pImageInfo@ /must/ be a valid pointer to an -- array of @pDescriptorWrites@[i].@descriptorCount@ valid -- 'Vulkan.Core10.DescriptorSet.DescriptorImageInfo' structures -- -- == Valid Usage (Implicit) -- -- - #VUID-vkCmdPushDescriptorSetKHR-commandBuffer-parameter# -- @commandBuffer@ /must/ be a valid -- 'Vulkan.Core10.Handles.CommandBuffer' handle -- -- - #VUID-vkCmdPushDescriptorSetKHR-pipelineBindPoint-parameter# -- @pipelineBindPoint@ /must/ be a valid -- 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint' value -- -- - #VUID-vkCmdPushDescriptorSetKHR-layout-parameter# @layout@ /must/ be -- a valid 'Vulkan.Core10.Handles.PipelineLayout' handle -- -- - #VUID-vkCmdPushDescriptorSetKHR-pDescriptorWrites-parameter# -- @pDescriptorWrites@ /must/ be a valid pointer to an array of -- @descriptorWriteCount@ valid -- 'Vulkan.Core10.DescriptorSet.WriteDescriptorSet' structures -- -- - #VUID-vkCmdPushDescriptorSetKHR-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-vkCmdPushDescriptorSetKHR-commandBuffer-cmdpool# The -- 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was -- allocated from /must/ support graphics, or compute operations -- -- - #VUID-vkCmdPushDescriptorSetKHR-videocoding# This command /must/ -- only be called outside of a video coding scope -- -- - #VUID-vkCmdPushDescriptorSetKHR-descriptorWriteCount-arraylength# -- @descriptorWriteCount@ /must/ be greater than @0@ -- -- - #VUID-vkCmdPushDescriptorSetKHR-commonparent# Both of -- @commandBuffer@, and @layout@ /must/ have been created, allocated, -- or retrieved from the same 'Vulkan.Core10.Handles.Device' -- -- == Host Synchronization -- -- - Host access to @commandBuffer@ /must/ be externally synchronized -- -- - 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 | Both | Outside | Graphics | State | -- | Secondary | | | Compute | | -- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+ -- -- = See Also -- -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_push_descriptor VK_KHR_push_descriptor>, -- 'Vulkan.Core10.Handles.CommandBuffer', -- 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint', -- 'Vulkan.Core10.Handles.PipelineLayout', -- 'Vulkan.Core10.DescriptorSet.WriteDescriptorSet' cmdPushDescriptorSetKHR :: forall io . (MonadIO io) => -- | @commandBuffer@ is the command buffer that the descriptors will be -- recorded in. CommandBuffer -> -- | @pipelineBindPoint@ is a -- 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint' indicating the -- type of the pipeline that will use the descriptors. There is a separate -- set of push descriptor bindings for each pipeline type, so binding one -- does not disturb the others. PipelineBindPoint -> -- | @layout@ is a 'Vulkan.Core10.Handles.PipelineLayout' object used to -- program the bindings. PipelineLayout -> -- | @set@ is the set number of the descriptor set in the pipeline layout -- that will be updated. ("set" ::: Word32) -> -- | @pDescriptorWrites@ is a pointer to an array of -- 'Vulkan.Core10.DescriptorSet.WriteDescriptorSet' structures describing -- the descriptors to be updated. ("descriptorWrites" ::: Vector (SomeStruct WriteDescriptorSet)) -> io () cmdPushDescriptorSetKHR :: forall (io :: * -> *). MonadIO io => CommandBuffer -> PipelineBindPoint -> PipelineLayout -> ("set" ::: Word32) -> ("descriptorWrites" ::: Vector (SomeStruct WriteDescriptorSet)) -> io () cmdPushDescriptorSetKHR CommandBuffer commandBuffer PipelineBindPoint pipelineBindPoint PipelineLayout layout "set" ::: Word32 set "descriptorWrites" ::: Vector (SomeStruct WriteDescriptorSet) descriptorWrites = 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 vkCmdPushDescriptorSetKHRPtr :: FunPtr (Ptr CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> ("set" ::: Word32) -> ("set" ::: Word32) -> ("pDescriptorWrites" ::: Ptr (SomeStruct WriteDescriptorSet)) -> IO ()) vkCmdPushDescriptorSetKHRPtr = DeviceCmds -> FunPtr (Ptr CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> ("set" ::: Word32) -> ("set" ::: Word32) -> ("pDescriptorWrites" ::: Ptr (SomeStruct WriteDescriptorSet)) -> IO ()) pVkCmdPushDescriptorSetKHR (case CommandBuffer commandBuffer of CommandBuffer{DeviceCmds $sel:deviceCmds:CommandBuffer :: CommandBuffer -> 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 CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> ("set" ::: Word32) -> ("set" ::: Word32) -> ("pDescriptorWrites" ::: Ptr (SomeStruct WriteDescriptorSet)) -> IO ()) vkCmdPushDescriptorSetKHRPtr 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 vkCmdPushDescriptorSetKHR is null" forall a. Maybe a Nothing forall a. Maybe a Nothing let vkCmdPushDescriptorSetKHR' :: Ptr CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> ("set" ::: Word32) -> ("set" ::: Word32) -> ("pDescriptorWrites" ::: Ptr (SomeStruct WriteDescriptorSet)) -> IO () vkCmdPushDescriptorSetKHR' = FunPtr (Ptr CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> ("set" ::: Word32) -> ("set" ::: Word32) -> ("pDescriptorWrites" ::: Ptr (SomeStruct WriteDescriptorSet)) -> IO ()) -> Ptr CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> ("set" ::: Word32) -> ("set" ::: Word32) -> ("pDescriptorWrites" ::: Ptr (SomeStruct WriteDescriptorSet)) -> IO () mkVkCmdPushDescriptorSetKHR FunPtr (Ptr CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> ("set" ::: Word32) -> ("set" ::: Word32) -> ("pDescriptorWrites" ::: Ptr (SomeStruct WriteDescriptorSet)) -> IO ()) vkCmdPushDescriptorSetKHRPtr Ptr (WriteDescriptorSet Any) pPDescriptorWrites <- 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 @(WriteDescriptorSet _) ((forall a. Vector a -> Int Data.Vector.length ("descriptorWrites" ::: Vector (SomeStruct WriteDescriptorSet) descriptorWrites)) 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 WriteDescriptorSet 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 (WriteDescriptorSet Any) pPDescriptorWrites forall a b. Ptr a -> Int -> Ptr b `plusPtr` (Int 64 forall a. Num a => a -> a -> a * (Int i)) :: Ptr (WriteDescriptorSet _))) (SomeStruct WriteDescriptorSet e) forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a b. (a -> b) -> a -> b $ ())) ("descriptorWrites" ::: Vector (SomeStruct WriteDescriptorSet) descriptorWrites) 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 "vkCmdPushDescriptorSetKHR" (Ptr CommandBuffer_T -> PipelineBindPoint -> PipelineLayout -> ("set" ::: Word32) -> ("set" ::: Word32) -> ("pDescriptorWrites" ::: Ptr (SomeStruct WriteDescriptorSet)) -> IO () vkCmdPushDescriptorSetKHR' (CommandBuffer -> Ptr CommandBuffer_T commandBufferHandle (CommandBuffer commandBuffer)) (PipelineBindPoint pipelineBindPoint) (PipelineLayout layout) ("set" ::: Word32 set) ((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 $ ("descriptorWrites" ::: Vector (SomeStruct WriteDescriptorSet) descriptorWrites)) :: Word32)) (forall (a :: [*] -> *) (es :: [*]). Ptr (a es) -> Ptr (SomeStruct a) forgetExtensions (Ptr (WriteDescriptorSet Any) pPDescriptorWrites))) 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" mkVkCmdPushDescriptorSetWithTemplateKHR :: FunPtr (Ptr CommandBuffer_T -> DescriptorUpdateTemplate -> PipelineLayout -> Word32 -> Ptr () -> IO ()) -> Ptr CommandBuffer_T -> DescriptorUpdateTemplate -> PipelineLayout -> Word32 -> Ptr () -> IO () -- | vkCmdPushDescriptorSetWithTemplateKHR - Pushes descriptor updates into a -- command buffer using a descriptor update template -- -- == Valid Usage -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-commandBuffer-00366# The -- @pipelineBindPoint@ specified during the creation of the descriptor -- update template /must/ be supported by the @commandBuffer@’s parent -- 'Vulkan.Core10.Handles.CommandPool'’s queue family -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-pData-01686# @pData@ -- /must/ be a valid pointer to a memory containing one or more valid -- instances of 'Vulkan.Core10.DescriptorSet.DescriptorImageInfo', -- 'Vulkan.Core10.DescriptorSet.DescriptorBufferInfo', or -- 'Vulkan.Core10.Handles.BufferView' in a layout defined by -- @descriptorUpdateTemplate@ when it was created with -- 'Vulkan.Core11.Promoted_From_VK_KHR_descriptor_update_template.createDescriptorUpdateTemplate' -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-layout-07993# @layout@ -- /must/ be compatible with the layout used to create -- @descriptorUpdateTemplate@ -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-descriptorUpdateTemplate-07994# -- @descriptorUpdateTemplate@ /must/ have been created with a -- @templateType@ of -- 'Vulkan.Core11.Enums.DescriptorUpdateTemplateType.DESCRIPTOR_UPDATE_TEMPLATE_TYPE_PUSH_DESCRIPTORS_KHR' -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-set-07995# @set@ /must/ -- be the same value used to create @descriptorUpdateTemplate@ -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-set-07304# @set@ /must/ -- be less than -- 'Vulkan.Core10.PipelineLayout.PipelineLayoutCreateInfo'::@setLayoutCount@ -- provided when @layout@ was created -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-set-07305# @set@ /must/ -- be the unique set number in the pipeline layout that uses a -- descriptor set layout that was created with -- 'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_PUSH_DESCRIPTOR_BIT_KHR' -- -- == Valid Usage (Implicit) -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-commandBuffer-parameter# -- @commandBuffer@ /must/ be a valid -- 'Vulkan.Core10.Handles.CommandBuffer' handle -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-descriptorUpdateTemplate-parameter# -- @descriptorUpdateTemplate@ /must/ be a valid -- 'Vulkan.Core11.Handles.DescriptorUpdateTemplate' handle -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-layout-parameter# -- @layout@ /must/ be a valid 'Vulkan.Core10.Handles.PipelineLayout' -- handle -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-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-vkCmdPushDescriptorSetWithTemplateKHR-commandBuffer-cmdpool# -- The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was -- allocated from /must/ support graphics, or compute operations -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-videocoding# This -- command /must/ only be called outside of a video coding scope -- -- - #VUID-vkCmdPushDescriptorSetWithTemplateKHR-commonparent# Each of -- @commandBuffer@, @descriptorUpdateTemplate@, and @layout@ /must/ -- have been created, allocated, or retrieved from the same -- 'Vulkan.Core10.Handles.Device' -- -- == Host Synchronization -- -- - Host access to @commandBuffer@ /must/ be externally synchronized -- -- - 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 | Both | Outside | Graphics | State | -- | Secondary | | | Compute | | -- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+ -- -- __API example__ -- -- > struct AppDataStructure -- > { -- > VkDescriptorImageInfo imageInfo; // a single image info -- > // ... some more application related data -- > }; -- > -- > const VkDescriptorUpdateTemplateEntry descriptorUpdateTemplateEntries[] = -- > { -- > // binding to a single image descriptor -- > { -- > .binding = 0, -- > .dstArrayElement = 0, -- > .descriptorCount = 1, -- > .descriptorType = VK_DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER, -- > .offset = offsetof(AppDataStructure, imageInfo), -- > .stride = 0 // not required if descriptorCount is 1 -- > } -- > }; -- > -- > // create a descriptor update template for push descriptor set updates -- > const VkDescriptorUpdateTemplateCreateInfo createInfo = -- > { -- > .sType = VK_STRUCTURE_TYPE_DESCRIPTOR_UPDATE_TEMPLATE_CREATE_INFO, -- > .pNext = NULL, -- > .flags = 0, -- > .descriptorUpdateEntryCount = 1, -- > .pDescriptorUpdateEntries = descriptorUpdateTemplateEntries, -- > .templateType = VK_DESCRIPTOR_UPDATE_TEMPLATE_TYPE_PUSH_DESCRIPTORS_KHR, -- > .descriptorSetLayout = 0, // ignored by given templateType -- > .pipelineBindPoint = VK_PIPELINE_BIND_POINT_GRAPHICS, -- > .pipelineLayout = myPipelineLayout, -- > .set = 0, -- > }; -- > -- > VkDescriptorUpdateTemplate myDescriptorUpdateTemplate; -- > myResult = vkCreateDescriptorUpdateTemplate( -- > myDevice, -- > &createInfo, -- > NULL, -- > &myDescriptorUpdateTemplate); -- > -- > AppDataStructure appData; -- > // fill appData here or cache it in your engine -- > vkCmdPushDescriptorSetWithTemplateKHR(myCmdBuffer, myDescriptorUpdateTemplate, myPipelineLayout, 0,&appData); -- -- = See Also -- -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_descriptor_update_template VK_KHR_descriptor_update_template>, -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_push_descriptor VK_KHR_push_descriptor>, -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>, -- 'Vulkan.Core10.Handles.CommandBuffer', -- 'Vulkan.Core11.Handles.DescriptorUpdateTemplate', -- 'Vulkan.Core10.Handles.PipelineLayout' cmdPushDescriptorSetWithTemplateKHR :: forall io . (MonadIO io) => -- | @commandBuffer@ is the command buffer that the descriptors will be -- recorded in. CommandBuffer -> -- | @descriptorUpdateTemplate@ is a descriptor update template defining how -- to interpret the descriptor information in @pData@. DescriptorUpdateTemplate -> -- | @layout@ is a 'Vulkan.Core10.Handles.PipelineLayout' object used to -- program the bindings. It /must/ be compatible with the layout used to -- create the @descriptorUpdateTemplate@ handle. PipelineLayout -> -- | @set@ is the set number of the descriptor set in the pipeline layout -- that will be updated. This /must/ be the same number used to create the -- @descriptorUpdateTemplate@ handle. ("set" ::: Word32) -> -- | @pData@ is a pointer to memory containing descriptors for the templated -- update. ("data" ::: Ptr ()) -> io () cmdPushDescriptorSetWithTemplateKHR :: forall (io :: * -> *). MonadIO io => CommandBuffer -> DescriptorUpdateTemplate -> PipelineLayout -> ("set" ::: Word32) -> ("data" ::: Ptr ()) -> io () cmdPushDescriptorSetWithTemplateKHR CommandBuffer commandBuffer DescriptorUpdateTemplate descriptorUpdateTemplate PipelineLayout layout "set" ::: Word32 set "data" ::: Ptr () data' = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ do let vkCmdPushDescriptorSetWithTemplateKHRPtr :: FunPtr (Ptr CommandBuffer_T -> DescriptorUpdateTemplate -> PipelineLayout -> ("set" ::: Word32) -> ("data" ::: Ptr ()) -> IO ()) vkCmdPushDescriptorSetWithTemplateKHRPtr = DeviceCmds -> FunPtr (Ptr CommandBuffer_T -> DescriptorUpdateTemplate -> PipelineLayout -> ("set" ::: Word32) -> ("data" ::: Ptr ()) -> IO ()) pVkCmdPushDescriptorSetWithTemplateKHR (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 -> DescriptorUpdateTemplate -> PipelineLayout -> ("set" ::: Word32) -> ("data" ::: Ptr ()) -> IO ()) vkCmdPushDescriptorSetWithTemplateKHRPtr 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 vkCmdPushDescriptorSetWithTemplateKHR is null" forall a. Maybe a Nothing forall a. Maybe a Nothing let vkCmdPushDescriptorSetWithTemplateKHR' :: Ptr CommandBuffer_T -> DescriptorUpdateTemplate -> PipelineLayout -> ("set" ::: Word32) -> ("data" ::: Ptr ()) -> IO () vkCmdPushDescriptorSetWithTemplateKHR' = FunPtr (Ptr CommandBuffer_T -> DescriptorUpdateTemplate -> PipelineLayout -> ("set" ::: Word32) -> ("data" ::: Ptr ()) -> IO ()) -> Ptr CommandBuffer_T -> DescriptorUpdateTemplate -> PipelineLayout -> ("set" ::: Word32) -> ("data" ::: Ptr ()) -> IO () mkVkCmdPushDescriptorSetWithTemplateKHR FunPtr (Ptr CommandBuffer_T -> DescriptorUpdateTemplate -> PipelineLayout -> ("set" ::: Word32) -> ("data" ::: Ptr ()) -> IO ()) vkCmdPushDescriptorSetWithTemplateKHRPtr forall a. String -> IO a -> IO a traceAroundEvent String "vkCmdPushDescriptorSetWithTemplateKHR" (Ptr CommandBuffer_T -> DescriptorUpdateTemplate -> PipelineLayout -> ("set" ::: Word32) -> ("data" ::: Ptr ()) -> IO () vkCmdPushDescriptorSetWithTemplateKHR' (CommandBuffer -> Ptr CommandBuffer_T commandBufferHandle (CommandBuffer commandBuffer)) (DescriptorUpdateTemplate descriptorUpdateTemplate) (PipelineLayout layout) ("set" ::: Word32 set) ("data" ::: Ptr () data')) forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ () -- | VkPhysicalDevicePushDescriptorPropertiesKHR - Structure describing push -- descriptor limits that can be supported by an implementation -- -- = Description -- -- If the 'PhysicalDevicePushDescriptorPropertiesKHR' structure is included -- in the @pNext@ chain of the -- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2' -- structure passed to -- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2', -- it is filled in with each corresponding implementation-dependent -- property. -- -- == Valid Usage (Implicit) -- -- = See Also -- -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_push_descriptor VK_KHR_push_descriptor>, -- 'Vulkan.Core10.Enums.StructureType.StructureType' data PhysicalDevicePushDescriptorPropertiesKHR = PhysicalDevicePushDescriptorPropertiesKHR { -- | #limits-maxPushDescriptors# @maxPushDescriptors@ is the maximum number -- of descriptors that /can/ be used in a descriptor set layout created -- with -- 'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_PUSH_DESCRIPTOR_BIT_KHR' -- set. PhysicalDevicePushDescriptorPropertiesKHR -> "set" ::: Word32 maxPushDescriptors :: Word32 } deriving (Typeable, PhysicalDevicePushDescriptorPropertiesKHR -> PhysicalDevicePushDescriptorPropertiesKHR -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: PhysicalDevicePushDescriptorPropertiesKHR -> PhysicalDevicePushDescriptorPropertiesKHR -> Bool $c/= :: PhysicalDevicePushDescriptorPropertiesKHR -> PhysicalDevicePushDescriptorPropertiesKHR -> Bool == :: PhysicalDevicePushDescriptorPropertiesKHR -> PhysicalDevicePushDescriptorPropertiesKHR -> Bool $c== :: PhysicalDevicePushDescriptorPropertiesKHR -> PhysicalDevicePushDescriptorPropertiesKHR -> Bool Eq) #if defined(GENERIC_INSTANCES) deriving instance Generic (PhysicalDevicePushDescriptorPropertiesKHR) #endif deriving instance Show PhysicalDevicePushDescriptorPropertiesKHR instance ToCStruct PhysicalDevicePushDescriptorPropertiesKHR where withCStruct :: forall b. PhysicalDevicePushDescriptorPropertiesKHR -> (Ptr PhysicalDevicePushDescriptorPropertiesKHR -> IO b) -> IO b withCStruct PhysicalDevicePushDescriptorPropertiesKHR x Ptr PhysicalDevicePushDescriptorPropertiesKHR -> IO b f = forall a b. Int -> (Ptr a -> IO b) -> IO b allocaBytes Int 24 forall a b. (a -> b) -> a -> b $ \Ptr PhysicalDevicePushDescriptorPropertiesKHR p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b pokeCStruct Ptr PhysicalDevicePushDescriptorPropertiesKHR p PhysicalDevicePushDescriptorPropertiesKHR x (Ptr PhysicalDevicePushDescriptorPropertiesKHR -> IO b f Ptr PhysicalDevicePushDescriptorPropertiesKHR p) pokeCStruct :: forall b. Ptr PhysicalDevicePushDescriptorPropertiesKHR -> PhysicalDevicePushDescriptorPropertiesKHR -> IO b -> IO b pokeCStruct Ptr PhysicalDevicePushDescriptorPropertiesKHR p PhysicalDevicePushDescriptorPropertiesKHR{"set" ::: Word32 maxPushDescriptors :: "set" ::: Word32 $sel:maxPushDescriptors:PhysicalDevicePushDescriptorPropertiesKHR :: PhysicalDevicePushDescriptorPropertiesKHR -> "set" ::: Word32 ..} IO b f = do forall a. Storable a => Ptr a -> a -> IO () poke ((Ptr PhysicalDevicePushDescriptorPropertiesKHR p forall a b. Ptr a -> Int -> Ptr b `plusPtr` Int 0 :: Ptr StructureType)) (StructureType STRUCTURE_TYPE_PHYSICAL_DEVICE_PUSH_DESCRIPTOR_PROPERTIES_KHR) forall a. Storable a => Ptr a -> a -> IO () poke ((Ptr PhysicalDevicePushDescriptorPropertiesKHR 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 PhysicalDevicePushDescriptorPropertiesKHR p forall a b. Ptr a -> Int -> Ptr b `plusPtr` Int 16 :: Ptr Word32)) ("set" ::: Word32 maxPushDescriptors) IO b f cStructSize :: Int cStructSize = Int 24 cStructAlignment :: Int cStructAlignment = Int 8 pokeZeroCStruct :: forall b. Ptr PhysicalDevicePushDescriptorPropertiesKHR -> IO b -> IO b pokeZeroCStruct Ptr PhysicalDevicePushDescriptorPropertiesKHR p IO b f = do forall a. Storable a => Ptr a -> a -> IO () poke ((Ptr PhysicalDevicePushDescriptorPropertiesKHR p forall a b. Ptr a -> Int -> Ptr b `plusPtr` Int 0 :: Ptr StructureType)) (StructureType STRUCTURE_TYPE_PHYSICAL_DEVICE_PUSH_DESCRIPTOR_PROPERTIES_KHR) forall a. Storable a => Ptr a -> a -> IO () poke ((Ptr PhysicalDevicePushDescriptorPropertiesKHR 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 PhysicalDevicePushDescriptorPropertiesKHR p forall a b. Ptr a -> Int -> Ptr b `plusPtr` Int 16 :: Ptr Word32)) (forall a. Zero a => a zero) IO b f instance FromCStruct PhysicalDevicePushDescriptorPropertiesKHR where peekCStruct :: Ptr PhysicalDevicePushDescriptorPropertiesKHR -> IO PhysicalDevicePushDescriptorPropertiesKHR peekCStruct Ptr PhysicalDevicePushDescriptorPropertiesKHR p = do "set" ::: Word32 maxPushDescriptors <- forall a. Storable a => Ptr a -> IO a peek @Word32 ((Ptr PhysicalDevicePushDescriptorPropertiesKHR p forall a b. Ptr a -> Int -> Ptr b `plusPtr` Int 16 :: Ptr Word32)) forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ ("set" ::: Word32) -> PhysicalDevicePushDescriptorPropertiesKHR PhysicalDevicePushDescriptorPropertiesKHR "set" ::: Word32 maxPushDescriptors instance Storable PhysicalDevicePushDescriptorPropertiesKHR where sizeOf :: PhysicalDevicePushDescriptorPropertiesKHR -> Int sizeOf ~PhysicalDevicePushDescriptorPropertiesKHR _ = Int 24 alignment :: PhysicalDevicePushDescriptorPropertiesKHR -> Int alignment ~PhysicalDevicePushDescriptorPropertiesKHR _ = Int 8 peek :: Ptr PhysicalDevicePushDescriptorPropertiesKHR -> IO PhysicalDevicePushDescriptorPropertiesKHR peek = forall a. FromCStruct a => Ptr a -> IO a peekCStruct poke :: Ptr PhysicalDevicePushDescriptorPropertiesKHR -> PhysicalDevicePushDescriptorPropertiesKHR -> IO () poke Ptr PhysicalDevicePushDescriptorPropertiesKHR ptr PhysicalDevicePushDescriptorPropertiesKHR poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b pokeCStruct Ptr PhysicalDevicePushDescriptorPropertiesKHR ptr PhysicalDevicePushDescriptorPropertiesKHR poked (forall (f :: * -> *) a. Applicative f => a -> f a pure ()) instance Zero PhysicalDevicePushDescriptorPropertiesKHR where zero :: PhysicalDevicePushDescriptorPropertiesKHR zero = ("set" ::: Word32) -> PhysicalDevicePushDescriptorPropertiesKHR PhysicalDevicePushDescriptorPropertiesKHR forall a. Zero a => a zero type KHR_PUSH_DESCRIPTOR_SPEC_VERSION = 2 -- No documentation found for TopLevel "VK_KHR_PUSH_DESCRIPTOR_SPEC_VERSION" pattern KHR_PUSH_DESCRIPTOR_SPEC_VERSION :: forall a . Integral a => a pattern $bKHR_PUSH_DESCRIPTOR_SPEC_VERSION :: forall a. Integral a => a $mKHR_PUSH_DESCRIPTOR_SPEC_VERSION :: forall {r} {a}. Integral a => a -> ((# #) -> r) -> ((# #) -> r) -> r KHR_PUSH_DESCRIPTOR_SPEC_VERSION = 2 type KHR_PUSH_DESCRIPTOR_EXTENSION_NAME = "VK_KHR_push_descriptor" -- No documentation found for TopLevel "VK_KHR_PUSH_DESCRIPTOR_EXTENSION_NAME" pattern KHR_PUSH_DESCRIPTOR_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a pattern $bKHR_PUSH_DESCRIPTOR_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a $mKHR_PUSH_DESCRIPTOR_EXTENSION_NAME :: forall {r} {a}. (Eq a, IsString a) => a -> ((# #) -> r) -> ((# #) -> r) -> r KHR_PUSH_DESCRIPTOR_EXTENSION_NAME = "VK_KHR_push_descriptor"