{-# language CPP #-}
-- | = Name
--
-- VK_NVX_binary_import - device extension
--
-- == VK_NVX_binary_import
--
-- [__Name String__]
--     @VK_NVX_binary_import@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     30
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
-- [__Contact__]
--
--     -   Eric Werness
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?title=VK_NVX_binary_import:%20&body=@ewerness%20 >
--
--     -   Liam Middlebrook
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?title=VK_NVX_binary_import:%20&body=@liam-middlebrook%20 >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2021-04-09
--
-- [__Contributors__]
--
--     -   Eric Werness, NVIDIA
--
--     -   Liam Middlebrook, NVIDIA
--
-- == Description
--
-- This extension allows applications to import CuBIN binaries and execute
-- them.
--
-- == New Object Types
--
-- -   'Vulkan.Extensions.Handles.CuFunctionNVX'
--
-- -   'Vulkan.Extensions.Handles.CuModuleNVX'
--
-- == New Commands
--
-- -   'cmdCuLaunchKernelNVX'
--
-- -   'createCuFunctionNVX'
--
-- -   'createCuModuleNVX'
--
-- -   'destroyCuFunctionNVX'
--
-- -   'destroyCuModuleNVX'
--
-- == New Structures
--
-- -   'CuFunctionCreateInfoNVX'
--
-- -   'CuLaunchInfoNVX'
--
-- -   'CuModuleCreateInfoNVX'
--
-- == New Enum Constants
--
-- -   'NVX_BINARY_IMPORT_EXTENSION_NAME'
--
-- -   'NVX_BINARY_IMPORT_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Extensions.VK_EXT_debug_report.DebugReportObjectTypeEXT':
--
--     -   'Vulkan.Extensions.VK_EXT_debug_report.DEBUG_REPORT_OBJECT_TYPE_CU_FUNCTION_NVX_EXT'
--
--     -   'Vulkan.Extensions.VK_EXT_debug_report.DEBUG_REPORT_OBJECT_TYPE_CU_MODULE_NVX_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.ObjectType.ObjectType':
--
--     -   'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_CU_FUNCTION_NVX'
--
--     -   'Vulkan.Core10.Enums.ObjectType.OBJECT_TYPE_CU_MODULE_NVX'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_FUNCTION_CREATE_INFO_NVX'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_LAUNCH_INFO_NVX'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_CU_MODULE_CREATE_INFO_NVX'
--
-- == Version History
--
-- -   Revision 1, 2021-04-09 (Eric Werness)
--
--     -   Internal revisions
--
-- = See Also
--
-- 'CuFunctionCreateInfoNVX', 'Vulkan.Extensions.Handles.CuFunctionNVX',
-- 'CuLaunchInfoNVX', 'CuModuleCreateInfoNVX',
-- 'Vulkan.Extensions.Handles.CuModuleNVX', 'cmdCuLaunchKernelNVX',
-- 'createCuFunctionNVX', 'createCuModuleNVX', 'destroyCuFunctionNVX',
-- 'destroyCuModuleNVX'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_binary_import Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_NVX_binary_import  ( createCuModuleNVX
                                               , withCuModuleNVX
                                               , createCuFunctionNVX
                                               , withCuFunctionNVX
                                               , destroyCuModuleNVX
                                               , destroyCuFunctionNVX
                                               , cmdCuLaunchKernelNVX
                                               , CuModuleCreateInfoNVX(..)
                                               , CuFunctionCreateInfoNVX(..)
                                               , CuLaunchInfoNVX(..)
                                               , NVX_BINARY_IMPORT_SPEC_VERSION
                                               , pattern NVX_BINARY_IMPORT_SPEC_VERSION
                                               , NVX_BINARY_IMPORT_EXTENSION_NAME
                                               , pattern NVX_BINARY_IMPORT_EXTENSION_NAME
                                               , CuModuleNVX(..)
                                               , CuFunctionNVX(..)
                                               , DebugReportObjectTypeEXT(..)
                                               ) where

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

-- No documentation found for TopLevel "vkCreateCuModuleNVX"
createCuModuleNVX :: forall io
                   . (MonadIO io)
                  => -- No documentation found for Nested "vkCreateCuModuleNVX" "device"
                     Device
                  -> -- No documentation found for Nested "vkCreateCuModuleNVX" "pCreateInfo"
                     CuModuleCreateInfoNVX
                  -> -- No documentation found for Nested "vkCreateCuModuleNVX" "pAllocator"
                     ("allocator" ::: Maybe AllocationCallbacks)
                  -> io (CuModuleNVX)
createCuModuleNVX :: Device
-> CuModuleCreateInfoNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CuModuleNVX
createCuModuleNVX device :: Device
device createInfo :: CuModuleCreateInfoNVX
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO CuModuleNVX -> io CuModuleNVX
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CuModuleNVX -> io CuModuleNVX)
-> (ContT CuModuleNVX IO CuModuleNVX -> IO CuModuleNVX)
-> ContT CuModuleNVX IO CuModuleNVX
-> io CuModuleNVX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT CuModuleNVX IO CuModuleNVX -> IO CuModuleNVX
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT CuModuleNVX IO CuModuleNVX -> io CuModuleNVX)
-> ContT CuModuleNVX IO CuModuleNVX -> io CuModuleNVX
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateCuModuleNVXPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> IO Result)
vkCreateCuModuleNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pModule" ::: Ptr CuModuleNVX)
      -> IO Result)
