{-# language CPP #-}
-- | = Name
--
-- VK_NVX_binary_import - device extension
--
-- == VK_NVX_binary_import
--
-- [__Name String__]
--     @VK_NVX_binary_import@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     30
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
-- [__Contact__]
--
--     -   Eric Werness
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NVX_binary_import] @ewerness-nv%0A*Here describe the issue or question you have about the VK_NVX_binary_import extension* >
--
--     -   Liam Middlebrook
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NVX_binary_import] @liam-middlebrook%0A*Here describe the issue or question you have about the VK_NVX_binary_import extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2021-04-09
--
-- [__Contributors__]
--
--     -   Eric Werness, NVIDIA
--
--     -   Liam Middlebrook, NVIDIA
--
-- == Description
--
-- This extension allows applications to import CuBIN binaries and execute
-- them.
--
-- Note
--
-- There is currently no specification language written for this extension.
-- The links to APIs defined by the extension are to stubs that only
-- include generated content such as API declarations and implicit valid
-- usage statements.
--
-- == New Object Types
--
-- -   'Vulkan.Extensions.Handles.CuFunctionNVX'
--
-- -   'Vulkan.Extensions.Handles.CuModuleNVX'
--
-- == New Commands
--
-- -   'cmdCuLaunchKernelNVX'
--
-- -   'createCuFunctionNVX'
--
-- -   'createCuModuleNVX'
--
-- -   'destroyCuFunctionNVX'
--
-- -   'destroyCuModuleNVX'
--
-- == New Structures
--
-- -   'CuFunctionCreateInfoNVX'
--
-- -   'CuLaunchInfoNVX'
--
-- -   'CuModuleCreateInfoNVX'
--
-- == New Enum Constants
--
-- -   'NVX_BINARY_IMPORT_EXTENSION_NAME'
--
-- -   'NVX_BINARY_IMPORT_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Extensions.VK_EXT_debug_report.DebugReportObjectTypeEXT':
--
--     -   'Vulkan.Extensions.VK_EXT_debug_report.DEBUG_REPORT_OBJECT_TYPE_CU_FUNCTION_NVX_EXT'
--
--     -   'Vulkan.Extensions.VK_EXT_debug_report.DEBUG_REPORT_OBJECT_TYPE_CU_MODULE_NVX_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.ObjectType.ObjectType':
--
--     -   'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_CU_FUNCTION_NVX'
--
--     -   'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_CU_MODULE_NVX'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_FUNCTION_CREATE_INFO_NVX'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_LAUNCH_INFO_NVX'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_MODULE_CREATE_INFO_NVX'
--
-- == Stub API References
--
-- There is currently no specification language written for this type. This
-- section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > VK_DEFINE_NON_DISPATCHABLE_HANDLE(VkCuFunctionNVX)
--
-- There is currently no specification language written for this type. This
-- section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > VK_DEFINE_NON_DISPATCHABLE_HANDLE(VkCuModuleNVX)
--
-- There is currently no specification language written for this command.
-- This section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > VkResult vkCreateCuFunctionNVX(
-- >     VkDevice                                    device,
-- >     const VkCuFunctionCreateInfoNVX*            pCreateInfo,
-- >     const VkAllocationCallbacks*                pAllocator,
-- >     VkCuFunctionNVX*                            pFunction);
--
-- === Valid Usage (Implicit)
--
-- -   #VUID-vkCreateCuFunctionNVX-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateCuFunctionNVX-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'CuFunctionCreateInfoNVX'
--     structure
--
-- -   #VUID-vkCreateCuFunctionNVX-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateCuFunctionNVX-pFunction-parameter# @pFunction@ /must/
--     be a valid pointer to a 'Vulkan.Extensions.Handles.CuFunctionNVX'
--     handle
--
-- === 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'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
-- There is currently no specification language written for this type. This
-- section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > typedef struct VkCuFunctionCreateInfoNVX {
-- >     VkStructureType    sType;
-- >     const void*        pNext;
-- >     VkCuModuleNVX      module;
-- >     const char*        pName;
-- > } VkCuFunctionCreateInfoNVX;
--
-- === Valid Usage (Implicit)
--
-- -   #VUID-VkCuFunctionCreateInfoNVX-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_FUNCTION_CREATE_INFO_NVX'
--
-- -   #VUID-VkCuFunctionCreateInfoNVX-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkCuFunctionCreateInfoNVX-module-parameter# @module@ /must/ be
--     a valid 'Vulkan.Extensions.Handles.CuModuleNVX' handle
--
-- -   #VUID-VkCuFunctionCreateInfoNVX-pName-parameter# @pName@ /must/ be a
--     null-terminated UTF-8 string
--
-- There is currently no specification language written for this command.
-- This section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > void vkDestroyCuFunctionNVX(
-- >     VkDevice                                    device,
-- >     VkCuFunctionNVX                             function,
-- >     const VkAllocationCallbacks*                pAllocator);
--
-- === Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyCuFunctionNVX-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyCuFunctionNVX-function-parameter# @function@ /must/
--     be a valid 'Vulkan.Extensions.Handles.CuFunctionNVX' handle
--
-- -   #VUID-vkDestroyCuFunctionNVX-pAllocator-parameter# If @pAllocator@
--     is not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroyCuFunctionNVX-function-parent# @function@ /must/ have
--     been created, allocated, or retrieved from @device@
--
-- There is currently no specification language written for this command.
-- This section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > VkResult vkCreateCuModuleNVX(
-- >     VkDevice                                    device,
-- >     const VkCuModuleCreateInfoNVX*              pCreateInfo,
-- >     const VkAllocationCallbacks*                pAllocator,
-- >     VkCuModuleNVX*                              pModule);
--
-- === Valid Usage (Implicit)
--
-- -   #VUID-vkCreateCuModuleNVX-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateCuModuleNVX-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'CuModuleCreateInfoNVX'
--     structure
--
-- -   #VUID-vkCreateCuModuleNVX-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateCuModuleNVX-pModule-parameter# @pModule@ /must/ be a
--     valid pointer to a 'Vulkan.Extensions.Handles.CuModuleNVX' handle
--
-- === 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'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
-- There is currently no specification language written for this type. This
-- section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > typedef struct VkCuModuleCreateInfoNVX {
-- >     VkStructureType    sType;
-- >     const void*        pNext;
-- >     size_t             dataSize;
-- >     const void*        pData;
-- > } VkCuModuleCreateInfoNVX;
--
-- === Valid Usage (Implicit)
--
-- -   #VUID-VkCuModuleCreateInfoNVX-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_MODULE_CREATE_INFO_NVX'
--
-- -   #VUID-VkCuModuleCreateInfoNVX-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkCuModuleCreateInfoNVX-pData-parameter# @pData@ /must/ be a
--     valid pointer to an array of @dataSize@ bytes
--
-- -   #VUID-VkCuModuleCreateInfoNVX-dataSize-arraylength# @dataSize@
--     /must/ be greater than @0@
--
-- There is currently no specification language written for this command.
-- This section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > void vkDestroyCuModuleNVX(
-- >     VkDevice                                    device,
-- >     VkCuModuleNVX                               module,
-- >     const VkAllocationCallbacks*                pAllocator);
--
-- === Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyCuModuleNVX-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyCuModuleNVX-module-parameter# @module@ /must/ be a
--     valid 'Vulkan.Extensions.Handles.CuModuleNVX' handle
--
-- -   #VUID-vkDestroyCuModuleNVX-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroyCuModuleNVX-module-parent# @module@ /must/ have been
--     created, allocated, or retrieved from @device@
--
-- There is currently no specification language written for this command.
-- This section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > void vkCmdCuLaunchKernelNVX(
-- >     VkCommandBuffer                             commandBuffer,
-- >     const VkCuLaunchInfoNVX*                    pLaunchInfo);
--
-- === Valid Usage (Implicit)
--
-- -   #VUID-vkCmdCuLaunchKernelNVX-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdCuLaunchKernelNVX-pLaunchInfo-parameter# @pLaunchInfo@
--     /must/ be a valid pointer to a valid 'CuLaunchInfoNVX' structure
--
-- -   #VUID-vkCmdCuLaunchKernelNVX-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-vkCmdCuLaunchKernelNVX-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics, or compute operations
--
-- -   #VUID-vkCmdCuLaunchKernelNVX-videocoding# This command /must/ only
--     be called outside of a video coding scope
--
-- === 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                                                                                                                    | Both                                                                                                                   | Outside                                                                                                                     | Graphics                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- There is currently no specification language written for this type. This
-- section acts only as placeholder and to avoid dead links in the
-- specification and reference pages.
--
-- > // Provided by VK_NVX_binary_import
-- > typedef struct VkCuLaunchInfoNVX {
-- >     VkStructureType        sType;
-- >     const void*            pNext;
-- >     VkCuFunctionNVX        function;
-- >     uint32_t               gridDimX;
-- >     uint32_t               gridDimY;
-- >     uint32_t               gridDimZ;
-- >     uint32_t               blockDimX;
-- >     uint32_t               blockDimY;
-- >     uint32_t               blockDimZ;
-- >     uint32_t               sharedMemBytes;
-- >     size_t                 paramCount;
-- >     const void* const *    pParams;
-- >     size_t                 extraCount;
-- >     const void* const *    pExtras;
-- > } VkCuLaunchInfoNVX;
--
-- === Valid Usage (Implicit)
--
-- -   #VUID-VkCuLaunchInfoNVX-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_LAUNCH_INFO_NVX'
--
-- -   #VUID-VkCuLaunchInfoNVX-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkCuLaunchInfoNVX-function-parameter# @function@ /must/ be a
--     valid 'Vulkan.Extensions.Handles.CuFunctionNVX' handle
--
-- -   #VUID-VkCuLaunchInfoNVX-pParams-parameter# If @paramCount@ is not
--     @0@, @pParams@ /must/ be a valid pointer to an array of @paramCount@
--     bytes
--
-- -   #VUID-VkCuLaunchInfoNVX-pExtras-parameter# If @extraCount@ is not
--     @0@, @pExtras@ /must/ be a valid pointer to an array of @extraCount@
--     bytes
--
-- == Version History
--
-- -   Revision 1, 2021-04-09 (Eric Werness)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'CuFunctionCreateInfoNVX', 'Vulkan.Extensions.Handles.CuFunctionNVX',
-- 'CuLaunchInfoNVX', 'CuModuleCreateInfoNVX',
-- 'Vulkan.Extensions.Handles.CuModuleNVX', 'cmdCuLaunchKernelNVX',
-- 'createCuFunctionNVX', 'createCuModuleNVX', 'destroyCuFunctionNVX',
-- 'destroyCuModuleNVX'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NVX_binary_import Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_NVX_binary_import  ( createCuModuleNVX
                                               , withCuModuleNVX
                                               , createCuFunctionNVX
                                               , withCuFunctionNVX
                                               , destroyCuModuleNVX
                                               , destroyCuFunctionNVX
                                               , cmdCuLaunchKernelNVX
                                               , CuModuleCreateInfoNVX(..)
                                               , CuFunctionCreateInfoNVX(..)
                                               , CuLaunchInfoNVX(..)
                                               , NVX_BINARY_IMPORT_SPEC_VERSION
                                               , pattern NVX_BINARY_IMPORT_SPEC_VERSION
                                               , NVX_BINARY_IMPORT_EXTENSION_NAME
                                               , pattern NVX_BINARY_IMPORT_EXTENSION_NAME
                                               , CuModuleNVX(..)
                                               , CuFunctionNVX(..)
                                               , DebugReportObjectTypeEXT(..)
                                               ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Data.ByteString (useAsCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
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.C.Types (CChar)
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.C.Types (CSize(CSize))
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.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.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Extensions.Handles (CuFunctionNVX)
import Vulkan.Extensions.Handles (CuFunctionNVX(..))
import Vulkan.Extensions.Handles (CuModuleNVX)
import Vulkan.Extensions.Handles (CuModuleNVX(..))
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCuLaunchKernelNVX))
import Vulkan.Dynamic (DeviceCmds(pVkCreateCuFunctionNVX))
import Vulkan.Dynamic (DeviceCmds(pVkCreateCuModuleNVX))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyCuFunctionNVX))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyCuModuleNVX))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_CU_FUNCTION_CREATE_INFO_NVX))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_CU_LAUNCH_INFO_NVX))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_CU_MODULE_CREATE_INFO_NVX))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.Handles (CuFunctionNVX(..))
import Vulkan.Extensions.Handles (CuModuleNVX(..))
import Vulkan.Extensions.VK_EXT_debug_report (DebugReportObjectTypeEXT(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateCuModuleNVX
  :: FunPtr (Ptr Device_T -> Ptr CuModuleCreateInfoNVX -> Ptr AllocationCallbacks -> Ptr CuModuleNVX -> IO Result) -> Ptr Device_T -> Ptr CuModuleCreateInfoNVX -> Ptr AllocationCallbacks -> Ptr CuModuleNVX -> IO Result

-- | vkCreateCuModuleNVX - Stub description of vkCreateCuModuleNVX
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateCuModuleNVX-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateCuModuleNVX-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'CuModuleCreateInfoNVX'
--     structure
--
-- -   #VUID-vkCreateCuModuleNVX-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateCuModuleNVX-pModule-parameter# @pModule@ /must/ be a
--     valid pointer to a 'Vulkan.Extensions.Handles.CuModuleNVX' handle
--
-- == 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'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_binary_import VK_NVX_binary_import>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'CuModuleCreateInfoNVX', 'Vulkan.Extensions.Handles.CuModuleNVX',
-- 'Vulkan.Core10.Handles.Device'
createCuModuleNVX :: forall io
                   . (MonadIO io)
                  => -- No documentation found for Nested "vkCreateCuModuleNVX" "device"
                     Device
                  -> -- No documentation found for Nested "vkCreateCuModuleNVX" "pCreateInfo"
                     CuModuleCreateInfoNVX
                  -> -- No documentation found for Nested "vkCreateCuModuleNVX" "pAllocator"
                     ("allocator" ::: Maybe AllocationCallbacks)
                  -> io (CuModuleNVX)
createCuModuleNVX :: forall (io :: * -> *).
MonadIO io =>
Device
-> CuModuleCreateInfoNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CuModuleNVX
createCuModuleNVX Device
device CuModuleCreateInfoNVX
createInfo "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 vkCreateCuModuleNVXPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> IO Result)
vkCreateCuModuleNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pModule" ::: Ptr CuModuleNVX)
      -> IO Result)
pVkCreateCuModuleNVX (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
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> IO Result)
vkCreateCuModuleNVXPtr 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 vkCreateCuModuleNVX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCreateCuModuleNVX' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CuModuleNVX)
-> IO Result
vkCreateCuModuleNVX' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CuModuleNVX)
-> IO Result
mkVkCreateCuModuleNVX FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> IO Result)
vkCreateCuModuleNVXPtr
  "pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
