{-# language CPP #-}
module Vulkan.Core10.Memory  ( allocateMemory
                             , withMemory
                             , freeMemory
                             , mapMemory
                             , withMappedMemory
                             , unmapMemory
                             , flushMappedMemoryRanges
                             , invalidateMappedMemoryRanges
                             , getDeviceMemoryCommitment
                             , MemoryAllocateInfo(..)
                             , MappedMemoryRange(..)
                             , MemoryMapFlags(..)
                             ) where

import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
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 (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.CStruct.Extends (Chain)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_dedicated_allocation (DedicatedAllocationMemoryAllocateInfoNV)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkAllocateMemory))
import Vulkan.Dynamic (DeviceCmds(pVkFlushMappedMemoryRanges))
import Vulkan.Dynamic (DeviceCmds(pVkFreeMemory))
import Vulkan.Dynamic (DeviceCmds(pVkGetDeviceMemoryCommitment))
import Vulkan.Dynamic (DeviceCmds(pVkInvalidateMappedMemoryRanges))
import Vulkan.Dynamic (DeviceCmds(pVkMapMemory))
import Vulkan.Dynamic (DeviceCmds(pVkUnmapMemory))
import Vulkan.Core10.Handles (DeviceMemory)
import Vulkan.Core10.Handles (DeviceMemory(..))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_external_memory (ExportMemoryAllocateInfo)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_external_memory (ExportMemoryAllocateInfoNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_external_memory_win32 (ExportMemoryWin32HandleInfoKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_external_memory_win32 (ExportMemoryWin32HandleInfoNV)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer (ImportAndroidHardwareBufferInfoANDROID)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_external_memory_fd (ImportMemoryFdInfoKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_external_memory_host (ImportMemoryHostPointerInfoEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_external_memory_win32 (ImportMemoryWin32HandleInfoKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_external_memory_win32 (ImportMemoryWin32HandleInfoNV)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_device_group (MemoryAllocateFlagsInfo)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation (MemoryDedicatedAllocateInfo)
import Vulkan.Core10.Enums.MemoryMapFlags (MemoryMapFlags)
import Vulkan.Core10.Enums.MemoryMapFlags (MemoryMapFlags(..))
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address (MemoryOpaqueCaptureAddressAllocateInfo)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_memory_priority (MemoryPriorityAllocateInfoEXT)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MAPPED_MEMORY_RANGE))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Enums.MemoryMapFlags (MemoryMapFlags(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkAllocateMemory
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct MemoryAllocateInfo) -> Ptr AllocationCallbacks -> Ptr DeviceMemory -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct MemoryAllocateInfo) -> Ptr AllocationCallbacks -> Ptr DeviceMemory -> IO Result

-- | vkAllocateMemory - Allocate device memory
--
-- = Description
--
-- Allocations returned by 'allocateMemory' are guaranteed to meet any
-- alignment requirement of the implementation. For example, if an
-- implementation requires 128 byte alignment for images and 64 byte
-- alignment for buffers, the device memory returned through this mechanism
-- would be 128-byte aligned. This ensures that applications /can/
-- correctly suballocate objects of different types (with potentially
-- different alignment requirements) in the same memory object.
--
-- When memory is allocated, its contents are undefined with the following
-- constraint:
--
-- -   The contents of unprotected memory /must/ not be a function of data
--     protected memory objects, even if those memory objects were
--     previously freed.
--
-- Note
--
-- The contents of memory allocated by one application /should/ not be a
-- function of data from protected memory objects of another application,
-- even if those memory objects were previously freed.
--
-- The maximum number of valid memory allocations that /can/ exist
-- simultaneously within a 'Vulkan.Core10.Handles.Device' /may/ be
-- restricted by implementation- or platform-dependent limits. If a call to
-- 'allocateMemory' would cause the total number of allocations to exceed
-- these limits, such a call will fail and /must/ return
-- 'Vulkan.Core10.Enums.Result.ERROR_TOO_MANY_OBJECTS'. The
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxMemoryAllocationCount maxMemoryAllocationCount>
-- feature describes the number of allocations that /can/ exist
-- simultaneously before encountering these internal limits.
--
-- Some platforms /may/ have a limit on the maximum size of a single
-- allocation. For example, certain systems /may/ fail to create
-- allocations with a size greater than or equal to 4GB. Such a limit is
-- implementation-dependent, and if such a failure occurs then the error
-- 'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY' /must/ be
-- returned. This limit is advertised in
-- 'Vulkan.Core11.Promoted_From_VK_KHR_maintenance3.PhysicalDeviceMaintenance3Properties'::@maxMemoryAllocationSize@.
--
-- The cumulative memory size allocated to a heap /can/ be limited by the
-- size of the specified heap. In such cases, allocated memory is tracked
-- on a per-device and per-heap basis. Some platforms allow overallocation
-- into other heaps. The overallocation behavior /can/ be specified through
-- the @VK_AMD_memory_overallocation_behavior@ extension.
--
-- == Valid Usage
--
-- -   @pAllocateInfo->allocationSize@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceMemoryProperties'::@memoryHeaps@[memindex].size
--     where @memindex@ =
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceMemoryProperties'::@memoryTypes@[pAllocateInfo->memoryTypeIndex].heapIndex
--     as returned by
--     'Vulkan.Core10.DeviceInitialization.getPhysicalDeviceMemoryProperties'
--     for the 'Vulkan.Core10.Handles.PhysicalDevice' that @device@ was
--     created from
--
-- -   @pAllocateInfo->memoryTypeIndex@ /must/ be less than
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceMemoryProperties'::@memoryTypeCount@
--     as returned by
--     'Vulkan.Core10.DeviceInitialization.getPhysicalDeviceMemoryProperties'
--     for the 'Vulkan.Core10.Handles.PhysicalDevice' that @device@ was
--     created from
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-deviceCoherentMemory deviceCoherentMemory>
--     feature is not enabled, @pAllocateInfo->memoryTypeIndex@ /must/ not
--     identify a memory type supporting
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD'
--
-- -   There /must/ be less than
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxMemoryAllocationCount@
--     device memory allocations currently allocated on the device.
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pAllocateInfo@ /must/ be a valid pointer to a valid
--     'MemoryAllocateInfo' structure
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   @pMemory@ /must/ be a valid pointer to a
--     'Vulkan.Core10.Handles.DeviceMemory' handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_TOO_MANY_OBJECTS'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INVALID_EXTERNAL_HANDLE'
--
--     -   'Vulkan.Extensions.VK_KHR_buffer_device_address.ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS_KHR'
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.DeviceMemory',
-- 'MemoryAllocateInfo'
allocateMemory :: forall a io
                . (Extendss MemoryAllocateInfo a, PokeChain a, MonadIO io)
               => -- | @device@ is the logical device that owns the memory.
                  Device
               -> -- | @pAllocateInfo@ is a pointer to a 'MemoryAllocateInfo' structure
                  -- describing parameters of the allocation. A successful returned
                  -- allocation /must/ use the requested parameters — no substitution is
                  -- permitted by the implementation.
                  (MemoryAllocateInfo a)
               -> -- | @pAllocator@ controls host memory allocation as described in the
                  -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                  -- chapter.
                  ("allocator" ::: Maybe AllocationCallbacks)
               -> io (DeviceMemory)
allocateMemory :: Device
-> MemoryAllocateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DeviceMemory
allocateMemory device :: Device
device allocateInfo :: MemoryAllocateInfo a
allocateInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO DeviceMemory -> io DeviceMemory
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DeviceMemory -> io DeviceMemory)
-> (ContT DeviceMemory IO DeviceMemory -> IO DeviceMemory)
-> ContT DeviceMemory IO DeviceMemory
-> io DeviceMemory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT DeviceMemory IO DeviceMemory -> IO DeviceMemory
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT DeviceMemory IO DeviceMemory -> io DeviceMemory)
-> ContT DeviceMemory IO DeviceMemory -> io DeviceMemory
forall a b. (a -> b) -> a -> b
$ do
  let vkAllocateMemoryPtr :: FunPtr
  (Ptr Device_T
   -> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMemory" ::: Ptr DeviceMemory)
   -> IO Result)
vkAllocateMemoryPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pMemory" ::: Ptr DeviceMemory)
      -> IO Result)
pVkAllocateMemory (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT DeviceMemory IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT DeviceMemory IO ())
-> IO () -> ContT DeviceMemory IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMemory" ::: Ptr DeviceMemory)
   -> IO Result)
vkAllocateMemoryPtr FunPtr
  (Ptr Device_T
   -> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMemory" ::: Ptr DeviceMemory)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pMemory" ::: Ptr DeviceMemory)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMemory" ::: Ptr DeviceMemory)
   -> 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 vkAllocateMemory is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkAllocateMemory' :: Ptr Device_T
-> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pMemory" ::: Ptr DeviceMemory)
-> IO Result
vkAllocateMemory' = FunPtr
  (Ptr Device_T
   -> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMemory" ::: Ptr DeviceMemory)
   -> IO Result)
-> Ptr Device_T
-> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pMemory" ::: Ptr DeviceMemory)
-> IO Result
mkVkAllocateMemory FunPtr
  (Ptr Device_T
   -> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pMemory" ::: Ptr DeviceMemory)
   -> IO Result)
vkAllocateMemoryPtr
  Ptr (MemoryAllocateInfo a)
pAllocateInfo <- ((Ptr (MemoryAllocateInfo a) -> IO DeviceMemory)
 -> IO DeviceMemory)
-> ContT DeviceMemory IO (Ptr (MemoryAllocateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (MemoryAllocateInfo a) -> IO DeviceMemory)
  -> IO DeviceMemory)
 -> ContT DeviceMemory IO (Ptr (MemoryAllocateInfo a)))