pVkCreateCuModuleNVX (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT CuModuleNVX IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT CuModuleNVX IO ())
-> IO () -> ContT CuModuleNVX IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> IO Result)
vkCreateCuModuleNVXPtr FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pModule" ::: Ptr CuModuleNVX)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> 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 "" "The function pointer for vkCreateCuModuleNVX is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateCuModuleNVX' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CuModuleNVX)
-> IO Result
vkCreateCuModuleNVX' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CuModuleNVX)
-> IO Result
mkVkCreateCuModuleNVX FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pModule" ::: Ptr CuModuleNVX)
   -> IO Result)
vkCreateCuModuleNVXPtr
  "pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
pCreateInfo <- ((("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX) -> IO CuModuleNVX)
 -> IO CuModuleNVX)
-> ContT
     CuModuleNVX IO ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX) -> IO CuModuleNVX)
  -> IO CuModuleNVX)
 -> ContT
      CuModuleNVX IO ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX))
-> ((("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
     -> IO CuModuleNVX)
    -> IO CuModuleNVX)
-> ContT
     CuModuleNVX IO ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
forall a b. (a -> b) -> a -> b
$ CuModuleCreateInfoNVX
-> (("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
    -> IO CuModuleNVX)
-> IO CuModuleNVX
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CuModuleCreateInfoNVX
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT CuModuleNVX IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO CuModuleNVX)
 -> IO CuModuleNVX)
-> ContT CuModuleNVX IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO CuModuleNVX)
  -> IO CuModuleNVX)
 -> ContT CuModuleNVX IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO CuModuleNVX)
    -> IO CuModuleNVX)
-> ContT CuModuleNVX IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO CuModuleNVX)
-> IO CuModuleNVX
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pModule" ::: Ptr CuModuleNVX
pPModule <- ((("pModule" ::: Ptr CuModuleNVX) -> IO CuModuleNVX)
 -> IO CuModuleNVX)
-> ContT CuModuleNVX IO ("pModule" ::: Ptr CuModuleNVX)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pModule" ::: Ptr CuModuleNVX) -> IO CuModuleNVX)
  -> IO CuModuleNVX)
 -> ContT CuModuleNVX IO ("pModule" ::: Ptr CuModuleNVX))
-> ((("pModule" ::: Ptr CuModuleNVX) -> IO CuModuleNVX)
    -> IO CuModuleNVX)
