{-# language CPP #-}
-- | = Name
--
-- VK_EXT_external_memory_host - device extension
--
-- == VK_EXT_external_memory_host
--
-- [__Name String__]
--     @VK_EXT_external_memory_host@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     179
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Not ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory VK_KHR_external_memory>
--     or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#versions-1.1 Version 1.1>
--
-- [__Contact__]
--
--     -   Daniel Rakos
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_external_memory_host] @drakos-amd%0A*Here describe the issue or question you have about the VK_EXT_external_memory_host extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2017-11-10
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Jaakko Konttinen, AMD
--
--     -   David Mao, AMD
--
--     -   Daniel Rakos, AMD
--
--     -   Tobias Hector, Imagination Technologies
--
--     -   Faith Ekstrand, Intel
--
--     -   James Jones, NVIDIA
--
-- == Description
--
-- This extension enables an application to import host allocations and
-- host mapped foreign device memory to Vulkan memory objects.
--
-- == New Commands
--
-- -   'getMemoryHostPointerPropertiesEXT'
--
-- == New Structures
--
-- -   'MemoryHostPointerPropertiesEXT'
--
-- -   Extending 'Vulkan.Core10.Memory.MemoryAllocateInfo':
--
--     -   'ImportMemoryHostPointerInfoEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceExternalMemoryHostPropertiesEXT'
--
-- == New Enum Constants
--
-- -   'EXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME'
--
-- -   'EXT_EXTERNAL_MEMORY_HOST_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits':
--
--     -   'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT'
--
--     -   'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_MAPPED_FOREIGN_MEMORY_BIT_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMPORT_MEMORY_HOST_POINTER_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_HOST_POINTER_PROPERTIES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_MEMORY_HOST_PROPERTIES_EXT'
--
-- == Issues
--
-- 1) What memory type has to be used to import host pointers?
--
-- __RESOLVED__: Depends on the implementation. Applications have to use
-- the new 'getMemoryHostPointerPropertiesEXT' command to query the
-- supported memory types for a particular host pointer. The reported
-- memory types may include memory types that come from a memory heap that
-- is otherwise not usable for regular memory object allocation and thus
-- such a heap’s size may be zero.
--
-- 2) Can the application still access the contents of the host allocation
-- after importing?
--
-- __RESOLVED__: Yes. However, usual synchronization requirements apply.
--
-- 3) Can the application free the host allocation?
--
-- __RESOLVED__: No, it violates valid usage conditions. Using the memory
-- object imported from a host allocation that is already freed thus
-- results in undefined behavior.
--
-- 4) Is 'Vulkan.Core10.Memory.mapMemory' expected to return the same host
-- address which was specified when importing it to the memory object?
--
-- __RESOLVED__: No. Implementations are allowed to return the same address
-- but it is not required. Some implementations might return a different
-- virtual mapping of the allocation, although the same physical pages will
-- be used.
--
-- 5) Is there any limitation on the alignment of the host pointer and\/or
-- size?
--
-- __RESOLVED__: Yes. Both the address and the size have to be an integer
-- multiple of @minImportedHostPointerAlignment@. In addition, some
-- platforms and foreign devices may have additional restrictions.
--
-- 6) Can the same host allocation be imported multiple times into a given
-- physical device?
--
-- __RESOLVED__: No, at least not guaranteed by this extension. Some
-- platforms do not allow locking the same physical pages for device access
-- multiple times, so attempting to do it may result in undefined behavior.
--
-- 7) Does this extension support exporting the new handle type?
--
-- __RESOLVED__: No.
--
-- 8) Should we include the possibility to import host mapped foreign
-- device memory using this API?
--
-- __RESOLVED__: Yes, through a separate handle type. Implementations are
-- still allowed to support only one of the handle types introduced by this
-- extension by not returning import support for a particular handle type
-- as returned in
-- 'Vulkan.Extensions.VK_KHR_external_memory_capabilities.ExternalMemoryPropertiesKHR'.
--
-- == Version History
--
-- -   Revision 1, 2017-11-10 (Daniel Rakos)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'ImportMemoryHostPointerInfoEXT', 'MemoryHostPointerPropertiesEXT',
-- 'PhysicalDeviceExternalMemoryHostPropertiesEXT',
-- 'getMemoryHostPointerPropertiesEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_external_memory_host Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_EXT_external_memory_host  ( getMemoryHostPointerPropertiesEXT
                                                      , ImportMemoryHostPointerInfoEXT(..)
                                                      , MemoryHostPointerPropertiesEXT(..)
                                                      , PhysicalDeviceExternalMemoryHostPropertiesEXT(..)
                                                      , EXT_EXTERNAL_MEMORY_HOST_SPEC_VERSION
                                                      , pattern EXT_EXTERNAL_MEMORY_HOST_SPEC_VERSION
                                                      , EXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME
                                                      , pattern EXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME
                                                      ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.Base (when)