pCreateInfo <- 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 (CuModuleCreateInfoNVX
createInfo)
  "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)
  "pModule" ::: Ptr CuModuleNVX
pPModule <- 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 @CuModuleNVX 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
"vkCreateCuModuleNVX" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CuModuleNVX)
-> IO Result
vkCreateCuModuleNVX'
                                                        (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                        "pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
pCreateInfo
                                                        "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                        ("pModule" ::: Ptr CuModuleNVX
pPModule))
  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))
  CuModuleNVX
pModule <- 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 @CuModuleNVX "pModule" ::: Ptr CuModuleNVX
pPModule
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (CuModuleNVX
pModule)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createCuModuleNVX' and 'destroyCuModuleNVX'
--
-- To ensure that 'destroyCuModuleNVX' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the last argument.
-- To just extract the pair pass '(,)' as the last argument.
--
withCuModuleNVX :: forall io r . MonadIO io => Device -> CuModuleCreateInfoNVX -> Maybe AllocationCallbacks -> (io CuModuleNVX -> (CuModuleNVX -> io ()) -> r) -> r
withCuModuleNVX :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> CuModuleCreateInfoNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io CuModuleNVX -> (CuModuleNVX -> io ()) -> r)
-> r
withCuModuleNVX Device
device CuModuleCreateInfoNVX
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io CuModuleNVX -> (CuModuleNVX -> io ()) -> r
b =
  io CuModuleNVX -> (CuModuleNVX -> io ()) -> r