-> ContT CuModuleNVX IO ("pModule" ::: Ptr CuModuleNVX)
forall a b. (a -> b) -> a -> b
$ IO ("pModule" ::: Ptr CuModuleNVX)
-> (("pModule" ::: Ptr CuModuleNVX) -> IO ())
-> (("pModule" ::: Ptr CuModuleNVX) -> IO CuModuleNVX)
-> IO CuModuleNVX
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pModule" ::: Ptr CuModuleNVX)
forall a. Int -> IO (Ptr a)
callocBytes @CuModuleNVX 8) ("pModule" ::: Ptr CuModuleNVX) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT CuModuleNVX IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT CuModuleNVX IO Result)
-> IO Result -> ContT CuModuleNVX IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "vkCreateCuModuleNVX" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuModuleCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pModule" ::: Ptr CuModuleNVX)
-> IO Result
vkCreateCuModuleNVX' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pCreateInfo" ::: Ptr CuModuleCreateInfoNVX
pCreateInfo "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pModule" ::: Ptr CuModuleNVX
pPModule))
  IO () -> ContT CuModuleNVX IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT CuModuleNVX IO ())
-> IO () -> ContT CuModuleNVX 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))
  CuModuleNVX
pModule <- IO CuModuleNVX -> ContT CuModuleNVX IO CuModuleNVX
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CuModuleNVX -> ContT CuModuleNVX IO CuModuleNVX)
-> IO CuModuleNVX -> ContT CuModuleNVX IO CuModuleNVX
forall a b. (a -> b) -> a -> b
$ ("pModule" ::: Ptr CuModuleNVX) -> IO CuModuleNVX
forall a. Storable a => Ptr a -> IO a
peek @CuModuleNVX "pModule" ::: Ptr CuModuleNVX
pPModule
  CuModuleNVX -> ContT CuModuleNVX IO CuModuleNVX
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CuModuleNVX -> ContT CuModuleNVX IO CuModuleNVX)
-> CuModuleNVX -> ContT CuModuleNVX IO CuModuleNVX
forall a b. (a -> b) -> a -> b
$ (CuModuleNVX
pModule)

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


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

-- No documentation found for TopLevel "vkCreateCuFunctionNVX"
createCuFunctionNVX :: forall io
                     . (MonadIO io)
                    => -- No documentation found for Nested "vkCreateCuFunctionNVX" "device"
                       Device
                    -> -- No documentation found for Nested "vkCreateCuFunctionNVX" "pCreateInfo"
                       CuFunctionCreateInfoNVX
                    -> -- No documentation found for Nested "vkCreateCuFunctionNVX" "pAllocator"
                       ("allocator" ::: Maybe AllocationCallbacks)
                    -> io (CuFunctionNVX)
createCuFunctionNVX :: Device
-> CuFunctionCreateInfoNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io CuFunctionNVX
createCuFunctionNVX device :: Device
device createInfo :: CuFunctionCreateInfoNVX
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO CuFunctionNVX -> io CuFunctionNVX
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CuFunctionNVX -> io CuFunctionNVX)
-> (ContT CuFunctionNVX IO CuFunctionNVX -> IO CuFunctionNVX)
-> ContT CuFunctionNVX IO CuFunctionNVX
-> io CuFunctionNVX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT CuFunctionNVX IO CuFunctionNVX -> IO CuFunctionNVX
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT CuFunctionNVX IO CuFunctionNVX -> io CuFunctionNVX)
-> ContT CuFunctionNVX IO CuFunctionNVX -> io CuFunctionNVX
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateCuFunctionNVXPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> IO Result)
vkCreateCuFunctionNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pFunction" ::: Ptr CuFunctionNVX)
      -> IO Result)
pVkCreateCuFunctionNVX (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT CuFunctionNVX IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT CuFunctionNVX IO ())
-> IO () -> ContT CuFunctionNVX IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> IO Result)
vkCreateCuFunctionNVXPtr FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pFunction" ::: Ptr CuFunctionNVX)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> 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 "" "The function pointer for vkCreateCuFunctionNVX is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateCuFunctionNVX' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CuFunctionNVX)
-> IO Result
vkCreateCuFunctionNVX' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CuFunctionNVX)
-> IO Result
mkVkCreateCuFunctionNVX FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pFunction" ::: Ptr CuFunctionNVX)
   -> IO Result)
vkCreateCuFunctionNVXPtr
  "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