-> ((Ptr (MemoryAllocateInfo a) -> IO DeviceMemory)
    -> IO DeviceMemory)
-> ContT DeviceMemory IO (Ptr (MemoryAllocateInfo a))
forall a b. (a -> b) -> a -> b
$ MemoryAllocateInfo a
-> (Ptr (MemoryAllocateInfo a) -> IO DeviceMemory)
-> IO DeviceMemory
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (MemoryAllocateInfo a
allocateInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT DeviceMemory 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 DeviceMemory)
 -> IO DeviceMemory)
-> ContT DeviceMemory 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 DeviceMemory)
  -> IO DeviceMemory)
 -> ContT
      DeviceMemory IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO DeviceMemory)
    -> IO DeviceMemory)
-> ContT DeviceMemory IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO DeviceMemory)
-> IO DeviceMemory
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pMemory" ::: Ptr DeviceMemory
pPMemory <- ((("pMemory" ::: Ptr DeviceMemory) -> IO DeviceMemory)
 -> IO DeviceMemory)
-> ContT DeviceMemory IO ("pMemory" ::: Ptr DeviceMemory)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pMemory" ::: Ptr DeviceMemory) -> IO DeviceMemory)
  -> IO DeviceMemory)
 -> ContT DeviceMemory IO ("pMemory" ::: Ptr DeviceMemory))
-> ((("pMemory" ::: Ptr DeviceMemory) -> IO DeviceMemory)
    -> IO DeviceMemory)
-> ContT DeviceMemory IO ("pMemory" ::: Ptr DeviceMemory)
forall a b. (a -> b) -> a -> b
$ IO ("pMemory" ::: Ptr DeviceMemory)
-> (("pMemory" ::: Ptr DeviceMemory) -> IO ())
-> (("pMemory" ::: Ptr DeviceMemory) -> IO DeviceMemory)
-> IO DeviceMemory
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pMemory" ::: Ptr DeviceMemory)
forall a. Int -> IO (Ptr a)
callocBytes @DeviceMemory 8) ("pMemory" ::: Ptr DeviceMemory) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT DeviceMemory IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT DeviceMemory IO Result)
-> IO Result -> ContT DeviceMemory IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pMemory" ::: Ptr DeviceMemory)
-> IO Result
vkAllocateMemory' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (MemoryAllocateInfo a)
-> "pAllocateInfo" ::: Ptr (SomeStruct MemoryAllocateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (MemoryAllocateInfo a)
pAllocateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pMemory" ::: Ptr DeviceMemory
pPMemory)
  IO () -> ContT DeviceMemory IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT DeviceMemory IO ())
-> IO () -> ContT DeviceMemory 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))
  DeviceMemory
pMemory <- IO DeviceMemory -> ContT DeviceMemory IO DeviceMemory
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO DeviceMemory -> ContT DeviceMemory IO DeviceMemory)
-> IO DeviceMemory -> ContT DeviceMemory IO DeviceMemory
forall a b. (a -> b) -> a -> b
$ ("pMemory" ::: Ptr DeviceMemory) -> IO DeviceMemory
forall a. Storable a => Ptr a -> IO a
peek @DeviceMemory "pMemory" ::: Ptr DeviceMemory
pPMemory
  DeviceMemory -> ContT DeviceMemory IO DeviceMemory
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceMemory -> ContT DeviceMemory IO DeviceMemory)
-> DeviceMemory -> ContT DeviceMemory IO DeviceMemory
forall a b. (a -> b) -> a -> b
$ (DeviceMemory
pMemory)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'allocateMemory' and 'freeMemory'
--
-- To ensure that 'freeMemory' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the first argument.
-- To just extract the pair pass '(,)' as the first argument.
--
withMemory :: forall a io r . (Extendss MemoryAllocateInfo a, PokeChain a, MonadIO io) => Device -> MemoryAllocateInfo a -> Maybe AllocationCallbacks -> (io (DeviceMemory) -> ((DeviceMemory) -> io ()) -> r) -> r
withMemory :: Device
-> MemoryAllocateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io DeviceMemory -> (DeviceMemory -> io ()) -> r)
-> r
withMemory device :: Device
device pAllocateInfo :: MemoryAllocateInfo a
pAllocateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io DeviceMemory -> (DeviceMemory -> io ()) -> r
b =
  io DeviceMemory -> (DeviceMemory -> io ()) -> r
b (Device
-> MemoryAllocateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DeviceMemory
forall (a :: [*]) (io :: * -> *).
(Extendss MemoryAllocateInfo a, PokeChain a, MonadIO io) =>
Device
-> MemoryAllocateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DeviceMemory
allocateMemory Device
device MemoryAllocateInfo a
pAllocateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(DeviceMemory
o0) -> Device
-> DeviceMemory
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> DeviceMemory
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
freeMemory Device
device DeviceMemory
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


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

-- | vkFreeMemory - Free device memory
--
-- = Description
--
-- Before freeing a memory object, an application /must/ ensure the memory
-- object is no longer in use by the device—​for example by command buffers
-- in the /pending state/. Memory /can/ be freed whilst still bound to
-- resources, but those resources /must/ not be used afterwards. If there
-- are still any bound images or buffers, the memory /may/ not be
-- immediately released by the implementation, but /must/ be released by
-- the time all bound images and buffers have been destroyed. Once memory
-- is released, it is returned to the heap from which it was allocated.
--
-- How memory objects are bound to Images and Buffers is described in
-- detail in the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-association Resource Memory Association>
-- section.
--
-- If a memory object is mapped at the time it is freed, it is implicitly
-- unmapped.
--
-- Note
--
-- As described
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-device-unmap-does-not-flush below>,
-- host writes are not implicitly flushed when the memory object is
-- unmapped, but the implementation /must/ guarantee that writes that have
-- not been flushed do not affect any other memory.
--
-- == Valid Usage
--
-- -   All submitted commands that refer to @memory@ (via images or
--     buffers) /must/ have completed execution
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   If @memory@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @memory@ /must/ be a valid 'Vulkan.Core10.Handles.DeviceMemory'
--     handle
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   If @memory@ is a valid handle, it /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @memory@ /must/ be externally synchronized
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.DeviceMemory'
freeMemory :: forall io
            . (MonadIO io)
           => -- | @device@ is the logical device that owns the memory.
              Device
           -> -- | @memory@ is the 'Vulkan.Core10.Handles.DeviceMemory' object to be freed.
              DeviceMemory
           -> -- | @pAllocator@ controls host memory allocation as described in the
              -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
              -- chapter.
              ("allocator" ::: Maybe AllocationCallbacks)
           -> io ()
freeMemory :: Device
-> DeviceMemory
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
freeMemory device :: Device
device memory :: DeviceMemory
memory 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 vkFreeMemoryPtr :: FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkFreeMemoryPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> DeviceMemory
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkFreeMemory (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
   -> DeviceMemory
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkFreeMemoryPtr FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> DeviceMemory
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("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 vkFreeMemory is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkFreeMemory' :: Ptr Device_T
-> DeviceMemory
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkFreeMemory' = FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> DeviceMemory
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkFreeMemory FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkFreeMemoryPtr
  "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
$ Ptr Device_T
-> DeviceMemory
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkFreeMemory' (Device -> Ptr Device_T
deviceHandle (Device
device)) (DeviceMemory
memory) "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" mkVkMapMemory
  :: FunPtr (Ptr Device_T -> DeviceMemory -> DeviceSize -> DeviceSize -> MemoryMapFlags -> Ptr (Ptr ()) -> IO Result) -> Ptr Device_T -> DeviceMemory -> DeviceSize -> DeviceSize -> MemoryMapFlags -> Ptr (Ptr ()) -> IO Result

-- | vkMapMemory - Map a memory object into application address space
--
-- = Description
--
-- After a successful call to 'mapMemory' the memory object @memory@ is
-- considered to be currently /host mapped/.
--
-- Note
--
-- It is an application error to call 'mapMemory' on a memory object that
-- is already /host mapped/.
--
-- Note
--
-- 'mapMemory' will fail if the implementation is unable to allocate an
-- appropriately sized contiguous virtual address range, e.g. due to
-- virtual address space fragmentation or platform limits. In such cases,
-- 'mapMemory' /must/ return
-- 'Vulkan.Core10.Enums.Result.ERROR_MEMORY_MAP_FAILED'. The application
-- /can/ improve the likelihood of success by reducing the size of the
-- mapped range and\/or removing unneeded mappings using 'unmapMemory'.
--
-- 'mapMemory' does not check whether the device memory is currently in use
-- before returning the host-accessible pointer. The application /must/
-- guarantee that any previously submitted command that writes to this
-- range has completed before the host reads from or writes to that range,
-- and that any previously submitted command that reads from that range has
-- completed before the host writes to that region (see
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-submission-host-writes here>
-- for details on fulfilling such a guarantee). If the device memory was
-- allocated without the
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
-- set, these guarantees /must/ be made for an extended range: the
-- application /must/ round down the start of the range to the nearest
-- multiple of
-- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@nonCoherentAtomSize@,
-- and round the end of the range up to the nearest multiple of
-- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@nonCoherentAtomSize@.
--
-- While a range of device memory is host mapped, the application is
-- responsible for synchronizing both device and host access to that memory
-- range.
--
-- Note
--
-- It is important for the application developer to become meticulously
-- familiar with all of the mechanisms described in the chapter on
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization Synchronization and Cache Control>
-- as they are crucial to maintaining memory access ordering.
--
-- == Valid Usage
--
-- -   @memory@ /must/ not be currently host mapped
--
-- -   @offset@ /must/ be less than the size of @memory@
--
-- -   If @size@ is not equal to 'Vulkan.Core10.APIConstants.WHOLE_SIZE',
--     @size@ /must/ be greater than @0@
--
-- -   If @size@ is not equal to 'Vulkan.Core10.APIConstants.WHOLE_SIZE',
--     @size@ /must/ be less than or equal to the size of the @memory@
--     minus @offset@
--
-- -   @memory@ /must/ have been created with a memory type that reports
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_VISIBLE_BIT'
--
-- -   @memory@ /must/ not have been allocated with multiple instances
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @memory@ /must/ be a valid 'Vulkan.Core10.Handles.DeviceMemory'
--     handle
--
-- -   @flags@ /must/ be @0@
--
-- -   @ppData@ /must/ be a valid pointer to a pointer value
--
-- -   @memory@ /must/ have been created, allocated, or retrieved from
--     @device@
--
-- == Host Synchronization
--
-- -   Host access to @memory@ /must/ be externally synchronized
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_MEMORY_MAP_FAILED'
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.DeviceMemory',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.MemoryMapFlags.MemoryMapFlags'
mapMemory :: forall io
           . (MonadIO io)
          => -- | @device@ is the logical device that owns the memory.
             Device
          -> -- | @memory@ is the 'Vulkan.Core10.Handles.DeviceMemory' object to be
             -- mapped.
             DeviceMemory
          -> -- | @offset@ is a zero-based byte offset from the beginning of the memory
             -- object.
             ("offset" ::: DeviceSize)
          -> -- | @size@ is the size of the memory range to map, or
             -- 'Vulkan.Core10.APIConstants.WHOLE_SIZE' to map from @offset@ to the end
             -- of the allocation.
             DeviceSize
          -> -- | @flags@ is reserved for future use.
             MemoryMapFlags
          -> io (("data" ::: Ptr ()))
mapMemory :: Device
-> DeviceMemory
-> ("offset" ::: DeviceSize)
-> ("offset" ::: DeviceSize)
-> MemoryMapFlags
-> io ("data" ::: Ptr ())
mapMemory device :: Device
device memory :: DeviceMemory
memory offset :: "offset" ::: DeviceSize
offset size :: "offset" ::: DeviceSize
size flags :: MemoryMapFlags
flags = IO ("data" ::: Ptr ()) -> io ("data" ::: Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("data" ::: Ptr ()) -> io ("data" ::: Ptr ()))
-> (ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ())
    -> IO ("data" ::: Ptr ()))
-> ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ())
-> io ("data" ::: Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ())
-> IO ("data" ::: Ptr ())
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ())
 -> io ("data" ::: Ptr ()))
-> ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ())
-> io ("data" ::: Ptr ())
forall a b. (a -> b) -> a -> b
$ do
  let vkMapMemoryPtr :: FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("offset" ::: DeviceSize)
   -> ("offset" ::: DeviceSize)
   -> MemoryMapFlags
   -> ("ppData" ::: Ptr ("data" ::: Ptr ()))
   -> IO Result)
vkMapMemoryPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> DeviceMemory
      -> ("offset" ::: DeviceSize)
      -> ("offset" ::: DeviceSize)
      -> MemoryMapFlags
      -> ("ppData" ::: Ptr ("data" ::: Ptr ()))
      -> IO Result)
pVkMapMemory (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT ("data" ::: Ptr ()) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("data" ::: Ptr ()) IO ())
-> IO () -> ContT ("data" ::: Ptr ()) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("offset" ::: DeviceSize)
   -> ("offset" ::: DeviceSize)
   -> MemoryMapFlags
   -> ("ppData" ::: Ptr ("data" ::: Ptr ()))
   -> IO Result)
vkMapMemoryPtr FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("offset" ::: DeviceSize)
   -> ("offset" ::: DeviceSize)
   -> MemoryMapFlags
   -> ("ppData" ::: Ptr ("data" ::: Ptr ()))
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> DeviceMemory
      -> ("offset" ::: DeviceSize)
      -> ("offset" ::: DeviceSize)
      -> MemoryMapFlags
      -> ("ppData" ::: Ptr ("data" ::: Ptr ()))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("offset" ::: DeviceSize)
   -> ("offset" ::: DeviceSize)
   -> MemoryMapFlags
   -> ("ppData" ::: Ptr ("data" ::: 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 "" "The function pointer for vkMapMemory is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkMapMemory' :: Ptr Device_T
-> DeviceMemory
-> ("offset" ::: DeviceSize)
-> ("offset" ::: DeviceSize)
-> MemoryMapFlags
-> ("ppData" ::: Ptr ("data" ::: Ptr ()))
-> IO Result
vkMapMemory' = FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("offset" ::: DeviceSize)
   -> ("offset" ::: DeviceSize)
   -> MemoryMapFlags
   -> ("ppData" ::: Ptr ("data" ::: Ptr ()))
   -> IO Result)
-> Ptr Device_T
-> DeviceMemory
-> ("offset" ::: DeviceSize)
-> ("offset" ::: DeviceSize)
-> MemoryMapFlags
-> ("ppData" ::: Ptr ("data" ::: Ptr ()))
-> IO Result
mkVkMapMemory FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("offset" ::: DeviceSize)
   -> ("offset" ::: DeviceSize)
   -> MemoryMapFlags
   -> ("ppData" ::: Ptr ("data" ::: Ptr ()))
   -> IO Result)
vkMapMemoryPtr
  "ppData" ::: Ptr ("data" ::: Ptr ())
pPpData <- ((("ppData" ::: Ptr ("data" ::: Ptr ())) -> IO ("data" ::: Ptr ()))
 -> IO ("data" ::: Ptr ()))
-> ContT
     ("data" ::: Ptr ()) IO ("ppData" ::: Ptr ("data" ::: Ptr ()))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("ppData" ::: Ptr ("data" ::: Ptr ()))
   -> IO ("data" ::: Ptr ()))
  -> IO ("data" ::: Ptr ()))
 -> ContT
      ("data" ::: Ptr ()) IO ("ppData" ::: Ptr ("data" ::: Ptr ())))
-> ((("ppData" ::: Ptr ("data" ::: Ptr ()))
     -> IO ("data" ::: Ptr ()))
    -> IO ("data" ::: Ptr ()))
-> ContT
     ("data" ::: Ptr ()) IO ("ppData" ::: Ptr ("data" ::: Ptr ()))
forall a b. (a -> b) -> a -> b
$ IO ("ppData" ::: Ptr ("data" ::: Ptr ()))
-> (("ppData" ::: Ptr ("data" ::: Ptr ())) -> IO ())
-> (("ppData" ::: Ptr ("data" ::: Ptr ()))
    -> IO ("data" ::: Ptr ()))
-> IO ("data" ::: Ptr ())
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("ppData" ::: Ptr ("data" ::: Ptr ()))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr ()) 8) ("ppData" ::: Ptr ("data" ::: Ptr ())) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT ("data" ::: Ptr ()) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ("data" ::: Ptr ()) IO Result)
-> IO Result -> ContT ("data" ::: Ptr ()) IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> DeviceMemory
-> ("offset" ::: DeviceSize)
-> ("offset" ::: DeviceSize)
-> MemoryMapFlags
-> ("ppData" ::: Ptr ("data" ::: Ptr ()))
-> IO Result
vkMapMemory' (Device -> Ptr Device_T
deviceHandle (Device
device)) (DeviceMemory
memory) ("offset" ::: DeviceSize
offset) ("offset" ::: DeviceSize
size) (MemoryMapFlags
flags) ("ppData" ::: Ptr ("data" ::: Ptr ())
pPpData)
  IO () -> ContT ("data" ::: Ptr ()) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("data" ::: Ptr ()) IO ())
-> IO () -> ContT ("data" ::: Ptr ()) 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))
  "data" ::: Ptr ()
ppData <- IO ("data" ::: Ptr ())
-> ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("data" ::: Ptr ())
 -> ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ()))
-> IO ("data" ::: Ptr ())
-> ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ())
forall a b. (a -> b) -> a -> b
$ ("ppData" ::: Ptr ("data" ::: Ptr ())) -> IO ("data" ::: Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) "ppData" ::: Ptr ("data" ::: Ptr ())
pPpData
  ("data" ::: Ptr ())
-> ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("data" ::: Ptr ())
 -> ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ()))
-> ("data" ::: Ptr ())
-> ContT ("data" ::: Ptr ()) IO ("data" ::: Ptr ())
forall a b. (a -> b) -> a -> b
$ ("data" ::: Ptr ()
ppData)

-- | A convenience wrapper to make a compatible pair of calls to 'mapMemory'
-- and 'unmapMemory'
--
-- To ensure that 'unmapMemory' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the first argument.
-- To just extract the pair pass '(,)' as the first argument.
--
withMappedMemory :: forall io r . MonadIO io => Device -> DeviceMemory -> DeviceSize -> DeviceSize -> MemoryMapFlags -> (io (Ptr ()) -> ((Ptr ()) -> io ()) -> r) -> r
withMappedMemory :: Device
-> DeviceMemory
-> ("offset" ::: DeviceSize)
-> ("offset" ::: DeviceSize)
-> MemoryMapFlags
-> (io ("data" ::: Ptr ()) -> (("data" ::: Ptr ()) -> io ()) -> r)
-> r
withMappedMemory device :: Device
device memory :: DeviceMemory
memory offset :: "offset" ::: DeviceSize
offset size :: "offset" ::: DeviceSize
size flags :: MemoryMapFlags
flags b :: io ("data" ::: Ptr ()) -> (("data" ::: Ptr ()) -> io ()) -> r
b =
  io ("data" ::: Ptr ()) -> (("data" ::: Ptr ()) -> io ()) -> r
