{-# language CPP #-}
-- | = Name
--
-- VK_NV_cuda_kernel_launch - device extension
--
-- == VK_NV_cuda_kernel_launch
--
-- [__Name String__]
--     @VK_NV_cuda_kernel_launch@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     308
--
-- [__Revision__]
--     2
--
-- [__Ratification Status__]
--     Not ratified
--
-- [__Extension and Version Dependencies__]
--
--     -   __This is a /provisional/ extension and /must/ be used with
--         caution. See the
--         <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#boilerplate-provisional-header description>
--         of provisional header files for enablement and stability
--         details.__
--
-- [__Contact__]
--
--     -   Tristan Lorach
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_cuda_kernel_launch] @tlorach%0A*Here describe the issue or question you have about the VK_NV_cuda_kernel_launch extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2020-09-30
--
-- [__Contributors__]
--
--     -   Eric Werness, NVIDIA
--
-- == Description
--
-- Interoperability between APIs can sometimes create additional overhead
-- depending on the platform used. This extension targets deployment of
-- existing CUDA kernels via Vulkan, with a way to directly upload PTX
-- kernels and dispatch the kernels from Vulkan’s command buffer without
-- the need to use interoperability between the Vulkan and CUDA contexts.
-- However, we do encourage actual development using the native CUDA
-- runtime for the purpose of debugging and profiling.
--
-- The application will first have to create a CUDA module using
-- 'createCudaModuleNV' then create the CUDA function entry point with
-- 'createCudaFunctionNV'.
--
-- Then in order to dispatch this function, the application will create a
-- command buffer where it will launch the kernel with
-- 'cmdCudaLaunchKernelNV'.
--
-- When done, the application will then destroy the function handle, as
-- well as the CUDA module handle with 'destroyCudaFunctionNV' and
-- 'destroyCudaModuleNV'.
--
-- To reduce the impact of compilation time, this extension offers the
-- capability to return a binary cache from the PTX that was provided. For
-- this, a first query for the required cache size is made with
-- 'getCudaModuleCacheNV' with a @NULL@ pointer to a buffer and with a
-- valid pointer receiving the size; then another call of the same function
-- with a valid pointer to a buffer to retrieve the data. The resulting
-- cache could then be user later for further runs of this application by
-- sending this cache instead of the PTX code (using the same
-- 'createCudaModuleNV'), thus significantly speeding up the initialization
-- of the CUDA module.
--
-- As with 'Vulkan.Core10.Handles.PipelineCache', the binary cache depends
-- on the hardware architecture. Therefore the application must assume the
-- cache might fail, and thus need to handle falling back to the original
-- PTX code as necessary. Most often, the cache will succeed if the same
-- GPU driver and architecture is used between the cache generation from
-- PTX and the use of this cache. But most often, in the event of a new
-- driver version or a if using a different GPU But in the event of a new
-- driver version or if using a different GPU architecture, the cache is
-- likely to become invalid.
--
-- == New Object Types
--
-- -   'Vulkan.Extensions.Handles.CudaFunctionNV'
--
-- -   'Vulkan.Extensions.Handles.CudaModuleNV'
--
-- == New Commands
--
-- -   'cmdCudaLaunchKernelNV'
--
-- -   'createCudaFunctionNV'
--
-- -   'createCudaModuleNV'
--
-- -   'destroyCudaFunctionNV'
--
-- -   'destroyCudaModuleNV'
--
-- -   'getCudaModuleCacheNV'
--
-- == New Structures
--
-- -   'CudaFunctionCreateInfoNV'
--
-- -   'CudaLaunchInfoNV'
--
-- -   'CudaModuleCreateInfoNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceCudaKernelLaunchFeaturesNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceCudaKernelLaunchPropertiesNV'
--
-- == New Enum Constants
--
-- -   'NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME'
--
-- -   'NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Extensions.VK_EXT_debug_report.DebugReportObjectTypeEXT':
--
--     -   'Vulkan.Extensions.VK_EXT_debug_report.DEBUG_REPORT_OBJECT_TYPE_CUDA_FUNCTION_NV'
--
--     -   'Vulkan.Extensions.VK_EXT_debug_report.DEBUG_REPORT_OBJECT_TYPE_CUDA_MODULE_NV'
--
-- -   Extending 'Vulkan.Core10.Enums.ObjectType.ObjectType':
--
--     -   'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_CUDA_FUNCTION_NV'
--
--     -   'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_CUDA_MODULE_NV'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CUDA_FUNCTION_CREATE_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CUDA_MODULE_CREATE_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_FEATURES_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_PROPERTIES_NV'
--
-- == Issues
--
-- None.
--
-- == Version History
--
-- -   Revision 1, 2020-03-01 (Tristan Lorach)
--
-- -   Revision 2, 2020-09-30 (Tristan Lorach)
--
-- == See Also
--
-- 'CudaFunctionCreateInfoNV', 'Vulkan.Extensions.Handles.CudaFunctionNV',
-- 'CudaLaunchInfoNV', 'CudaModuleCreateInfoNV',
-- 'Vulkan.Extensions.Handles.CudaModuleNV',
-- 'PhysicalDeviceCudaKernelLaunchFeaturesNV',
-- 'PhysicalDeviceCudaKernelLaunchPropertiesNV', 'cmdCudaLaunchKernelNV',
-- 'createCudaFunctionNV', 'createCudaModuleNV', 'destroyCudaFunctionNV',
-- 'destroyCudaModuleNV', 'getCudaModuleCacheNV'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NV_cuda_kernel_launch Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_NV_cuda_kernel_launch  ( createCudaModuleNV
                                                   , withCudaModuleNV
                                                   , getCudaModuleCacheNV
                                                   , createCudaFunctionNV
                                                   , withCudaFunctionNV
                                                   , destroyCudaModuleNV
                                                   , destroyCudaFunctionNV
                                                   , cmdCudaLaunchKernelNV
                                                   , CudaModuleCreateInfoNV(..)
                                                   , CudaFunctionCreateInfoNV(..)
                                                   , CudaLaunchInfoNV(..)
                                                   , PhysicalDeviceCudaKernelLaunchFeaturesNV(..)
                                                   , PhysicalDeviceCudaKernelLaunchPropertiesNV(..)
                                                   , NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION
                                                   , pattern NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION
                                                   , NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME
                                                   , pattern NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME
                                                   , CudaModuleNV(..)
                                                   , CudaFunctionNV(..)
                                                   , 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 (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Data.ByteString (packCStringLen)
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 Foreign.C.Types (CSize(..))
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.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
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 (CudaFunctionNV)
import Vulkan.Extensions.Handles (CudaFunctionNV(..))
import Vulkan.Extensions.Handles (CudaModuleNV)
import Vulkan.Extensions.Handles (CudaModuleNV(..))
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCudaLaunchKernelNV))
import Vulkan.Dynamic (DeviceCmds(pVkCreateCudaFunctionNV))
import Vulkan.Dynamic (DeviceCmds(pVkCreateCudaModuleNV))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyCudaFunctionNV))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyCudaModuleNV))
import Vulkan.Dynamic (DeviceCmds(pVkGetCudaModuleCacheNV))
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_CUDA_FUNCTION_CREATE_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_CUDA_MODULE_CREATE_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_PROPERTIES_NV))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.Handles (CudaFunctionNV(..))
import Vulkan.Extensions.Handles (CudaModuleNV(..))
import Vulkan.Extensions.VK_EXT_debug_report (DebugReportObjectTypeEXT(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateCudaModuleNV
  :: FunPtr (Ptr Device_T -> Ptr CudaModuleCreateInfoNV -> Ptr AllocationCallbacks -> Ptr CudaModuleNV -> IO Result) -> Ptr Device_T -> Ptr CudaModuleCreateInfoNV -> Ptr AllocationCallbacks -> Ptr CudaModuleNV -> IO Result

-- | vkCreateCudaModuleNV - Creates a new CUDA module object
--
-- = Description
--
-- Once a CUDA module has been created, you /may/ create the function entry
-- point that /must/ refer to one function in the module.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateCudaModuleNV-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateCudaModuleNV-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'CudaModuleCreateInfoNV'
--     structure
--
-- -   #VUID-vkCreateCudaModuleNV-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateCudaModuleNV-pModule-parameter# @pModule@ /must/ be a
--     valid pointer to a 'Vulkan.Extensions.Handles.CudaModuleNV' 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_INITIALIZATION_FAILED'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'CudaModuleCreateInfoNV', 'Vulkan.Extensions.Handles.CudaModuleNV',
-- 'Vulkan.Core10.Handles.Device'
createCudaModuleNV :: forall io
                    . (MonadIO io)
                   => -- | @device@ is the logical device that creates the shader module.
                      Device
                   -> -- | @pCreateInfo@ is a pointer to a 'CudaModuleCreateInfoNV' structure.
                      CudaModuleCreateInfoNV
                   -> -- | @pAllocator@ controls host memory allocation as described in the
                      -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                      -- chapter.
                      ("allocator" ::: Maybe AllocationCallbacks)
                   -> io (CudaModuleNV)
createCudaModuleNV :: forall (io :: * -> *).
MonadIO io =>
Device
-> CudaModuleCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaModuleNV
createCudaModuleNV Device
device CudaModuleCreateInfoNV
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 vkCreateCudaModuleNVPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CudaModuleNV)
   -> IO Result)
vkCreateCudaModuleNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pModule" ::: Ptr CudaModuleNV)
      -> IO Result)
pVkCreateCudaModuleNV (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 CudaModuleCreateInfoNV)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CudaModuleNV)
   -> IO Result)
vkCreateCudaModuleNVPtr 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 vkCreateCudaModuleNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCreateCudaModuleNV' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result
vkCreateCudaModuleNV' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CudaModuleNV)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result
mkVkCreateCudaModuleNV FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CudaModuleNV)
   -> IO Result)
vkCreateCudaModuleNVPtr
  "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
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 (CudaModuleCreateInfoNV
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 CudaModuleNV
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 @CudaModuleNV 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
"vkCreateCudaModuleNV" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CudaModuleNV)
-> IO Result
vkCreateCudaModuleNV'
                                                         (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                         "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
pCreateInfo
                                                         "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                         ("pModule" ::: Ptr CudaModuleNV
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))
  CudaModuleNV
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 @CudaModuleNV "pModule" ::: Ptr CudaModuleNV
pPModule
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (CudaModuleNV
pModule)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createCudaModuleNV' and 'destroyCudaModuleNV'
--
-- To ensure that 'destroyCudaModuleNV' 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.
--
withCudaModuleNV :: forall io r . MonadIO io => Device -> CudaModuleCreateInfoNV -> Maybe AllocationCallbacks -> (io CudaModuleNV -> (CudaModuleNV -> io ()) -> r) -> r
withCudaModuleNV :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> CudaModuleCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io CudaModuleNV -> (CudaModuleNV -> io ()) -> r)
-> r
withCudaModuleNV Device
device CudaModuleCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io CudaModuleNV -> (CudaModuleNV -> io ()) -> r
b =
  io CudaModuleNV -> (CudaModuleNV -> io ()) -> r