pCreateInfo <- ((("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
  -> IO CuFunctionNVX)
 -> IO CuFunctionNVX)
-> ContT
     CuFunctionNVX IO ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
   -> IO CuFunctionNVX)
  -> IO CuFunctionNVX)
 -> ContT
      CuFunctionNVX IO ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX))
-> ((("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
     -> IO CuFunctionNVX)
    -> IO CuFunctionNVX)
-> ContT
     CuFunctionNVX IO ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
forall a b. (a -> b) -> a -> b
$ CuFunctionCreateInfoNVX
-> (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
    -> IO CuFunctionNVX)
-> IO CuFunctionNVX
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CuFunctionCreateInfoNVX
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT
     CuFunctionNVX IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO CuFunctionNVX)
 -> IO CuFunctionNVX)
-> ContT
     CuFunctionNVX IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO CuFunctionNVX)
  -> IO CuFunctionNVX)
 -> ContT
      CuFunctionNVX IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks)
     -> IO CuFunctionNVX)
    -> IO CuFunctionNVX)
-> ContT
     CuFunctionNVX IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO CuFunctionNVX)
-> IO CuFunctionNVX
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pFunction" ::: Ptr CuFunctionNVX
pPFunction <- ((("pFunction" ::: Ptr CuFunctionNVX) -> IO CuFunctionNVX)
 -> IO CuFunctionNVX)
-> ContT CuFunctionNVX IO ("pFunction" ::: Ptr CuFunctionNVX)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pFunction" ::: Ptr CuFunctionNVX) -> IO CuFunctionNVX)
  -> IO CuFunctionNVX)
 -> ContT CuFunctionNVX IO ("pFunction" ::: Ptr CuFunctionNVX))
-> ((("pFunction" ::: Ptr CuFunctionNVX) -> IO CuFunctionNVX)
    -> IO CuFunctionNVX)
-> ContT CuFunctionNVX IO ("pFunction" ::: Ptr CuFunctionNVX)
forall a b. (a -> b) -> a -> b
$ IO ("pFunction" ::: Ptr CuFunctionNVX)
-> (("pFunction" ::: Ptr CuFunctionNVX) -> IO ())
-> (("pFunction" ::: Ptr CuFunctionNVX) -> IO CuFunctionNVX)
-> IO CuFunctionNVX
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pFunction" ::: Ptr CuFunctionNVX)
forall a. Int -> IO (Ptr a)
callocBytes @CuFunctionNVX 8) ("pFunction" ::: Ptr CuFunctionNVX) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT CuFunctionNVX IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT CuFunctionNVX IO Result)
-> IO Result -> ContT CuFunctionNVX IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "vkCreateCuFunctionNVX" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pFunction" ::: Ptr CuFunctionNVX)
-> IO Result
vkCreateCuFunctionNVX' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
pCreateInfo "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pFunction" ::: Ptr CuFunctionNVX
pPFunction))
  IO () -> ContT CuFunctionNVX IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT CuFunctionNVX IO ())
-> IO () -> ContT CuFunctionNVX 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))
  CuFunctionNVX
pFunction <- IO CuFunctionNVX -> ContT CuFunctionNVX IO CuFunctionNVX
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CuFunctionNVX -> ContT CuFunctionNVX IO CuFunctionNVX)
-> IO CuFunctionNVX -> ContT CuFunctionNVX IO CuFunctionNVX
forall a b. (a -> b) -> a -> b
$ ("pFunction" ::: Ptr CuFunctionNVX) -> IO CuFunctionNVX
forall a. Storable a => Ptr a -> IO a
peek @CuFunctionNVX "pFunction" ::: Ptr CuFunctionNVX
pPFunction
  CuFunctionNVX -> ContT CuFunctionNVX IO CuFunctionNVX
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CuFunctionNVX -> ContT CuFunctionNVX IO CuFunctionNVX)
-> CuFunctionNVX -> ContT CuFunctionNVX IO CuFunctionNVX
forall a b. (a -> b) -> a -> b
$ (CuFunctionNVX
pFunction)

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


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

