{-# 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__]
--     None
--
--     -   __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.__
--
-- [__API Interactions__]
--
--     -   Interacts with VK_EXT_debug_report
--
-- [__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. The application must assume the cache
-- might fail, and 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. 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.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'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_debug_report VK_EXT_debug_report>
-- is supported:
--
-- -   Extending
--     'Vulkan.Extensions.VK_EXT_debug_report.DebugReportObjectTypeEXT':
--
--     -   'Vulkan.Extensions.VK_EXT_debug_report.DEBUG_REPORT_OBJECT_TYPE_CUDA_FUNCTION_NV_EXT'
--
--     -   'Vulkan.Extensions.VK_EXT_debug_report.DEBUG_REPORT_OBJECT_TYPE_CUDA_MODULE_NV_EXT'
--
-- == 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, the application /may/ create the
-- function entry point, which /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 = IO CudaModuleNV -> io CudaModuleNV
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CudaModuleNV -> io CudaModuleNV)
-> (ContT CudaModuleNV IO CudaModuleNV -> IO CudaModuleNV)
-> ContT CudaModuleNV IO CudaModuleNV
-> io CudaModuleNV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT CudaModuleNV IO CudaModuleNV -> IO CudaModuleNV
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT CudaModuleNV IO CudaModuleNV -> io CudaModuleNV)
-> ContT CudaModuleNV IO CudaModuleNV -> io CudaModuleNV
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateCudaModuleNVPtr :: FunPtr
  (Ptr Device_T
   -> Ptr CudaModuleCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaModuleNV
   -> IO Result)
vkCreateCudaModuleNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Ptr CudaModuleCreateInfoNV
      -> Ptr AllocationCallbacks
      -> Ptr CudaModuleNV
      -> IO Result)
pVkCreateCudaModuleNV (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT CudaModuleNV IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT CudaModuleNV m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT CudaModuleNV IO ())
-> IO () -> ContT CudaModuleNV IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Ptr CudaModuleCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaModuleNV
   -> IO Result)
vkCreateCudaModuleNVPtr FunPtr
  (Ptr Device_T
   -> Ptr CudaModuleCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaModuleNV
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> Ptr CudaModuleCreateInfoNV
      -> Ptr AllocationCallbacks
      -> Ptr CudaModuleNV
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Ptr CudaModuleCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaModuleNV
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateCudaModuleNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateCudaModuleNV' :: Ptr Device_T
-> Ptr CudaModuleCreateInfoNV
-> Ptr AllocationCallbacks
-> Ptr CudaModuleNV
-> IO Result
vkCreateCudaModuleNV' = FunPtr
  (Ptr Device_T
   -> Ptr CudaModuleCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaModuleNV
   -> IO Result)
-> Ptr Device_T
-> Ptr CudaModuleCreateInfoNV
-> Ptr AllocationCallbacks
-> Ptr CudaModuleNV
-> IO Result
mkVkCreateCudaModuleNV FunPtr
  (Ptr Device_T
   -> Ptr CudaModuleCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaModuleNV
   -> IO Result)
vkCreateCudaModuleNVPtr
  Ptr CudaModuleCreateInfoNV
pCreateInfo <- ((Ptr CudaModuleCreateInfoNV -> IO CudaModuleNV)
 -> IO CudaModuleNV)
-> ContT CudaModuleNV IO (Ptr CudaModuleCreateInfoNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CudaModuleCreateInfoNV -> IO CudaModuleNV)
  -> IO CudaModuleNV)
 -> ContT CudaModuleNV IO (Ptr CudaModuleCreateInfoNV))
-> ((Ptr CudaModuleCreateInfoNV -> IO CudaModuleNV)
    -> IO CudaModuleNV)
-> ContT CudaModuleNV IO (Ptr CudaModuleCreateInfoNV)
forall a b. (a -> b) -> a -> b
$ CudaModuleCreateInfoNV
-> (Ptr CudaModuleCreateInfoNV -> IO CudaModuleNV)
-> IO CudaModuleNV
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
CudaModuleCreateInfoNV
-> (Ptr CudaModuleCreateInfoNV -> IO b) -> IO b
withCStruct (CudaModuleCreateInfoNV
createInfo)
  Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> Ptr AllocationCallbacks
-> ContT CudaModuleNV IO (Ptr AllocationCallbacks)
forall a. a -> ContT CudaModuleNV IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> ((Ptr AllocationCallbacks -> IO CudaModuleNV) -> IO CudaModuleNV)
-> ContT CudaModuleNV IO (Ptr AllocationCallbacks)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCallbacks -> IO CudaModuleNV) -> IO CudaModuleNV)
 -> ContT CudaModuleNV IO (Ptr AllocationCallbacks))
-> ((Ptr AllocationCallbacks -> IO CudaModuleNV)
    -> IO CudaModuleNV)
-> ContT CudaModuleNV IO (Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (Ptr AllocationCallbacks -> IO CudaModuleNV) -> IO CudaModuleNV
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
AllocationCallbacks -> (Ptr AllocationCallbacks -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  Ptr CudaModuleNV
pPModule <- ((Ptr CudaModuleNV -> IO CudaModuleNV) -> IO CudaModuleNV)
-> ContT CudaModuleNV IO (Ptr CudaModuleNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CudaModuleNV -> IO CudaModuleNV) -> IO CudaModuleNV)
 -> ContT CudaModuleNV IO (Ptr CudaModuleNV))
-> ((Ptr CudaModuleNV -> IO CudaModuleNV) -> IO CudaModuleNV)
-> ContT CudaModuleNV IO (Ptr CudaModuleNV)
forall a b. (a -> b) -> a -> b
$ IO (Ptr CudaModuleNV)
-> (Ptr CudaModuleNV -> IO ())
-> (Ptr CudaModuleNV -> IO CudaModuleNV)
-> IO CudaModuleNV
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) Ptr CudaModuleNV -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT CudaModuleNV IO Result
forall (m :: * -> *) a. Monad m => m a -> ContT CudaModuleNV m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT CudaModuleNV IO Result)
-> IO Result -> ContT CudaModuleNV IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateCudaModuleNV" (Ptr Device_T
-> Ptr CudaModuleCreateInfoNV
-> Ptr AllocationCallbacks
-> Ptr CudaModuleNV
-> IO Result
vkCreateCudaModuleNV'
                                                         (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                         Ptr CudaModuleCreateInfoNV
pCreateInfo
                                                         Ptr AllocationCallbacks
pAllocator
                                                         (Ptr CudaModuleNV
pPModule))
  IO () -> ContT CudaModuleNV IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT CudaModuleNV m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT CudaModuleNV IO ())