b (forall (io :: * -> *).
MonadIO io =>
Device
-> CuModuleCreateInfoNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CuModuleNVX
createCuModuleNVX Device
device CuModuleCreateInfoNVX
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(CuModuleNVX
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> CuModuleNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCuModuleNVX Device
device CuModuleNVX
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateCuFunctionNVX
  :: FunPtr (Ptr Device_T -> Ptr CuFunctionCreateInfoNVX -> Ptr AllocationCallbacks -> Ptr CuFunctionNVX -> IO Result) -> Ptr Device_T -> Ptr CuFunctionCreateInfoNVX -> Ptr AllocationCallbacks -> Ptr CuFunctionNVX -> IO Result

-- | vkCreateCuFunctionNVX - Stub description of vkCreateCuFunctionNVX
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateCuFunctionNVX-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateCuFunctionNVX-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'CuFunctionCreateInfoNVX'
--     structure
--
-- -   #VUID-vkCreateCuFunctionNVX-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateCuFunctionNVX-pFunction-parameter# @pFunction@ /must/
--     be a valid pointer to a 'Vulkan.Extensions.Handles.CuFunctionNVX'
--     handle
--
-- == 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'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_binary_import VK_NVX_binary_import>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'CuFunctionCreateInfoNVX', 'Vulkan.Extensions.Handles.CuFunctionNVX',
-- 'Vulkan.Core10.Handles.Device'
createCuFunctionNVX :: forall io
                     . (MonadIO io)
                    => -- No documentation found for Nested "vkCreateCuFunctionNVX" "device"
                       Device
                    -> -- No documentation found for Nested "vkCreateCuFunctionNVX" "pCreateInfo"
                       CuFunctionCreateInfoNVX
                    -> -- No documentation found for Nested "vkCreateCuFunctionNVX" "pAllocator"
                       ("allocator" ::: Maybe AllocationCallbacks)
                    -> io (CuFunctionNVX)
createCuFunctionNVX :: forall (io :: * -> *).
MonadIO io =>
Device
-> CuFunctionCreateInfoNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CuFunctionNVX
createCuFunctionNVX Device
device CuFunctionCreateInfoNVX
createInfo "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 vkCreateCuFunctionNVXPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> IO Result)
vkCreateCuFunctionNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pFunction" ::: Ptr CuFunctionNVX)
      -> IO Result)
pVkCreateCuFunctionNVX (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
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> IO Result)
vkCreateCuFunctionNVXPtr 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 vkCreateCuFunctionNVX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCreateCuFunctionNVX' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CuFunctionNVX)
-> IO Result
vkCreateCuFunctionNVX' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CuFunctionNVX)
-> IO Result
mkVkCreateCuFunctionNVX FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> IO Result)
vkCreateCuFunctionNVXPtr
  "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