b (Device
-> DeviceMemory
-> ("offset" ::: DeviceSize)
-> ("offset" ::: DeviceSize)
-> MemoryMapFlags
-> io ("data" ::: Ptr ())
forall (io :: * -> *).
MonadIO io =>
Device
-> DeviceMemory
-> ("offset" ::: DeviceSize)
-> ("offset" ::: DeviceSize)
-> MemoryMapFlags
-> io ("data" ::: Ptr ())
mapMemory Device
device DeviceMemory
memory "offset" ::: DeviceSize
offset "offset" ::: DeviceSize
size MemoryMapFlags
flags)
    (\("data" ::: Ptr ()
_) -> Device -> DeviceMemory -> io ()
forall (io :: * -> *).
MonadIO io =>
Device -> DeviceMemory -> io ()
unmapMemory Device
device DeviceMemory
memory)


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

-- | vkUnmapMemory - Unmap a previously mapped memory object
--
-- == Valid Usage
--
-- -   @memory@ /must/ be currently host mapped
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @memory@ /must/ be a valid 'Vulkan.Core10.Handles.DeviceMemory'
--     handle
--
-- -   @memory@ /must/ have been created, allocated, or retrieved from
--     @device@
--
-- == Host Synchronization
--
-- -   Host access to @memory@ /must/ be externally synchronized
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.DeviceMemory'
unmapMemory :: forall io
             . (MonadIO io)
            => -- | @device@ is the logical device that owns the memory.
               Device
            -> -- | @memory@ is the memory object to be unmapped.
               DeviceMemory
            -> io ()
unmapMemory :: Device -> DeviceMemory -> io ()
unmapMemory device :: Device
device memory :: DeviceMemory
memory = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkUnmapMemoryPtr :: FunPtr (Ptr Device_T -> DeviceMemory -> IO ())
vkUnmapMemoryPtr = DeviceCmds -> FunPtr (Ptr Device_T -> DeviceMemory -> IO ())
pVkUnmapMemory (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Device_T -> DeviceMemory -> IO ())
vkUnmapMemoryPtr FunPtr (Ptr Device_T -> DeviceMemory -> IO ())
-> FunPtr (Ptr Device_T -> DeviceMemory -> IO ()) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Device_T -> DeviceMemory -> 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 vkUnmapMemory is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkUnmapMemory' :: Ptr Device_T -> DeviceMemory -> IO ()
vkUnmapMemory' = FunPtr (Ptr Device_T -> DeviceMemory -> IO ())
-> Ptr Device_T -> DeviceMemory -> IO ()
mkVkUnmapMemory FunPtr (Ptr Device_T -> DeviceMemory -> IO ())
vkUnmapMemoryPtr
  Ptr Device_T -> DeviceMemory -> IO ()
vkUnmapMemory' (Device -> Ptr Device_T
deviceHandle (Device
device)) (DeviceMemory
memory)
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkFlushMappedMemoryRanges
  :: FunPtr (Ptr Device_T -> Word32 -> Ptr MappedMemoryRange -> IO Result) -> Ptr Device_T -> Word32 -> Ptr MappedMemoryRange -> IO Result

-- | vkFlushMappedMemoryRanges - Flush mapped memory ranges
--
-- = Description
--
-- 'flushMappedMemoryRanges' guarantees that host writes to the memory
-- ranges described by @pMemoryRanges@ are made available to the host
-- memory domain, such that they /can/ be made available to the device
-- memory domain via
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-dependencies-available-and-visible memory domain operations>
-- using the 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_HOST_WRITE_BIT'
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-access-types access type>.
--
-- Within each range described by @pMemoryRanges@, each set of
-- @nonCoherentAtomSize@ bytes in that range is flushed if any byte in that
-- set has been written by the host since it was first host mapped, or the
-- last time it was flushed. If @pMemoryRanges@ includes sets of
-- @nonCoherentAtomSize@ bytes where no bytes have been written by the
-- host, those bytes /must/ not be flushed.
--
-- Unmapping non-coherent memory does not implicitly flush the host mapped
-- memory, and host writes that have not been flushed /may/ not ever be
-- visible to the device. However, implementations /must/ ensure that
-- writes that have not been flushed do not become visible to any other
-- memory.
--
-- Note
--
-- The above guarantee avoids a potential memory corruption in scenarios
-- where host writes to a mapped memory object have not been flushed before
-- the memory is unmapped (or freed), and the virtual address range is
-- subsequently reused for a different mapping (or memory allocation).
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Device', 'MappedMemoryRange'
flushMappedMemoryRanges :: forall io
                         . (MonadIO io)
                        => -- | @device@ is the logical device that owns the memory ranges.
                           --
                           -- @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                           Device
                        -> -- | @pMemoryRanges@ is a pointer to an array of 'MappedMemoryRange'
                           -- structures describing the memory ranges to flush.
                           --
                           -- @pMemoryRanges@ /must/ be a valid pointer to an array of
                           -- @memoryRangeCount@ valid 'MappedMemoryRange' structures
                           ("memoryRanges" ::: Vector MappedMemoryRange)
                        -> io ()
flushMappedMemoryRanges :: Device -> ("memoryRanges" ::: Vector MappedMemoryRange) -> io ()
flushMappedMemoryRanges device :: Device
device memoryRanges :: "memoryRanges" ::: Vector MappedMemoryRange
memoryRanges = 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 vkFlushMappedMemoryRangesPtr :: FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
vkFlushMappedMemoryRangesPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("memoryRangeCount" ::: Word32)
      -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
      -> IO Result)
pVkFlushMappedMemoryRanges (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
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
vkFlushMappedMemoryRangesPtr FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("memoryRangeCount" ::: Word32)
      -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> 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 vkFlushMappedMemoryRanges is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkFlushMappedMemoryRanges' :: Ptr Device_T
-> ("memoryRangeCount" ::: Word32)
-> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> IO Result
vkFlushMappedMemoryRanges' = FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
-> Ptr Device_T
-> ("memoryRangeCount" ::: Word32)
-> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> IO Result
mkVkFlushMappedMemoryRanges FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
vkFlushMappedMemoryRangesPtr
  "pMemoryRanges" ::: Ptr MappedMemoryRange
pPMemoryRanges <- ((("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO ()) -> IO ())
-> ContT () IO ("pMemoryRanges" ::: Ptr MappedMemoryRange)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO ()) -> IO ())
 -> ContT () IO ("pMemoryRanges" ::: Ptr MappedMemoryRange))
-> ((("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO ())
    -> IO ())
-> ContT () IO ("pMemoryRanges" ::: Ptr MappedMemoryRange)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @MappedMemoryRange ((("memoryRanges" ::: Vector MappedMemoryRange) -> Int
forall a. Vector a -> Int
Data.Vector.length ("memoryRanges" ::: Vector MappedMemoryRange
memoryRanges)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 40) 8
  (Int -> MappedMemoryRange -> ContT () IO ())
-> ("memoryRanges" ::: Vector MappedMemoryRange) -> ContT () IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MappedMemoryRange
e -> ((() -> IO ()) -> IO ()) -> ContT () IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO ()) -> IO ()) -> ContT () IO ())
-> ((() -> IO ()) -> IO ()) -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> MappedMemoryRange -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ("pMemoryRanges" ::: Ptr MappedMemoryRange
pPMemoryRanges ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int -> "pMemoryRanges" ::: Ptr MappedMemoryRange
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MappedMemoryRange) (MappedMemoryRange
e) (IO () -> IO ())
-> ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ())) ("memoryRanges" ::: Vector MappedMemoryRange
memoryRanges)
  Result
r <- IO Result -> ContT () IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("memoryRangeCount" ::: Word32)
-> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> IO Result
vkFlushMappedMemoryRanges' (Device -> Ptr Device_T
deviceHandle (Device
device)) ((Int -> "memoryRangeCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("memoryRanges" ::: Vector MappedMemoryRange) -> Int
forall a. Vector a -> Int
Data.Vector.length (("memoryRanges" ::: Vector MappedMemoryRange) -> Int)
-> ("memoryRanges" ::: Vector MappedMemoryRange) -> Int
forall a b. (a -> b) -> a -> b
$ ("memoryRanges" ::: Vector MappedMemoryRange
memoryRanges)) :: Word32)) ("pMemoryRanges" ::: Ptr MappedMemoryRange
pPMemoryRanges)
  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 ()
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))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkInvalidateMappedMemoryRanges
  :: FunPtr (Ptr Device_T -> Word32 -> Ptr MappedMemoryRange -> IO Result) -> Ptr Device_T -> Word32 -> Ptr MappedMemoryRange -> IO Result

-- | vkInvalidateMappedMemoryRanges - Invalidate ranges of mapped memory
-- objects
--
-- = Description
--
-- 'invalidateMappedMemoryRanges' guarantees that device writes to the
-- memory ranges described by @pMemoryRanges@, which have been made
-- available to the host memory domain using the
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_HOST_WRITE_BIT' and
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_HOST_READ_BIT'
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-access-types access types>,
-- are made visible to the host. If a range of non-coherent memory is
-- written by the host and then invalidated without first being flushed,
-- its contents are undefined.
--
-- Within each range described by @pMemoryRanges@, each set of
-- @nonCoherentAtomSize@ bytes in that range is invalidated if any byte in
-- that set has been written by the device since it was first host mapped,
-- or the last time it was invalidated.
--
-- Note
--
-- Mapping non-coherent memory does not implicitly invalidate that memory.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Device', 'MappedMemoryRange'
invalidateMappedMemoryRanges :: forall io
                              . (MonadIO io)
                             => -- | @device@ is the logical device that owns the memory ranges.
                                --
                                -- @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                                Device
                             -> -- | @pMemoryRanges@ is a pointer to an array of 'MappedMemoryRange'
                                -- structures describing the memory ranges to invalidate.
                                --
                                -- @pMemoryRanges@ /must/ be a valid pointer to an array of
                                -- @memoryRangeCount@ valid 'MappedMemoryRange' structures
                                ("memoryRanges" ::: Vector MappedMemoryRange)
                             -> io ()