-> IO () -> ContT CudaModuleNV IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  CudaModuleNV
pModule <- IO CudaModuleNV -> ContT CudaModuleNV IO CudaModuleNV
forall (m :: * -> *) a. Monad m => m a -> ContT CudaModuleNV m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CudaModuleNV -> ContT CudaModuleNV IO CudaModuleNV)
-> IO CudaModuleNV -> ContT CudaModuleNV IO CudaModuleNV
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @CudaModuleNV Ptr CudaModuleNV
pPModule
  CudaModuleNV -> ContT CudaModuleNV IO CudaModuleNV
forall a. a -> ContT CudaModuleNV IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CudaModuleNV -> ContT CudaModuleNV IO CudaModuleNV)
-> CudaModuleNV -> ContT CudaModuleNV IO CudaModuleNV
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 (Device
-> CudaModuleCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaModuleNV
forall (io :: * -> *).
MonadIO io =>
Device
-> CudaModuleCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaModuleNV
createCudaModuleNV Device
device CudaModuleCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(CudaModuleNV
o0) -> Device
-> CudaModuleNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
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
--
-- = Description
--
-- If @pCacheData@ is @NULL@, then the size of the binary cache, in bytes,
-- is returned in @pCacheSize@. Otherwise, @pCacheSize@ /must/ point to a
-- variable set by the user to the size of the buffer, in bytes, pointed to
-- by @pCacheData@, and on return the variable is overwritten with the
-- amount of data actually written to @pCacheData@. If @pCacheSize@ is less
-- than the size of the binary shader code, nothing is written to
-- @pCacheData@, and 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be
-- returned instead of 'Vulkan.Core10.Enums.Result.SUCCESS'.
--
-- The returned cache /may/ then be used later for further initialization
-- of the CUDA module, by sending this cache /instead/ of the PTX code when
-- using 'createCudaModuleNV'.
--
-- Note
--
-- Using the binary cache instead of the original PTX code /should/
-- significantly speed up initialization of the CUDA module, given that the
-- whole compilation and validation will not be necessary.
--
-- As with 'Vulkan.Core10.Handles.PipelineCache', the binary cache depends
-- on the specific implementation. The application /must/ assume the cache
-- upload might fail in many circumstances and thus /may/ have to get ready
-- for falling back to the original PTX code if necessary. Most often, the
-- cache /may/ succeed if the same device driver and architecture is used
-- between the cache generation from PTX and the use of this cache. In the
-- event of a new driver version or if using a different device
-- architecture, this cache /may/ become invalid.
--
-- == 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' = IO (Result, "cacheData" ::: ByteString)
-> io (Result, "cacheData" ::: ByteString)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "cacheData" ::: ByteString)
 -> io (Result, "cacheData" ::: ByteString))
-> (ContT
      (Result, "cacheData" ::: ByteString)
      IO
      (Result, "cacheData" ::: ByteString)
    -> IO (Result, "cacheData" ::: ByteString))
-> ContT
     (Result, "cacheData" ::: ByteString)
     IO
     (Result, "cacheData" ::: ByteString)
-> io (Result, "cacheData" ::: ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "cacheData" ::: ByteString)
  IO
  (Result, "cacheData" ::: ByteString)
-> IO (Result, "cacheData" ::: ByteString)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "cacheData" ::: ByteString)
   IO
   (Result, "cacheData" ::: ByteString)
 -> io (Result, "cacheData" ::: ByteString))
-> ContT
     (Result, "cacheData" ::: ByteString)
     IO
     (Result, "cacheData" ::: ByteString)
-> io (Result, "cacheData" ::: ByteString)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetCudaModuleCacheNVPtr :: FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result)
vkGetCudaModuleCacheNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result)
pVkGetCudaModuleCacheNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT (Result, "cacheData" ::: ByteString) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "cacheData" ::: ByteString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "cacheData" ::: ByteString) IO ())
-> IO () -> ContT (Result, "cacheData" ::: ByteString) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result)
vkGetCudaModuleCacheNVPtr FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result)
-> FunPtr
     (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetCudaModuleCacheNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetCudaModuleCacheNV' :: Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result
vkGetCudaModuleCacheNV' = FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result)
-> Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result
mkVkGetCudaModuleCacheNV FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result)
vkGetCudaModuleCacheNVPtr
  let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
  Ptr CSize
pPCacheSize <- ((Ptr CSize -> IO (Result, "cacheData" ::: ByteString))
 -> IO (Result, "cacheData" ::: ByteString))
-> ContT (Result, "cacheData" ::: ByteString) IO (Ptr CSize)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CSize -> IO (Result, "cacheData" ::: ByteString))
  -> IO (Result, "cacheData" ::: ByteString))
 -> ContT (Result, "cacheData" ::: ByteString) IO (Ptr CSize))
-> ((Ptr CSize -> IO (Result, "cacheData" ::: ByteString))
    -> IO (Result, "cacheData" ::: ByteString))
-> ContT (Result, "cacheData" ::: ByteString) IO (Ptr CSize)
forall a b. (a -> b) -> a -> b
$ IO (Ptr CSize)
-> (Ptr CSize -> IO ())
-> (Ptr CSize -> IO (Result, "cacheData" ::: ByteString))
-> IO (Result, "cacheData" ::: ByteString)
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) Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT (Result, "cacheData" ::: ByteString) IO Result
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "cacheData" ::: ByteString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, "cacheData" ::: ByteString) IO Result)
-> IO Result
-> ContT (Result, "cacheData" ::: ByteString) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetCudaModuleCacheNV" (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result
vkGetCudaModuleCacheNV'
                                                           Ptr Device_T
device'
                                                           (CudaModuleNV
module')
                                                           (Ptr CSize
pPCacheSize)
                                                           (Ptr ()
forall a. Ptr a
nullPtr))
  IO () -> ContT (Result, "cacheData" ::: ByteString) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "cacheData" ::: ByteString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "cacheData" ::: ByteString) IO ())