pCreateInfo <- 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 (CuFunctionCreateInfoNVX
createInfo)
  "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)
  "pFunction" ::: Ptr CuFunctionNVX
pPFunction <- 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 @CuFunctionNVX 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
"vkCreateCuFunctionNVX" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CuFunctionNVX)
-> IO Result
vkCreateCuFunctionNVX'
                                                          (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                          "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
pCreateInfo
                                                          "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                          ("pFunction" ::: Ptr CuFunctionNVX
pPFunction))
  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))
  CuFunctionNVX
pFunction <- 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 @CuFunctionNVX "pFunction" ::: Ptr CuFunctionNVX
pPFunction
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (CuFunctionNVX
pFunction)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createCuFunctionNVX' and 'destroyCuFunctionNVX'
--
-- To ensure that 'destroyCuFunctionNVX' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the last argument.
-- To just extract the pair pass '(,)' as the last argument.
--
withCuFunctionNVX :: forall io r . MonadIO io => Device -> CuFunctionCreateInfoNVX -> Maybe AllocationCallbacks -> (io CuFunctionNVX -> (CuFunctionNVX -> io ()) -> r) -> r
withCuFunctionNVX :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> CuFunctionCreateInfoNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io CuFunctionNVX -> (CuFunctionNVX -> io ()) -> r)
-> r
withCuFunctionNVX Device
device CuFunctionCreateInfoNVX
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io CuFunctionNVX -> (CuFunctionNVX -> io ()) -> r
b =
  io CuFunctionNVX -> (CuFunctionNVX -> io ()) -> r