b (forall (io :: * -> *).
MonadIO io =>
Device
-> CudaModuleCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaModuleNV
createCudaModuleNV Device
device CudaModuleCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(CudaModuleNV
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> CudaModuleNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaModuleNV Device
device CudaModuleNV
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetCudaModuleCacheNV
  :: FunPtr (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result) -> Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result

-- | vkGetCudaModuleCacheNV - Get CUDA module cache
--
-- == Valid Usage
--
-- -   #VUID-vkGetCudaModuleCacheNV-pCacheSize-09414# @pCacheSize@ /must/
--     be a pointer containing the amount of bytes to be copied in
--     @pCacheData@. If @pCacheData@ is NULL, the function will return in
--     this pointer the total amount of bytes required to later perform the
--     copy into @pCacheData@.
--
-- -   #VUID-vkGetCudaModuleCacheNV-pCacheData-09415# @pCacheData@ /may/ be
--     a pointer to a buffer in which the binary cache will be copied. The
--     amount of bytes copied is defined by the value in @pCacheSize@. This
--     pointer /may/ be NULL. In this case, the function will write the
--     total amount of required data in @pCacheSize@.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetCudaModuleCacheNV-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetCudaModuleCacheNV-module-parameter# @module@ /must/ be a
--     valid 'Vulkan.Extensions.Handles.CudaModuleNV' handle
--
-- -   #VUID-vkGetCudaModuleCacheNV-pCacheSize-parameter# @pCacheSize@
--     /must/ be a valid pointer to a @size_t@ value
--
-- -   #VUID-vkGetCudaModuleCacheNV-pCacheData-parameter# If the value
--     referenced by @pCacheSize@ is not @0@, and @pCacheData@ is not
--     @NULL@, @pCacheData@ /must/ be a valid pointer to an array of
--     @pCacheSize@ bytes
--
-- -   #VUID-vkGetCudaModuleCacheNV-module-parent# @module@ /must/ have
--     been created, allocated, or retrieved from @device@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Extensions.Handles.CudaModuleNV', 'Vulkan.Core10.Handles.Device'
getCudaModuleCacheNV :: forall io
                      . (MonadIO io)
                     => -- | @device@ is the logical device that destroys the Function.
                        Device
                     -> -- | @module@ is the CUDA module.
                        CudaModuleNV
                     -> io (Result, ("cacheData" ::: ByteString))
getCudaModuleCacheNV :: forall (io :: * -> *).
MonadIO io =>
Device -> CudaModuleNV -> io (Result, "cacheData" ::: ByteString)
getCudaModuleCacheNV Device
device CudaModuleNV
module' = 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 vkGetCudaModuleCacheNVPtr :: FunPtr
  (Ptr Device_T
   -> CudaModuleNV
   -> ("pCacheSize" ::: Ptr CSize)
   -> ("pCacheData" ::: Ptr ())
   -> IO Result)
vkGetCudaModuleCacheNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> CudaModuleNV
      -> ("pCacheSize" ::: Ptr CSize)
      -> ("pCacheData" ::: Ptr ())
      -> IO Result)
pVkGetCudaModuleCacheNV (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
   -> CudaModuleNV
   -> ("pCacheSize" ::: Ptr CSize)
   -> ("pCacheData" ::: Ptr ())
   -> IO Result)
vkGetCudaModuleCacheNVPtr 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 vkGetCudaModuleCacheNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetCudaModuleCacheNV' :: Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result
vkGetCudaModuleCacheNV' = FunPtr
  (Ptr Device_T
   -> CudaModuleNV
   -> ("pCacheSize" ::: Ptr CSize)
   -> ("pCacheData" ::: Ptr ())
   -> IO Result)
-> Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result
mkVkGetCudaModuleCacheNV FunPtr
  (Ptr Device_T
   -> CudaModuleNV
   -> ("pCacheSize" ::: Ptr CSize)
   -> ("pCacheData" ::: Ptr ())
   -> IO Result)
vkGetCudaModuleCacheNVPtr
  let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
  "pCacheSize" ::: Ptr CSize
pPCacheSize <- 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 @CSize 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
"vkGetCudaModuleCacheNV" (Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result
vkGetCudaModuleCacheNV'
                                                           Ptr Device_T
device'
                                                           (CudaModuleNV
module')
                                                           ("pCacheSize" ::: Ptr CSize
pPCacheSize)
                                                           (forall a. Ptr a
nullPtr))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  CSize
pCacheSize <- 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 @CSize "pCacheSize" ::: Ptr CSize
pPCacheSize
  "pCacheData" ::: Ptr ()
pPCacheData <- 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 @(()) (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
pCacheSize)))) 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
"vkGetCudaModuleCacheNV" (Ptr Device_T
-> CudaModuleNV
-> ("pCacheSize" ::: Ptr CSize)
-> ("pCacheData" ::: Ptr ())
-> IO Result
vkGetCudaModuleCacheNV'
                                                            Ptr Device_T
device'
                                                            (CudaModuleNV
module')
                                                            ("pCacheSize" ::: Ptr CSize
pPCacheSize)
                                                            ("pCacheData" ::: Ptr ()
pPCacheData))
  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'))
  CSize
pCacheSize'' <- 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 @CSize "pCacheSize" ::: Ptr CSize
pPCacheSize
  "cacheData" ::: ByteString
pCacheData' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ("cacheData" ::: ByteString)
packCStringLen  ( forall a b. Ptr a -> Ptr b
castPtr @() @CChar "pCacheData" ::: Ptr ()
pPCacheData
                                        , (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
pCacheSize''))) )
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "cacheData" ::: ByteString
pCacheData')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateCudaFunctionNV
  :: FunPtr (Ptr Device_T -> Ptr CudaFunctionCreateInfoNV -> Ptr AllocationCallbacks -> Ptr CudaFunctionNV -> IO Result) -> Ptr Device_T -> Ptr CudaFunctionCreateInfoNV -> Ptr AllocationCallbacks -> Ptr CudaFunctionNV -> IO Result