-> IO () -> ContT (Result, "cacheData" ::: ByteString) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  CSize
pCacheSize <- IO CSize -> ContT (Result, "cacheData" ::: ByteString) IO CSize
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "cacheData" ::: ByteString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CSize -> ContT (Result, "cacheData" ::: ByteString) IO CSize)
-> IO CSize -> ContT (Result, "cacheData" ::: ByteString) IO CSize
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @CSize Ptr CSize
pPCacheSize
  Ptr ()
pPCacheData <- ((Ptr () -> IO (Result, "cacheData" ::: ByteString))
 -> IO (Result, "cacheData" ::: ByteString))
-> ContT (Result, "cacheData" ::: ByteString) IO (Ptr ())
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr () -> IO (Result, "cacheData" ::: ByteString))
  -> IO (Result, "cacheData" ::: ByteString))
 -> ContT (Result, "cacheData" ::: ByteString) IO (Ptr ()))
-> ((Ptr () -> IO (Result, "cacheData" ::: ByteString))
    -> IO (Result, "cacheData" ::: ByteString))
-> ContT (Result, "cacheData" ::: ByteString) IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ IO (Ptr ())
-> (Ptr () -> IO ())
-> (Ptr () -> IO (Result, "cacheData" ::: ByteString))
-> IO (Result, "cacheData" ::: ByteString)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @(()) (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
pCacheSize)))) Ptr () -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r' <- IO Result -> ContT (Result, "cacheData" ::: ByteString) IO Result
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "cacheData" ::: ByteString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, "cacheData" ::: ByteString) IO Result)
-> IO Result
-> ContT (Result, "cacheData" ::: ByteString) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetCudaModuleCacheNV" (Ptr Device_T -> CudaModuleNV -> Ptr CSize -> Ptr () -> IO Result
vkGetCudaModuleCacheNV'
                                                            Ptr Device_T
device'
                                                            (CudaModuleNV
module')
                                                            (Ptr CSize
pPCacheSize)
                                                            (Ptr ()
pPCacheData))
  IO () -> ContT (Result, "cacheData" ::: ByteString) IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "cacheData" ::: ByteString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "cacheData" ::: ByteString) IO ())
-> IO () -> ContT (Result, "cacheData" ::: ByteString) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
  CSize
pCacheSize'' <- IO CSize -> ContT (Result, "cacheData" ::: ByteString) IO CSize
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "cacheData" ::: ByteString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CSize -> ContT (Result, "cacheData" ::: ByteString) IO CSize)
-> IO CSize -> ContT (Result, "cacheData" ::: ByteString) IO CSize
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @CSize Ptr CSize
pPCacheSize
  "cacheData" ::: ByteString
pCacheData' <- IO ("cacheData" ::: ByteString)
-> ContT
     (Result, "cacheData" ::: ByteString)
     IO
     ("cacheData" ::: ByteString)
forall (m :: * -> *) a.
Monad m =>
m a -> ContT (Result, "cacheData" ::: ByteString) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("cacheData" ::: ByteString)
 -> ContT
      (Result, "cacheData" ::: ByteString)
      IO
      ("cacheData" ::: ByteString))
-> IO ("cacheData" ::: ByteString)
-> ContT
     (Result, "cacheData" ::: ByteString)
     IO
     ("cacheData" ::: ByteString)
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ("cacheData" ::: ByteString)
packCStringLen  ( forall a b. Ptr a -> Ptr b
castPtr @() @CChar Ptr ()
pPCacheData
                                        , (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
pCacheSize''))) )
  (Result, "cacheData" ::: ByteString)
-> ContT
     (Result, "cacheData" ::: ByteString)
     IO
     (Result, "cacheData" ::: ByteString)
forall a. a -> ContT (Result, "cacheData" ::: ByteString) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "cacheData" ::: ByteString)
 -> ContT
      (Result, "cacheData" ::: ByteString)
      IO
      (Result, "cacheData" ::: ByteString))
-> (Result, "cacheData" ::: ByteString)
-> ContT
     (Result, "cacheData" ::: ByteString)
     IO
     (Result, "cacheData" ::: ByteString)
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 = IO CudaFunctionNV -> io CudaFunctionNV
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CudaFunctionNV -> io CudaFunctionNV)
-> (ContT CudaFunctionNV IO CudaFunctionNV -> IO CudaFunctionNV)
-> ContT CudaFunctionNV IO CudaFunctionNV
-> io CudaFunctionNV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT CudaFunctionNV IO CudaFunctionNV -> IO CudaFunctionNV
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT CudaFunctionNV IO CudaFunctionNV -> io CudaFunctionNV)
-> ContT CudaFunctionNV IO CudaFunctionNV -> io CudaFunctionNV
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateCudaFunctionNVPtr :: FunPtr
  (Ptr Device_T
   -> Ptr CudaFunctionCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaFunctionNV
   -> IO Result)
vkCreateCudaFunctionNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Ptr CudaFunctionCreateInfoNV
      -> Ptr AllocationCallbacks
      -> Ptr CudaFunctionNV
      -> IO Result)
pVkCreateCudaFunctionNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT CudaFunctionNV IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT CudaFunctionNV m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT CudaFunctionNV IO ())
-> IO () -> ContT CudaFunctionNV IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Ptr CudaFunctionCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaFunctionNV
   -> IO Result)