b (forall (io :: * -> *).
MonadIO io =>
Device
-> CuFunctionCreateInfoNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CuFunctionNVX
createCuFunctionNVX Device
device CuFunctionCreateInfoNVX
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(CuFunctionNVX
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> CuFunctionNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCuFunctionNVX Device
device CuFunctionNVX
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkDestroyCuModuleNVX
  :: FunPtr (Ptr Device_T -> CuModuleNVX -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> CuModuleNVX -> Ptr AllocationCallbacks -> IO ()

-- | vkDestroyCuModuleNVX - Stub description of vkDestroyCuModuleNVX
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyCuModuleNVX-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyCuModuleNVX-module-parameter# @module@ /must/ be a
--     valid 'Vulkan.Extensions.Handles.CuModuleNVX' handle
--
-- -   #VUID-vkDestroyCuModuleNVX-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroyCuModuleNVX-module-parent# @module@ /must/ have been
--     created, allocated, or retrieved from @device@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_binary_import VK_NVX_binary_import>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Extensions.Handles.CuModuleNVX', 'Vulkan.Core10.Handles.Device'
destroyCuModuleNVX :: forall io
                    . (MonadIO io)
                   => -- No documentation found for Nested "vkDestroyCuModuleNVX" "device"
                      Device
                   -> -- No documentation found for Nested "vkDestroyCuModuleNVX" "module"
                      CuModuleNVX
                   -> -- No documentation found for Nested "vkDestroyCuModuleNVX" "pAllocator"
                      ("allocator" ::: Maybe AllocationCallbacks)
                   -> io ()
destroyCuModuleNVX :: forall (io :: * -> *).
MonadIO io =>
Device
-> CuModuleNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCuModuleNVX Device
device CuModuleNVX
module' "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 vkDestroyCuModuleNVXPtr :: FunPtr
  (Ptr Device_T
   -> CuModuleNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuModuleNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> CuModuleNVX
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyCuModuleNVX (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
   -> CuModuleNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuModuleNVXPtr 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 vkDestroyCuModuleNVX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkDestroyCuModuleNVX' :: Ptr Device_T
-> CuModuleNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCuModuleNVX' = FunPtr
  (Ptr Device_T
   -> CuModuleNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> CuModuleNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyCuModuleNVX FunPtr
  (Ptr Device_T
   -> CuModuleNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuModuleNVXPtr
  "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)
  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
"vkDestroyCuModuleNVX" (Ptr Device_T
-> CuModuleNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCuModuleNVX'
                                                    (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                    (CuModuleNVX
module')
                                                    "pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
  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" mkVkDestroyCuFunctionNVX
  :: FunPtr (Ptr Device_T -> CuFunctionNVX -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> CuFunctionNVX -> Ptr AllocationCallbacks -> IO ()

-- | vkDestroyCuFunctionNVX - Stub description of vkDestroyCuFunctionNVX
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyCuFunctionNVX-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyCuFunctionNVX-function-parameter# @function@ /must/
--     be a valid 'Vulkan.Extensions.Handles.CuFunctionNVX' handle
--
-- -   #VUID-vkDestroyCuFunctionNVX-pAllocator-parameter# If @pAllocator@
--     is not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroyCuFunctionNVX-function-parent# @function@ /must/ have
--     been created, allocated, or retrieved from @device@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_binary_import VK_NVX_binary_import>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Extensions.Handles.CuFunctionNVX',
-- 'Vulkan.Core10.Handles.Device'
destroyCuFunctionNVX :: forall io
                      . (MonadIO io)
                     => -- No documentation found for Nested "vkDestroyCuFunctionNVX" "device"
                        Device
                     -> -- No documentation found for Nested "vkDestroyCuFunctionNVX" "function"
                        CuFunctionNVX
                     -> -- No documentation found for Nested "vkDestroyCuFunctionNVX" "pAllocator"
                        ("allocator" ::: Maybe AllocationCallbacks)
                     -> io ()
destroyCuFunctionNVX :: forall (io :: * -> *).
MonadIO io =>
Device
-> CuFunctionNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCuFunctionNVX Device
device CuFunctionNVX
function "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 vkDestroyCuFunctionNVXPtr :: FunPtr
  (Ptr Device_T
   -> CuFunctionNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuFunctionNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> CuFunctionNVX
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyCuFunctionNVX (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
   -> CuFunctionNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuFunctionNVXPtr 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 vkDestroyCuFunctionNVX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkDestroyCuFunctionNVX' :: Ptr Device_T
-> CuFunctionNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCuFunctionNVX' = FunPtr
  (Ptr Device_T
   -> CuFunctionNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> CuFunctionNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyCuFunctionNVX FunPtr
  (Ptr Device_T
   -> CuFunctionNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuFunctionNVXPtr
  "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)
  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
"vkDestroyCuFunctionNVX" (Ptr Device_T
-> CuFunctionNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCuFunctionNVX'
                                                      (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                      (CuFunctionNVX
function)
                                                      "pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
  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" mkVkCmdCuLaunchKernelNVX
  :: FunPtr (Ptr CommandBuffer_T -> Ptr CuLaunchInfoNVX -> IO ()) -> Ptr CommandBuffer_T -> Ptr CuLaunchInfoNVX -> IO ()

-- | vkCmdCuLaunchKernelNVX - Stub description of vkCmdCuLaunchKernelNVX
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdCuLaunchKernelNVX-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdCuLaunchKernelNVX-pLaunchInfo-parameter# @pLaunchInfo@
--     /must/ be a valid pointer to a valid 'CuLaunchInfoNVX' structure
--
-- -   #VUID-vkCmdCuLaunchKernelNVX-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-vkCmdCuLaunchKernelNVX-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics, or compute operations
--
-- -   #VUID-vkCmdCuLaunchKernelNVX-videocoding# This command /must/ only
--     be called outside of a video coding scope
--
-- == 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                                                                                                                    | Both                                                                                                                   | Outside                                                                                                                     | Graphics                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_binary_import VK_NVX_binary_import>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'CuLaunchInfoNVX'
cmdCuLaunchKernelNVX :: forall io
                      . (MonadIO io)
                     => -- No documentation found for Nested "vkCmdCuLaunchKernelNVX" "commandBuffer"
                        CommandBuffer
                     -> -- No documentation found for Nested "vkCmdCuLaunchKernelNVX" "pLaunchInfo"
                        CuLaunchInfoNVX
                     -> io ()
cmdCuLaunchKernelNVX :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> CuLaunchInfoNVX -> io ()
cmdCuLaunchKernelNVX CommandBuffer
commandBuffer CuLaunchInfoNVX
launchInfo = 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 vkCmdCuLaunchKernelNVXPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
vkCmdCuLaunchKernelNVXPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
pVkCmdCuLaunchKernelNVX (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
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
vkCmdCuLaunchKernelNVXPtr 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 vkCmdCuLaunchKernelNVX is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCmdCuLaunchKernelNVX' :: Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ()
vkCmdCuLaunchKernelNVX' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
-> Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> IO ()
mkVkCmdCuLaunchKernelNVX FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
vkCmdCuLaunchKernelNVXPtr
  "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
pLaunchInfo <- 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 (CuLaunchInfoNVX
launchInfo)
  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
"vkCmdCuLaunchKernelNVX" (Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ()
vkCmdCuLaunchKernelNVX'
                                                      (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                      "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
pLaunchInfo)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


-- | VkCuModuleCreateInfoNVX - Stub description of VkCuModuleCreateInfoNVX
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_binary_import VK_NVX_binary_import>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createCuModuleNVX'
data CuModuleCreateInfoNVX = CuModuleCreateInfoNVX
  { -- | #VUID-VkCuModuleCreateInfoNVX-dataSize-arraylength# @dataSize@ /must/ be
    -- greater than @0@
    CuModuleCreateInfoNVX -> Word64
dataSize :: Word64
  , -- | #VUID-VkCuModuleCreateInfoNVX-pData-parameter# @pData@ /must/ be a valid
    -- pointer to an array of @dataSize@ bytes
    CuModuleCreateInfoNVX -> Ptr ()
data' :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CuModuleCreateInfoNVX)
#endif
deriving instance Show CuModuleCreateInfoNVX

instance ToCStruct CuModuleCreateInfoNVX where
  withCStruct :: forall b.
CuModuleCreateInfoNVX
-> (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX) -> IO b) -> IO b
withCStruct CuModuleCreateInfoNVX
x ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p CuModuleCreateInfoNVX
x (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX) -> IO b
f "pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p)
  pokeCStruct :: forall b.
("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
-> CuModuleCreateInfoNVX -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p CuModuleCreateInfoNVX{Word64
Ptr ()
data' :: Ptr ()
dataSize :: Word64
$sel:data':CuModuleCreateInfoNVX :: CuModuleCreateInfoNVX -> Ptr ()
$sel:dataSize:CuModuleCreateInfoNVX :: CuModuleCreateInfoNVX -> Word64
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_MODULE_CREATE_INFO_NVX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
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 (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
dataSize))
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ()))) (Ptr ()
data')
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_MODULE_CREATE_INFO_NVX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
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 (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CSize)) (Word64 -> CSize
CSize (forall a. Zero a => a
zero))
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ()))) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CuModuleCreateInfoNVX where
  peekCStruct :: ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
-> IO CuModuleCreateInfoNVX
peekCStruct "pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p = do
    CSize
dataSize <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CSize))
    Ptr ()
pData <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ())))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word64 -> Ptr () -> CuModuleCreateInfoNVX
CuModuleCreateInfoNVX
             (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
dataSize) Ptr ()
pData

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

instance Zero CuModuleCreateInfoNVX where
  zero :: CuModuleCreateInfoNVX
zero = Word64 -> Ptr () -> CuModuleCreateInfoNVX
CuModuleCreateInfoNVX
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkCuFunctionCreateInfoNVX - Stub description of
-- VkCuFunctionCreateInfoNVX
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_binary_import VK_NVX_binary_import>,
-- 'Vulkan.Extensions.Handles.CuModuleNVX',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createCuFunctionNVX'
data CuFunctionCreateInfoNVX = CuFunctionCreateInfoNVX
  { -- | #VUID-VkCuFunctionCreateInfoNVX-module-parameter# @module@ /must/ be a
    -- valid 'Vulkan.Extensions.Handles.CuModuleNVX' handle
    CuFunctionCreateInfoNVX -> CuModuleNVX
module' :: CuModuleNVX
  , -- | #VUID-VkCuFunctionCreateInfoNVX-pName-parameter# @pName@ /must/ be a
    -- null-terminated UTF-8 string
    CuFunctionCreateInfoNVX -> ByteString
name :: ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CuFunctionCreateInfoNVX)
#endif
deriving instance Show CuFunctionCreateInfoNVX

instance ToCStruct CuFunctionCreateInfoNVX where
  withCStruct :: forall b.
CuFunctionCreateInfoNVX
-> (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b)
-> IO b
withCStruct CuFunctionCreateInfoNVX
x ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p CuFunctionCreateInfoNVX
x (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b
f "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p)
  pokeCStruct :: forall b.
("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> CuFunctionCreateInfoNVX -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p CuFunctionCreateInfoNVX{ByteString
CuModuleNVX
name :: ByteString
module' :: CuModuleNVX
$sel:name:CuFunctionCreateInfoNVX :: CuFunctionCreateInfoNVX -> ByteString
$sel:module':CuFunctionCreateInfoNVX :: CuFunctionCreateInfoNVX -> CuModuleNVX
..} 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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_FUNCTION_CREATE_INFO_NVX)
    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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CuModuleNVX)) (CuModuleNVX
module')
    Ptr CChar
pName'' <- 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
name)
    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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: 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
$ IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_FUNCTION_CREATE_INFO_NVX)
    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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CuModuleNVX)) (forall a. Zero a => a
zero)
    Ptr CChar
pName'' <- 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 (forall a. Monoid a => a
mempty)
    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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: 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
$ IO b
f

instance FromCStruct CuFunctionCreateInfoNVX where
  peekCStruct :: ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> IO CuFunctionCreateInfoNVX
peekCStruct "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p = do
    CuModuleNVX
module' <- forall a. Storable a => Ptr a -> IO a
peek @CuModuleNVX (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CuModuleNVX))
    ByteString
pName <- Ptr CChar -> IO ByteString
packCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr CChar)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CuModuleNVX -> ByteString -> CuFunctionCreateInfoNVX
CuFunctionCreateInfoNVX
             CuModuleNVX
module' ByteString
pName

instance Zero CuFunctionCreateInfoNVX where
  zero :: CuFunctionCreateInfoNVX
zero = CuModuleNVX -> ByteString -> CuFunctionCreateInfoNVX
CuFunctionCreateInfoNVX
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkCuLaunchInfoNVX - Stub description of VkCuLaunchInfoNVX
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCuLaunchInfoNVX-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_LAUNCH_INFO_NVX'
--
-- -   #VUID-VkCuLaunchInfoNVX-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkCuLaunchInfoNVX-function-parameter# @function@ /must/ be a
--     valid 'Vulkan.Extensions.Handles.CuFunctionNVX' handle
--
-- -   #VUID-VkCuLaunchInfoNVX-pParams-parameter# If @paramCount@ is not
--     @0@, @pParams@ /must/ be a valid pointer to an array of @paramCount@
--     bytes
--
-- -   #VUID-VkCuLaunchInfoNVX-pExtras-parameter# If @extraCount@ is not
--     @0@, @pExtras@ /must/ be a valid pointer to an array of @extraCount@
--     bytes
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_binary_import VK_NVX_binary_import>,
-- 'Vulkan.Extensions.Handles.CuFunctionNVX',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'cmdCuLaunchKernelNVX'
data CuLaunchInfoNVX = CuLaunchInfoNVX
  { -- No documentation found for Nested "VkCuLaunchInfoNVX" "function"
    CuLaunchInfoNVX -> CuFunctionNVX
function :: CuFunctionNVX
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "gridDimX"
    CuLaunchInfoNVX -> Word32
gridDimX :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "gridDimY"
    CuLaunchInfoNVX -> Word32
gridDimY :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "gridDimZ"
    CuLaunchInfoNVX -> Word32
gridDimZ :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "blockDimX"
    CuLaunchInfoNVX -> Word32
blockDimX :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "blockDimY"
    CuLaunchInfoNVX -> Word32
blockDimY :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "blockDimZ"
    CuLaunchInfoNVX -> Word32
blockDimZ :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "sharedMemBytes"
    CuLaunchInfoNVX -> Word32
sharedMemBytes :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "pParams"
    CuLaunchInfoNVX -> Vector (Ptr ())
params :: Vector (Ptr ())
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "pExtras"
    CuLaunchInfoNVX -> Vector (Ptr ())
extras :: Vector (Ptr ())
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CuLaunchInfoNVX)
#endif
deriving instance Show CuLaunchInfoNVX

instance ToCStruct CuLaunchInfoNVX where
  withCStruct :: forall b.
CuLaunchInfoNVX
-> (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b) -> IO b
withCStruct CuLaunchInfoNVX
x ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
88 forall a b. (a -> b) -> a -> b
$ \"pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p CuLaunchInfoNVX
x (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b
f "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p)
  pokeCStruct :: forall b.
("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> CuLaunchInfoNVX -> IO b -> IO b
pokeCStruct "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p CuLaunchInfoNVX{Word32
Vector (Ptr ())
CuFunctionNVX
extras :: Vector (Ptr ())
params :: Vector (Ptr ())
sharedMemBytes :: Word32
blockDimZ :: Word32
blockDimY :: Word32
blockDimX :: Word32
gridDimZ :: Word32
gridDimY :: Word32
gridDimX :: Word32
function :: CuFunctionNVX
$sel:extras:CuLaunchInfoNVX :: CuLaunchInfoNVX -> Vector (Ptr ())
$sel:params:CuLaunchInfoNVX :: CuLaunchInfoNVX -> Vector (Ptr ())
$sel:sharedMemBytes:CuLaunchInfoNVX :: CuLaunchInfoNVX -> Word32
$sel:blockDimZ:CuLaunchInfoNVX :: CuLaunchInfoNVX -> Word32
$sel:blockDimY:CuLaunchInfoNVX :: CuLaunchInfoNVX -> Word32
$sel:blockDimX:CuLaunchInfoNVX :: CuLaunchInfoNVX -> Word32
$sel:gridDimZ:CuLaunchInfoNVX :: CuLaunchInfoNVX -> Word32
$sel:gridDimY:CuLaunchInfoNVX :: CuLaunchInfoNVX -> Word32
$sel:gridDimX:CuLaunchInfoNVX :: CuLaunchInfoNVX -> Word32
$sel:function:CuLaunchInfoNVX :: CuLaunchInfoNVX -> CuFunctionNVX
..} 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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_LAUNCH_INFO_NVX)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CuFunctionNVX)) (CuFunctionNVX
function)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
gridDimX)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
gridDimY)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
gridDimZ)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
blockDimX)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (Word32
blockDimY)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (Word32
blockDimZ)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) (Word32
sharedMemBytes)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr CSize)) ((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
$ (Vector (Ptr ())
params)) :: CSize))
    Ptr (Ptr ())