invalidateMappedMemoryRanges :: Device -> ("memoryRanges" ::: Vector MappedMemoryRange) -> io ()
invalidateMappedMemoryRanges device :: Device
device memoryRanges :: "memoryRanges" ::: Vector MappedMemoryRange
memoryRanges = 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 vkInvalidateMappedMemoryRangesPtr :: FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
vkInvalidateMappedMemoryRangesPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("memoryRangeCount" ::: Word32)
      -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
      -> IO Result)
pVkInvalidateMappedMemoryRanges (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
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
vkInvalidateMappedMemoryRangesPtr FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("memoryRangeCount" ::: Word32)
      -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> 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 vkInvalidateMappedMemoryRanges is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkInvalidateMappedMemoryRanges' :: Ptr Device_T
-> ("memoryRangeCount" ::: Word32)
-> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> IO Result
vkInvalidateMappedMemoryRanges' = FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
-> Ptr Device_T
-> ("memoryRangeCount" ::: Word32)
-> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> IO Result
mkVkInvalidateMappedMemoryRanges FunPtr
  (Ptr Device_T
   -> ("memoryRangeCount" ::: Word32)
   -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
   -> IO Result)
vkInvalidateMappedMemoryRangesPtr
  "pMemoryRanges" ::: Ptr MappedMemoryRange
pPMemoryRanges <- ((("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO ()) -> IO ())
-> ContT () IO ("pMemoryRanges" ::: Ptr MappedMemoryRange)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO ()) -> IO ())
 -> ContT () IO ("pMemoryRanges" ::: Ptr MappedMemoryRange))
-> ((("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO ())
    -> IO ())
-> ContT () IO ("pMemoryRanges" ::: Ptr MappedMemoryRange)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @MappedMemoryRange ((("memoryRanges" ::: Vector MappedMemoryRange) -> Int
forall a. Vector a -> Int
Data.Vector.length ("memoryRanges" ::: Vector MappedMemoryRange
memoryRanges)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 40) 8
  (Int -> MappedMemoryRange -> ContT () IO ())
-> ("memoryRanges" ::: Vector MappedMemoryRange) -> ContT () IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MappedMemoryRange
e -> ((() -> IO ()) -> IO ()) -> ContT () IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO ()) -> IO ()) -> ContT () IO ())
-> ((() -> IO ()) -> IO ()) -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> MappedMemoryRange -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ("pMemoryRanges" ::: Ptr MappedMemoryRange
pPMemoryRanges ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int -> "pMemoryRanges" ::: Ptr MappedMemoryRange
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MappedMemoryRange) (MappedMemoryRange
e) (IO () -> IO ())
-> ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ())) ("memoryRanges" ::: Vector MappedMemoryRange
memoryRanges)
  Result
r <- IO Result -> ContT () IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("memoryRangeCount" ::: Word32)
-> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> IO Result
vkInvalidateMappedMemoryRanges' (Device -> Ptr Device_T
deviceHandle (Device
device)) ((Int -> "memoryRangeCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("memoryRanges" ::: Vector MappedMemoryRange) -> Int
forall a. Vector a -> Int
Data.Vector.length (("memoryRanges" ::: Vector MappedMemoryRange) -> Int)
-> ("memoryRanges" ::: Vector MappedMemoryRange) -> Int
forall a b. (a -> b) -> a -> b
$ ("memoryRanges" ::: Vector MappedMemoryRange
memoryRanges)) :: Word32)) ("pMemoryRanges" ::: Ptr MappedMemoryRange
pPMemoryRanges)
  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 ()
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))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetDeviceMemoryCommitment
  :: FunPtr (Ptr Device_T -> DeviceMemory -> Ptr DeviceSize -> IO ()) -> Ptr Device_T -> DeviceMemory -> Ptr DeviceSize -> IO ()

-- | vkGetDeviceMemoryCommitment - Query the current commitment for a
-- VkDeviceMemory
--
-- = Description
--
-- The implementation /may/ update the commitment at any time, and the
-- value returned by this query /may/ be out of date.
--
-- The implementation guarantees to allocate any committed memory from the
-- @heapIndex@ indicated by the memory type that the memory object was
-- created with.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.DeviceMemory',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize'
getDeviceMemoryCommitment :: forall io
                           . (MonadIO io)
                          => -- | @device@ is the logical device that owns the memory.
                             --
                             -- @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                             Device
                          -> -- | @memory@ is the memory object being queried.
                             --
                             -- @memory@ /must/ have been created with a memory type that reports
                             -- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT'
                             --
                             -- @memory@ /must/ be a valid 'Vulkan.Core10.Handles.DeviceMemory' handle
                             --
                             -- @memory@ /must/ have been created, allocated, or retrieved from @device@
                             DeviceMemory
                          -> io (("committedMemoryInBytes" ::: DeviceSize))
getDeviceMemoryCommitment :: Device -> DeviceMemory -> io ("offset" ::: DeviceSize)
getDeviceMemoryCommitment device :: Device
device memory :: DeviceMemory
memory = IO ("offset" ::: DeviceSize) -> io ("offset" ::: DeviceSize)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("offset" ::: DeviceSize) -> io ("offset" ::: DeviceSize))
-> (ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize)
    -> IO ("offset" ::: DeviceSize))
-> ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize)
-> io ("offset" ::: DeviceSize)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize)
-> IO ("offset" ::: DeviceSize)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize)
 -> io ("offset" ::: DeviceSize))
-> ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize)
-> io ("offset" ::: DeviceSize)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetDeviceMemoryCommitmentPtr :: FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
   -> IO ())
vkGetDeviceMemoryCommitmentPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> DeviceMemory
      -> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
      -> IO ())
pVkGetDeviceMemoryCommitment (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT ("offset" ::: DeviceSize) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("offset" ::: DeviceSize) IO ())
-> IO () -> ContT ("offset" ::: DeviceSize) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
   -> IO ())
vkGetDeviceMemoryCommitmentPtr FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> DeviceMemory
      -> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
   -> 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 vkGetDeviceMemoryCommitment is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetDeviceMemoryCommitment' :: Ptr Device_T
-> DeviceMemory
-> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> IO ()
vkGetDeviceMemoryCommitment' = FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
   -> IO ())
-> Ptr Device_T
-> DeviceMemory
-> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> IO ()
mkVkGetDeviceMemoryCommitment FunPtr
  (Ptr Device_T
   -> DeviceMemory
   -> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
   -> IO ())
vkGetDeviceMemoryCommitmentPtr
  "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
pPCommittedMemoryInBytes <- ((("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
  -> IO ("offset" ::: DeviceSize))
 -> IO ("offset" ::: DeviceSize))
-> ContT
     ("offset" ::: DeviceSize)
     IO
     ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
   -> IO ("offset" ::: DeviceSize))
  -> IO ("offset" ::: DeviceSize))
 -> ContT
      ("offset" ::: DeviceSize)
      IO
      ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)))
-> ((("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
     -> IO ("offset" ::: DeviceSize))
    -> IO ("offset" ::: DeviceSize))
-> ContT
     ("offset" ::: DeviceSize)
     IO
     ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
forall a b. (a -> b) -> a -> b
$ IO ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> (("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
    -> IO ())
-> (("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
    -> IO ("offset" ::: DeviceSize))
-> IO ("offset" ::: DeviceSize)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
forall a. Int -> IO (Ptr a)
callocBytes @DeviceSize 8) ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> IO ()
forall a. Ptr a -> IO ()
free
  IO () -> ContT ("offset" ::: DeviceSize) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("offset" ::: DeviceSize) IO ())
-> IO () -> ContT ("offset" ::: DeviceSize) IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> DeviceMemory
-> ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> IO ()
vkGetDeviceMemoryCommitment' (Device -> Ptr Device_T
deviceHandle (Device
device)) (DeviceMemory
memory) ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
pPCommittedMemoryInBytes)
  "offset" ::: DeviceSize
pCommittedMemoryInBytes <- IO ("offset" ::: DeviceSize)
-> ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("offset" ::: DeviceSize)
 -> ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize))
-> IO ("offset" ::: DeviceSize)
-> ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize)
forall a b. (a -> b) -> a -> b
$ ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> IO ("offset" ::: DeviceSize)
forall a. Storable a => Ptr a -> IO a
peek @DeviceSize "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
pPCommittedMemoryInBytes
  ("offset" ::: DeviceSize)
-> ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("offset" ::: DeviceSize)
 -> ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize))
-> ("offset" ::: DeviceSize)
-> ContT ("offset" ::: DeviceSize) IO ("offset" ::: DeviceSize)
forall a b. (a -> b) -> a -> b
$ ("offset" ::: DeviceSize
pCommittedMemoryInBytes)