vkCreateCudaFunctionNVPtr FunPtr
  (Ptr Device_T
   -> Ptr CudaFunctionCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaFunctionNV
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> Ptr CudaFunctionCreateInfoNV
      -> Ptr AllocationCallbacks
      -> Ptr CudaFunctionNV
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Ptr CudaFunctionCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaFunctionNV
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateCudaFunctionNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateCudaFunctionNV' :: Ptr Device_T
-> Ptr CudaFunctionCreateInfoNV
-> Ptr AllocationCallbacks
-> Ptr CudaFunctionNV
-> IO Result
vkCreateCudaFunctionNV' = FunPtr
  (Ptr Device_T
   -> Ptr CudaFunctionCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaFunctionNV
   -> IO Result)
-> Ptr Device_T
-> Ptr CudaFunctionCreateInfoNV
-> Ptr AllocationCallbacks
-> Ptr CudaFunctionNV
-> IO Result
mkVkCreateCudaFunctionNV FunPtr
  (Ptr Device_T
   -> Ptr CudaFunctionCreateInfoNV
   -> Ptr AllocationCallbacks
   -> Ptr CudaFunctionNV
   -> IO Result)
vkCreateCudaFunctionNVPtr
  Ptr CudaFunctionCreateInfoNV
pCreateInfo <- ((Ptr CudaFunctionCreateInfoNV -> IO CudaFunctionNV)
 -> IO CudaFunctionNV)
-> ContT CudaFunctionNV IO (Ptr CudaFunctionCreateInfoNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CudaFunctionCreateInfoNV -> IO CudaFunctionNV)
  -> IO CudaFunctionNV)
 -> ContT CudaFunctionNV IO (Ptr CudaFunctionCreateInfoNV))
-> ((Ptr CudaFunctionCreateInfoNV -> IO CudaFunctionNV)
    -> IO CudaFunctionNV)
-> ContT CudaFunctionNV IO (Ptr CudaFunctionCreateInfoNV)
forall a b. (a -> b) -> a -> b
$ CudaFunctionCreateInfoNV
-> (Ptr CudaFunctionCreateInfoNV -> IO CudaFunctionNV)
-> IO CudaFunctionNV
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
CudaFunctionCreateInfoNV
-> (Ptr CudaFunctionCreateInfoNV -> IO b) -> IO b
withCStruct (CudaFunctionCreateInfoNV
createInfo)
  Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> Ptr AllocationCallbacks
-> ContT CudaFunctionNV IO (Ptr AllocationCallbacks)
forall a. a -> ContT CudaFunctionNV IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> ((Ptr AllocationCallbacks -> IO CudaFunctionNV)
 -> IO CudaFunctionNV)
-> ContT CudaFunctionNV IO (Ptr AllocationCallbacks)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCallbacks -> IO CudaFunctionNV)
  -> IO CudaFunctionNV)
 -> ContT CudaFunctionNV IO (Ptr AllocationCallbacks))
-> ((Ptr AllocationCallbacks -> IO CudaFunctionNV)
    -> IO CudaFunctionNV)
-> ContT CudaFunctionNV IO (Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (Ptr AllocationCallbacks -> IO CudaFunctionNV)
-> IO CudaFunctionNV
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
AllocationCallbacks -> (Ptr AllocationCallbacks -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  Ptr CudaFunctionNV
pPFunction <- ((Ptr CudaFunctionNV -> IO CudaFunctionNV) -> IO CudaFunctionNV)
-> ContT CudaFunctionNV IO (Ptr CudaFunctionNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CudaFunctionNV -> IO CudaFunctionNV) -> IO CudaFunctionNV)
 -> ContT CudaFunctionNV IO (Ptr CudaFunctionNV))
-> ((Ptr CudaFunctionNV -> IO CudaFunctionNV) -> IO CudaFunctionNV)
-> ContT CudaFunctionNV IO (Ptr CudaFunctionNV)
forall a b. (a -> b) -> a -> b
$ IO (Ptr CudaFunctionNV)
-> (Ptr CudaFunctionNV -> IO ())
-> (Ptr CudaFunctionNV -> IO CudaFunctionNV)
-> IO CudaFunctionNV
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) Ptr CudaFunctionNV -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT CudaFunctionNV IO Result
forall (m :: * -> *) a. Monad m => m a -> ContT CudaFunctionNV m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT CudaFunctionNV IO Result)
-> IO Result -> ContT CudaFunctionNV IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateCudaFunctionNV" (Ptr Device_T
-> Ptr CudaFunctionCreateInfoNV
-> Ptr AllocationCallbacks
-> Ptr CudaFunctionNV
-> IO Result
vkCreateCudaFunctionNV'
                                                           (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                           Ptr CudaFunctionCreateInfoNV
pCreateInfo
                                                           Ptr AllocationCallbacks
pAllocator
                                                           (Ptr CudaFunctionNV
pPFunction))
  IO () -> ContT CudaFunctionNV IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT CudaFunctionNV m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT CudaFunctionNV IO ())
-> IO () -> ContT CudaFunctionNV IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  CudaFunctionNV
pFunction <- IO CudaFunctionNV -> ContT CudaFunctionNV IO CudaFunctionNV
forall (m :: * -> *) a. Monad m => m a -> ContT CudaFunctionNV m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CudaFunctionNV -> ContT CudaFunctionNV IO CudaFunctionNV)
-> IO CudaFunctionNV -> ContT CudaFunctionNV IO CudaFunctionNV
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @CudaFunctionNV Ptr CudaFunctionNV
pPFunction
  CudaFunctionNV -> ContT CudaFunctionNV IO CudaFunctionNV
forall a. a -> ContT CudaFunctionNV IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CudaFunctionNV -> ContT CudaFunctionNV IO CudaFunctionNV)
-> CudaFunctionNV -> ContT CudaFunctionNV IO CudaFunctionNV
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 (Device
-> CudaFunctionCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaFunctionNV
forall (io :: * -> *).
MonadIO io =>
Device
-> CudaFunctionCreateInfoNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CudaFunctionNV
createCudaFunctionNV Device
device CudaFunctionCreateInfoNV
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(CudaFunctionNV
o0) -> Device
-> CudaFunctionNV
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
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 = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkDestroyCudaModuleNVPtr :: FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ())
vkDestroyCudaModuleNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ())
pVkDestroyCudaModuleNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ())
vkDestroyCudaModuleNVPtr FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ())
-> FunPtr
     (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroyCudaModuleNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyCudaModuleNV' :: Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ()
vkDestroyCudaModuleNV' = FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ())
-> Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ()
mkVkDestroyCudaModuleNV FunPtr
  (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ())
vkDestroyCudaModuleNVPtr
  Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> Ptr AllocationCallbacks -> ContT () IO (Ptr AllocationCallbacks)
forall a. a -> ContT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> ((Ptr AllocationCallbacks -> IO ()) -> IO ())
-> ContT () IO (Ptr AllocationCallbacks)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCallbacks -> IO ()) -> IO ())
 -> ContT () IO (Ptr AllocationCallbacks))