-- No documentation found for TopLevel "vkDestroyCuModuleNVX"
destroyCuModuleNVX :: forall io
                    . (MonadIO io)
                   => -- No documentation found for Nested "vkDestroyCuModuleNVX" "device"
                      Device
                   -> -- No documentation found for Nested "vkDestroyCuModuleNVX" "module"
                      CuModuleNVX
                   -> -- No documentation found for Nested "vkDestroyCuModuleNVX" "pAllocator"
                      ("allocator" ::: Maybe AllocationCallbacks)
                   -> io ()
destroyCuModuleNVX :: Device
-> CuModuleNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCuModuleNVX device :: Device
device module' :: CuModuleNVX
module' allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
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 vkDestroyCuModuleNVXPtr :: FunPtr
  (Ptr Device_T
   -> CuModuleNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuModuleNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> CuModuleNVX
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyCuModuleNVX (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT () IO ()
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
   -> CuModuleNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuModuleNVXPtr FunPtr
  (Ptr Device_T
   -> CuModuleNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> CuModuleNVX
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> CuModuleNVX
   -> ("pAllocator" ::: 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 "" "The function pointer for vkDestroyCuModuleNVX is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyCuModuleNVX' :: Ptr Device_T
-> CuModuleNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCuModuleNVX' = FunPtr
  (Ptr Device_T
   -> CuModuleNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> CuModuleNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyCuModuleNVX FunPtr
  (Ptr Device_T
   -> CuModuleNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuModuleNVXPtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
 -> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
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 "vkDestroyCuModuleNVX" (Ptr Device_T
-> CuModuleNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCuModuleNVX' (Device -> Ptr Device_T
deviceHandle (Device
device)) (CuModuleNVX
module') "pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
  () -> ContT () IO ()
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" mkVkDestroyCuFunctionNVX
  :: FunPtr (Ptr Device_T -> CuFunctionNVX -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> CuFunctionNVX -> Ptr AllocationCallbacks -> IO ()

-- No documentation found for TopLevel "vkDestroyCuFunctionNVX"
destroyCuFunctionNVX :: forall io
                      . (MonadIO io)
                     => -- No documentation found for Nested "vkDestroyCuFunctionNVX" "device"
                        Device
                     -> -- No documentation found for Nested "vkDestroyCuFunctionNVX" "function"
                        CuFunctionNVX
                     -> -- No documentation found for Nested "vkDestroyCuFunctionNVX" "pAllocator"
                        ("allocator" ::: Maybe AllocationCallbacks)
                     -> io ()
destroyCuFunctionNVX :: Device
-> CuFunctionNVX
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyCuFunctionNVX device :: Device
device function :: CuFunctionNVX
function allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
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 vkDestroyCuFunctionNVXPtr :: FunPtr
  (Ptr Device_T
   -> CuFunctionNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuFunctionNVXPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> CuFunctionNVX
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyCuFunctionNVX (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT () IO ()
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
   -> CuFunctionNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuFunctionNVXPtr FunPtr
  (Ptr Device_T
   -> CuFunctionNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> CuFunctionNVX
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> CuFunctionNVX
   -> ("pAllocator" ::: 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 "" "The function pointer for vkDestroyCuFunctionNVX is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyCuFunctionNVX' :: Ptr Device_T
-> CuFunctionNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCuFunctionNVX' = FunPtr
  (Ptr Device_T
   -> CuFunctionNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> CuFunctionNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyCuFunctionNVX FunPtr
  (Ptr Device_T
   -> CuFunctionNVX
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyCuFunctionNVXPtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
 -> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
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 "vkDestroyCuFunctionNVX" (Ptr Device_T
-> CuFunctionNVX
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyCuFunctionNVX' (Device -> Ptr Device_T
deviceHandle (Device
device)) (CuFunctionNVX
function) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
  () -> ContT () IO ()
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" mkVkCmdCuLaunchKernelNVX
  :: FunPtr (Ptr CommandBuffer_T -> Ptr CuLaunchInfoNVX -> IO ()) -> Ptr CommandBuffer_T -> Ptr CuLaunchInfoNVX -> IO ()

-- No documentation found for TopLevel "vkCmdCuLaunchKernelNVX"
cmdCuLaunchKernelNVX :: forall io
                      . (MonadIO io)
                     => -- No documentation found for Nested "vkCmdCuLaunchKernelNVX" "commandBuffer"
                        CommandBuffer
                     -> -- No documentation found for Nested "vkCmdCuLaunchKernelNVX" "pLaunchInfo"
                        CuLaunchInfoNVX
                     -> io ()
cmdCuLaunchKernelNVX :: CommandBuffer -> CuLaunchInfoNVX -> io ()
cmdCuLaunchKernelNVX commandBuffer :: CommandBuffer
commandBuffer launchInfo :: CuLaunchInfoNVX
launchInfo = IO () -> io ()
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 vkCmdCuLaunchKernelNVXPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
vkCmdCuLaunchKernelNVXPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
pVkCmdCuLaunchKernelNVX (CommandBuffer -> DeviceCmds
deviceCmds (CommandBuffer
commandBuffer :: CommandBuffer))
  IO () -> ContT () IO ()
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
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
vkCmdCuLaunchKernelNVXPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> 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 "" "The function pointer for vkCmdCuLaunchKernelNVX is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCuLaunchKernelNVX' :: Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ()
vkCmdCuLaunchKernelNVX' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
-> Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> IO ()
mkVkCmdCuLaunchKernelNVX FunPtr
  (Ptr CommandBuffer_T
   -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ())
vkCmdCuLaunchKernelNVXPtr
  "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
pLaunchInfo <- ((("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ()) -> IO ())
-> ContT () IO ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ()) -> IO ())
 -> ContT () IO ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX))
-> ((("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ()) -> IO ())
-> ContT () IO ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
forall a b. (a -> b) -> a -> b
$ CuLaunchInfoNVX
-> (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CuLaunchInfoNVX
launchInfo)
  IO () -> ContT () IO ()
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 "vkCmdCuLaunchKernelNVX" (Ptr CommandBuffer_T
-> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO ()
vkCmdCuLaunchKernelNVX' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
pLaunchInfo)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- No documentation found for TopLevel "VkCuModuleCreateInfoNVX"
data CuModuleCreateInfoNVX = CuModuleCreateInfoNVX
  { -- No documentation found for Nested "VkCuModuleCreateInfoNVX" "dataSize"
    CuModuleCreateInfoNVX -> Word64
dataSize :: Word64
  , -- No documentation found for Nested "VkCuModuleCreateInfoNVX" "pData"
    CuModuleCreateInfoNVX -> Ptr ()
data' :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CuModuleCreateInfoNVX)
#endif
deriving instance Show CuModuleCreateInfoNVX

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

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

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

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


-- No documentation found for TopLevel "VkCuFunctionCreateInfoNVX"
data CuFunctionCreateInfoNVX = CuFunctionCreateInfoNVX
  { -- No documentation found for Nested "VkCuFunctionCreateInfoNVX" "module"
    CuFunctionCreateInfoNVX -> CuModuleNVX
module' :: CuModuleNVX
  , -- No documentation found for Nested "VkCuFunctionCreateInfoNVX" "pName"
    CuFunctionCreateInfoNVX -> ByteString
name :: ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CuFunctionCreateInfoNVX)
#endif
deriving instance Show CuFunctionCreateInfoNVX

instance ToCStruct CuFunctionCreateInfoNVX where
  withCStruct :: CuFunctionCreateInfoNVX
-> (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b)
-> IO b
withCStruct x :: CuFunctionCreateInfoNVX
x f :: ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b
f = Int
-> Int
-> (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b) -> IO b)
-> (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p -> ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> CuFunctionCreateInfoNVX -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p CuFunctionCreateInfoNVX
x (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b
f "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p)
  pokeCStruct :: ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> CuFunctionCreateInfoNVX -> IO b -> IO b
pokeCStruct p :: "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p CuFunctionCreateInfoNVX{..} f :: 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 (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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_FUNCTION_CREATE_INFO_NVX)
    IO () -> ContT b IO ()
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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
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
$ ("pModule" ::: Ptr CuModuleNVX) -> CuModuleNVX -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> "pModule" ::: Ptr CuModuleNVX
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CuModuleNVX)) (CuModuleNVX
module')
    CString
pName'' <- ((CString -> IO b) -> IO b) -> ContT b IO CString
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((CString -> IO b) -> IO b) -> ContT b IO CString)
-> ((CString -> IO b) -> IO b) -> ContT b IO CString
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO b) -> IO b
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (ByteString
name)
    IO () -> ContT b IO ()
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 CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr CChar))) CString
pName''
    IO b -> ContT b IO b
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 = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX) -> IO b -> IO b
pokeZeroCStruct p :: "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p f :: 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 (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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_FUNCTION_CREATE_INFO_NVX)
    IO () -> ContT b IO ()
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 (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
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
$ ("pModule" ::: Ptr CuModuleNVX) -> CuModuleNVX -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> "pModule" ::: Ptr CuModuleNVX
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CuModuleNVX)) (CuModuleNVX
forall a. Zero a => a
zero)
    CString
pName'' <- ((CString -> IO b) -> IO b) -> ContT b IO CString
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((CString -> IO b) -> IO b) -> ContT b IO CString)
-> ((CString -> IO b) -> IO b) -> ContT b IO CString
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO b) -> IO b
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (ByteString
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
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 CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr CChar))) CString
pName''
    IO b -> ContT b IO b
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 CuFunctionCreateInfoNVX where
  peekCStruct :: ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> IO CuFunctionCreateInfoNVX
peekCStruct p :: "pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p = do
    CuModuleNVX
module' <- ("pModule" ::: Ptr CuModuleNVX) -> IO CuModuleNVX
forall a. Storable a => Ptr a -> IO a
peek @CuModuleNVX (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> "pModule" ::: Ptr CuModuleNVX
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CuModuleNVX))
    ByteString
pName <- CString -> IO ByteString
packCString (CString -> IO ByteString) -> IO CString -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX
p ("pCreateInfo" ::: Ptr CuFunctionCreateInfoNVX)
-> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr CChar)))
    CuFunctionCreateInfoNVX -> IO CuFunctionCreateInfoNVX
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CuFunctionCreateInfoNVX -> IO CuFunctionCreateInfoNVX)
-> CuFunctionCreateInfoNVX -> IO CuFunctionCreateInfoNVX
forall a b. (a -> b) -> a -> b
$ CuModuleNVX -> ByteString -> CuFunctionCreateInfoNVX
CuFunctionCreateInfoNVX
             CuModuleNVX
module' ByteString
pName

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


-- No documentation found for TopLevel "VkCuLaunchInfoNVX"
data CuLaunchInfoNVX = CuLaunchInfoNVX
  { -- No documentation found for Nested "VkCuLaunchInfoNVX" "function"
    CuLaunchInfoNVX -> CuFunctionNVX
function :: CuFunctionNVX
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "gridDimX"
    CuLaunchInfoNVX -> Word32
gridDimX :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "gridDimY"
    CuLaunchInfoNVX -> Word32
gridDimY :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "gridDimZ"
    CuLaunchInfoNVX -> Word32
gridDimZ :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "blockDimX"
    CuLaunchInfoNVX -> Word32
blockDimX :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "blockDimY"
    CuLaunchInfoNVX -> Word32
blockDimY :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "blockDimZ"
    CuLaunchInfoNVX -> Word32
blockDimZ :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "sharedMemBytes"
    CuLaunchInfoNVX -> Word32
sharedMemBytes :: Word32
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "paramCount"
    CuLaunchInfoNVX -> Word64
paramCount :: Word64
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "pParams"
    CuLaunchInfoNVX -> Ptr (Ptr ())
params :: Ptr (Ptr ())
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "extraCount"
    CuLaunchInfoNVX -> Word64
extraCount :: Word64
  , -- No documentation found for Nested "VkCuLaunchInfoNVX" "pExtras"
    CuLaunchInfoNVX -> Ptr (Ptr ())
extras :: Ptr (Ptr ())
  }
  deriving (Typeable, CuLaunchInfoNVX -> CuLaunchInfoNVX -> Bool
(CuLaunchInfoNVX -> CuLaunchInfoNVX -> Bool)
-> (CuLaunchInfoNVX -> CuLaunchInfoNVX -> Bool)
-> Eq CuLaunchInfoNVX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CuLaunchInfoNVX -> CuLaunchInfoNVX -> Bool
$c/= :: CuLaunchInfoNVX -> CuLaunchInfoNVX -> Bool
== :: CuLaunchInfoNVX -> CuLaunchInfoNVX -> Bool
$c== :: CuLaunchInfoNVX -> CuLaunchInfoNVX -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CuLaunchInfoNVX)
#endif
deriving instance Show CuLaunchInfoNVX

instance ToCStruct CuLaunchInfoNVX where
  withCStruct :: CuLaunchInfoNVX
-> (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b) -> IO b
withCStruct x :: CuLaunchInfoNVX
x f :: ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b
f = Int
-> Int -> (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 88 8 ((("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b) -> IO b)
-> (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p -> ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> CuLaunchInfoNVX -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p CuLaunchInfoNVX
x (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b
f "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p)
  pokeCStruct :: ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> CuLaunchInfoNVX -> IO b -> IO b
pokeCStruct p :: "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p CuLaunchInfoNVX{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_LAUNCH_INFO_NVX)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("pFunction" ::: Ptr CuFunctionNVX) -> CuFunctionNVX -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> Int -> "pFunction" ::: Ptr CuFunctionNVX
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CuFunctionNVX)) (CuFunctionNVX
function)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
gridDimX)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr Word32)) (Word32
gridDimY)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) (Word32
gridDimZ)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Word32)) (Word32
blockDimX)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32)) (Word32
blockDimY)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32)) (Word32
blockDimZ)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32)) (Word32
sharedMemBytes)
    Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