pPParams' <- 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 @(Ptr ()) ((forall a. Vector a -> Int
Data.Vector.length (Vector (Ptr ())
params)) forall a. Num a => a -> a -> a
* Int
8)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Ptr ()
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Ptr ())
pPParams' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ())) (Ptr ()
e)) (Vector (Ptr ())
params)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (Ptr ())))) (Ptr (Ptr ())
pPParams')
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr CSize)) ((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
$ (Vector (Ptr ())
extras)) :: CSize))
    Ptr (Ptr ())
pPExtras' <- 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 @(Ptr ()) ((forall a. Vector a -> Int
Data.Vector.length (Vector (Ptr ())
extras)) forall a. Num a => a -> a -> a
* Int
8)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Ptr ()
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Ptr ())
pPExtras' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ())) (Ptr ()
e)) (Vector (Ptr ())
extras)
    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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr (Ptr ())))) (Ptr (Ptr ())
pPExtras')
    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
88
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b -> IO b
pokeZeroCStruct "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_LAUNCH_INFO_NVX)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CuFunctionNVX)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
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 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CuLaunchInfoNVX where
  peekCStruct :: ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO CuLaunchInfoNVX
peekCStruct "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p = do
    CuFunctionNVX
function <- forall a. Storable a => Ptr a -> IO a
peek @CuFunctionNVX (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CuFunctionNVX))
    Word32