-> ((Ptr AllocationCallbacks -> IO ()) -> IO ())
-> ContT () IO (Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks -> (Ptr AllocationCallbacks -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
AllocationCallbacks -> (Ptr AllocationCallbacks -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyCudaModuleNV" (Ptr Device_T -> CudaModuleNV -> Ptr AllocationCallbacks -> IO ()
vkDestroyCudaModuleNV'
                                                     (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                     (CudaModuleNV
module')
                                                     Ptr AllocationCallbacks
pAllocator)
  () -> ContT () IO ()
forall a. a -> ContT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
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 = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkDestroyCudaFunctionNVPtr :: FunPtr
  (Ptr Device_T
   -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ())
vkDestroyCudaFunctionNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ())
pVkDestroyCudaFunctionNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ())
vkDestroyCudaFunctionNVPtr FunPtr
  (Ptr Device_T
   -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ())
-> FunPtr
     (Ptr Device_T
      -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroyCudaFunctionNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyCudaFunctionNV' :: Ptr Device_T -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ()
vkDestroyCudaFunctionNV' = FunPtr
  (Ptr Device_T
   -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ())
-> Ptr Device_T
-> CudaFunctionNV
-> Ptr AllocationCallbacks
-> IO ()
mkVkDestroyCudaFunctionNV FunPtr
  (Ptr Device_T
   -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ())
vkDestroyCudaFunctionNVPtr
  Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> Ptr AllocationCallbacks -> ContT () IO (Ptr AllocationCallbacks)
forall a. a -> ContT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> ((Ptr AllocationCallbacks -> IO ()) -> IO ())
-> ContT () IO (Ptr AllocationCallbacks)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCallbacks -> IO ()) -> IO ())
 -> ContT () IO (Ptr AllocationCallbacks))
-> ((Ptr AllocationCallbacks -> IO ()) -> IO ())
-> ContT () IO (Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks -> (Ptr AllocationCallbacks -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
AllocationCallbacks -> (Ptr AllocationCallbacks -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyCudaFunctionNV" (Ptr Device_T -> CudaFunctionNV -> Ptr AllocationCallbacks -> IO ()
vkDestroyCudaFunctionNV'
                                                       (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                       (CudaFunctionNV
function)
                                                       Ptr AllocationCallbacks
pAllocator)
  () -> ContT () IO ()
forall a. a -> ContT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
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 = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkCmdCudaLaunchKernelNVPtr :: FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ())
vkCmdCudaLaunchKernelNVPtr = DeviceCmds
-> FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ())
pVkCmdCudaLaunchKernelNV (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ())
vkCmdCudaLaunchKernelNVPtr FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ())
-> FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCmdCudaLaunchKernelNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCudaLaunchKernelNV' :: Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ()
vkCmdCudaLaunchKernelNV' = FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ())
-> Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ()
mkVkCmdCudaLaunchKernelNV FunPtr (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ())
vkCmdCudaLaunchKernelNVPtr
  Ptr CudaLaunchInfoNV
pLaunchInfo <- ((Ptr CudaLaunchInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr CudaLaunchInfoNV)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CudaLaunchInfoNV -> IO ()) -> IO ())
 -> ContT () IO (Ptr CudaLaunchInfoNV))
-> ((Ptr CudaLaunchInfoNV -> IO ()) -> IO ())
-> ContT () IO (Ptr CudaLaunchInfoNV)
forall a b. (a -> b) -> a -> b
$ CudaLaunchInfoNV -> (Ptr CudaLaunchInfoNV -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
CudaLaunchInfoNV -> (Ptr CudaLaunchInfoNV -> IO b) -> IO b
withCStruct (CudaLaunchInfoNV
launchInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdCudaLaunchKernelNV" (Ptr CommandBuffer_T -> Ptr CudaLaunchInfoNV -> IO ()
vkCmdCudaLaunchKernelNV'
                                                       (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                       Ptr CudaLaunchInfoNV
pLaunchInfo)
  () -> ContT () IO ()
forall a. a -> ContT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
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 -> 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
-> (Ptr CudaModuleCreateInfoNV -> IO b) -> IO b
withCStruct CudaModuleCreateInfoNV
x Ptr CudaModuleCreateInfoNV -> IO b
f = Int -> (Ptr CudaModuleCreateInfoNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr CudaModuleCreateInfoNV -> IO b) -> IO b)
-> (Ptr CudaModuleCreateInfoNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr CudaModuleCreateInfoNV
p -> Ptr CudaModuleCreateInfoNV
-> CudaModuleCreateInfoNV -> IO b -> IO b
forall b.
Ptr CudaModuleCreateInfoNV
-> CudaModuleCreateInfoNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CudaModuleCreateInfoNV
p CudaModuleCreateInfoNV
x (Ptr CudaModuleCreateInfoNV -> IO b
f Ptr CudaModuleCreateInfoNV
p)
  pokeCStruct :: forall b.
Ptr CudaModuleCreateInfoNV
-> CudaModuleCreateInfoNV -> IO b -> IO b
pokeCStruct Ptr CudaModuleCreateInfoNV
p CudaModuleCreateInfoNV{Word64
Ptr ()
$sel:dataSize:CudaModuleCreateInfoNV :: CudaModuleCreateInfoNV -> Word64
$sel:data':CudaModuleCreateInfoNV :: CudaModuleCreateInfoNV -> Ptr ()
dataSize :: Word64
data' :: Ptr ()
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaModuleCreateInfoNV
p Ptr CudaModuleCreateInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_MODULE_CREATE_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaModuleCreateInfoNV
p Ptr CudaModuleCreateInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaModuleCreateInfoNV
p Ptr CudaModuleCreateInfoNV -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
dataSize))
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaModuleCreateInfoNV
p Ptr CudaModuleCreateInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ()))) (Ptr ()
data')
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr CudaModuleCreateInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr CudaModuleCreateInfoNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaModuleCreateInfoNV
p Ptr CudaModuleCreateInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_MODULE_CREATE_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaModuleCreateInfoNV
p Ptr CudaModuleCreateInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaModuleCreateInfoNV
p Ptr CudaModuleCreateInfoNV -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
forall a. Zero a => a
zero))
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaModuleCreateInfoNV
p Ptr CudaModuleCreateInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ()))) (Ptr ()
forall a. Zero a => a
zero)
    IO b