-- | VkMemoryAllocateInfo - Structure containing parameters of a memory
-- allocation
--
-- = Description
--
-- A 'MemoryAllocateInfo' structure defines a memory import operation if
-- its @pNext@ chain includes one of the following structures:
--
-- -   'Vulkan.Extensions.VK_KHR_external_memory_win32.ImportMemoryWin32HandleInfoKHR'
--     with non-zero @handleType@ value
--
-- -   'Vulkan.Extensions.VK_KHR_external_memory_fd.ImportMemoryFdInfoKHR'
--     with a non-zero @handleType@ value
--
-- -   'Vulkan.Extensions.VK_EXT_external_memory_host.ImportMemoryHostPointerInfoEXT'
--     with a non-zero @handleType@ value
--
-- -   'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.ImportAndroidHardwareBufferInfoANDROID'
--     with a non-@NULL@ @buffer@ value
--
-- If the parameters define an import operation and the external handle
-- type is
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D11_TEXTURE_BIT',
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D11_TEXTURE_KMT_BIT',
-- or
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_RESOURCE_BIT',
-- @allocationSize@ is ignored. The implementation /must/ query the size of
-- these allocations from the OS.
--
-- Importing memory /must/ not modify the content of the memory.
-- Implementations /must/ ensure that importing memory does not enable the
-- importing Vulkan instance to access any memory or resources in other
-- Vulkan instances other than that corresponding to the memory object
-- imported. Implementations /must/ also ensure accessing imported memory
-- which has not been initialized does not allow the importing Vulkan
-- instance to obtain data from the exporting Vulkan instance or
-- vice-versa.
--
-- Note
--
-- How exported and imported memory is isolated is left to the
-- implementation, but applications should be aware that such isolation
-- /may/ prevent implementations from placing multiple exportable memory
-- objects in the same physical or virtual page. Hence, applications
-- /should/ avoid creating many small external memory objects whenever
-- possible.
--
-- When performing a memory import operation, it is the responsibility of
-- the application to ensure the external handles meet all valid usage
-- requirements. However, implementations /must/ perform sufficient
-- validation of external handles to ensure that the operation results in a
-- valid memory object which will not cause program termination, device
-- loss, queue stalls, or corruption of other resources when used as
-- allowed according to its allocation parameters. If the external handle
-- provided does not meet these requirements, the implementation /must/
-- fail the memory import operation with the error code
-- 'Vulkan.Core10.Enums.Result.ERROR_INVALID_EXTERNAL_HANDLE'.
--
-- == Valid Usage
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'
--     structure, and any of the handle types specified in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'::@handleTypes@
--     require a dedicated allocation, as reported by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--     in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalImageFormatProperties'::@externalMemoryProperties.externalMemoryFeatures@
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalBufferProperties'::@externalMemoryProperties.externalMemoryFeatures@,
--     the @pNext@ chain /must/ include a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     or
--     'Vulkan.Extensions.VK_NV_dedicated_allocation.DedicatedAllocationMemoryAllocateInfoNV'
--     structure with either its @image@ or @buffer@ member set to a value
--     other than 'Vulkan.Core10.APIConstants.NULL_HANDLE'.
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'
--     structure, it /must/ not include a
--     'Vulkan.Extensions.VK_NV_external_memory.ExportMemoryAllocateInfoNV'
--     or
--     'Vulkan.Extensions.VK_NV_external_memory_win32.ExportMemoryWin32HandleInfoNV'
--     structure
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Extensions.VK_KHR_external_memory_win32.ImportMemoryWin32HandleInfoKHR'
--     structure, it /must/ not include a
--     'Vulkan.Extensions.VK_NV_external_memory_win32.ImportMemoryWin32HandleInfoNV'
--     structure
--
-- -   If the parameters define an import operation, the external handle
--     specified was created by the Vulkan API, and the external handle
--     type is
--     'Vulkan.Extensions.VK_KHR_external_memory_capabilities.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_FD_BIT_KHR',
--     then the values of @allocationSize@ and @memoryTypeIndex@ /must/
--     match those specified when the memory object being imported was
--     created
--
-- -   If the parameters define an import operation and the external handle
--     specified was created by the Vulkan API, the device mask specified
--     by
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.MemoryAllocateFlagsInfo'
--     /must/ match that specified when the memory object being imported
--     was allocated
--
-- -   If the parameters define an import operation and the external handle
--     specified was created by the Vulkan API, the list of physical
--     devices that comprise the logical device passed to 'allocateMemory'
--     /must/ match the list of physical devices that comprise the logical
--     device on which the memory was originally allocated
--
-- -   If the parameters define an import operation and the external handle
--     is an NT handle or a global share handle created outside of the
--     Vulkan API, the value of @memoryTypeIndex@ /must/ be one of those
--     returned by
--     'Vulkan.Extensions.VK_KHR_external_memory_win32.getMemoryWin32HandlePropertiesKHR'
--
-- -   If the parameters define an import operation, the external handle
--     was created by the Vulkan API, and the external handle type is
--     'Vulkan.Extensions.VK_KHR_external_memory_capabilities.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_BIT_KHR'
--     or
--     'Vulkan.Extensions.VK_KHR_external_memory_capabilities.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_KMT_BIT_KHR',
--     then the values of @allocationSize@ and @memoryTypeIndex@ /must/
--     match those specified when the memory object being imported was
--     created
--
-- -   If the parameters define an import operation and the external handle
--     type is
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_HEAP_BIT',
--     @allocationSize@ /must/ match the size specified when creating the
--     Direct3D 12 heap from which the external handle was extracted
--
-- -   If the parameters define an import operation and the external handle
--     is a POSIX file descriptor created outside of the Vulkan API, the
--     value of @memoryTypeIndex@ /must/ be one of those returned by
--     'Vulkan.Extensions.VK_KHR_external_memory_fd.getMemoryFdPropertiesKHR'
--
-- -   If the protected memory feature is not enabled, the
--     'MemoryAllocateInfo'::@memoryTypeIndex@ /must/ not indicate a memory
--     type that reports
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_PROTECTED_BIT'
--
-- -   If the parameters define an import operation and the external handle
--     is a host pointer, the value of @memoryTypeIndex@ /must/ be one of
--     those returned by
--     'Vulkan.Extensions.VK_EXT_external_memory_host.getMemoryHostPointerPropertiesEXT'
--
-- -   If the parameters define an import operation and the external handle
--     is a host pointer, @allocationSize@ /must/ be an integer multiple of
--     'Vulkan.Extensions.VK_EXT_external_memory_host.PhysicalDeviceExternalMemoryHostPropertiesEXT'::@minImportedHostPointerAlignment@
--
-- -   If the parameters define an import operation and the external handle
--     is a host pointer, the @pNext@ chain /must/ not include a
--     'Vulkan.Extensions.VK_NV_dedicated_allocation.DedicatedAllocationMemoryAllocateInfoNV'
--     structure with either its @image@ or @buffer@ field set to a value
--     other than 'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   If the parameters define an import operation and the external handle
--     is a host pointer, the @pNext@ chain /must/ not include a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     structure with either its @image@ or @buffer@ field set to a value
--     other than 'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   If the parameters define an import operation and the external handle
--     type is
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ANDROID_HARDWARE_BUFFER_BIT_ANDROID',
--     @allocationSize@ /must/ be the size returned by
--     'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.getAndroidHardwareBufferPropertiesANDROID'
--     for the Android hardware buffer
--
-- -   If the parameters define an import operation and the external handle
--     type is
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ANDROID_HARDWARE_BUFFER_BIT_ANDROID',
--     and the @pNext@ chain does not include a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     structure or
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'::@image@
--     is 'Vulkan.Core10.APIConstants.NULL_HANDLE', the Android hardware
--     buffer /must/ have a @AHardwareBuffer_Desc@::@format@ of
--     @AHARDWAREBUFFER_FORMAT_BLOB@ and a @AHardwareBuffer_Desc@::@usage@
--     that includes @AHARDWAREBUFFER_USAGE_GPU_DATA_BUFFER@
--
-- -   If the parameters define an import operation and the external handle
--     type is
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ANDROID_HARDWARE_BUFFER_BIT_ANDROID',
--     @memoryTypeIndex@ /must/ be one of those returned by
--     'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.getAndroidHardwareBufferPropertiesANDROID'
--     for the Android hardware buffer
--
-- -   If the parameters do not define an import operation, and the @pNext@
--     chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'
--     structure with
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ANDROID_HARDWARE_BUFFER_BIT_ANDROID'
--     included in its @handleTypes@ member, and the @pNext@ chain includes
--     a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     structure with @image@ not equal to
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', then @allocationSize@
--     /must/ be @0@, otherwise @allocationSize@ /must/ be greater than @0@
--
-- -   If the parameters define an import operation, the external handle is
--     an Android hardware buffer, and the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     with @image@ that is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     the Android hardware buffer’s
--     'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.AHardwareBuffer'::@usage@
--     /must/ include at least one of
--     @AHARDWAREBUFFER_USAGE_GPU_FRAMEBUFFER@ or
--     @AHARDWAREBUFFER_USAGE_GPU_SAMPLED_IMAGE@
--
-- -   If the parameters define an import operation, the external handle is
--     an Android hardware buffer, and the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     with @image@ that is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     the format of @image@ /must/ be
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED' or the format returned
--     by
--     'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.getAndroidHardwareBufferPropertiesANDROID'
--     in
--     'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.AndroidHardwareBufferFormatPropertiesANDROID'::@format@
--     for the Android hardware buffer
--
-- -   If the parameters define an import operation, the external handle is
--     an Android hardware buffer, and the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     structure with @image@ that is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', the width, height, and
--     array layer dimensions of @image@ and the Android hardware buffer’s
--     @AHardwareBuffer_Desc@ /must/ be identical
--
-- -   If the parameters define an import operation, the external handle is
--     an Android hardware buffer, and the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     structure with @image@ that is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and the Android hardware
--     buffer’s
--     'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.AHardwareBuffer'::@usage@
--     includes @AHARDWAREBUFFER_USAGE_GPU_MIPMAP_COMPLETE@, the @image@
--     /must/ have a complete mipmap chain
--
-- -   If the parameters define an import operation, the external handle is
--     an Android hardware buffer, and the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     structure with @image@ that is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and the Android hardware
--     buffer’s
--     'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.AHardwareBuffer'::@usage@
--     does not include @AHARDWAREBUFFER_USAGE_GPU_MIPMAP_COMPLETE@, the
--     @image@ /must/ have exactly one mipmap level
--
-- -   If the parameters define an import operation, the external handle is
--     an Android hardware buffer, and the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo'
--     structure with @image@ that is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', each bit set in the usage
--     of @image@ /must/ be listed in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-external-android-hardware-buffer-usage AHardwareBuffer Usage Equivalence>,
--     and if there is a corresponding @AHARDWAREBUFFER_USAGE@ bit listed
--     that bit /must/ be included in the Android hardware buffer’s
--     @AHardwareBuffer_Desc@::@usage@
--
-- -   If
--     'Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address.MemoryOpaqueCaptureAddressAllocateInfo'::@opaqueCaptureAddress@
--     is not zero,
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.MemoryAllocateFlagsInfo'::@flags@
--     /must/ include
--     'Vulkan.Core11.Enums.MemoryAllocateFlagBits.MEMORY_ALLOCATE_DEVICE_ADDRESS_CAPTURE_REPLAY_BIT'
--
-- -   If
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.MemoryAllocateFlagsInfo'::@flags@
--     includes
--     'Vulkan.Core11.Enums.MemoryAllocateFlagBits.MEMORY_ALLOCATE_DEVICE_ADDRESS_CAPTURE_REPLAY_BIT',
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-bufferDeviceAddressCaptureReplay bufferDeviceAddressCaptureReplay>
--     feature /must/ be enabled
--
-- -   If
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.MemoryAllocateFlagsInfo'::@flags@
--     includes
--     'Vulkan.Core11.Enums.MemoryAllocateFlagBits.MEMORY_ALLOCATE_DEVICE_ADDRESS_BIT',
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-bufferDeviceAddress bufferDeviceAddress>
--     feature /must/ be enabled
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Extensions.VK_EXT_external_memory_host.ImportMemoryHostPointerInfoEXT'
--     structure,
--     'Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address.MemoryOpaqueCaptureAddressAllocateInfo'::@opaqueCaptureAddress@
--     /must/ be zero
--
-- -   If the parameters define an import operation,
--     'Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address.MemoryOpaqueCaptureAddressAllocateInfo'::@opaqueCaptureAddress@
--     /must/ be zero
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO'
--
-- -   Each @pNext@ member of any structure (including this one) in the
--     @pNext@ chain /must/ be either @NULL@ or a pointer to a valid
--     instance of
--     'Vulkan.Extensions.VK_NV_dedicated_allocation.DedicatedAllocationMemoryAllocateInfoNV',
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo',
--     'Vulkan.Extensions.VK_NV_external_memory.ExportMemoryAllocateInfoNV',
--     'Vulkan.Extensions.VK_KHR_external_memory_win32.ExportMemoryWin32HandleInfoKHR',
--     'Vulkan.Extensions.VK_NV_external_memory_win32.ExportMemoryWin32HandleInfoNV',
--     'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.ImportAndroidHardwareBufferInfoANDROID',
--     'Vulkan.Extensions.VK_KHR_external_memory_fd.ImportMemoryFdInfoKHR',
--     'Vulkan.Extensions.VK_EXT_external_memory_host.ImportMemoryHostPointerInfoEXT',
--     'Vulkan.Extensions.VK_KHR_external_memory_win32.ImportMemoryWin32HandleInfoKHR',
--     'Vulkan.Extensions.VK_NV_external_memory_win32.ImportMemoryWin32HandleInfoNV',
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.MemoryAllocateFlagsInfo',
--     'Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation.MemoryDedicatedAllocateInfo',
--     'Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address.MemoryOpaqueCaptureAddressAllocateInfo',
--     or
--     'Vulkan.Extensions.VK_EXT_memory_priority.MemoryPriorityAllocateInfoEXT'
--
-- -   The @sType@ value of each struct in the @pNext@ chain /must/ be
--     unique
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'allocateMemory'
data MemoryAllocateInfo (es :: [Type]) = MemoryAllocateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    MemoryAllocateInfo es -> Chain es
next :: Chain es
  , -- | @allocationSize@ is the size of the allocation in bytes
    MemoryAllocateInfo es -> "offset" ::: DeviceSize