import GHC.IO (throwIO)
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 Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.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 Vulkan.NamedType ((:::))
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetMemoryHostPointerPropertiesEXT))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits (ExternalMemoryHandleTypeFlagBits)
import Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits (ExternalMemoryHandleTypeFlagBits(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMPORT_MEMORY_HOST_POINTER_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_HOST_POINTER_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_MEMORY_HOST_PROPERTIES_EXT))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetMemoryHostPointerPropertiesEXT
  :: FunPtr (Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> Ptr () -> Ptr MemoryHostPointerPropertiesEXT -> IO Result) -> Ptr Device_T -> ExternalMemoryHandleTypeFlagBits -> Ptr () -> Ptr MemoryHostPointerPropertiesEXT -> IO Result

-- | vkGetMemoryHostPointerPropertiesEXT - Get properties of external memory
-- host pointer
--
-- == Valid Usage
--
-- -   #VUID-vkGetMemoryHostPointerPropertiesEXT-handleType-01752#
--     @handleType@ /must/ be
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT'
--     or
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_MAPPED_FOREIGN_MEMORY_BIT_EXT'
--
-- -   #VUID-vkGetMemoryHostPointerPropertiesEXT-pHostPointer-01753#
--     @pHostPointer@ /must/ be a pointer aligned to an integer multiple of
--     'PhysicalDeviceExternalMemoryHostPropertiesEXT'::@minImportedHostPointerAlignment@
--
-- -   #VUID-vkGetMemoryHostPointerPropertiesEXT-handleType-01754# If
--     @handleType@ is
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT',
--     @pHostPointer@ /must/ be a pointer to host memory
--
-- -   #VUID-vkGetMemoryHostPointerPropertiesEXT-handleType-01755# If
--     @handleType@ is
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_MAPPED_FOREIGN_MEMORY_BIT_EXT',
--     @pHostPointer@ /must/ be a pointer to host mapped foreign memory
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetMemoryHostPointerPropertiesEXT-device-parameter# @device@
--     /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetMemoryHostPointerPropertiesEXT-handleType-parameter#
--     @handleType@ /must/ be a valid
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
--     value
--
-- -   #VUID-vkGetMemoryHostPointerPropertiesEXT-pHostPointer-parameter#
--     @pHostPointer@ /must/ be a pointer value
--
-- -   #VUID-vkGetMemoryHostPointerPropertiesEXT-pMemoryHostPointerProperties-parameter#
--     @pMemoryHostPointerProperties@ /must/ be a valid pointer to a
--     'MemoryHostPointerPropertiesEXT' structure
--
-- == 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_INVALID_EXTERNAL_HANDLE'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_external_memory_host VK_EXT_external_memory_host>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'MemoryHostPointerPropertiesEXT'
getMemoryHostPointerPropertiesEXT :: forall io
                                   . (MonadIO io)
                                  => -- | @device@ is the logical device that will be importing @pHostPointer@.
                                     Device
                                  -> -- | @handleType@ is a
                                     -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
                                     -- value specifying the type of the handle @pHostPointer@.
                                     ExternalMemoryHandleTypeFlagBits
                                  -> -- | @pHostPointer@ is the host pointer to import from.
                                     ("hostPointer" ::: Ptr ())
                                  -> io (MemoryHostPointerPropertiesEXT)
getMemoryHostPointerPropertiesEXT :: forall (io :: * -> *).
MonadIO io =>
Device
-> ExternalMemoryHandleTypeFlagBits
-> ("hostPointer" ::: Ptr ())
-> io MemoryHostPointerPropertiesEXT
getMemoryHostPointerPropertiesEXT Device
device
                                    ExternalMemoryHandleTypeFlagBits
handleType
                                    "hostPointer" ::: Ptr ()