f

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

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

instance Zero CudaModuleCreateInfoNV where
  zero :: CudaModuleCreateInfoNV
zero = Word64 -> Ptr () -> CudaModuleCreateInfoNV
CudaModuleCreateInfoNV
           Word64
forall a. Zero a => a
zero
           Ptr ()
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@ is 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
-> (Ptr CudaFunctionCreateInfoNV -> IO b) -> IO b
withCStruct CudaFunctionCreateInfoNV
x Ptr CudaFunctionCreateInfoNV -> IO b
f = Int -> (Ptr CudaFunctionCreateInfoNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr CudaFunctionCreateInfoNV -> IO b) -> IO b)
-> (Ptr CudaFunctionCreateInfoNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr CudaFunctionCreateInfoNV
p -> Ptr CudaFunctionCreateInfoNV
-> CudaFunctionCreateInfoNV -> IO b -> IO b
forall b.
Ptr CudaFunctionCreateInfoNV
-> CudaFunctionCreateInfoNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CudaFunctionCreateInfoNV
p CudaFunctionCreateInfoNV
x (Ptr CudaFunctionCreateInfoNV -> IO b
f Ptr CudaFunctionCreateInfoNV
p)
  pokeCStruct :: forall b.
Ptr CudaFunctionCreateInfoNV
-> CudaFunctionCreateInfoNV -> IO b -> IO b
pokeCStruct Ptr CudaFunctionCreateInfoNV
p CudaFunctionCreateInfoNV{"cacheData" ::: ByteString
CudaModuleNV
$sel:module':CudaFunctionCreateInfoNV :: CudaFunctionCreateInfoNV -> CudaModuleNV
$sel:name:CudaFunctionCreateInfoNV :: CudaFunctionCreateInfoNV -> "cacheData" ::: ByteString
module' :: CudaModuleNV
name :: "cacheData" ::: ByteString
..} IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_FUNCTION_CREATE_INFO_NV)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CudaModuleNV -> CudaModuleNV -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr CudaModuleNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaModuleNV)) (CudaModuleNV
module')
    Ptr CChar
pName'' <- ((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar))
-> ((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("cacheData" ::: ByteString) -> (Ptr CChar -> IO b) -> IO b
forall a.
("cacheData" ::: ByteString) -> (Ptr CChar -> IO a) -> IO a
useAsCString ("cacheData" ::: ByteString
name)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr CChar))) Ptr CChar
pName''
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr CudaFunctionCreateInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr CudaFunctionCreateInfoNV
p IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_FUNCTION_CREATE_INFO_NV)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CudaModuleNV -> CudaModuleNV -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr CudaModuleNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaModuleNV)) (CudaModuleNV
forall a. Zero a => a
zero)
    Ptr CChar
pName'' <- ((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar))
-> ((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("cacheData" ::: ByteString) -> (Ptr CChar -> IO b) -> IO b
forall a.
("cacheData" ::: ByteString) -> (Ptr CChar -> IO a) -> IO a
useAsCString ("cacheData" ::: ByteString
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr CChar))) Ptr CChar
pName''
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance FromCStruct CudaFunctionCreateInfoNV where
  peekCStruct :: Ptr CudaFunctionCreateInfoNV -> IO CudaFunctionCreateInfoNV
peekCStruct Ptr CudaFunctionCreateInfoNV
p = do
    CudaModuleNV
module' <- forall a. Storable a => Ptr a -> IO a
peek @CudaModuleNV ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr CudaModuleNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaModuleNV))
    "cacheData" ::: ByteString
pName <- Ptr CChar -> IO ("cacheData" ::: ByteString)
packCString (Ptr CChar -> IO ("cacheData" ::: ByteString))
-> IO (Ptr CChar) -> IO ("cacheData" ::: ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek ((Ptr CudaFunctionCreateInfoNV
p Ptr CudaFunctionCreateInfoNV -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr CChar)))
    CudaFunctionCreateInfoNV -> IO CudaFunctionCreateInfoNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CudaFunctionCreateInfoNV -> IO CudaFunctionCreateInfoNV)
-> CudaFunctionCreateInfoNV -> IO CudaFunctionCreateInfoNV
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
           CudaModuleNV
forall a. Zero a => a
zero
           "cacheData" ::: ByteString
forall a. Monoid a => a
mempty


-- | VkCudaLaunchInfoNV - Structure specifying the parameters to launch a
-- CUDA kernel
--
-- = Description
--
-- Kernel parameters of @function@ are specified via @pParams@, very much
-- the same way as described in
-- <https://docs.nvidia.com/cuda/cuda-driver-api/group__CUDA__EXEC.html#group__CUDA__EXEC_1gb8f3dc3031b40da29d5f9a7139e52e15 cuLaunchKernel>
--
-- If @function@ has N parameters, then @pParams@ /must/ be an array of N
-- pointers and @paramCount@ /must/ be set to N. Each of @kernelParams@[0]
-- through @kernelParams@[N-1] /must/ point to a region of memory from
-- which the actual kernel parameter will be copied. The number of kernel
-- parameters and their offsets and sizes are not specified here as that
-- information is stored in the 'Vulkan.Extensions.Handles.CudaFunctionNV'
-- object.
--
-- The application-owned memory pointed to by @pParams@ and
-- @kernelParams@[0] through @kernelParams@[N-1] are consumed immediately,
-- and /may/ be altered or freed after 'cmdCudaLaunchKernelNV' has
-- returned.
--
-- == 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@, and @pParams@ is not @NULL@, @pParams@ /must/ be a valid
--     pointer to an array of @paramCount@ bytes
--
-- -   #VUID-VkCudaLaunchInfoNV-pExtras-parameter# If @extraCount@ is not
--     @0@, and @pExtras@ is not @NULL@, @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
  , -- | @paramCount@ is the length of the @pParams@ table.
    CudaLaunchInfoNV -> Word64
paramCount :: Word64
  , -- | @pParams@ is a pointer to an array of @paramCount@ pointers,
    -- corresponding to the arguments of @function@.
    CudaLaunchInfoNV -> Vector (Ptr ())
params :: Vector (Ptr ())
  , -- | @extraCount@ is reserved for future use.
    CudaLaunchInfoNV -> Word64