-- | vkCreateCudaFunctionNV - Creates a new CUDA function object
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateCudaFunctionNV-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateCudaFunctionNV-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'CudaFunctionCreateInfoNV'
--     structure
--
-- -   #VUID-vkCreateCudaFunctionNV-pAllocator-parameter# If @pAllocator@
--     is not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateCudaFunctionNV-pFunction-parameter# @pFunction@ /must/
--     be a valid pointer to a 'Vulkan.Extensions.Handles.CudaFunctionNV'
--     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_INITIALIZATION_FAILED'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'CudaFunctionCreateInfoNV', 'Vulkan.Extensions.Handles.CudaFunctionNV',
-- 'Vulkan.Core10.Handles.Device'
createCudaFunctionNV :: forall io
                      . (MonadIO io)
                     => -- | @device@ is the logical device that creates the shader module.
                        Device
                     -> -- | @pCreateInfo@ is a pointer to a 'CudaFunctionCreateInfoNV' structure.
                        CudaFunctionCreateInfoNV
                     -> -- | @pAllocator@ controls host memory allocation as described in the
                        -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                        -- chapter.
                        ("allocator" ::: Maybe AllocationCallbacks)
                     -> io (CudaFunctionNV)
createCudaFunctionNV :: forall (io :: * -> *).
MonadIO io =>
Device
-> CudaFunctionCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaFunctionNV
createCudaFunctionNV Device
device CudaFunctionCreateInfoNV
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 vkCreateCudaFunctionNVPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CudaFunctionNV)
   -> IO Result)
vkCreateCudaFunctionNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pFunction" ::: Ptr CudaFunctionNV)
      -> IO Result)
pVkCreateCudaFunctionNV (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 CudaFunctionCreateInfoNV)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CudaFunctionNV)
   -> IO Result)
vkCreateCudaFunctionNVPtr 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 vkCreateCudaFunctionNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCreateCudaFunctionNV' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result
vkCreateCudaFunctionNV' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CudaFunctionNV)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result
mkVkCreateCudaFunctionNV FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CudaFunctionNV)
   -> IO Result)
vkCreateCudaFunctionNVPtr
  "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
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 (CudaFunctionCreateInfoNV
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 CudaFunctionNV
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 @CudaFunctionNV 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
"vkCreateCudaFunctionNV" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CudaFunctionNV)
-> IO Result
vkCreateCudaFunctionNV'
                                                           (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                           "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
pCreateInfo
                                                           "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
                                                           ("pFunction" ::: Ptr CudaFunctionNV
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))
  CudaFunctionNV
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 @CudaFunctionNV "pFunction" ::: Ptr CudaFunctionNV
pPFunction
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (CudaFunctionNV
pFunction)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createCudaFunctionNV' and 'destroyCudaFunctionNV'
--
-- To ensure that 'destroyCudaFunctionNV' 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.
--
withCudaFunctionNV :: forall io r . MonadIO io => Device -> CudaFunctionCreateInfoNV -> Maybe AllocationCallbacks -> (io CudaFunctionNV -> (CudaFunctionNV -> io ()) -> r) -> r
withCudaFunctionNV :: forall (io :: * -> *) r.
MonadIO io =>
Device
-> CudaFunctionCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io CudaFunctionNV -> (CudaFunctionNV -> io ()) -> r)
-> r
withCudaFunctionNV Device
device CudaFunctionCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io CudaFunctionNV -> (CudaFunctionNV -> io ()) -> r
b =
  io CudaFunctionNV -> (CudaFunctionNV -> io ()) -> r