hostPointer = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetMemoryHostPointerPropertiesEXTPtr :: FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("hostPointer" ::: Ptr ())
   -> ("pMemoryHostPointerProperties"
       ::: Ptr MemoryHostPointerPropertiesEXT)
   -> IO Result)
vkGetMemoryHostPointerPropertiesEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ExternalMemoryHandleTypeFlagBits
      -> ("hostPointer" ::: Ptr ())
      -> ("pMemoryHostPointerProperties"
          ::: Ptr MemoryHostPointerPropertiesEXT)
      -> IO Result)
pVkGetMemoryHostPointerPropertiesEXT (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("hostPointer" ::: Ptr ())
   -> ("pMemoryHostPointerProperties"
       ::: Ptr MemoryHostPointerPropertiesEXT)
   -> IO Result)
vkGetMemoryHostPointerPropertiesEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetMemoryHostPointerPropertiesEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetMemoryHostPointerPropertiesEXT' :: Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("hostPointer" ::: Ptr ())
-> ("pMemoryHostPointerProperties"
    ::: Ptr MemoryHostPointerPropertiesEXT)
-> IO Result
vkGetMemoryHostPointerPropertiesEXT' = FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("hostPointer" ::: Ptr ())
   -> ("pMemoryHostPointerProperties"
       ::: Ptr MemoryHostPointerPropertiesEXT)
   -> IO Result)
-> Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("hostPointer" ::: Ptr ())
-> ("pMemoryHostPointerProperties"
    ::: Ptr MemoryHostPointerPropertiesEXT)
-> IO Result
mkVkGetMemoryHostPointerPropertiesEXT FunPtr
  (Ptr Device_T
   -> ExternalMemoryHandleTypeFlagBits
   -> ("hostPointer" ::: Ptr ())
   -> ("pMemoryHostPointerProperties"
       ::: Ptr MemoryHostPointerPropertiesEXT)
   -> IO Result)
vkGetMemoryHostPointerPropertiesEXTPtr
  "pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
pPMemoryHostPointerProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @MemoryHostPointerPropertiesEXT)
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetMemoryHostPointerPropertiesEXT" (Ptr Device_T
-> ExternalMemoryHandleTypeFlagBits
-> ("hostPointer" ::: Ptr ())
-> ("pMemoryHostPointerProperties"
    ::: Ptr MemoryHostPointerPropertiesEXT)
-> IO Result
vkGetMemoryHostPointerPropertiesEXT'
                                                                        (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                        (ExternalMemoryHandleTypeFlagBits
handleType)
                                                                        ("hostPointer" ::: Ptr ()
hostPointer)
                                                                        ("pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
pPMemoryHostPointerProperties))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  MemoryHostPointerPropertiesEXT
pMemoryHostPointerProperties <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryHostPointerPropertiesEXT "pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
pPMemoryHostPointerProperties
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (MemoryHostPointerPropertiesEXT
pMemoryHostPointerProperties)