extraCount :: Word64
  , -- | @pExtras@ is reserved for future use.
    CudaLaunchInfoNV -> Vector (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 -> (Ptr CudaLaunchInfoNV -> IO b) -> IO b
withCStruct CudaLaunchInfoNV
x Ptr CudaLaunchInfoNV -> IO b
f = Int -> (Ptr CudaLaunchInfoNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
88 ((Ptr CudaLaunchInfoNV -> IO b) -> IO b)
-> (Ptr CudaLaunchInfoNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr CudaLaunchInfoNV
p -> Ptr CudaLaunchInfoNV -> CudaLaunchInfoNV -> IO b -> IO b
forall b. Ptr CudaLaunchInfoNV -> CudaLaunchInfoNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CudaLaunchInfoNV
p CudaLaunchInfoNV
x (Ptr CudaLaunchInfoNV -> IO b
f Ptr CudaLaunchInfoNV
p)
  pokeCStruct :: forall b. Ptr CudaLaunchInfoNV -> CudaLaunchInfoNV -> IO b -> IO b
pokeCStruct Ptr CudaLaunchInfoNV
p CudaLaunchInfoNV{Word32
Word64
Vector (Ptr ())
CudaFunctionNV
$sel:function:CudaLaunchInfoNV :: CudaLaunchInfoNV -> CudaFunctionNV
$sel:gridDimX:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:gridDimY:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:gridDimZ:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:blockDimX:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:blockDimY:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:blockDimZ:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:sharedMemBytes:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word32
$sel:paramCount:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word64
$sel:params:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Vector (Ptr ())
$sel:extraCount:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Word64
$sel:extras:CudaLaunchInfoNV :: CudaLaunchInfoNV -> Vector (Ptr ())
function :: CudaFunctionNV
gridDimX :: Word32
gridDimY :: Word32
gridDimZ :: Word32
blockDimX :: Word32
blockDimY :: Word32
blockDimZ :: Word32
sharedMemBytes :: Word32
paramCount :: Word64
params :: Vector (Ptr ())
extraCount :: Word64
extras :: Vector (Ptr ())
..} IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CudaFunctionNV -> CudaFunctionNV -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr CudaFunctionNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaFunctionNV)) (CudaFunctionNV
function)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
gridDimX)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
gridDimY)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
gridDimZ)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
blockDimX)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (Word32
blockDimY)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (Word32
blockDimZ)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) (Word32
sharedMemBytes)
    let pParamsLength :: Int
pParamsLength = Vector (Ptr ()) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (Ptr ()) -> Int) -> Vector (Ptr ()) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (Ptr ())
params)
    Word64
paramCount'' <- IO Word64 -> ContT b IO Word64
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word64 -> ContT b IO Word64) -> IO Word64 -> ContT b IO Word64
forall a b. (a -> b) -> a -> b
$ if (Word64
paramCount) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
      then Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pParamsLength
      else do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pParamsLength Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word64
paramCount) Bool -> Bool -> Bool
|| Int
pParamsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"pParams must be empty or have 'paramCount' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
        Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
paramCount)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr CSize)) (Word64 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
paramCount''))
    Ptr (Ptr ())
pPParams' <- ((Ptr (Ptr ()) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr ()))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Ptr ()) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr ())))
-> ((Ptr (Ptr ()) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr ()))
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(Ptr ()) ((Vector (Ptr ()) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (Ptr ())
params)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Ptr () -> IO ()) -> Vector (Ptr ()) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Ptr ()
e -> Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Ptr ())
pPParams' Ptr (Ptr ()) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ())) (Ptr ()
e)) (Vector (Ptr ())
params)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (Ptr ())) -> Ptr (Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr (Ptr (Ptr ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (Ptr ())))) (Ptr (Ptr ())
pPParams')
    let pExtrasLength :: Int
pExtrasLength = Vector (Ptr ()) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (Ptr ()) -> Int) -> Vector (Ptr ()) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (Ptr ())
extras)
    Word64
extraCount'' <- IO Word64 -> ContT b IO Word64
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word64 -> ContT b IO Word64) -> IO Word64 -> ContT b IO Word64
forall a b. (a -> b) -> a -> b
$ if (Word64
extraCount) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
      then Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> IO Word64) -> Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pExtrasLength
      else do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pExtrasLength Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== (Word64
extraCount) Bool -> Bool -> Bool
|| Int
pExtrasLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"pExtras must be empty or have 'extraCount' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
        Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
extraCount)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr CSize)) (Word64 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
extraCount''))
    Ptr (Ptr ())
pPExtras' <- ((Ptr (Ptr ()) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr ()))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Ptr ()) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr ())))
-> ((Ptr (Ptr ()) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr ()))
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(Ptr ()) ((Vector (Ptr ()) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (Ptr ())
extras)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Ptr () -> IO ()) -> Vector (Ptr ()) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Ptr ()
e -> Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Ptr ())
pPExtras' Ptr (Ptr ()) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ())) (Ptr ()
e)) (Vector (Ptr ())
extras)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (Ptr ())) -> Ptr (Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr (Ptr (Ptr ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr (Ptr ())))) (Ptr (Ptr ())
pPExtras')
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
88
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr CudaLaunchInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr CudaLaunchInfoNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CUDA_LAUNCH_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr CudaFunctionNV -> CudaFunctionNV -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr CudaFunctionNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CudaFunctionNV)) (CudaFunctionNV
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CudaLaunchInfoNV where
  peekCStruct :: Ptr CudaLaunchInfoNV -> IO CudaLaunchInfoNV
peekCStruct Ptr CudaLaunchInfoNV
p = do
    CudaFunctionNV
function <- forall a. Storable a => Ptr a -> IO a
peek @CudaFunctionNV ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr CudaFunctionNV
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 ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
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 ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
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 ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
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 ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
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 ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
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 ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
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 ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr Word32
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 ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr CSize))
    let paramCount' :: Word64
paramCount' = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
paramCount
    Ptr (Ptr ())
pParams <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr ())) ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr (Ptr (Ptr ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (Ptr ()))))
    Vector (Ptr ())
pParams' <- Int -> (Int -> IO (Ptr ())) -> IO (Vector (Ptr ()))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
paramCount') (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (Ptr ())
pParams Ptr (Ptr ()) -> Int -> Ptr (Ptr ())
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ()))))
    CSize