paramCount))
    Ptr (Ptr (Ptr ())) -> Ptr (Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> Int -> Ptr (Ptr (Ptr ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64 :: Ptr (Ptr (Ptr ())))) (Ptr (Ptr ())
params)
    Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
extraCount))
    Ptr (Ptr (Ptr ())) -> Ptr (Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> Int -> Ptr (Ptr (Ptr ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr (Ptr (Ptr ())))) (Ptr (Ptr ())
extras)
    IO b
f
  cStructSize :: Int
cStructSize = 88
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> IO b -> IO b
pokeZeroCStruct p :: "pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_CU_LAUNCH_INFO_NVX)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("pFunction" ::: Ptr CuFunctionNVX) -> CuFunctionNVX -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> Int -> "pFunction" ::: Ptr CuFunctionNVX
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CuFunctionNVX)) (CuFunctionNVX
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
forall a. Zero a => a
zero))
    Ptr (Ptr (Ptr ())) -> Ptr (Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> Int -> Ptr (Ptr (Ptr ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64 :: Ptr (Ptr (Ptr ())))) (Ptr (Ptr ())
forall a. Zero a => a
zero)
    Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX) -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
forall a. Zero a => a
zero))
    Ptr (Ptr (Ptr ())) -> Ptr (Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pLaunchInfo" ::: Ptr CuLaunchInfoNVX
p ("pLaunchInfo" ::: Ptr CuLaunchInfoNVX)
-> Int -> Ptr (Ptr (Ptr ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr (Ptr (Ptr ())))) (Ptr (Ptr ())
forall a. Zero a => a
zero)
    IO b
f

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

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

instance Zero CuLaunchInfoNVX where
  zero :: CuLaunchInfoNVX
zero = CuFunctionNVX
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word64
-> Ptr (Ptr ())
-> Word64
-> Ptr (Ptr ())
-> CuLaunchInfoNVX
CuLaunchInfoNVX
           CuFunctionNVX
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
           Ptr (Ptr ())
forall a. Zero a => a
zero
           Word64
forall a. Zero a => a
zero
           Ptr (Ptr ())
forall a. Zero a => a
zero


type NVX_BINARY_IMPORT_SPEC_VERSION = 1

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


type NVX_BINARY_IMPORT_EXTENSION_NAME = "VK_NVX_binary_import"

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