allocationSize :: DeviceSize
  , -- | @memoryTypeIndex@ is an index identifying a memory type from the
    -- @memoryTypes@ array of the
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceMemoryProperties'
    -- structure
    MemoryAllocateInfo es -> "memoryRangeCount" ::: Word32
memoryTypeIndex :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryAllocateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (MemoryAllocateInfo es)

instance Extensible MemoryAllocateInfo where
  extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO
  setNext :: MemoryAllocateInfo ds -> Chain es -> MemoryAllocateInfo es
setNext x :: MemoryAllocateInfo ds
x next :: Chain es
next = MemoryAllocateInfo ds
x{$sel:next:MemoryAllocateInfo :: Chain es
next = Chain es
next}
  getNext :: MemoryAllocateInfo es -> Chain es
getNext MemoryAllocateInfo{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends MemoryAllocateInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends MemoryAllocateInfo e => b) -> Maybe b
extends _ f :: Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable MemoryOpaqueCaptureAddressAllocateInfo) =>
Maybe (e :~: MemoryOpaqueCaptureAddressAllocateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @MemoryOpaqueCaptureAddressAllocateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable MemoryPriorityAllocateInfoEXT) =>
Maybe (e :~: MemoryPriorityAllocateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @MemoryPriorityAllocateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ImportAndroidHardwareBufferInfoANDROID) =>
Maybe (e :~: ImportAndroidHardwareBufferInfoANDROID)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ImportAndroidHardwareBufferInfoANDROID = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ImportMemoryHostPointerInfoEXT) =>
Maybe (e :~: ImportMemoryHostPointerInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ImportMemoryHostPointerInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable MemoryDedicatedAllocateInfo) =>
Maybe (e :~: MemoryDedicatedAllocateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @MemoryDedicatedAllocateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable MemoryAllocateFlagsInfo) =>
Maybe (e :~: MemoryAllocateFlagsInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @MemoryAllocateFlagsInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ImportMemoryFdInfoKHR) =>
Maybe (e :~: ImportMemoryFdInfoKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ImportMemoryFdInfoKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ExportMemoryWin32HandleInfoKHR) =>
Maybe (e :~: ExportMemoryWin32HandleInfoKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportMemoryWin32HandleInfoKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ImportMemoryWin32HandleInfoKHR) =>
Maybe (e :~: ImportMemoryWin32HandleInfoKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ImportMemoryWin32HandleInfoKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ExportMemoryAllocateInfo) =>
Maybe (e :~: ExportMemoryAllocateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportMemoryAllocateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ExportMemoryWin32HandleInfoNV) =>
Maybe (e :~: ExportMemoryWin32HandleInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportMemoryWin32HandleInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ImportMemoryWin32HandleInfoNV) =>
Maybe (e :~: ImportMemoryWin32HandleInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ImportMemoryWin32HandleInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ExportMemoryAllocateInfoNV) =>
Maybe (e :~: ExportMemoryAllocateInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportMemoryAllocateInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable DedicatedAllocationMemoryAllocateInfoNV) =>
Maybe (e :~: DedicatedAllocationMemoryAllocateInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DedicatedAllocationMemoryAllocateInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends MemoryAllocateInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss MemoryAllocateInfo es, PokeChain es) => ToCStruct (MemoryAllocateInfo es) where
  withCStruct :: MemoryAllocateInfo es