b (forall (io :: * -> *).
MonadIO io =>
Device
-> CudaFunctionCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaFunctionNV
createCudaFunctionNV Device
device CudaFunctionCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(CudaFunctionNV
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> CudaFunctionNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaFunctionNV Device
device CudaFunctionNV
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


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

-- | vkDestroyCudaModuleNV - Destroy a CUDA module
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyCudaModuleNV-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyCudaModuleNV-module-parameter# @module@ /must/ be a
--     valid 'Vulkan.Extensions.Handles.CudaModuleNV' handle
--
-- -   #VUID-vkDestroyCudaModuleNV-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroyCudaModuleNV-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_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Extensions.Handles.CudaModuleNV', 'Vulkan.Core10.Handles.Device'
destroyCudaModuleNV :: forall io
                     . (MonadIO io)
                    => -- | @device@ is the logical device that destroys the shader module.
                       Device
                    -> -- | @module@ is the handle of the CUDA module to destroy.
                       CudaModuleNV
                    -> -- | @pAllocator@ controls host memory allocation as described in the
                       -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                       -- chapter.
                       ("allocator" ::: Maybe AllocationCallbacks)
                    -> io ()
destroyCudaModuleNV :: forall (io :: * -> *).
MonadIO io =>
Device
-> CudaModuleNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaModuleNV Device
device CudaModuleNV
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 vkDestroyCudaModuleNVPtr :: FunPtr
  (Ptr Device_T
   -> CudaModuleNV
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCudaModuleNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> CudaModuleNV
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyCudaModuleNV (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
   -> CudaModuleNV
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCudaModuleNVPtr 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 vkDestroyCudaModuleNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkDestroyCudaModuleNV' :: Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCudaModuleNV' = FunPtr
  (Ptr Device_T
   -> CudaModuleNV
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyCudaModuleNV FunPtr
  (Ptr Device_T
   -> CudaModuleNV
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCudaModuleNVPtr
  "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
"vkDestroyCudaModuleNV" (Ptr Device_T
-> CudaModuleNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCudaModuleNV'
                                                     (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                     (CudaModuleNV
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" mkVkDestroyCudaFunctionNV
  :: FunPtr (Ptr Device_T -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ()

-- | vkDestroyCudaFunctionNV - Destroy a CUDA function
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyCudaFunctionNV-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyCudaFunctionNV-function-parameter# @function@ /must/
--     be a valid 'Vulkan.Extensions.Handles.CudaFunctionNV' handle
--
-- -   #VUID-vkDestroyCudaFunctionNV-pAllocator-parameter# If @pAllocator@
--     is not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkDestroyCudaFunctionNV-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_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Extensions.Handles.CudaFunctionNV',
-- 'Vulkan.Core10.Handles.Device'
destroyCudaFunctionNV :: forall io
                       . (MonadIO io)
                      => -- | @device@ is the logical device that destroys the Function.
                         Device
                      -> -- | @function@ is the handle of the CUDA function to destroy.
                         CudaFunctionNV
                      -> -- | @pAllocator@ controls host memory allocation as described in the
                         -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                         -- chapter.
                         ("allocator" ::: Maybe AllocationCallbacks)
                      -> io ()
destroyCudaFunctionNV :: forall (io :: * -> *).
MonadIO io =>
Device
-> CudaFunctionNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCudaFunctionNV Device
device CudaFunctionNV
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 vkDestroyCudaFunctionNVPtr :: FunPtr
  (Ptr Device_T
   -> CudaFunctionNV
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCudaFunctionNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> CudaFunctionNV
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyCudaFunctionNV (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
   -> CudaFunctionNV
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCudaFunctionNVPtr 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 vkDestroyCudaFunctionNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkDestroyCudaFunctionNV' :: Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCudaFunctionNV' = FunPtr
  (Ptr Device_T
   -> CudaFunctionNV
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyCudaFunctionNV FunPtr
  (Ptr Device_T
   -> CudaFunctionNV
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCudaFunctionNVPtr
  "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
"vkDestroyCudaFunctionNV" (Ptr Device_T
-> CudaFunctionNV
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCudaFunctionNV'
                                                       (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                       (CudaFunctionNV
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" mkVkCmdCudaLaunchKernelNV
  :: FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ()) -> Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ()

-- | vkCmdCudaLaunchKernelNV - Dispatch compute work items
--
-- = Description
--
-- When the command is executed, a global workgroup consisting of
-- @gridDimX@ × @gridDimY@ × @gridDimZ@ local workgroups is assembled.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdCudaLaunchKernelNV-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdCudaLaunchKernelNV-pLaunchInfo-parameter# @pLaunchInfo@
--     /must/ be a valid pointer to a valid 'CudaLaunchInfoNV' structure
--
-- -   #VUID-vkCmdCudaLaunchKernelNV-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-vkCmdCudaLaunchKernelNV-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics, or compute operations
--
-- -   #VUID-vkCmdCudaLaunchKernelNV-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_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'CudaLaunchInfoNV'
cmdCudaLaunchKernelNV :: forall io
                       . (MonadIO io)
                      => -- | @commandBuffer@ is the command buffer into which the command will be
                         -- recorded.
                         CommandBuffer
                      -> -- | @pLaunchInfo@ is a pointer to a 'CudaLaunchInfoNV' structure in which
                         -- the grid (similar to workgroup) dimension, function handle and related
                         -- arguments are defined.
                         CudaLaunchInfoNV
                      -> io ()
cmdCudaLaunchKernelNV :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> CudaLaunchInfoNV -> io ()
cmdCudaLaunchKernelNV CommandBuffer
commandBuffer CudaLaunchInfoNV
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 vkCmdCudaLaunchKernelNVPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ())
vkCmdCudaLaunchKernelNVPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ())
pVkCmdCudaLaunchKernelNV (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 CudaLaunchInfoNV) -> IO ())
vkCmdCudaLaunchKernelNVPtr 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 vkCmdCudaLaunchKernelNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCmdCudaLaunchKernelNV' :: Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ()
vkCmdCudaLaunchKernelNV' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ())
-> Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV)
-> IO ()
mkVkCmdCudaLaunchKernelNV FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ())
vkCmdCudaLaunchKernelNVPtr
  "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
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 (CudaLaunchInfoNV
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
"vkCmdCudaLaunchKernelNV" (Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO ()
vkCmdCudaLaunchKernelNV'
                                                       (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                       "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
pLaunchInfo)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


-- | VkCudaModuleCreateInfoNV - Structure specifying the parameters to create
-- a CUDA Module
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createCudaModuleNV'
data CudaModuleCreateInfoNV = CudaModuleCreateInfoNV
  { -- | @dataSize@ is the length of the @pData@ array.
    --
    -- #VUID-VkCudaModuleCreateInfoNV-dataSize-09413# @dataSize@ /must/ be the
    -- total size in bytes of the PTX files or binary cache passed to @pData@.
    --
    -- #VUID-VkCudaModuleCreateInfoNV-dataSize-arraylength# @dataSize@ /must/
    -- be greater than @0@
    CudaModuleCreateInfoNV -> Word64
dataSize :: Word64
  , -- | @pData@ is a pointer to CUDA code
    --
    -- #VUID-VkCudaModuleCreateInfoNV-pData-parameter# @pData@ /must/ be a
    -- valid pointer to an array of @dataSize@ bytes
    CudaModuleCreateInfoNV -> "pCacheData" ::: Ptr ()
data' :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CudaModuleCreateInfoNV)
#endif
deriving instance Show CudaModuleCreateInfoNV

instance ToCStruct CudaModuleCreateInfoNV where
  withCStruct :: forall b.
CudaModuleCreateInfoNV
-> (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV) -> IO b) -> IO b
withCStruct CudaModuleCreateInfoNV
x ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV) -> 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 CudaModuleCreateInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p CudaModuleCreateInfoNV
x (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV) -> IO b
f "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p)
  pokeCStruct :: forall b.
("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> CudaModuleCreateInfoNV -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p CudaModuleCreateInfoNV{Word64
"pCacheData" ::: Ptr ()
data' :: "pCacheData" ::: Ptr ()
dataSize :: Word64
$sel:data':CudaModuleCreateInfoNV :: CudaModuleCreateInfoNV -> "pCacheData" ::: Ptr ()
$sel:dataSize:CudaModuleCreateInfoNV :: CudaModuleCreateInfoNV -> Word64
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_MODULE_CREATE_INFO_NV)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
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 CudaModuleCreateInfoNV
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 CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ()))) ("pCacheData" ::: Ptr ()
data')
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_MODULE_CREATE_INFO_NV)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
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 CudaModuleCreateInfoNV
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 CudaModuleCreateInfoNV
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 CudaModuleCreateInfoNV where
  peekCStruct :: ("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV)
-> IO CudaModuleCreateInfoNV
peekCStruct "pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p = do
    CSize
dataSize <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CSize))
    "pCacheData" ::: Ptr ()
pData <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) (("pCreateInfo" ::: Ptr CudaModuleCreateInfoNV
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 -> ("pCacheData" ::: Ptr ()) -> CudaModuleCreateInfoNV
CudaModuleCreateInfoNV
             (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
dataSize) "pCacheData" ::: Ptr ()
pData

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

instance Zero CudaModuleCreateInfoNV where
  zero :: CudaModuleCreateInfoNV
zero = Word64 -> ("pCacheData" ::: Ptr ()) -> CudaModuleCreateInfoNV
CudaModuleCreateInfoNV
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkCudaFunctionCreateInfoNV - Structure specifying the parameters to
-- create a CUDA Function
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Extensions.Handles.CudaModuleNV',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'createCudaFunctionNV'
data CudaFunctionCreateInfoNV = CudaFunctionCreateInfoNV
  { -- | @module@ /must/ be the CUDA 'Vulkan.Extensions.Handles.CudaModuleNV'
    -- module in which the function resides.
    --
    -- #VUID-VkCudaFunctionCreateInfoNV-module-parameter# @module@ /must/ be a
    -- valid 'Vulkan.Extensions.Handles.CudaModuleNV' handle
    CudaFunctionCreateInfoNV -> CudaModuleNV
module' :: CudaModuleNV
  , -- | @pName@ is a null-terminated UTF-8 string containing the name of the
    -- shader entry point for this stage.
    --
    -- #VUID-VkCudaFunctionCreateInfoNV-pName-parameter# @pName@ /must/ be a
    -- null-terminated UTF-8 string
    CudaFunctionCreateInfoNV -> "cacheData" ::: ByteString
name :: ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CudaFunctionCreateInfoNV)
#endif
deriving instance Show CudaFunctionCreateInfoNV

instance ToCStruct CudaFunctionCreateInfoNV where
  withCStruct :: forall b.
CudaFunctionCreateInfoNV
-> (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV) -> IO b)
-> IO b
withCStruct CudaFunctionCreateInfoNV
x ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV) -> 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 CudaFunctionCreateInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p CudaFunctionCreateInfoNV
x (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV) -> IO b
f "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p)
  pokeCStruct :: forall b.
("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> CudaFunctionCreateInfoNV -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p CudaFunctionCreateInfoNV{"cacheData" ::: ByteString
CudaModuleNV
name :: "cacheData" ::: ByteString
module' :: CudaModuleNV
$sel:name:CudaFunctionCreateInfoNV :: CudaFunctionCreateInfoNV -> "cacheData" ::: ByteString
$sel:module':CudaFunctionCreateInfoNV :: CudaFunctionCreateInfoNV -> CudaModuleNV
..} 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 CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_FUNCTION_CREATE_INFO_NV)
    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 CudaFunctionCreateInfoNV
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 CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaModuleNV)) (CudaModuleNV
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.
("cacheData" ::: ByteString) -> (Ptr CChar -> IO a) -> IO a
useAsCString ("cacheData" ::: 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 CudaFunctionCreateInfoNV
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 CudaFunctionCreateInfoNV) -> IO b -> IO b
pokeZeroCStruct "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
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 CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_FUNCTION_CREATE_INFO_NV)
    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 CudaFunctionCreateInfoNV
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 CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaModuleNV)) (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.
("cacheData" ::: 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 CudaFunctionCreateInfoNV
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 CudaFunctionCreateInfoNV where
  peekCStruct :: ("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV)
-> IO CudaFunctionCreateInfoNV
peekCStruct "pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p = do
    CudaModuleNV
module' <- forall a. Storable a => Ptr a -> IO a
peek @CudaModuleNV (("pCreateInfo" ::: Ptr CudaFunctionCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaModuleNV))
    "cacheData" ::: ByteString
pName <- Ptr CChar -> IO ("cacheData" ::: 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 CudaFunctionCreateInfoNV
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
$ CudaModuleNV
-> ("cacheData" ::: ByteString) -> CudaFunctionCreateInfoNV
CudaFunctionCreateInfoNV
             CudaModuleNV
module' "cacheData" ::: ByteString
pName

instance Zero CudaFunctionCreateInfoNV where
  zero :: CudaFunctionCreateInfoNV
zero = CudaModuleNV
-> ("cacheData" ::: ByteString) -> CudaFunctionCreateInfoNV
CudaFunctionCreateInfoNV
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkCudaLaunchInfoNV - Structure specifying the parameters to launch a
-- CUDA kernel
--
-- == Valid Usage
--
-- -   #VUID-VkCudaLaunchInfoNV-gridDimX-09406# @gridDimX@ /must/ be less
--     than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[0]
--
-- -   #VUID-VkCudaLaunchInfoNV-gridDimY-09407# @gridDimY@ /must/ be less
--     than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[1]
--
-- -   #VUID-VkCudaLaunchInfoNV-gridDimZ-09408# @gridDimZ@ /must/ be less
--     than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[2]
--
-- -   #VUID-VkCudaLaunchInfoNV-paramCount-09409# @paramCount@ /must/ be
--     the total amount of parameters listed in the @pParams@ table.
--
-- -   #VUID-VkCudaLaunchInfoNV-pParams-09410# @pParams@ /must/ be a
--     pointer to a table of @paramCount@ parameters, corresponding to the
--     arguments of @function@.
--
-- -   #VUID-VkCudaLaunchInfoNV-extraCount-09411# @extraCount@ must be 0
--
-- -   #VUID-VkCudaLaunchInfoNV-pExtras-09412# @pExtras@ must be NULL
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCudaLaunchInfoNV-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV'
--
-- -   #VUID-VkCudaLaunchInfoNV-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkCudaLaunchInfoNV-function-parameter# @function@ /must/ be a
--     valid 'Vulkan.Extensions.Handles.CudaFunctionNV' handle
--
-- -   #VUID-VkCudaLaunchInfoNV-pParams-parameter# If @paramCount@ is not
--     @0@, @pParams@ /must/ be a valid pointer to an array of @paramCount@
--     bytes
--
-- -   #VUID-VkCudaLaunchInfoNV-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_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Extensions.Handles.CudaFunctionNV',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'cmdCudaLaunchKernelNV'
data CudaLaunchInfoNV = CudaLaunchInfoNV
  { -- | @function@ is the CUDA-Driver handle to the function being launched.
    CudaLaunchInfoNV -> CudaFunctionNV
function :: CudaFunctionNV
  , -- | @gridDimX@ is the number of local workgroups to dispatch in the X
    -- dimension. It must be less than or equal to
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[0]
    CudaLaunchInfoNV -> Word32
gridDimX :: Word32
  , -- | @gridDimY@ is the number of local workgroups to dispatch in the Y
    -- dimension. It must be less than or equal to
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[1]
    CudaLaunchInfoNV -> Word32
gridDimY :: Word32
  , -- | @gridDimZ@ is the number of local workgroups to dispatch in the Z
    -- dimension. It must be less than or equal to
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[2]
    CudaLaunchInfoNV -> Word32
gridDimZ :: Word32
  , -- | @blockDimX@ is block size in the X dimension.
    CudaLaunchInfoNV -> Word32
blockDimX :: Word32
  , -- | @blockDimY@ is block size in the Y dimension.
    CudaLaunchInfoNV -> Word32
blockDimY :: Word32
  , -- | @blockDimZ@ is block size in the Z dimension.
    CudaLaunchInfoNV -> Word32
blockDimZ :: Word32
  , -- | @sharedMemBytes@ is the dynamic shared-memory size per thread block in
    -- bytes.
    CudaLaunchInfoNV -> Word32
sharedMemBytes :: Word32
  , -- | @pParams@ is a pointer to an array of @paramCount@ pointers,
    -- corresponding to the arguments of @function@.
    CudaLaunchInfoNV -> Vector ("pCacheData" ::: Ptr ())
params :: Vector (Ptr ())
  , -- | @pExtras@ is reserved for future use.
    CudaLaunchInfoNV -> Vector ("pCacheData" ::: Ptr ())
extras :: Vector (Ptr ())
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CudaLaunchInfoNV)
#endif
deriving instance Show CudaLaunchInfoNV

instance ToCStruct CudaLaunchInfoNV where
  withCStruct :: forall b.
CudaLaunchInfoNV
-> (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO b) -> IO b
withCStruct CudaLaunchInfoNV
x ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> 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 CudaLaunchInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p CudaLaunchInfoNV
x (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO b
f "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p)
  pokeCStruct :: forall b.
("pLaunchInfo" ::: Ptr CudaLaunchInfoNV)
-> CudaLaunchInfoNV -> IO b -> IO b
pokeCStruct "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p CudaLaunchInfoNV{Word32
Vector ("pCacheData" ::: Ptr ())
CudaFunctionNV
extras :: Vector ("pCacheData" ::: Ptr ())
params :: Vector ("pCacheData" ::: Ptr ())
sharedMemBytes :: Word32
blockDimZ :: Word32
blockDimY :: Word32
blockDimX :: Word32
gridDimZ :: Word32
gridDimY :: Word32
gridDimX :: Word32
function :: CudaFunctionNV
$sel:extras:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Vector ("pCacheData" ::: Ptr ())
$sel:params:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Vector ("pCacheData" ::: Ptr ())
$sel:sharedMemBytes:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:blockDimZ:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:blockDimY:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:blockDimX:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:gridDimZ:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:gridDimY:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:gridDimX:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:function:CudaLaunchInfoNV :: CudaLaunchInfoNV -> CudaFunctionNV
..} 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 CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV)
    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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaFunctionNV)) (CudaFunctionNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 ("pCacheData" ::: Ptr ())
params)) :: CSize))
    Ptr ("pCacheData" ::: 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 ("pCacheData" ::: 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 "pCacheData" ::: Ptr ()
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pCacheData" ::: Ptr ())
pPParams' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ())) ("pCacheData" ::: Ptr ()
e)) (Vector ("pCacheData" ::: 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 CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (Ptr ())))) (Ptr ("pCacheData" ::: 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 CudaLaunchInfoNV
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 ("pCacheData" ::: Ptr ())
extras)) :: CSize))
    Ptr ("pCacheData" ::: 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 ("pCacheData" ::: 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 "pCacheData" ::: Ptr ()
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pCacheData" ::: Ptr ())
pPExtras' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ())) ("pCacheData" ::: Ptr ()
e)) (Vector ("pCacheData" ::: 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 CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr (Ptr ())))) (Ptr ("pCacheData" ::: 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 CudaLaunchInfoNV) -> IO b -> IO b
pokeZeroCStruct "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
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 CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaFunctionNV)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV where
  peekCStruct :: ("pLaunchInfo" ::: Ptr CudaLaunchInfoNV) -> IO CudaLaunchInfoNV