-- | VkImportMemoryHostPointerInfoEXT - Import memory from a host pointer
--
-- = Description
--
-- Importing memory from a host pointer shares ownership of the memory
-- between the host and the Vulkan implementation. The application /can/
-- continue to access the memory through the host pointer but it is the
-- application’s responsibility to synchronize device and non-device access
-- to the payload as defined in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#memory-device-hostaccess Host Access to Device Memory Objects>.
--
-- Applications /can/ import the same payload into multiple instances of
-- Vulkan and multiple times into a given Vulkan instance. However,
-- implementations /may/ fail to import the same payload multiple times
-- into a given physical device due to platform constraints.
--
-- Importing memory from a particular host pointer /may/ not be possible
-- due to additional platform-specific restrictions beyond the scope of
-- this specification in which case the implementation /must/ fail the
-- memory import operation with the error code
-- 'Vulkan.Extensions.VK_KHR_external_memory.ERROR_INVALID_EXTERNAL_HANDLE_KHR'.
--
-- Whether device memory objects imported from a host pointer hold a
-- reference to their payload is undefined. As such, the application /must/
-- ensure that the imported memory range remains valid and accessible for
-- the lifetime of the imported memory object.
--
-- == Valid Usage
--
-- -   #VUID-VkImportMemoryHostPointerInfoEXT-handleType-01747# If
--     @handleType@ is not @0@, it /must/ be supported for import, as
--     reported in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalMemoryProperties'
--
-- -   #VUID-VkImportMemoryHostPointerInfoEXT-handleType-01748# If
--     @handleType@ is not @0@, it /must/ be
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT'
--     or
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_MAPPED_FOREIGN_MEMORY_BIT_EXT'
--
-- -   #VUID-VkImportMemoryHostPointerInfoEXT-pHostPointer-01749#
--     @pHostPointer@ /must/ be a pointer aligned to an integer multiple of
--     'PhysicalDeviceExternalMemoryHostPropertiesEXT'::@minImportedHostPointerAlignment@
--
-- -   #VUID-VkImportMemoryHostPointerInfoEXT-handleType-01750# If
--     @handleType@ is
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT',
--     @pHostPointer@ /must/ be a pointer to @allocationSize@ number of
--     bytes of host memory, where @allocationSize@ is the member of the
--     'Vulkan.Core10.Memory.MemoryAllocateInfo' structure this structure
--     is chained to
--
-- -   #VUID-VkImportMemoryHostPointerInfoEXT-handleType-01751# If
--     @handleType@ is
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_HOST_MAPPED_FOREIGN_MEMORY_BIT_EXT',
--     @pHostPointer@ /must/ be a pointer to @allocationSize@ number of
--     bytes of host mapped foreign memory, where @allocationSize@ is the
--     member of the 'Vulkan.Core10.Memory.MemoryAllocateInfo' structure
--     this structure is chained to
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImportMemoryHostPointerInfoEXT-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMPORT_MEMORY_HOST_POINTER_INFO_EXT'
--
-- -   #VUID-VkImportMemoryHostPointerInfoEXT-handleType-parameter#
--     @handleType@ /must/ be a valid
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
--     value
--
-- -   #VUID-VkImportMemoryHostPointerInfoEXT-pHostPointer-parameter#
--     @pHostPointer@ /must/ be a pointer value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_external_memory_host VK_EXT_external_memory_host>,
-- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImportMemoryHostPointerInfoEXT = ImportMemoryHostPointerInfoEXT
  { -- | @handleType@ is a
    -- 'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.ExternalMemoryHandleTypeFlagBits'
    -- value specifying the handle type.
    ImportMemoryHostPointerInfoEXT -> ExternalMemoryHandleTypeFlagBits
handleType :: ExternalMemoryHandleTypeFlagBits
  , -- | @pHostPointer@ is the host pointer to import from.
    ImportMemoryHostPointerInfoEXT -> "hostPointer" ::: Ptr ()
hostPointer :: Ptr ()
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImportMemoryHostPointerInfoEXT)
#endif
deriving instance Show ImportMemoryHostPointerInfoEXT

instance ToCStruct ImportMemoryHostPointerInfoEXT where
  withCStruct :: forall b.
ImportMemoryHostPointerInfoEXT
-> (Ptr ImportMemoryHostPointerInfoEXT -> IO b) -> IO b
withCStruct ImportMemoryHostPointerInfoEXT
x Ptr ImportMemoryHostPointerInfoEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr ImportMemoryHostPointerInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImportMemoryHostPointerInfoEXT
p ImportMemoryHostPointerInfoEXT
x (Ptr ImportMemoryHostPointerInfoEXT -> IO b
f Ptr ImportMemoryHostPointerInfoEXT
p)
  pokeCStruct :: forall b.
Ptr ImportMemoryHostPointerInfoEXT
-> ImportMemoryHostPointerInfoEXT -> IO b -> IO b
pokeCStruct Ptr ImportMemoryHostPointerInfoEXT
p ImportMemoryHostPointerInfoEXT{"hostPointer" ::: Ptr ()
ExternalMemoryHandleTypeFlagBits
hostPointer :: "hostPointer" ::: Ptr ()
handleType :: ExternalMemoryHandleTypeFlagBits
$sel:hostPointer:ImportMemoryHostPointerInfoEXT :: ImportMemoryHostPointerInfoEXT -> "hostPointer" ::: Ptr ()
$sel:handleType:ImportMemoryHostPointerInfoEXT :: ImportMemoryHostPointerInfoEXT -> ExternalMemoryHandleTypeFlagBits
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_HOST_POINTER_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits)) (ExternalMemoryHandleTypeFlagBits
handleType)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ()))) ("hostPointer" ::: Ptr ()
hostPointer)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr ImportMemoryHostPointerInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr ImportMemoryHostPointerInfoEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMPORT_MEMORY_HOST_POINTER_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ()))) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ImportMemoryHostPointerInfoEXT where
  peekCStruct :: Ptr ImportMemoryHostPointerInfoEXT