extraCount <- forall a. Storable a => Ptr a -> IO a
peek @CSize ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr CSize))
    let extraCount' :: Word64
extraCount' = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
extraCount
    Ptr (Ptr ())
pExtras <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr ())) ((Ptr CudaLaunchInfoNV
p Ptr CudaLaunchInfoNV -> Int -> Ptr (Ptr (Ptr ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr (Ptr ()))))
    Vector (Ptr ())
pExtras' <- Int -> (Int -> IO (Ptr ())) -> IO (Vector (Ptr ()))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
extraCount') (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (Ptr ())
pExtras Ptr (Ptr ()) -> Int -> Ptr (Ptr ())
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ()))))
    CudaLaunchInfoNV -> IO CudaLaunchInfoNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CudaLaunchInfoNV -> IO CudaLaunchInfoNV)
-> CudaLaunchInfoNV -> IO CudaLaunchInfoNV
forall a b. (a -> b) -> a -> b
$ CudaFunctionNV
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word64
-> Vector (Ptr ())
-> Word64
-> Vector (Ptr ())
-> CudaLaunchInfoNV
CudaLaunchInfoNV
             CudaFunctionNV
function
             Word32
gridDimX
             Word32
gridDimY
             Word32
gridDimZ
             Word32
blockDimX
             Word32
blockDimY
             Word32
blockDimZ
             Word32
sharedMemBytes
             Word64
paramCount'
             Vector (Ptr ())
pParams'
             Word64
extraCount'
             Vector (Ptr ())
pExtras'

instance Zero CudaLaunchInfoNV where
  zero :: CudaLaunchInfoNV
zero = CudaFunctionNV
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word64
-> Vector (Ptr ())
-> Word64
-> Vector (Ptr ())
-> CudaLaunchInfoNV
CudaLaunchInfoNV
           CudaFunctionNV
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Vector (Ptr ())
forall a. Monoid a => a
mempty
           Word64
forall a. Zero a => a
zero
           Vector (Ptr ())
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
(PhysicalDeviceCudaKernelLaunchFeaturesNV
 -> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool)
-> (PhysicalDeviceCudaKernelLaunchFeaturesNV
    -> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool)
-> Eq PhysicalDeviceCudaKernelLaunchFeaturesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
== :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
$c/= :: PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
/= :: 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 = Int
-> (Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b) -> IO b)
-> (Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p -> Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b -> IO b
forall b.
Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b -> IO b
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
$sel:cudaKernelLaunchFeatures:PhysicalDeviceCudaKernelLaunchFeaturesNV :: PhysicalDeviceCudaKernelLaunchFeaturesNV -> Bool
cudaKernelLaunchFeatures :: Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_FEATURES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> Int -> Ptr Bool32
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
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_FEATURES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
p Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    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 Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    PhysicalDeviceCudaKernelLaunchFeaturesNV
-> IO PhysicalDeviceCudaKernelLaunchFeaturesNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceCudaKernelLaunchFeaturesNV
 -> IO PhysicalDeviceCudaKernelLaunchFeaturesNV)
-> PhysicalDeviceCudaKernelLaunchFeaturesNV
-> IO PhysicalDeviceCudaKernelLaunchFeaturesNV
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 = Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> IO PhysicalDeviceCudaKernelLaunchFeaturesNV
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO ()
poke Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
poked = Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO () -> IO ()
forall b.
Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
-> PhysicalDeviceCudaKernelLaunchFeaturesNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
ptr PhysicalDeviceCudaKernelLaunchFeaturesNV
poked (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceCudaKernelLaunchFeaturesNV where
  zero :: PhysicalDeviceCudaKernelLaunchFeaturesNV
zero = Bool -> PhysicalDeviceCudaKernelLaunchFeaturesNV
PhysicalDeviceCudaKernelLaunchFeaturesNV
           Bool
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
    -- major version number of the compute code.
    PhysicalDeviceCudaKernelLaunchPropertiesNV -> Word32
computeCapabilityMajor :: Word32
  }
  deriving (Typeable, PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
(PhysicalDeviceCudaKernelLaunchPropertiesNV
 -> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool)
-> (PhysicalDeviceCudaKernelLaunchPropertiesNV
    -> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool)
-> Eq PhysicalDeviceCudaKernelLaunchPropertiesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
== :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
$c/= :: PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> Bool
/= :: 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 = Int
-> (Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b) -> IO b)
-> (Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p -> Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b -> IO b
forall b.
Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b -> IO b
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
$sel:computeCapabilityMinor:PhysicalDeviceCudaKernelLaunchPropertiesNV :: PhysicalDeviceCudaKernelLaunchPropertiesNV -> Word32
$sel:computeCapabilityMajor:PhysicalDeviceCudaKernelLaunchPropertiesNV :: PhysicalDeviceCudaKernelLaunchPropertiesNV -> Word32
computeCapabilityMinor :: Word32
computeCapabilityMajor :: Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_PROPERTIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
computeCapabilityMinor)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> Int -> Ptr Word32
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
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUDA_KERNEL_LAUNCH_PROPERTIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
p Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (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 Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> Int -> Ptr Word32
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 Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    PhysicalDeviceCudaKernelLaunchPropertiesNV
-> IO PhysicalDeviceCudaKernelLaunchPropertiesNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceCudaKernelLaunchPropertiesNV
 -> IO PhysicalDeviceCudaKernelLaunchPropertiesNV)
-> PhysicalDeviceCudaKernelLaunchPropertiesNV
-> IO PhysicalDeviceCudaKernelLaunchPropertiesNV
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 = Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> IO PhysicalDeviceCudaKernelLaunchPropertiesNV
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO ()
poke Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
poked = Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO () -> IO ()
forall b.
Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
-> PhysicalDeviceCudaKernelLaunchPropertiesNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
ptr PhysicalDeviceCudaKernelLaunchPropertiesNV
poked (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceCudaKernelLaunchPropertiesNV where
  zero :: PhysicalDeviceCudaKernelLaunchPropertiesNV
zero = Word32 -> Word32 -> PhysicalDeviceCudaKernelLaunchPropertiesNV
PhysicalDeviceCudaKernelLaunchPropertiesNV
           Word32
forall a. Zero a => a
zero
           Word32
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"