peekCStruct "pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p = do
    CudaFunctionNV
function <- forall a. Storable a => Ptr a -> IO a
peek @CudaFunctionNV (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaFunctionNV))
    Word32
gridDimX <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
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 CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr CSize))
    Ptr ("pCacheData" ::: Ptr ())
pParams <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr ())) (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (Ptr ()))))
    Vector ("pCacheData" ::: 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 ("pCacheData" ::: 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 CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr CSize))
    Ptr ("pCacheData" ::: Ptr ())
pExtras <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr ())) (("pLaunchInfo" ::: Ptr CudaLaunchInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr (Ptr ()))))
    Vector ("pCacheData" ::: 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 ("pCacheData" ::: 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
$ CudaFunctionNV
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Vector ("pCacheData" ::: Ptr ())
-> Vector ("pCacheData" ::: Ptr ())
-> CudaLaunchInfoNV
CudaLaunchInfoNV
             CudaFunctionNV
function
             Word32
gridDimX
             Word32
gridDimY
             Word32
gridDimZ
             Word32
blockDimX
             Word32
blockDimY
             Word32
blockDimZ
             Word32
sharedMemBytes
             Vector ("pCacheData" ::: Ptr ())
pParams'
             Vector ("pCacheData" ::: Ptr ())
pExtras'

instance Zero CudaLaunchInfoNV where
  zero :: CudaLaunchInfoNV
zero = CudaFunctionNV
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Vector ("pCacheData" ::: Ptr ())
-> Vector ("pCacheData" ::: Ptr ())
-> CudaLaunchInfoNV
CudaLaunchInfoNV
           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


-- | VkPhysicalDeviceCudaKernelLaunchFeaturesNV - Structure describing
-- whether cuda kernel launch is supported by the implementation
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceCudaKernelLaunchFeaturesNV' structure is included
-- in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceCudaKernelLaunchFeaturesNV' /can/ also be used
-- in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceCudaKernelLaunchFeaturesNV = PhysicalDeviceCudaKernelLaunchFeaturesNV
  { -- | #features-cudaKernelLaunchFeatures# @cudaKernelLaunchFeatures@ is
    -- non-zero if cuda kernel launch is supported.
    PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
cudaKernelLaunchFeatures :: Bool }
  deriving (Typeable, PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
$c/= :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
== :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
$c== :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCudaKernelLaunchFeaturesNV)
#endif
deriving instance Show PhysicalDeviceCudaKernelLaunchFeaturesNV

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

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

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

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


-- | VkPhysicalDeviceCudaKernelLaunchPropertiesNV - Structure describing the
-- compute capability version available
--
-- = Members
--
-- The members of the 'PhysicalDeviceCudaKernelLaunchPropertiesNV'
-- structure describe the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceCudaKernelLaunchPropertiesNV' 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_NV_cuda_kernel_launch VK_NV_cuda_kernel_launch>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceCudaKernelLaunchPropertiesNV = PhysicalDeviceCudaKernelLaunchPropertiesNV
  { -- | #limits-computeCapabilityMinor# @computeCapabilityMinor@ indicates the
    -- minor version number of the compute code.
    PhysicalDeviceCudaKernelLaunchPropertiesNV -> Word32
computeCapabilityMinor :: Word32
  , -- | #limits-computeCapabilityMajor# @computeCapabilityMajor@ indicates the
    -- minor version number of the compute code.
    PhysicalDeviceCudaKernelLaunchPropertiesNV -> Word32
computeCapabilityMajor :: Word32
  }
  deriving (Typeable, PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
$c/= :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
== :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
$c== :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCudaKernelLaunchPropertiesNV)
#endif
deriving instance Show PhysicalDeviceCudaKernelLaunchPropertiesNV

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

instance FromCStruct PhysicalDeviceCudaKernelLaunchPropertiesNV where
  peekCStruct :: Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> IO PhysicalDeviceCudaKernelLaunchPropertiesNV
peekCStruct Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p = do
    Word32
computeCapabilityMinor <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Word32
computeCapabilityMajor <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> PhysicalDeviceCudaKernelLaunchPropertiesNV
PhysicalDeviceCudaKernelLaunchPropertiesNV
             Word32
computeCapabilityMinor Word32
computeCapabilityMajor

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

instance Zero PhysicalDeviceCudaKernelLaunchPropertiesNV where
  zero :: PhysicalDeviceCudaKernelLaunchPropertiesNV
zero = Word32 -> Word32 -> PhysicalDeviceCudaKernelLaunchPropertiesNV
PhysicalDeviceCudaKernelLaunchPropertiesNV
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


type NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION = 2

-- No documentation found for TopLevel "VK_NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION"
pattern NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_CUDA_KERNEL_LAUNCH_SPEC_VERSION :: forall a. Integral a => a
$mNV_CUDA_KERNEL_LAUNCH_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_CUDA_KERNEL_LAUNCH_SPEC_VERSION = 2


type NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME = "VK_NV_cuda_kernel_launch"

-- No documentation found for TopLevel "VK_NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME"
pattern NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_CUDA_KERNEL_LAUNCH_EXTENSION_NAME = "VK_NV_cuda_kernel_launch"