-> IO ImportMemoryHostPointerInfoEXT
peekCStruct Ptr ImportMemoryHostPointerInfoEXT
p = do
    ExternalMemoryHandleTypeFlagBits
handleType <- forall a. Storable a => Ptr a -> IO a
peek @ExternalMemoryHandleTypeFlagBits ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ExternalMemoryHandleTypeFlagBits))
    "hostPointer" ::: Ptr ()
pHostPointer <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr ImportMemoryHostPointerInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ())))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ExternalMemoryHandleTypeFlagBits
-> ("hostPointer" ::: Ptr ()) -> ImportMemoryHostPointerInfoEXT
ImportMemoryHostPointerInfoEXT
             ExternalMemoryHandleTypeFlagBits
handleType "hostPointer" ::: Ptr ()
pHostPointer

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

instance Zero ImportMemoryHostPointerInfoEXT where
  zero :: ImportMemoryHostPointerInfoEXT
zero = ExternalMemoryHandleTypeFlagBits
-> ("hostPointer" ::: Ptr ()) -> ImportMemoryHostPointerInfoEXT
ImportMemoryHostPointerInfoEXT
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkMemoryHostPointerPropertiesEXT - Properties of external memory host
-- pointer
--
-- = Description
--
-- The value returned by @memoryTypeBits@ /must/ only include bits that
-- identify memory types which are host visible.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_external_memory_host VK_EXT_external_memory_host>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getMemoryHostPointerPropertiesEXT'
data MemoryHostPointerPropertiesEXT = MemoryHostPointerPropertiesEXT
  { -- | @memoryTypeBits@ is a bitmask containing one bit set for every memory
    -- type which the specified host pointer /can/ be imported as.
    MemoryHostPointerPropertiesEXT -> Word32
memoryTypeBits :: Word32 }
  deriving (Typeable, MemoryHostPointerPropertiesEXT
-> MemoryHostPointerPropertiesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryHostPointerPropertiesEXT
-> MemoryHostPointerPropertiesEXT -> Bool
$c/= :: MemoryHostPointerPropertiesEXT
-> MemoryHostPointerPropertiesEXT -> Bool
== :: MemoryHostPointerPropertiesEXT
-> MemoryHostPointerPropertiesEXT -> Bool
$c== :: MemoryHostPointerPropertiesEXT
-> MemoryHostPointerPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryHostPointerPropertiesEXT)
#endif
deriving instance Show MemoryHostPointerPropertiesEXT

instance ToCStruct MemoryHostPointerPropertiesEXT where
  withCStruct :: forall b.
MemoryHostPointerPropertiesEXT
-> (("pMemoryHostPointerProperties"
     ::: Ptr MemoryHostPointerPropertiesEXT)
    -> IO b)
-> IO b
withCStruct MemoryHostPointerPropertiesEXT
x ("pMemoryHostPointerProperties"
 ::: Ptr MemoryHostPointerPropertiesEXT)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p MemoryHostPointerPropertiesEXT
x (("pMemoryHostPointerProperties"
 ::: Ptr MemoryHostPointerPropertiesEXT)
-> IO b
f "pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p)
  pokeCStruct :: forall b.
("pMemoryHostPointerProperties"
 ::: Ptr MemoryHostPointerPropertiesEXT)
-> MemoryHostPointerPropertiesEXT -> IO b -> IO b
pokeCStruct "pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p MemoryHostPointerPropertiesEXT{Word32
memoryTypeBits :: Word32
$sel:memoryTypeBits:MemoryHostPointerPropertiesEXT :: MemoryHostPointerPropertiesEXT -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_HOST_POINTER_PROPERTIES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
memoryTypeBits)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pMemoryHostPointerProperties"
 ::: Ptr MemoryHostPointerPropertiesEXT)
-> IO b -> IO b
pokeZeroCStruct "pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_HOST_POINTER_PROPERTIES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryHostPointerProperties"
::: Ptr MemoryHostPointerPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

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

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

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