gridDimX <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Word32
gridDimY <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    Word32
gridDimZ <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Word32
blockDimX <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    Word32
blockDimY <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32))
    Word32
blockDimZ <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32))
    Word32
sharedMemBytes <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32))
    CSize
paramCount <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr CSize))
    Ptr (Ptr ())
pParams <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr ())) (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (Ptr ()))))
    Vector (Ptr ())
pParams' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
paramCount)) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (Ptr ())
pParams forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ()))))
    CSize
extraCount <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr CSize))
    Ptr (Ptr ())
pExtras <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr ())) (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr (Ptr ()))))
    Vector (Ptr ())
pExtras' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
extraCount)) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (Ptr ())
pExtras forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ()))))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CuFunctionNVX
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Vector (Ptr ())
-> Vector (Ptr ())
-> CuLaunchInfoNVX
CuLaunchInfoNVX
             CuFunctionNVX
function
             Word32
gridDimX
             Word32
gridDimY
             Word32
gridDimZ
             Word32
blockDimX
             Word32
blockDimY
             Word32
blockDimZ
             Word32
sharedMemBytes
             Vector (Ptr ())
pParams'
             Vector (Ptr ())
pExtras'

instance Zero CuLaunchInfoNVX where
  zero :: CuLaunchInfoNVX
zero = CuFunctionNVX
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Vector (Ptr ())
-> Vector (Ptr ())
-> CuLaunchInfoNVX
CuLaunchInfoNVX
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty


type NVX_BINARY_IMPORT_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_NVX_BINARY_IMPORT_SPEC_VERSION"
pattern NVX_BINARY_IMPORT_SPEC_VERSION :: forall a . Integral a => a
pattern $bNVX_BINARY_IMPORT_SPEC_VERSION :: forall a. Integral a => a
$mNVX_BINARY_IMPORT_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NVX_BINARY_IMPORT_SPEC_VERSION = 1


type NVX_BINARY_IMPORT_EXTENSION_NAME = "VK_NVX_binary_import"

-- No documentation found for TopLevel "VK_NVX_BINARY_IMPORT_EXTENSION_NAME"
pattern NVX_BINARY_IMPORT_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNVX_BINARY_IMPORT_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNVX_BINARY_IMPORT_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NVX_BINARY_IMPORT_EXTENSION_NAME = "VK_NVX_binary_import"