-> (Ptr (MemoryAllocateInfo es) -> IO b) -> IO b
withCStruct x :: MemoryAllocateInfo es
x f :: Ptr (MemoryAllocateInfo es) -> IO b
f = Int -> Int -> (Ptr (MemoryAllocateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr (MemoryAllocateInfo es) -> IO b) -> IO b)
-> (Ptr (MemoryAllocateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (MemoryAllocateInfo es)
p -> Ptr (MemoryAllocateInfo es)
-> MemoryAllocateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (MemoryAllocateInfo es)
p MemoryAllocateInfo es
x (Ptr (MemoryAllocateInfo es) -> IO b
f Ptr (MemoryAllocateInfo es)
p)
  pokeCStruct :: Ptr (MemoryAllocateInfo es)
-> MemoryAllocateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (MemoryAllocateInfo es)
p MemoryAllocateInfo{..} 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 ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO)
    "data" ::: Ptr ()
pNext'' <- (Ptr (Chain es) -> "data" ::: Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO ("data" ::: Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> "data" ::: Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO ("data" ::: Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO ("data" ::: Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b)
 -> ContT b IO ("data" ::: Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO ("data" ::: Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    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
$ ("ppData" ::: Ptr ("data" ::: Ptr ()))
-> ("data" ::: Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es)
-> Int -> "ppData" ::: Ptr ("data" ::: Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) "data" ::: Ptr ()
pNext''
    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
$ ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> ("offset" ::: DeviceSize) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es)
-> Int
-> "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceSize)) ("offset" ::: DeviceSize
allocationSize)
    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 ("memoryRangeCount" ::: Word32)
-> ("memoryRangeCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es)
-> Int -> Ptr ("memoryRangeCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) ("memoryRangeCount" ::: Word32
memoryTypeIndex)
    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 :: Ptr (MemoryAllocateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (MemoryAllocateInfo es)
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 ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO)
    "data" ::: Ptr ()
pNext' <- (Ptr (Chain es) -> "data" ::: Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO ("data" ::: Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> "data" ::: Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO ("data" ::: Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO ("data" ::: Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b)
 -> ContT b IO ("data" ::: Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO ("data" ::: Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    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
$ ("ppData" ::: Ptr ("data" ::: Ptr ()))
-> ("data" ::: Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es)
-> Int -> "ppData" ::: Ptr ("data" ::: Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) "data" ::: Ptr ()
pNext'
    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
$ ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> ("offset" ::: DeviceSize) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es)
-> Int
-> "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceSize)) ("offset" ::: DeviceSize
forall a. Zero a => a
zero)
    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 ("memoryRangeCount" ::: Word32)
-> ("memoryRangeCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es)
-> Int -> Ptr ("memoryRangeCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) ("memoryRangeCount" ::: Word32
forall a. Zero a => a
zero)
    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 (Extendss MemoryAllocateInfo es, PeekChain es) => FromCStruct (MemoryAllocateInfo es) where
  peekCStruct :: Ptr (MemoryAllocateInfo es) -> IO (MemoryAllocateInfo es)
peekCStruct p :: Ptr (MemoryAllocateInfo es)
p = do
    "data" ::: Ptr ()
pNext <- ("ppData" ::: Ptr ("data" ::: Ptr ())) -> IO ("data" ::: Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es)
-> Int -> "ppData" ::: Ptr ("data" ::: Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (("data" ::: Ptr ()) -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr "data" ::: Ptr ()
pNext)
    "offset" ::: DeviceSize
allocationSize <- ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> IO ("offset" ::: DeviceSize)
forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es)
-> Int
-> "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceSize))
    "memoryRangeCount" ::: Word32
memoryTypeIndex <- Ptr ("memoryRangeCount" ::: Word32)
-> IO ("memoryRangeCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (MemoryAllocateInfo es)
p Ptr (MemoryAllocateInfo es)
-> Int -> Ptr ("memoryRangeCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32))
    MemoryAllocateInfo es -> IO (MemoryAllocateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryAllocateInfo es -> IO (MemoryAllocateInfo es))
-> MemoryAllocateInfo es -> IO (MemoryAllocateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> ("offset" ::: DeviceSize)
-> ("memoryRangeCount" ::: Word32)
-> MemoryAllocateInfo es
forall (es :: [*]).
Chain es
-> ("offset" ::: DeviceSize)
-> ("memoryRangeCount" ::: Word32)
-> MemoryAllocateInfo es
MemoryAllocateInfo
             Chain es
next "offset" ::: DeviceSize
allocationSize "memoryRangeCount" ::: Word32
memoryTypeIndex

instance es ~ '[] => Zero (MemoryAllocateInfo es) where
  zero :: MemoryAllocateInfo es
zero = Chain es
-> ("offset" ::: DeviceSize)
-> ("memoryRangeCount" ::: Word32)
-> MemoryAllocateInfo es
forall (es :: [*]).
Chain es
-> ("offset" ::: DeviceSize)
-> ("memoryRangeCount" ::: Word32)
-> MemoryAllocateInfo es
MemoryAllocateInfo
           ()
           "offset" ::: DeviceSize
forall a. Zero a => a
zero
           "memoryRangeCount" ::: Word32
forall a. Zero a => a
zero


-- | VkMappedMemoryRange - Structure specifying a mapped memory range
--
-- == Valid Usage
--
-- -   @memory@ /must/ be currently host mapped
--
-- -   If @size@ is not equal to 'Vulkan.Core10.APIConstants.WHOLE_SIZE',
--     @offset@ and @size@ /must/ specify a range contained within the
--     currently mapped range of @memory@
--
-- -   If @size@ is equal to 'Vulkan.Core10.APIConstants.WHOLE_SIZE',
--     @offset@ /must/ be within the currently mapped range of @memory@
--
-- -   If @size@ is equal to 'Vulkan.Core10.APIConstants.WHOLE_SIZE', the
--     end of the current mapping of @memory@ /must/ be a multiple of
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@nonCoherentAtomSize@
--     bytes from the beginning of the memory object
--
-- -   @offset@ /must/ be a multiple of
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@nonCoherentAtomSize@
--
-- -   If @size@ is not equal to 'Vulkan.Core10.APIConstants.WHOLE_SIZE',
--     @size@ /must/ either be a multiple of
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@nonCoherentAtomSize@,
--     or @offset@ plus @size@ /must/ equal the size of @memory@
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MAPPED_MEMORY_RANGE'
--
-- -   @pNext@ /must/ be @NULL@
--
-- -   @memory@ /must/ be a valid 'Vulkan.Core10.Handles.DeviceMemory'
--     handle
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.DeviceMemory',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'flushMappedMemoryRanges', 'invalidateMappedMemoryRanges'
data MappedMemoryRange = MappedMemoryRange
  { -- | @memory@ is the memory object to which this range belongs.
    MappedMemoryRange -> DeviceMemory
memory :: DeviceMemory
  , -- | @offset@ is the zero-based byte offset from the beginning of the memory
    -- object.
    MappedMemoryRange -> "offset" ::: DeviceSize
offset :: DeviceSize
  , -- | @size@ is either the size of range, or
    -- 'Vulkan.Core10.APIConstants.WHOLE_SIZE' to affect the range from
    -- @offset@ to the end of the current mapping of the allocation.
    MappedMemoryRange -> "offset" ::: DeviceSize
size :: DeviceSize
  }
  deriving (Typeable, MappedMemoryRange -> MappedMemoryRange -> Bool
(MappedMemoryRange -> MappedMemoryRange -> Bool)
-> (MappedMemoryRange -> MappedMemoryRange -> Bool)
-> Eq MappedMemoryRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MappedMemoryRange -> MappedMemoryRange -> Bool
$c/= :: MappedMemoryRange -> MappedMemoryRange -> Bool
== :: MappedMemoryRange -> MappedMemoryRange -> Bool
$c== :: MappedMemoryRange -> MappedMemoryRange -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MappedMemoryRange)
#endif
deriving instance Show MappedMemoryRange

instance ToCStruct MappedMemoryRange where
  withCStruct :: MappedMemoryRange
-> (("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO b) -> IO b
withCStruct x :: MappedMemoryRange
x f :: ("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO b
f = Int
-> Int
-> (("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO b) -> IO b)
-> (("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pMemoryRanges" ::: Ptr MappedMemoryRange
p -> ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> MappedMemoryRange -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryRanges" ::: Ptr MappedMemoryRange
p MappedMemoryRange
x (("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO b
f "pMemoryRanges" ::: Ptr MappedMemoryRange
p)
  pokeCStruct :: ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> MappedMemoryRange -> IO b -> IO b
pokeCStruct p :: "pMemoryRanges" ::: Ptr MappedMemoryRange
p MappedMemoryRange{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MAPPED_MEMORY_RANGE)
    ("ppData" ::: Ptr ("data" ::: Ptr ()))
-> ("data" ::: Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int -> "ppData" ::: Ptr ("data" ::: Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) ("data" ::: Ptr ()
forall a. Ptr a
nullPtr)
    ("pMemory" ::: Ptr DeviceMemory) -> DeviceMemory -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int -> "pMemory" ::: Ptr DeviceMemory
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceMemory)) (DeviceMemory
memory)
    ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> ("offset" ::: DeviceSize) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int
-> "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize)) ("offset" ::: DeviceSize
offset)
    ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> ("offset" ::: DeviceSize) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int
-> "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr DeviceSize)) ("offset" ::: DeviceSize
size)
    IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO b -> IO b
pokeZeroCStruct p :: "pMemoryRanges" ::: Ptr MappedMemoryRange
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MAPPED_MEMORY_RANGE)
    ("ppData" ::: Ptr ("data" ::: Ptr ()))
-> ("data" ::: Ptr ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int -> "ppData" ::: Ptr ("data" ::: Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) ("data" ::: Ptr ()
forall a. Ptr a
nullPtr)
    ("pMemory" ::: Ptr DeviceMemory) -> DeviceMemory -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int -> "pMemory" ::: Ptr DeviceMemory
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceMemory)) (DeviceMemory
forall a. Zero a => a
zero)
    ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> ("offset" ::: DeviceSize) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int
-> "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize)) ("offset" ::: DeviceSize
forall a. Zero a => a
zero)
    ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> ("offset" ::: DeviceSize) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int
-> "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr DeviceSize)) ("offset" ::: DeviceSize
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct MappedMemoryRange where
  peekCStruct :: ("pMemoryRanges" ::: Ptr MappedMemoryRange) -> IO MappedMemoryRange
peekCStruct p :: "pMemoryRanges" ::: Ptr MappedMemoryRange
p = do
    DeviceMemory
memory <- ("pMemory" ::: Ptr DeviceMemory) -> IO DeviceMemory
forall a. Storable a => Ptr a -> IO a
peek @DeviceMemory (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int -> "pMemory" ::: Ptr DeviceMemory
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceMemory))
    "offset" ::: DeviceSize
offset <- ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> IO ("offset" ::: DeviceSize)
forall a. Storable a => Ptr a -> IO a
peek @DeviceSize (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int
-> "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize))
    "offset" ::: DeviceSize
size <- ("pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize))
-> IO ("offset" ::: DeviceSize)
forall a. Storable a => Ptr a -> IO a
peek @DeviceSize (("pMemoryRanges" ::: Ptr MappedMemoryRange
p ("pMemoryRanges" ::: Ptr MappedMemoryRange)
-> Int
-> "pCommittedMemoryInBytes" ::: Ptr ("offset" ::: DeviceSize)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr DeviceSize))
    MappedMemoryRange -> IO MappedMemoryRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MappedMemoryRange -> IO MappedMemoryRange)
-> MappedMemoryRange -> IO MappedMemoryRange
forall a b. (a -> b) -> a -> b
$ DeviceMemory
-> ("offset" ::: DeviceSize)
-> ("offset" ::: DeviceSize)
-> MappedMemoryRange
MappedMemoryRange
             DeviceMemory
memory "offset" ::: DeviceSize
offset "offset" ::: DeviceSize
size

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

instance Zero MappedMemoryRange where
  zero :: MappedMemoryRange
zero = DeviceMemory
-> ("offset" ::: DeviceSize)
-> ("offset" ::: DeviceSize)
-> MappedMemoryRange
MappedMemoryRange
           DeviceMemory
forall a. Zero a => a
zero
           "offset" ::: DeviceSize
forall a. Zero a => a
zero
           "offset" ::: DeviceSize
forall a. Zero a => a
zero