-- | VkPhysicalDeviceExternalMemoryHostPropertiesEXT - Structure describing
-- external memory host pointer limits that can be supported by an
-- implementation
--
-- = Description
--
-- If the 'PhysicalDeviceExternalMemoryHostPropertiesEXT' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2',
-- it is filled in with each corresponding implementation-dependent
-- property.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_external_memory_host VK_EXT_external_memory_host>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceExternalMemoryHostPropertiesEXT = PhysicalDeviceExternalMemoryHostPropertiesEXT
  { -- | #limits-minImportedHostPointerAlignment#
    -- @minImportedHostPointerAlignment@ is the minimum /required/ alignment,
    -- in bytes, for the base address and size of host pointers that /can/ be
    -- imported to a Vulkan memory object. The value /must/ be a power of two.
    PhysicalDeviceExternalMemoryHostPropertiesEXT -> DeviceSize
minImportedHostPointerAlignment :: DeviceSize }
  deriving (Typeable, PhysicalDeviceExternalMemoryHostPropertiesEXT
-> PhysicalDeviceExternalMemoryHostPropertiesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceExternalMemoryHostPropertiesEXT
-> PhysicalDeviceExternalMemoryHostPropertiesEXT -> Bool
$c/= :: PhysicalDeviceExternalMemoryHostPropertiesEXT
-> PhysicalDeviceExternalMemoryHostPropertiesEXT -> Bool
== :: PhysicalDeviceExternalMemoryHostPropertiesEXT
-> PhysicalDeviceExternalMemoryHostPropertiesEXT -> Bool
$c== :: PhysicalDeviceExternalMemoryHostPropertiesEXT
-> PhysicalDeviceExternalMemoryHostPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceExternalMemoryHostPropertiesEXT)
#endif
deriving instance Show PhysicalDeviceExternalMemoryHostPropertiesEXT

instance ToCStruct PhysicalDeviceExternalMemoryHostPropertiesEXT where
  withCStruct :: forall b.
PhysicalDeviceExternalMemoryHostPropertiesEXT
-> (Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT -> IO b)
-> IO b
withCStruct PhysicalDeviceExternalMemoryHostPropertiesEXT
x Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p PhysicalDeviceExternalMemoryHostPropertiesEXT
x (Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT -> IO b
f Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
-> PhysicalDeviceExternalMemoryHostPropertiesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p PhysicalDeviceExternalMemoryHostPropertiesEXT{DeviceSize
minImportedHostPointerAlignment :: DeviceSize
$sel:minImportedHostPointerAlignment:PhysicalDeviceExternalMemoryHostPropertiesEXT :: PhysicalDeviceExternalMemoryHostPropertiesEXT -> DeviceSize
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_MEMORY_HOST_PROPERTIES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (DeviceSize
minImportedHostPointerAlignment)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTERNAL_MEMORY_HOST_PROPERTIES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PhysicalDeviceExternalMemoryHostPropertiesEXT where
  peekCStruct :: Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
-> IO PhysicalDeviceExternalMemoryHostPropertiesEXT
peekCStruct Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p = do
    DeviceSize
minImportedHostPointerAlignment <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceExternalMemoryHostPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceSize -> PhysicalDeviceExternalMemoryHostPropertiesEXT
PhysicalDeviceExternalMemoryHostPropertiesEXT
             DeviceSize
minImportedHostPointerAlignment

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

instance Zero PhysicalDeviceExternalMemoryHostPropertiesEXT where
  zero :: PhysicalDeviceExternalMemoryHostPropertiesEXT
zero = DeviceSize -> PhysicalDeviceExternalMemoryHostPropertiesEXT
PhysicalDeviceExternalMemoryHostPropertiesEXT
           forall a. Zero a => a
zero


type EXT_EXTERNAL_MEMORY_HOST_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_EXTERNAL_MEMORY_HOST_SPEC_VERSION"
pattern EXT_EXTERNAL_MEMORY_HOST_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_EXTERNAL_MEMORY_HOST_SPEC_VERSION :: forall a. Integral a => a
$mEXT_EXTERNAL_MEMORY_HOST_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_EXTERNAL_MEMORY_HOST_SPEC_VERSION = 1


type EXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME = "VK_EXT_external_memory_host"

-- No documentation found for TopLevel "VK_EXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME"
pattern EXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME = "VK_EXT_external_memory_host"