{-# language CPP #-}
-- No documentation found for Chapter "Device"
module Vulkan.Core10.Device  ( createDevice
                             , withDevice
                             , destroyDevice
                             , DeviceQueueCreateInfo(..)
                             , DeviceCreateInfo(..)
                             , Device(..)
                             , DeviceCreateFlags(..)
                             , DeviceQueueCreateFlagBits(..)
                             , DeviceQueueCreateFlags
                             ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (maybePeek)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Data.ByteString (useAsCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import 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.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(..))
import Foreign.C.Types (CFloat(CFloat))
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
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.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.Dynamic (initDeviceCmds)
import Vulkan.CStruct.Extends (peekSomeCStruct)
import Vulkan.CStruct.Extends (pokeSomeCStruct)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyDevice))
import Vulkan.Core10.Enums.DeviceCreateFlags (DeviceCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_device_memory_report (DeviceDeviceMemoryReportCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_device_diagnostics_config (DeviceDiagnosticsConfigCreateInfoNV)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_device_group_creation (DeviceGroupDeviceCreateInfo)
import {-# SOURCE #-} Vulkan.Extensions.VK_AMD_memory_overallocation_behavior (DeviceMemoryOverallocationCreateInfoAMD)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_private_data (DevicePrivateDataCreateInfoEXT)
import Vulkan.Core10.Enums.DeviceQueueCreateFlagBits (DeviceQueueCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_global_priority (DeviceQueueGlobalPriorityCreateInfoEXT)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Dynamic (InstanceCmds(pVkCreateDevice))
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_16bit_storage (PhysicalDevice16BitStorageFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_4444_formats (PhysicalDevice4444FormatsFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_8bit_storage (PhysicalDevice8BitStorageFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_astc_decode_mode (PhysicalDeviceASTCDecodeFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_acceleration_structure (PhysicalDeviceAccelerationStructureFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_blend_operation_advanced (PhysicalDeviceBlendOperationAdvancedFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address (PhysicalDeviceBufferDeviceAddressFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_buffer_device_address (PhysicalDeviceBufferDeviceAddressFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_AMD_device_coherent_memory (PhysicalDeviceCoherentMemoryFeaturesAMD)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_color_write_enable (PhysicalDeviceColorWriteEnableFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_compute_shader_derivatives (PhysicalDeviceComputeShaderDerivativesFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_conditional_rendering (PhysicalDeviceConditionalRenderingFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_cooperative_matrix (PhysicalDeviceCooperativeMatrixFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_corner_sampled_image (PhysicalDeviceCornerSampledImageFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_coverage_reduction_mode (PhysicalDeviceCoverageReductionModeFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_custom_border_color (PhysicalDeviceCustomBorderColorFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_dedicated_allocation_image_aliasing (PhysicalDeviceDedicatedAllocationImageAliasingFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_depth_clip_enable (PhysicalDeviceDepthClipEnableFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_EXT_descriptor_indexing (PhysicalDeviceDescriptorIndexingFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_device_generated_commands (PhysicalDeviceDeviceGeneratedCommandsFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_device_memory_report (PhysicalDeviceDeviceMemoryReportFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_device_diagnostics_config (PhysicalDeviceDiagnosticsConfigFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_scissor_exclusive (PhysicalDeviceExclusiveScissorFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_extended_dynamic_state2 (PhysicalDeviceExtendedDynamicState2FeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_extended_dynamic_state (PhysicalDeviceExtendedDynamicStateFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_external_memory_rdma (PhysicalDeviceExternalMemoryRDMAFeaturesNV)
import Vulkan.Core10.DeviceInitialization (PhysicalDeviceFeatures)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2 (PhysicalDeviceFeatures2)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_fragment_density_map2 (PhysicalDeviceFragmentDensityMap2FeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_fragment_density_map (PhysicalDeviceFragmentDensityMapFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_fragment_shader_barycentric (PhysicalDeviceFragmentShaderBarycentricFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_fragment_shader_interlock (PhysicalDeviceFragmentShaderInterlockFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_fragment_shading_rate_enums (PhysicalDeviceFragmentShadingRateEnumsFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_fragment_shading_rate (PhysicalDeviceFragmentShadingRateFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_global_priority_query (PhysicalDeviceGlobalPriorityQueryFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_EXT_host_query_reset (PhysicalDeviceHostQueryResetFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_image_robustness (PhysicalDeviceImageRobustnessFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_imageless_framebuffer (PhysicalDeviceImagelessFramebufferFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_index_type_uint8 (PhysicalDeviceIndexTypeUint8FeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_inherited_viewport_scissor (PhysicalDeviceInheritedViewportScissorFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_inline_uniform_block (PhysicalDeviceInlineUniformBlockFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_HUAWEI_invocation_mask (PhysicalDeviceInvocationMaskFeaturesHUAWEI)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_line_rasterization (PhysicalDeviceLineRasterizationFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_memory_priority (PhysicalDeviceMemoryPriorityFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_mesh_shader (PhysicalDeviceMeshShaderFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_multi_draw (PhysicalDeviceMultiDrawFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_multiview (PhysicalDeviceMultiviewFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_VALVE_mutable_descriptor_type (PhysicalDeviceMutableDescriptorTypeFeaturesVALVE)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_performance_query (PhysicalDevicePerformanceQueryFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_pipeline_creation_cache_control (PhysicalDevicePipelineCreationCacheControlFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_pipeline_executable_properties (PhysicalDevicePipelineExecutablePropertiesFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_portability_subset (PhysicalDevicePortabilitySubsetFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_present_id (PhysicalDevicePresentIdFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_present_wait (PhysicalDevicePresentWaitFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_private_data (PhysicalDevicePrivateDataFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core11.Originally_Based_On_VK_KHR_protected_memory (PhysicalDeviceProtectedMemoryFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_provoking_vertex (PhysicalDeviceProvokingVertexFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_ray_query (PhysicalDeviceRayQueryFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_ray_tracing_motion_blur (PhysicalDeviceRayTracingMotionBlurFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_ray_tracing_pipeline (PhysicalDeviceRayTracingPipelineFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_representative_fragment_test (PhysicalDeviceRepresentativeFragmentTestFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_robustness2 (PhysicalDeviceRobustness2FeaturesEXT)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion (PhysicalDeviceSamplerYcbcrConversionFeatures)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_EXT_scalar_block_layout (PhysicalDeviceScalarBlockLayoutFeatures)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts (PhysicalDeviceSeparateDepthStencilLayoutsFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_shader_atomic_float2 (PhysicalDeviceShaderAtomicFloat2FeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_shader_atomic_float (PhysicalDeviceShaderAtomicFloatFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_shader_atomic_int64 (PhysicalDeviceShaderAtomicInt64Features)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_shader_clock (PhysicalDeviceShaderClockFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_shader_demote_to_helper_invocation (PhysicalDeviceShaderDemoteToHelperInvocationFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_shader_draw_parameters (PhysicalDeviceShaderDrawParametersFeatures)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_shader_float16_int8 (PhysicalDeviceShaderFloat16Int8Features)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_shader_image_atomic_int64 (PhysicalDeviceShaderImageAtomicInt64FeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_shader_image_footprint (PhysicalDeviceShaderImageFootprintFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_INTEL_shader_integer_functions2 (PhysicalDeviceShaderIntegerFunctions2FeaturesINTEL)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_shader_sm_builtins (PhysicalDeviceShaderSMBuiltinsFeaturesNV)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_shader_subgroup_extended_types (PhysicalDeviceShaderSubgroupExtendedTypesFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_shader_subgroup_uniform_control_flow (PhysicalDeviceShaderSubgroupUniformControlFlowFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_shader_terminate_invocation (PhysicalDeviceShaderTerminateInvocationFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_shading_rate_image (PhysicalDeviceShadingRateImageFeaturesNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_subgroup_size_control (PhysicalDeviceSubgroupSizeControlFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_synchronization2 (PhysicalDeviceSynchronization2FeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_texel_buffer_alignment (PhysicalDeviceTexelBufferAlignmentFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_texture_compression_astc_hdr (PhysicalDeviceTextureCompressionASTCHDRFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore (PhysicalDeviceTimelineSemaphoreFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_transform_feedback (PhysicalDeviceTransformFeedbackFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_uniform_buffer_standard_layout (PhysicalDeviceUniformBufferStandardLayoutFeatures)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_variable_pointers (PhysicalDeviceVariablePointersFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_vertex_attribute_divisor (PhysicalDeviceVertexAttributeDivisorFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_vertex_input_dynamic_state (PhysicalDeviceVertexInputDynamicStateFeaturesEXT)
import {-# SOURCE #-} Vulkan.Core12 (PhysicalDeviceVulkan11Features)
import {-# SOURCE #-} Vulkan.Core12 (PhysicalDeviceVulkan12Features)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_vulkan_memory_model (PhysicalDeviceVulkanMemoryModelFeatures)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_workgroup_memory_explicit_layout (PhysicalDeviceWorkgroupMemoryExplicitLayoutFeaturesKHR)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_ycbcr_2plane_444_formats (PhysicalDeviceYcbcr2Plane444FormatsFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_ycbcr_image_arrays (PhysicalDeviceYcbcrImageArraysFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_zero_initialize_workgroup_memory (PhysicalDeviceZeroInitializeWorkgroupMemoryFeaturesKHR)
import Vulkan.Core10.Handles (PhysicalDevice_T)
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.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_QUEUE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Enums.DeviceCreateFlags (DeviceCreateFlags(..))
import Vulkan.Core10.Enums.DeviceQueueCreateFlagBits (DeviceQueueCreateFlagBits(..))
import Vulkan.Core10.Enums.DeviceQueueCreateFlagBits (DeviceQueueCreateFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateDevice
  :: FunPtr (Ptr PhysicalDevice_T -> Ptr (SomeStruct DeviceCreateInfo) -> Ptr AllocationCallbacks -> Ptr (Ptr Device_T) -> IO Result) -> Ptr PhysicalDevice_T -> Ptr (SomeStruct DeviceCreateInfo) -> Ptr AllocationCallbacks -> Ptr (Ptr Device_T) -> IO Result

-- | vkCreateDevice - Create a new device instance
--
-- = Description
--
-- 'createDevice' verifies that extensions and features requested in the
-- @ppEnabledExtensionNames@ and @pEnabledFeatures@ members of
-- @pCreateInfo@, respectively, are supported by the implementation. If any
-- requested extension is not supported, 'createDevice' /must/ return
-- 'Vulkan.Core10.Enums.Result.ERROR_EXTENSION_NOT_PRESENT'. If any
-- requested feature is not supported, 'createDevice' /must/ return
-- 'Vulkan.Core10.Enums.Result.ERROR_FEATURE_NOT_PRESENT'. Support for
-- extensions /can/ be checked before creating a device by querying
-- 'Vulkan.Core10.ExtensionDiscovery.enumerateDeviceExtensionProperties'.
-- Support for features /can/ similarly be checked by querying
-- 'Vulkan.Core10.DeviceInitialization.getPhysicalDeviceFeatures'.
--
-- After verifying and enabling the extensions the
-- 'Vulkan.Core10.Handles.Device' object is created and returned to the
-- application.
--
-- Multiple logical devices /can/ be created from the same physical device.
-- Logical device creation /may/ fail due to lack of device-specific
-- resources (in addition to other errors). If that occurs, 'createDevice'
-- will return 'Vulkan.Core10.Enums.Result.ERROR_TOO_MANY_OBJECTS'.
--
-- == Valid Usage
--
-- -   #VUID-vkCreateDevice-ppEnabledExtensionNames-01387# All
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-extensions-extensiondependencies required device extensions>
--     for each extension in the
--     'DeviceCreateInfo'::@ppEnabledExtensionNames@ list /must/ also be
--     present in that list
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateDevice-physicalDevice-parameter# @physicalDevice@
--     /must/ be a valid 'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkCreateDevice-pCreateInfo-parameter# @pCreateInfo@ /must/ be
--     a valid pointer to a valid 'DeviceCreateInfo' structure
--
-- -   #VUID-vkCreateDevice-pAllocator-parameter# If @pAllocator@ is not
--     @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateDevice-pDevice-parameter# @pDevice@ /must/ be a valid
--     pointer to a 'Vulkan.Core10.Handles.Device' 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_INITIALIZATION_FAILED'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_EXTENSION_NOT_PRESENT'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_FEATURE_NOT_PRESENT'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_TOO_MANY_OBJECTS'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_DEVICE_LOST'
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'DeviceCreateInfo',
-- 'Vulkan.Core10.Handles.PhysicalDevice'
createDevice :: forall a io
              . (Extendss DeviceCreateInfo a, PokeChain a, MonadIO io)
             => -- | @physicalDevice@ /must/ be one of the device handles returned from a
                -- call to 'Vulkan.Core10.DeviceInitialization.enumeratePhysicalDevices'
                -- (see
                -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#devsandqueues-physical-device-enumeration Physical Device Enumeration>).
                PhysicalDevice
             -> -- | @pCreateInfo@ is a pointer to a 'DeviceCreateInfo' structure containing
                -- information about how to create the device.
                (DeviceCreateInfo 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 (Device)
createDevice :: PhysicalDevice
-> DeviceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Device
createDevice PhysicalDevice
physicalDevice DeviceCreateInfo a
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = IO Device -> io Device
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> io Device)
-> (ContT Device IO Device -> IO Device)
-> ContT Device IO Device
-> io Device
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Device IO Device -> IO Device
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Device IO Device -> io Device)
-> ContT Device IO Device -> io Device
forall a b. (a -> b) -> a -> b
$ do
  let cmds :: InstanceCmds
cmds = PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice)
  let vkCreateDevicePtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pDevice" ::: Ptr (Ptr Device_T))
   -> IO Result)
vkCreateDevicePtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pDevice" ::: Ptr (Ptr Device_T))
      -> IO Result)
pVkCreateDevice InstanceCmds
cmds
  IO () -> ContT Device IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Device IO ()) -> IO () -> ContT Device IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pDevice" ::: Ptr (Ptr Device_T))
   -> IO Result)
vkCreateDevicePtr FunPtr
  (Ptr PhysicalDevice_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pDevice" ::: Ptr (Ptr Device_T))
   -> IO Result)
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pDevice" ::: Ptr (Ptr Device_T))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pDevice" ::: Ptr (Ptr Device_T))
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateDevice is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateDevice' :: Ptr PhysicalDevice_T
-> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDevice" ::: Ptr (Ptr Device_T))
-> IO Result
vkCreateDevice' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pDevice" ::: Ptr (Ptr Device_T))
   -> IO Result)
-> Ptr PhysicalDevice_T
-> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDevice" ::: Ptr (Ptr Device_T))
-> IO Result
mkVkCreateDevice FunPtr
  (Ptr PhysicalDevice_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pDevice" ::: Ptr (Ptr Device_T))
   -> IO Result)
vkCreateDevicePtr
  Ptr (DeviceCreateInfo a)
pCreateInfo <- ((Ptr (DeviceCreateInfo a) -> IO Device) -> IO Device)
-> ContT Device IO (Ptr (DeviceCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (DeviceCreateInfo a) -> IO Device) -> IO Device)
 -> ContT Device IO (Ptr (DeviceCreateInfo a)))
-> ((Ptr (DeviceCreateInfo a) -> IO Device) -> IO Device)
-> ContT Device IO (Ptr (DeviceCreateInfo a))
forall a b. (a -> b) -> a -> b
$ DeviceCreateInfo a
-> (Ptr (DeviceCreateInfo a) -> IO Device) -> IO Device
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (DeviceCreateInfo a
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT Device IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Device)
 -> IO Device)
-> ContT Device 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 Device)
  -> IO Device)
 -> ContT Device IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Device)
    -> IO Device)
-> ContT Device IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO Device)
-> IO Device
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pDevice" ::: Ptr (Ptr Device_T)
pPDevice <- ((("pDevice" ::: Ptr (Ptr Device_T)) -> IO Device) -> IO Device)
-> ContT Device IO ("pDevice" ::: Ptr (Ptr Device_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pDevice" ::: Ptr (Ptr Device_T)) -> IO Device) -> IO Device)
 -> ContT Device IO ("pDevice" ::: Ptr (Ptr Device_T)))
-> ((("pDevice" ::: Ptr (Ptr Device_T)) -> IO Device) -> IO Device)
-> ContT Device IO ("pDevice" ::: Ptr (Ptr Device_T))
forall a b. (a -> b) -> a -> b
$ IO ("pDevice" ::: Ptr (Ptr Device_T))
-> (("pDevice" ::: Ptr (Ptr Device_T)) -> IO ())
-> (("pDevice" ::: Ptr (Ptr Device_T)) -> IO Device)
-> IO Device
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pDevice" ::: Ptr (Ptr Device_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr Device_T) Int
8) ("pDevice" ::: Ptr (Ptr Device_T)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT Device IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Device IO Result)
-> IO Result -> ContT Device IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateDevice" (Ptr PhysicalDevice_T
-> ("pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pDevice" ::: Ptr (Ptr Device_T))
-> IO Result
vkCreateDevice' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) (Ptr (DeviceCreateInfo a)
-> "pCreateInfo" ::: Ptr (SomeStruct DeviceCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (DeviceCreateInfo a)
pCreateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pDevice" ::: Ptr (Ptr Device_T)
pPDevice))
  IO () -> ContT Device IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Device IO ()) -> IO () -> ContT Device 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))
  Ptr Device_T
pDevice <- IO (Ptr Device_T) -> ContT Device IO (Ptr Device_T)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr Device_T) -> ContT Device IO (Ptr Device_T))
-> IO (Ptr Device_T) -> ContT Device IO (Ptr Device_T)
forall a b. (a -> b) -> a -> b
$ ("pDevice" ::: Ptr (Ptr Device_T)) -> IO (Ptr Device_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Device_T) "pDevice" ::: Ptr (Ptr Device_T)
pPDevice
  Device
pDevice' <- IO Device -> ContT Device IO Device
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Device -> ContT Device IO Device)
-> IO Device -> ContT Device IO Device
forall a b. (a -> b) -> a -> b
$ (\Ptr Device_T
h -> Ptr Device_T -> DeviceCmds -> Device
Device Ptr Device_T
h (DeviceCmds -> Device) -> IO DeviceCmds -> IO Device
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InstanceCmds -> Ptr Device_T -> IO DeviceCmds
initDeviceCmds InstanceCmds
cmds Ptr Device_T
h) Ptr Device_T
pDevice
  Device -> ContT Device IO Device
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Device -> ContT Device IO Device)
-> Device -> ContT Device IO Device
forall a b. (a -> b) -> a -> b
$ (Device
pDevice')

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createDevice' and 'destroyDevice'
--
-- To ensure that 'destroyDevice' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the last argument.
-- To just extract the pair pass '(,)' as the last argument.
--
withDevice :: forall a io r . (Extendss DeviceCreateInfo a, PokeChain a, MonadIO io) => PhysicalDevice -> DeviceCreateInfo a -> Maybe AllocationCallbacks -> (io Device -> (Device -> io ()) -> r) -> r
withDevice :: PhysicalDevice
-> DeviceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Device -> (Device -> io ()) -> r)
-> r
withDevice PhysicalDevice
physicalDevice DeviceCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io Device -> (Device -> io ()) -> r
b =
  io Device -> (Device -> io ()) -> r
b (PhysicalDevice
-> DeviceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Device
forall (a :: [*]) (io :: * -> *).
(Extendss DeviceCreateInfo a, PokeChain a, MonadIO io) =>
PhysicalDevice
-> DeviceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Device
createDevice PhysicalDevice
physicalDevice DeviceCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(Device
o0) -> Device -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
forall (io :: * -> *).
MonadIO io =>
Device -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyDevice Device
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


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

-- | vkDestroyDevice - Destroy a logical device
--
-- = Description
--
-- To ensure that no work is active on the device,
-- 'Vulkan.Core10.Queue.deviceWaitIdle' /can/ be used to gate the
-- destruction of the device. Prior to destroying a device, an application
-- is responsible for destroying\/freeing any Vulkan objects that were
-- created using that device as the first parameter of the corresponding
-- @vkCreate*@ or @vkAllocate*@ command.
--
-- Note
--
-- The lifetime of each of these objects is bound by the lifetime of the
-- 'Vulkan.Core10.Handles.Device' object. Therefore, to avoid resource
-- leaks, it is critical that an application explicitly free all of these
-- resources prior to calling 'destroyDevice'.
--
-- == Valid Usage
--
-- -   #VUID-vkDestroyDevice-device-00378# All child objects created on
--     @device@ /must/ have been destroyed prior to destroying @device@
--
-- -   #VUID-vkDestroyDevice-device-00379# If
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @device@ was created, a compatible set of callbacks
--     /must/ be provided here
--
-- -   #VUID-vkDestroyDevice-device-00380# If no
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @device@ was created, @pAllocator@ /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkDestroyDevice-device-parameter# If @device@ is not @NULL@,
--     @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkDestroyDevice-pAllocator-parameter# If @pAllocator@ is not
--     @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- == Host Synchronization
--
-- -   Host access to @device@ /must/ be externally synchronized
--
-- -   Host access to all 'Vulkan.Core10.Handles.Queue' objects received
--     from @device@ /must/ be externally synchronized
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device'
destroyDevice :: forall io
               . (MonadIO io)
              => -- | @device@ is the logical device to destroy.
                 Device
              -> -- | @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 ()
destroyDevice :: Device -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyDevice Device
device "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 vkDestroyDevicePtr :: FunPtr
  (Ptr Device_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyDevicePtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
pVkDestroyDevice (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
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyDevicePtr FunPtr
  (Ptr Device_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> FunPtr
     (Ptr Device_T
      -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("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 String
"" String
"The function pointer for vkDestroyDevice is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyDevice' :: Ptr Device_T -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyDevice' = FunPtr
  (Ptr Device_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Ptr Device_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyDevice FunPtr
  (Ptr Device_T
   -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyDevicePtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
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 AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
 -> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyDevice" (Ptr Device_T -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyDevice' (Device -> Ptr Device_T
deviceHandle (Device
device)) "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
$ ()


-- | VkDeviceQueueCreateInfo - Structure specifying parameters of a newly
-- created device queue
--
-- == Valid Usage
--
-- -   #VUID-VkDeviceQueueCreateInfo-queueFamilyIndex-00381#
--     @queueFamilyIndex@ /must/ be less than @pQueueFamilyPropertyCount@
--     returned by
--     'Vulkan.Core10.DeviceInitialization.getPhysicalDeviceQueueFamilyProperties'
--
-- -   #VUID-VkDeviceQueueCreateInfo-queueCount-00382# @queueCount@ /must/
--     be less than or equal to the @queueCount@ member of the
--     'Vulkan.Core10.DeviceInitialization.QueueFamilyProperties'
--     structure, as returned by
--     'Vulkan.Core10.DeviceInitialization.getPhysicalDeviceQueueFamilyProperties'
--     in the @pQueueFamilyProperties@[queueFamilyIndex]
--
-- -   #VUID-VkDeviceQueueCreateInfo-pQueuePriorities-00383# Each element
--     of @pQueuePriorities@ /must/ be between @0.0@ and @1.0@ inclusive
--
-- -   #VUID-VkDeviceQueueCreateInfo-flags-02861# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-protectedMemory protected memory>
--     feature is not enabled, the
--     'Vulkan.Core10.Enums.DeviceQueueCreateFlagBits.DEVICE_QUEUE_CREATE_PROTECTED_BIT'
--     bit of @flags@ /must/ not be set
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkDeviceQueueCreateInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEVICE_QUEUE_CREATE_INFO'
--
-- -   #VUID-VkDeviceQueueCreateInfo-pNext-pNext# @pNext@ /must/ be @NULL@
--     or a pointer to a valid instance of
--     'Vulkan.Extensions.VK_EXT_global_priority.DeviceQueueGlobalPriorityCreateInfoEXT'
--
-- -   #VUID-VkDeviceQueueCreateInfo-sType-unique# The @sType@ value of
--     each struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkDeviceQueueCreateInfo-flags-parameter# @flags@ /must/ be a
--     valid combination of
--     'Vulkan.Core10.Enums.DeviceQueueCreateFlagBits.DeviceQueueCreateFlagBits'
--     values
--
-- -   #VUID-VkDeviceQueueCreateInfo-pQueuePriorities-parameter#
--     @pQueuePriorities@ /must/ be a valid pointer to an array of
--     @queueCount@ @float@ values
--
-- -   #VUID-VkDeviceQueueCreateInfo-queueCount-arraylength# @queueCount@
--     /must/ be greater than @0@
--
-- = See Also
--
-- 'DeviceCreateInfo',
-- 'Vulkan.Core10.Enums.DeviceQueueCreateFlagBits.DeviceQueueCreateFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data DeviceQueueCreateInfo (es :: [Type]) = DeviceQueueCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    DeviceQueueCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask indicating behavior of the queue.
    DeviceQueueCreateInfo es -> DeviceQueueCreateFlags
flags :: DeviceQueueCreateFlags
  , -- | @queueFamilyIndex@ is an unsigned integer indicating the index of the
    -- queue family in which to create the queue on this device. This index
    -- corresponds to the index of an element of the @pQueueFamilyProperties@
    -- array that was returned by
    -- 'Vulkan.Core10.DeviceInitialization.getPhysicalDeviceQueueFamilyProperties'.
    DeviceQueueCreateInfo es -> Word32
queueFamilyIndex :: Word32
  , -- | @pQueuePriorities@ is a pointer to an array of @queueCount@ normalized
    -- floating point values, specifying priorities of work that will be
    -- submitted to each created queue. See
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#devsandqueues-priority Queue Priority>
    -- for more information.
    DeviceQueueCreateInfo es -> Vector Float
queuePriorities :: Vector Float
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceQueueCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (DeviceQueueCreateInfo es)

instance Extensible DeviceQueueCreateInfo where
  extensibleTypeName :: String
extensibleTypeName = String
"DeviceQueueCreateInfo"
  setNext :: DeviceQueueCreateInfo ds -> Chain es -> DeviceQueueCreateInfo es
setNext DeviceQueueCreateInfo ds
x Chain es
next = DeviceQueueCreateInfo ds
x{$sel:next:DeviceQueueCreateInfo :: Chain es
next = Chain es
next}
  getNext :: DeviceQueueCreateInfo es -> Chain es
getNext DeviceQueueCreateInfo{Word32
Vector Float
Chain es
DeviceQueueCreateFlags
queuePriorities :: Vector Float
queueFamilyIndex :: Word32
flags :: DeviceQueueCreateFlags
next :: Chain es
$sel:queuePriorities:DeviceQueueCreateInfo :: forall (es :: [*]). DeviceQueueCreateInfo es -> Vector Float
$sel:queueFamilyIndex:DeviceQueueCreateInfo :: forall (es :: [*]). DeviceQueueCreateInfo es -> Word32
$sel:flags:DeviceQueueCreateInfo :: forall (es :: [*]).
DeviceQueueCreateInfo es -> DeviceQueueCreateFlags
$sel:next:DeviceQueueCreateInfo :: forall (es :: [*]). DeviceQueueCreateInfo es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends DeviceQueueCreateInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends DeviceQueueCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends DeviceQueueCreateInfo e => b
f
    | Just e :~: DeviceQueueGlobalPriorityCreateInfoEXT
Refl <- (Typeable e, Typeable DeviceQueueGlobalPriorityCreateInfoEXT) =>
Maybe (e :~: DeviceQueueGlobalPriorityCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DeviceQueueGlobalPriorityCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceQueueCreateInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss DeviceQueueCreateInfo es, PokeChain es) => ToCStruct (DeviceQueueCreateInfo es) where
  withCStruct :: DeviceQueueCreateInfo es
-> (Ptr (DeviceQueueCreateInfo es) -> IO b) -> IO b
withCStruct DeviceQueueCreateInfo es
x Ptr (DeviceQueueCreateInfo es) -> IO b
f = Int -> (Ptr (DeviceQueueCreateInfo es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr (DeviceQueueCreateInfo es) -> IO b) -> IO b)
-> (Ptr (DeviceQueueCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (DeviceQueueCreateInfo es)
p -> Ptr (DeviceQueueCreateInfo es)
-> DeviceQueueCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (DeviceQueueCreateInfo es)
p DeviceQueueCreateInfo es
x (Ptr (DeviceQueueCreateInfo es) -> IO b
f Ptr (DeviceQueueCreateInfo es)
p)
  pokeCStruct :: Ptr (DeviceQueueCreateInfo es)
-> DeviceQueueCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (DeviceQueueCreateInfo es)
p DeviceQueueCreateInfo{Word32
Vector Float
Chain es
DeviceQueueCreateFlags
queuePriorities :: Vector Float
queueFamilyIndex :: Word32
flags :: DeviceQueueCreateFlags
next :: Chain es
$sel:queuePriorities:DeviceQueueCreateInfo :: forall (es :: [*]). DeviceQueueCreateInfo es -> Vector Float
$sel:queueFamilyIndex:DeviceQueueCreateInfo :: forall (es :: [*]). DeviceQueueCreateInfo es -> Word32
$sel:flags:DeviceQueueCreateInfo :: forall (es :: [*]).
DeviceQueueCreateInfo es -> DeviceQueueCreateFlags
$sel:next:DeviceQueueCreateInfo :: forall (es :: [*]). DeviceQueueCreateInfo es -> Chain es
..} 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 (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_QUEUE_CREATE_INFO)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (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 (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (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
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) 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
$ Ptr DeviceQueueCreateFlags -> DeviceQueueCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr DeviceQueueCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceQueueCreateFlags)) (DeviceQueueCreateFlags
flags)
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
queueFamilyIndex)
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Float -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Float -> Int) -> Vector Float -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Float
queuePriorities)) :: Word32))
    Ptr CFloat
pPQueuePriorities' <- ((Ptr CFloat -> IO b) -> IO b) -> ContT b IO (Ptr CFloat)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CFloat -> IO b) -> IO b) -> ContT b IO (Ptr CFloat))
-> ((Ptr CFloat -> IO b) -> IO b) -> ContT b IO (Ptr CFloat)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr CFloat -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @CFloat ((Vector Float -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Float
queuePriorities)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
    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
$ (Int -> Float -> IO ()) -> Vector Float -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Float
e -> Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pPQueuePriorities' Ptr CFloat -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e))) (Vector Float
queuePriorities)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CFloat) -> Ptr CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr (Ptr CFloat)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr CFloat))) (Ptr CFloat
pPQueuePriorities')
    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 = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr (DeviceQueueCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (DeviceQueueCreateInfo es)
p IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (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 (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_QUEUE_CREATE_INFO)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (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 (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (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
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) 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
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b -> 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 DeviceQueueCreateInfo es, PeekChain es) => FromCStruct (DeviceQueueCreateInfo es) where
  peekCStruct :: Ptr (DeviceQueueCreateInfo es) -> IO (DeviceQueueCreateInfo es)
peekCStruct Ptr (DeviceQueueCreateInfo es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    DeviceQueueCreateFlags
flags <- Ptr DeviceQueueCreateFlags -> IO DeviceQueueCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @DeviceQueueCreateFlags ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr DeviceQueueCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceQueueCreateFlags))
    Word32
queueFamilyIndex <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    Word32
queueCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Ptr CFloat
pQueuePriorities <- Ptr (Ptr CFloat) -> IO (Ptr CFloat)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr CFloat) ((Ptr (DeviceQueueCreateInfo es)
p Ptr (DeviceQueueCreateInfo es) -> Int -> Ptr (Ptr CFloat)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr CFloat)))
    Vector Float
pQueuePriorities' <- Int -> (Int -> IO Float) -> IO (Vector Float)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
queueCount) (\Int
i -> do
      CFloat
pQueuePrioritiesElem <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CFloat
pQueuePriorities Ptr CFloat -> Int -> Ptr CFloat
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr CFloat))
      Float -> IO Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> IO Float) -> Float -> IO Float
forall a b. (a -> b) -> a -> b
$ CFloat -> Float
coerce @CFloat @Float CFloat
pQueuePrioritiesElem)
    DeviceQueueCreateInfo es -> IO (DeviceQueueCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceQueueCreateInfo es -> IO (DeviceQueueCreateInfo es))
-> DeviceQueueCreateInfo es -> IO (DeviceQueueCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> DeviceQueueCreateFlags
-> Word32
-> Vector Float
-> DeviceQueueCreateInfo es
forall (es :: [*]).
Chain es
-> DeviceQueueCreateFlags
-> Word32
-> Vector Float
-> DeviceQueueCreateInfo es
DeviceQueueCreateInfo
             Chain es
next DeviceQueueCreateFlags
flags Word32
queueFamilyIndex Vector Float
pQueuePriorities'

instance es ~ '[] => Zero (DeviceQueueCreateInfo es) where
  zero :: DeviceQueueCreateInfo es
zero = Chain es
-> DeviceQueueCreateFlags
-> Word32
-> Vector Float
-> DeviceQueueCreateInfo es
forall (es :: [*]).
Chain es
-> DeviceQueueCreateFlags
-> Word32
-> Vector Float
-> DeviceQueueCreateInfo es
DeviceQueueCreateInfo
           ()
           DeviceQueueCreateFlags
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Vector Float
forall a. Monoid a => a
mempty


-- | VkDeviceCreateInfo - Structure specifying parameters of a newly created
-- device
--
-- == Valid Usage
--
-- -   #VUID-VkDeviceCreateInfo-queueFamilyIndex-02802# The
--     @queueFamilyIndex@ member of each element of @pQueueCreateInfos@
--     /must/ be unique within @pQueueCreateInfos@, except that two members
--     can share the same @queueFamilyIndex@ if one is a protected-capable
--     queue and one is not a protected-capable queue
--
-- -   #VUID-VkDeviceCreateInfo-pNext-00373# If the @pNext@ chain includes
--     a
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
--     structure, then @pEnabledFeatures@ /must/ be @NULL@
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledExtensionNames-01840#
--     @ppEnabledExtensionNames@ /must/ not contain
--     @VK_AMD_negative_viewport_height@
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledExtensionNames-03328#
--     @ppEnabledExtensionNames@ /must/ not contain both
--     @VK_KHR_buffer_device_address@ and @VK_EXT_buffer_device_address@
--
-- -   #VUID-VkDeviceCreateInfo-pNext-04748# if the @pNext@ chain includes
--     a 'Vulkan.Core12.PhysicalDeviceVulkan12Features' structure and
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features'::@bufferDeviceAddress@
--     is VK_TRUE, @ppEnabledExtensionNames@ /must/ not contain
--     @VK_EXT_buffer_device_address@
--
-- -   #VUID-VkDeviceCreateInfo-pNext-02829# If the @pNext@ chain includes
--     a 'Vulkan.Core12.PhysicalDeviceVulkan11Features' structure, then it
--     /must/ not include a
--     'Vulkan.Core11.Promoted_From_VK_KHR_16bit_storage.PhysicalDevice16BitStorageFeatures',
--     'Vulkan.Core11.Promoted_From_VK_KHR_multiview.PhysicalDeviceMultiviewFeatures',
--     'Vulkan.Core11.Promoted_From_VK_KHR_variable_pointers.PhysicalDeviceVariablePointersFeatures',
--     'Vulkan.Core11.Originally_Based_On_VK_KHR_protected_memory.PhysicalDeviceProtectedMemoryFeatures',
--     'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.PhysicalDeviceSamplerYcbcrConversionFeatures',
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_shader_draw_parameters.PhysicalDeviceShaderDrawParametersFeatures'
--     structure
--
-- -   #VUID-VkDeviceCreateInfo-pNext-02830# If the @pNext@ chain includes
--     a 'Vulkan.Core12.PhysicalDeviceVulkan12Features' structure, then it
--     /must/ not include a
--     'Vulkan.Core12.Promoted_From_VK_KHR_8bit_storage.PhysicalDevice8BitStorageFeatures',
--     'Vulkan.Core12.Promoted_From_VK_KHR_shader_atomic_int64.PhysicalDeviceShaderAtomicInt64Features',
--     'Vulkan.Core12.Promoted_From_VK_KHR_shader_float16_int8.PhysicalDeviceShaderFloat16Int8Features',
--     'Vulkan.Core12.Promoted_From_VK_EXT_descriptor_indexing.PhysicalDeviceDescriptorIndexingFeatures',
--     'Vulkan.Core12.Promoted_From_VK_EXT_scalar_block_layout.PhysicalDeviceScalarBlockLayoutFeatures',
--     'Vulkan.Core12.Promoted_From_VK_KHR_imageless_framebuffer.PhysicalDeviceImagelessFramebufferFeatures',
--     'Vulkan.Core12.Promoted_From_VK_KHR_uniform_buffer_standard_layout.PhysicalDeviceUniformBufferStandardLayoutFeatures',
--     'Vulkan.Core12.Promoted_From_VK_KHR_shader_subgroup_extended_types.PhysicalDeviceShaderSubgroupExtendedTypesFeatures',
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.PhysicalDeviceSeparateDepthStencilLayoutsFeatures',
--     'Vulkan.Core12.Promoted_From_VK_EXT_host_query_reset.PhysicalDeviceHostQueryResetFeatures',
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.PhysicalDeviceTimelineSemaphoreFeatures',
--     'Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address.PhysicalDeviceBufferDeviceAddressFeatures',
--     or
--     'Vulkan.Core12.Promoted_From_VK_KHR_vulkan_memory_model.PhysicalDeviceVulkanMemoryModelFeatures'
--     structure
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledExtensions-04476# If
--     @ppEnabledExtensions@ contains @\"VK_KHR_shader_draw_parameters\"@
--     and the @pNext@ chain includes a
--     'Vulkan.Core12.PhysicalDeviceVulkan11Features' structure, then
--     'Vulkan.Core12.PhysicalDeviceVulkan11Features'::@shaderDrawParameters@
--     /must/ be 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledExtensions-02831# If
--     @ppEnabledExtensions@ contains @\"VK_KHR_draw_indirect_count\"@ and
--     the @pNext@ chain includes a
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features' structure, then
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features'::@drawIndirectCount@
--     /must/ be 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledExtensions-02832# If
--     @ppEnabledExtensions@ contains
--     @\"VK_KHR_sampler_mirror_clamp_to_edge\"@ and the @pNext@ chain
--     includes a 'Vulkan.Core12.PhysicalDeviceVulkan12Features' structure,
--     then
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features'::@samplerMirrorClampToEdge@
--     /must/ be 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledExtensions-02833# If
--     @ppEnabledExtensions@ contains @\"VK_EXT_descriptor_indexing\"@ and
--     the @pNext@ chain includes a
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features' structure, then
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features'::@descriptorIndexing@
--     /must/ be 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledExtensions-02834# If
--     @ppEnabledExtensions@ contains @\"VK_EXT_sampler_filter_minmax\"@
--     and the @pNext@ chain includes a
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features' structure, then
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features'::@samplerFilterMinmax@
--     /must/ be 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledExtensions-02835# If
--     @ppEnabledExtensions@ contains
--     @\"VK_EXT_shader_viewport_index_layer\"@ and the @pNext@ chain
--     includes a 'Vulkan.Core12.PhysicalDeviceVulkan12Features' structure,
--     then
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features'::@shaderOutputViewportIndex@
--     and
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features'::@shaderOutputLayer@
--     /must/ both be 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   #VUID-VkDeviceCreateInfo-pProperties-04451# If the
--     @VK_KHR_portability_subset@ extension is included in @pProperties@
--     of
--     'Vulkan.Core10.ExtensionDiscovery.enumerateDeviceExtensionProperties',
--     @ppEnabledExtensions@ /must/ include \"VK_KHR_portability_subset\".
--
-- -   #VUID-VkDeviceCreateInfo-shadingRateImage-04478# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shadingRateImage shadingRateImage>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-pipelineFragmentShadingRate pipelineFragmentShadingRate>
--     /must/ not be enabled
--
-- -   #VUID-VkDeviceCreateInfo-shadingRateImage-04479# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shadingRateImage shadingRateImage>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-primitiveFragmentShadingRate primitiveFragmentShadingRate>
--     /must/ not be enabled
--
-- -   #VUID-VkDeviceCreateInfo-shadingRateImage-04480# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shadingRateImage shadingRateImage>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-attachmentFragmentShadingRate attachmentFragmentShadingRate>
--     /must/ not be enabled
--
-- -   #VUID-VkDeviceCreateInfo-fragmentDensityMap-04481# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-fragmentDensityMap fragmentDensityMap>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-pipelineFragmentShadingRate pipelineFragmentShadingRate>
--     /must/ not be enabled
--
-- -   #VUID-VkDeviceCreateInfo-fragmentDensityMap-04482# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-fragmentDensityMap fragmentDensityMap>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-primitiveFragmentShadingRate primitiveFragmentShadingRate>
--     /must/ not be enabled
--
-- -   #VUID-VkDeviceCreateInfo-fragmentDensityMap-04483# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-fragmentDensityMap fragmentDensityMap>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-attachmentFragmentShadingRate attachmentFragmentShadingRate>
--     /must/ not be enabled
--
-- -   #VUID-VkDeviceCreateInfo-None-04896# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderImageInt64Atomics shaderImageInt64Atomics>
--     /must/ be enabled
--
-- -   #VUID-VkDeviceCreateInfo-None-04897# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageFloat32Atomics sparseImageFloat32Atomics>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderImageFloat32Atomics shaderImageFloat32Atomics>
--     /must/ be enabled
--
-- -   #VUID-VkDeviceCreateInfo-None-04898# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageFloat32AtomicAdd sparseImageFloat32AtomicAdd>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderImageFloat32AtomicAdd shaderImageFloat32AtomicAdd>
--     /must/ be enabled
--
-- -   #VUID-VkDeviceCreateInfo-sparseImageFloat32AtomicMinMax-04975# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageFloat32AtomicMinMax sparseImageFloat32AtomicMinMax>
--     is enabled,
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shaderImageFloat32AtomicMinMax shaderImageFloat32AtomicMinMax>
--     /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkDeviceCreateInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEVICE_CREATE_INFO'
--
-- -   #VUID-VkDeviceCreateInfo-pNext-pNext# 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_EXT_device_memory_report.DeviceDeviceMemoryReportCreateInfoEXT',
--     'Vulkan.Extensions.VK_NV_device_diagnostics_config.DeviceDiagnosticsConfigCreateInfoNV',
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group_creation.DeviceGroupDeviceCreateInfo',
--     'Vulkan.Extensions.VK_AMD_memory_overallocation_behavior.DeviceMemoryOverallocationCreateInfoAMD',
--     'Vulkan.Extensions.VK_EXT_private_data.DevicePrivateDataCreateInfoEXT',
--     'Vulkan.Core11.Promoted_From_VK_KHR_16bit_storage.PhysicalDevice16BitStorageFeatures',
--     'Vulkan.Extensions.VK_EXT_4444_formats.PhysicalDevice4444FormatsFeaturesEXT',
--     'Vulkan.Core12.Promoted_From_VK_KHR_8bit_storage.PhysicalDevice8BitStorageFeatures',
--     'Vulkan.Extensions.VK_EXT_astc_decode_mode.PhysicalDeviceASTCDecodeFeaturesEXT',
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.PhysicalDeviceAccelerationStructureFeaturesKHR',
--     'Vulkan.Extensions.VK_EXT_blend_operation_advanced.PhysicalDeviceBlendOperationAdvancedFeaturesEXT',
--     'Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address.PhysicalDeviceBufferDeviceAddressFeatures',
--     'Vulkan.Extensions.VK_EXT_buffer_device_address.PhysicalDeviceBufferDeviceAddressFeaturesEXT',
--     'Vulkan.Extensions.VK_AMD_device_coherent_memory.PhysicalDeviceCoherentMemoryFeaturesAMD',
--     'Vulkan.Extensions.VK_EXT_color_write_enable.PhysicalDeviceColorWriteEnableFeaturesEXT',
--     'Vulkan.Extensions.VK_NV_compute_shader_derivatives.PhysicalDeviceComputeShaderDerivativesFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_conditional_rendering.PhysicalDeviceConditionalRenderingFeaturesEXT',
--     'Vulkan.Extensions.VK_NV_cooperative_matrix.PhysicalDeviceCooperativeMatrixFeaturesNV',
--     'Vulkan.Extensions.VK_NV_corner_sampled_image.PhysicalDeviceCornerSampledImageFeaturesNV',
--     'Vulkan.Extensions.VK_NV_coverage_reduction_mode.PhysicalDeviceCoverageReductionModeFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_custom_border_color.PhysicalDeviceCustomBorderColorFeaturesEXT',
--     'Vulkan.Extensions.VK_NV_dedicated_allocation_image_aliasing.PhysicalDeviceDedicatedAllocationImageAliasingFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_depth_clip_enable.PhysicalDeviceDepthClipEnableFeaturesEXT',
--     'Vulkan.Core12.Promoted_From_VK_EXT_descriptor_indexing.PhysicalDeviceDescriptorIndexingFeatures',
--     'Vulkan.Extensions.VK_NV_device_generated_commands.PhysicalDeviceDeviceGeneratedCommandsFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_device_memory_report.PhysicalDeviceDeviceMemoryReportFeaturesEXT',
--     'Vulkan.Extensions.VK_NV_device_diagnostics_config.PhysicalDeviceDiagnosticsConfigFeaturesNV',
--     'Vulkan.Extensions.VK_NV_scissor_exclusive.PhysicalDeviceExclusiveScissorFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state2.PhysicalDeviceExtendedDynamicState2FeaturesEXT',
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.PhysicalDeviceExtendedDynamicStateFeaturesEXT',
--     'Vulkan.Extensions.VK_NV_external_memory_rdma.PhysicalDeviceExternalMemoryRDMAFeaturesNV',
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Extensions.VK_EXT_fragment_density_map2.PhysicalDeviceFragmentDensityMap2FeaturesEXT',
--     'Vulkan.Extensions.VK_EXT_fragment_density_map.PhysicalDeviceFragmentDensityMapFeaturesEXT',
--     'Vulkan.Extensions.VK_NV_fragment_shader_barycentric.PhysicalDeviceFragmentShaderBarycentricFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_fragment_shader_interlock.PhysicalDeviceFragmentShaderInterlockFeaturesEXT',
--     'Vulkan.Extensions.VK_NV_fragment_shading_rate_enums.PhysicalDeviceFragmentShadingRateEnumsFeaturesNV',
--     'Vulkan.Extensions.VK_KHR_fragment_shading_rate.PhysicalDeviceFragmentShadingRateFeaturesKHR',
--     'Vulkan.Extensions.VK_EXT_global_priority_query.PhysicalDeviceGlobalPriorityQueryFeaturesEXT',
--     'Vulkan.Core12.Promoted_From_VK_EXT_host_query_reset.PhysicalDeviceHostQueryResetFeatures',
--     'Vulkan.Extensions.VK_EXT_image_robustness.PhysicalDeviceImageRobustnessFeaturesEXT',
--     'Vulkan.Core12.Promoted_From_VK_KHR_imageless_framebuffer.PhysicalDeviceImagelessFramebufferFeatures',
--     'Vulkan.Extensions.VK_EXT_index_type_uint8.PhysicalDeviceIndexTypeUint8FeaturesEXT',
--     'Vulkan.Extensions.VK_NV_inherited_viewport_scissor.PhysicalDeviceInheritedViewportScissorFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_inline_uniform_block.PhysicalDeviceInlineUniformBlockFeaturesEXT',
--     'Vulkan.Extensions.VK_HUAWEI_invocation_mask.PhysicalDeviceInvocationMaskFeaturesHUAWEI',
--     'Vulkan.Extensions.VK_EXT_line_rasterization.PhysicalDeviceLineRasterizationFeaturesEXT',
--     'Vulkan.Extensions.VK_EXT_memory_priority.PhysicalDeviceMemoryPriorityFeaturesEXT',
--     'Vulkan.Extensions.VK_NV_mesh_shader.PhysicalDeviceMeshShaderFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_multi_draw.PhysicalDeviceMultiDrawFeaturesEXT',
--     'Vulkan.Core11.Promoted_From_VK_KHR_multiview.PhysicalDeviceMultiviewFeatures',
--     'Vulkan.Extensions.VK_VALVE_mutable_descriptor_type.PhysicalDeviceMutableDescriptorTypeFeaturesVALVE',
--     'Vulkan.Extensions.VK_KHR_performance_query.PhysicalDevicePerformanceQueryFeaturesKHR',
--     'Vulkan.Extensions.VK_EXT_pipeline_creation_cache_control.PhysicalDevicePipelineCreationCacheControlFeaturesEXT',
--     'Vulkan.Extensions.VK_KHR_pipeline_executable_properties.PhysicalDevicePipelineExecutablePropertiesFeaturesKHR',
--     'Vulkan.Extensions.VK_KHR_portability_subset.PhysicalDevicePortabilitySubsetFeaturesKHR',
--     'Vulkan.Extensions.VK_KHR_present_id.PhysicalDevicePresentIdFeaturesKHR',
--     'Vulkan.Extensions.VK_KHR_present_wait.PhysicalDevicePresentWaitFeaturesKHR',
--     'Vulkan.Extensions.VK_EXT_private_data.PhysicalDevicePrivateDataFeaturesEXT',
--     'Vulkan.Core11.Originally_Based_On_VK_KHR_protected_memory.PhysicalDeviceProtectedMemoryFeatures',
--     'Vulkan.Extensions.VK_EXT_provoking_vertex.PhysicalDeviceProvokingVertexFeaturesEXT',
--     'Vulkan.Extensions.VK_KHR_ray_query.PhysicalDeviceRayQueryFeaturesKHR',
--     'Vulkan.Extensions.VK_NV_ray_tracing_motion_blur.PhysicalDeviceRayTracingMotionBlurFeaturesNV',
--     'Vulkan.Extensions.VK_KHR_ray_tracing_pipeline.PhysicalDeviceRayTracingPipelineFeaturesKHR',
--     'Vulkan.Extensions.VK_NV_representative_fragment_test.PhysicalDeviceRepresentativeFragmentTestFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_robustness2.PhysicalDeviceRobustness2FeaturesEXT',
--     'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.PhysicalDeviceSamplerYcbcrConversionFeatures',
--     'Vulkan.Core12.Promoted_From_VK_EXT_scalar_block_layout.PhysicalDeviceScalarBlockLayoutFeatures',
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.PhysicalDeviceSeparateDepthStencilLayoutsFeatures',
--     'Vulkan.Extensions.VK_EXT_shader_atomic_float2.PhysicalDeviceShaderAtomicFloat2FeaturesEXT',
--     'Vulkan.Extensions.VK_EXT_shader_atomic_float.PhysicalDeviceShaderAtomicFloatFeaturesEXT',
--     'Vulkan.Core12.Promoted_From_VK_KHR_shader_atomic_int64.PhysicalDeviceShaderAtomicInt64Features',
--     'Vulkan.Extensions.VK_KHR_shader_clock.PhysicalDeviceShaderClockFeaturesKHR',
--     'Vulkan.Extensions.VK_EXT_shader_demote_to_helper_invocation.PhysicalDeviceShaderDemoteToHelperInvocationFeaturesEXT',
--     'Vulkan.Core11.Promoted_From_VK_KHR_shader_draw_parameters.PhysicalDeviceShaderDrawParametersFeatures',
--     'Vulkan.Core12.Promoted_From_VK_KHR_shader_float16_int8.PhysicalDeviceShaderFloat16Int8Features',
--     'Vulkan.Extensions.VK_EXT_shader_image_atomic_int64.PhysicalDeviceShaderImageAtomicInt64FeaturesEXT',
--     'Vulkan.Extensions.VK_NV_shader_image_footprint.PhysicalDeviceShaderImageFootprintFeaturesNV',
--     'Vulkan.Extensions.VK_INTEL_shader_integer_functions2.PhysicalDeviceShaderIntegerFunctions2FeaturesINTEL',
--     'Vulkan.Extensions.VK_NV_shader_sm_builtins.PhysicalDeviceShaderSMBuiltinsFeaturesNV',
--     'Vulkan.Core12.Promoted_From_VK_KHR_shader_subgroup_extended_types.PhysicalDeviceShaderSubgroupExtendedTypesFeatures',
--     'Vulkan.Extensions.VK_KHR_shader_subgroup_uniform_control_flow.PhysicalDeviceShaderSubgroupUniformControlFlowFeaturesKHR',
--     'Vulkan.Extensions.VK_KHR_shader_terminate_invocation.PhysicalDeviceShaderTerminateInvocationFeaturesKHR',
--     'Vulkan.Extensions.VK_NV_shading_rate_image.PhysicalDeviceShadingRateImageFeaturesNV',
--     'Vulkan.Extensions.VK_EXT_subgroup_size_control.PhysicalDeviceSubgroupSizeControlFeaturesEXT',
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkPhysicalDeviceSubpassShadingFeaturesHUAWEI VkPhysicalDeviceSubpassShadingFeaturesHUAWEI>,
--     'Vulkan.Extensions.VK_KHR_synchronization2.PhysicalDeviceSynchronization2FeaturesKHR',
--     'Vulkan.Extensions.VK_EXT_texel_buffer_alignment.PhysicalDeviceTexelBufferAlignmentFeaturesEXT',
--     'Vulkan.Extensions.VK_EXT_texture_compression_astc_hdr.PhysicalDeviceTextureCompressionASTCHDRFeaturesEXT',
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.PhysicalDeviceTimelineSemaphoreFeatures',
--     'Vulkan.Extensions.VK_EXT_transform_feedback.PhysicalDeviceTransformFeedbackFeaturesEXT',
--     'Vulkan.Core12.Promoted_From_VK_KHR_uniform_buffer_standard_layout.PhysicalDeviceUniformBufferStandardLayoutFeatures',
--     'Vulkan.Core11.Promoted_From_VK_KHR_variable_pointers.PhysicalDeviceVariablePointersFeatures',
--     'Vulkan.Extensions.VK_EXT_vertex_attribute_divisor.PhysicalDeviceVertexAttributeDivisorFeaturesEXT',
--     'Vulkan.Extensions.VK_EXT_vertex_input_dynamic_state.PhysicalDeviceVertexInputDynamicStateFeaturesEXT',
--     'Vulkan.Core12.PhysicalDeviceVulkan11Features',
--     'Vulkan.Core12.PhysicalDeviceVulkan12Features',
--     'Vulkan.Core12.Promoted_From_VK_KHR_vulkan_memory_model.PhysicalDeviceVulkanMemoryModelFeatures',
--     'Vulkan.Extensions.VK_KHR_workgroup_memory_explicit_layout.PhysicalDeviceWorkgroupMemoryExplicitLayoutFeaturesKHR',
--     'Vulkan.Extensions.VK_EXT_ycbcr_2plane_444_formats.PhysicalDeviceYcbcr2Plane444FormatsFeaturesEXT',
--     'Vulkan.Extensions.VK_EXT_ycbcr_image_arrays.PhysicalDeviceYcbcrImageArraysFeaturesEXT',
--     or
--     'Vulkan.Extensions.VK_KHR_zero_initialize_workgroup_memory.PhysicalDeviceZeroInitializeWorkgroupMemoryFeaturesKHR'
--
-- -   #VUID-VkDeviceCreateInfo-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique, with the exception of
--     structures of type
--     'Vulkan.Extensions.VK_EXT_device_memory_report.DeviceDeviceMemoryReportCreateInfoEXT'
--     or
--     'Vulkan.Extensions.VK_EXT_private_data.DevicePrivateDataCreateInfoEXT'
--
-- -   #VUID-VkDeviceCreateInfo-flags-zerobitmask# @flags@ /must/ be @0@
--
-- -   #VUID-VkDeviceCreateInfo-pQueueCreateInfos-parameter#
--     @pQueueCreateInfos@ /must/ be a valid pointer to an array of
--     @queueCreateInfoCount@ valid 'DeviceQueueCreateInfo' structures
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledLayerNames-parameter# If
--     @enabledLayerCount@ is not @0@, @ppEnabledLayerNames@ /must/ be a
--     valid pointer to an array of @enabledLayerCount@ null-terminated
--     UTF-8 strings
--
-- -   #VUID-VkDeviceCreateInfo-ppEnabledExtensionNames-parameter# If
--     @enabledExtensionCount@ is not @0@, @ppEnabledExtensionNames@ /must/
--     be a valid pointer to an array of @enabledExtensionCount@
--     null-terminated UTF-8 strings
--
-- -   #VUID-VkDeviceCreateInfo-pEnabledFeatures-parameter# If
--     @pEnabledFeatures@ is not @NULL@, @pEnabledFeatures@ /must/ be a
--     valid pointer to a valid
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceFeatures'
--     structure
--
-- -   #VUID-VkDeviceCreateInfo-queueCreateInfoCount-arraylength#
--     @queueCreateInfoCount@ /must/ be greater than @0@
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.DeviceCreateFlags.DeviceCreateFlags',
-- 'DeviceQueueCreateInfo',
-- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceFeatures',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createDevice'
data DeviceCreateInfo (es :: [Type]) = DeviceCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    DeviceCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is reserved for future use.
    DeviceCreateInfo es -> DeviceCreateFlags
flags :: DeviceCreateFlags
  , -- | @pQueueCreateInfos@ is a pointer to an array of 'DeviceQueueCreateInfo'
    -- structures describing the queues that are requested to be created along
    -- with the logical device. Refer to the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#devsandqueues-queue-creation Queue Creation>
    -- section below for further details.
    DeviceCreateInfo es -> Vector (SomeStruct DeviceQueueCreateInfo)
queueCreateInfos :: Vector (SomeStruct DeviceQueueCreateInfo)
  , -- | @ppEnabledLayerNames@ is deprecated and ignored. See
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-layers-devicelayerdeprecation>.
    DeviceCreateInfo es -> Vector ByteString
enabledLayerNames :: Vector ByteString
  , -- | @ppEnabledExtensionNames@ is a pointer to an array of
    -- @enabledExtensionCount@ null-terminated UTF-8 strings containing the
    -- names of extensions to enable for the created device. See the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-extensions>
    -- section for further details.
    DeviceCreateInfo es -> Vector ByteString
enabledExtensionNames :: Vector ByteString
  , -- | @pEnabledFeatures@ is @NULL@ or a pointer to a
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceFeatures' structure
    -- containing boolean indicators of all the features to be enabled. Refer
    -- to the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features Features>
    -- section for further details.
    DeviceCreateInfo es -> Maybe PhysicalDeviceFeatures
enabledFeatures :: Maybe PhysicalDeviceFeatures
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (DeviceCreateInfo es)

instance Extensible DeviceCreateInfo where
  extensibleTypeName :: String
extensibleTypeName = String
"DeviceCreateInfo"
  setNext :: DeviceCreateInfo ds -> Chain es -> DeviceCreateInfo es
setNext DeviceCreateInfo ds
x Chain es
next = DeviceCreateInfo ds
x{$sel:next:DeviceCreateInfo :: Chain es
next = Chain es
next}
  getNext :: DeviceCreateInfo es -> Chain es
getNext DeviceCreateInfo{Maybe PhysicalDeviceFeatures
Vector ByteString
Vector (SomeStruct DeviceQueueCreateInfo)
Chain es
DeviceCreateFlags
enabledFeatures :: Maybe PhysicalDeviceFeatures
enabledExtensionNames :: Vector ByteString
enabledLayerNames :: Vector ByteString
queueCreateInfos :: Vector (SomeStruct DeviceQueueCreateInfo)
flags :: DeviceCreateFlags
next :: Chain es
$sel:enabledFeatures:DeviceCreateInfo :: forall (es :: [*]).
DeviceCreateInfo es -> Maybe PhysicalDeviceFeatures
$sel:enabledExtensionNames:DeviceCreateInfo :: forall (es :: [*]). DeviceCreateInfo es -> Vector ByteString
$sel:enabledLayerNames:DeviceCreateInfo :: forall (es :: [*]). DeviceCreateInfo es -> Vector ByteString
$sel:queueCreateInfos:DeviceCreateInfo :: forall (es :: [*]).
DeviceCreateInfo es -> Vector (SomeStruct DeviceQueueCreateInfo)
$sel:flags:DeviceCreateInfo :: forall (es :: [*]). DeviceCreateInfo es -> DeviceCreateFlags
$sel:next:DeviceCreateInfo :: forall (es :: [*]). DeviceCreateInfo es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends DeviceCreateInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends DeviceCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceRayTracingMotionBlurFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceRayTracingMotionBlurFeaturesNV) =>
Maybe (e :~: PhysicalDeviceRayTracingMotionBlurFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceRayTracingMotionBlurFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceProvokingVertexFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceProvokingVertexFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceProvokingVertexFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceProvokingVertexFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceYcbcr2Plane444FormatsFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceYcbcr2Plane444FormatsFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceYcbcr2Plane444FormatsFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceYcbcr2Plane444FormatsFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceInheritedViewportScissorFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceInheritedViewportScissorFeaturesNV) =>
Maybe (e :~: PhysicalDeviceInheritedViewportScissorFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceInheritedViewportScissorFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceSynchronization2FeaturesKHR
Refl <- (Typeable e, Typeable PhysicalDeviceSynchronization2FeaturesKHR) =>
Maybe (e :~: PhysicalDeviceSynchronization2FeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceSynchronization2FeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceColorWriteEnableFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceColorWriteEnableFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceColorWriteEnableFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceColorWriteEnableFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceExternalMemoryRDMAFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceExternalMemoryRDMAFeaturesNV) =>
Maybe (e :~: PhysicalDeviceExternalMemoryRDMAFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceExternalMemoryRDMAFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceVertexInputDynamicStateFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceVertexInputDynamicStateFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceVertexInputDynamicStateFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceVertexInputDynamicStateFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
Refl <- (Typeable e,
 Typeable PhysicalDeviceMutableDescriptorTypeFeaturesVALVE) =>
Maybe (e :~: PhysicalDeviceMutableDescriptorTypeFeaturesVALVE)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceMutableDescriptorTypeFeaturesVALVE = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceFragmentShadingRateEnumsFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceFragmentShadingRateEnumsFeaturesNV) =>
Maybe (e :~: PhysicalDeviceFragmentShadingRateEnumsFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceFragmentShadingRateEnumsFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderTerminateInvocationFeaturesKHR
Refl <- (Typeable e,
 Typeable PhysicalDeviceShaderTerminateInvocationFeaturesKHR) =>
Maybe (e :~: PhysicalDeviceShaderTerminateInvocationFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderTerminateInvocationFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceFragmentShadingRateFeaturesKHR
Refl <- (Typeable e,
 Typeable PhysicalDeviceFragmentShadingRateFeaturesKHR) =>
Maybe (e :~: PhysicalDeviceFragmentShadingRateFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceFragmentShadingRateFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderImageAtomicInt64FeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceShaderImageAtomicInt64FeaturesEXT) =>
Maybe (e :~: PhysicalDeviceShaderImageAtomicInt64FeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderImageAtomicInt64FeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevice4444FormatsFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDevice4444FormatsFeaturesEXT) =>
Maybe (e :~: PhysicalDevice4444FormatsFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevice4444FormatsFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevicePortabilitySubsetFeaturesKHR
Refl <- (Typeable e,
 Typeable PhysicalDevicePortabilitySubsetFeaturesKHR) =>
Maybe (e :~: PhysicalDevicePortabilitySubsetFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevicePortabilitySubsetFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceWorkgroupMemoryExplicitLayoutFeaturesKHR
Refl <- (Typeable e,
 Typeable PhysicalDeviceWorkgroupMemoryExplicitLayoutFeaturesKHR) =>
Maybe
  (e :~: PhysicalDeviceWorkgroupMemoryExplicitLayoutFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceWorkgroupMemoryExplicitLayoutFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceImageRobustnessFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceImageRobustnessFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceImageRobustnessFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceImageRobustnessFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceRobustness2FeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceRobustness2FeaturesEXT) =>
Maybe (e :~: PhysicalDeviceRobustness2FeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceRobustness2FeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderSubgroupUniformControlFlowFeaturesKHR
Refl <- (Typeable e,
 Typeable
   PhysicalDeviceShaderSubgroupUniformControlFlowFeaturesKHR) =>
Maybe
  (e :~: PhysicalDeviceShaderSubgroupUniformControlFlowFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderSubgroupUniformControlFlowFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceZeroInitializeWorkgroupMemoryFeaturesKHR
Refl <- (Typeable e,
 Typeable PhysicalDeviceZeroInitializeWorkgroupMemoryFeaturesKHR) =>
Maybe
  (e :~: PhysicalDeviceZeroInitializeWorkgroupMemoryFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceZeroInitializeWorkgroupMemoryFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: DeviceDiagnosticsConfigCreateInfoNV
Refl <- (Typeable e, Typeable DeviceDiagnosticsConfigCreateInfoNV) =>
Maybe (e :~: DeviceDiagnosticsConfigCreateInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DeviceDiagnosticsConfigCreateInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceDiagnosticsConfigFeaturesNV
Refl <- (Typeable e, Typeable PhysicalDeviceDiagnosticsConfigFeaturesNV) =>
Maybe (e :~: PhysicalDeviceDiagnosticsConfigFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceDiagnosticsConfigFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceExtendedDynamicState2FeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceExtendedDynamicState2FeaturesEXT) =>
Maybe (e :~: PhysicalDeviceExtendedDynamicState2FeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceExtendedDynamicState2FeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceExtendedDynamicStateFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceExtendedDynamicStateFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceExtendedDynamicStateFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceExtendedDynamicStateFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceCustomBorderColorFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceCustomBorderColorFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceCustomBorderColorFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceCustomBorderColorFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceCoherentMemoryFeaturesAMD
Refl <- (Typeable e, Typeable PhysicalDeviceCoherentMemoryFeaturesAMD) =>
Maybe (e :~: PhysicalDeviceCoherentMemoryFeaturesAMD)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceCoherentMemoryFeaturesAMD = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceVulkan12Features
Refl <- (Typeable e, Typeable PhysicalDeviceVulkan12Features) =>
Maybe (e :~: PhysicalDeviceVulkan12Features)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceVulkan12Features = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceVulkan11Features
Refl <- (Typeable e, Typeable PhysicalDeviceVulkan11Features) =>
Maybe (e :~: PhysicalDeviceVulkan11Features)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceVulkan11Features = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevicePipelineCreationCacheControlFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDevicePipelineCreationCacheControlFeaturesEXT) =>
Maybe (e :~: PhysicalDevicePipelineCreationCacheControlFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevicePipelineCreationCacheControlFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceLineRasterizationFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceLineRasterizationFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceLineRasterizationFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceLineRasterizationFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceSubgroupSizeControlFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceSubgroupSizeControlFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceSubgroupSizeControlFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceSubgroupSizeControlFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceTexelBufferAlignmentFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceTexelBufferAlignmentFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceTexelBufferAlignmentFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceTexelBufferAlignmentFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderDemoteToHelperInvocationFeaturesEXT
Refl <- (Typeable e,
 Typeable
   PhysicalDeviceShaderDemoteToHelperInvocationFeaturesEXT) =>
Maybe
  (e :~: PhysicalDeviceShaderDemoteToHelperInvocationFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderDemoteToHelperInvocationFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
Refl <- (Typeable e,
 Typeable PhysicalDevicePipelineExecutablePropertiesFeaturesKHR) =>
Maybe (e :~: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevicePipelineExecutablePropertiesFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceSeparateDepthStencilLayoutsFeatures
Refl <- (Typeable e,
 Typeable PhysicalDeviceSeparateDepthStencilLayoutsFeatures) =>
Maybe (e :~: PhysicalDeviceSeparateDepthStencilLayoutsFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceSeparateDepthStencilLayoutsFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceFragmentShaderInterlockFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceFragmentShaderInterlockFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceFragmentShaderInterlockFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceFragmentShaderInterlockFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderSMBuiltinsFeaturesNV
Refl <- (Typeable e, Typeable PhysicalDeviceShaderSMBuiltinsFeaturesNV) =>
Maybe (e :~: PhysicalDeviceShaderSMBuiltinsFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderSMBuiltinsFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceIndexTypeUint8FeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceIndexTypeUint8FeaturesEXT) =>
Maybe (e :~: PhysicalDeviceIndexTypeUint8FeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceIndexTypeUint8FeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderClockFeaturesKHR
Refl <- (Typeable e, Typeable PhysicalDeviceShaderClockFeaturesKHR) =>
Maybe (e :~: PhysicalDeviceShaderClockFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderClockFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderIntegerFunctions2FeaturesINTEL
Refl <- (Typeable e,
 Typeable PhysicalDeviceShaderIntegerFunctions2FeaturesINTEL) =>
Maybe (e :~: PhysicalDeviceShaderIntegerFunctions2FeaturesINTEL)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderIntegerFunctions2FeaturesINTEL = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceCoverageReductionModeFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceCoverageReductionModeFeaturesNV) =>
Maybe (e :~: PhysicalDeviceCoverageReductionModeFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceCoverageReductionModeFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevicePerformanceQueryFeaturesKHR
Refl <- (Typeable e, Typeable PhysicalDevicePerformanceQueryFeaturesKHR) =>
Maybe (e :~: PhysicalDevicePerformanceQueryFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevicePerformanceQueryFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceYcbcrImageArraysFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceYcbcrImageArraysFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceYcbcrImageArraysFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceYcbcrImageArraysFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceCooperativeMatrixFeaturesNV
Refl <- (Typeable e, Typeable PhysicalDeviceCooperativeMatrixFeaturesNV) =>
Maybe (e :~: PhysicalDeviceCooperativeMatrixFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceCooperativeMatrixFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceTextureCompressionASTCHDRFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceTextureCompressionASTCHDRFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceTextureCompressionASTCHDRFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceTextureCompressionASTCHDRFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceImagelessFramebufferFeatures
Refl <- (Typeable e,
 Typeable PhysicalDeviceImagelessFramebufferFeatures) =>
Maybe (e :~: PhysicalDeviceImagelessFramebufferFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceImagelessFramebufferFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceBufferDeviceAddressFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceBufferDeviceAddressFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceBufferDeviceAddressFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceBufferDeviceAddressFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceBufferDeviceAddressFeatures
Refl <- (Typeable e, Typeable PhysicalDeviceBufferDeviceAddressFeatures) =>
Maybe (e :~: PhysicalDeviceBufferDeviceAddressFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceBufferDeviceAddressFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceMemoryPriorityFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceMemoryPriorityFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceMemoryPriorityFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceMemoryPriorityFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceDepthClipEnableFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceDepthClipEnableFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceDepthClipEnableFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceDepthClipEnableFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceUniformBufferStandardLayoutFeatures
Refl <- (Typeable e,
 Typeable PhysicalDeviceUniformBufferStandardLayoutFeatures) =>
Maybe (e :~: PhysicalDeviceUniformBufferStandardLayoutFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceUniformBufferStandardLayoutFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceScalarBlockLayoutFeatures
Refl <- (Typeable e, Typeable PhysicalDeviceScalarBlockLayoutFeatures) =>
Maybe (e :~: PhysicalDeviceScalarBlockLayoutFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceScalarBlockLayoutFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceFragmentDensityMap2FeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceFragmentDensityMap2FeaturesEXT) =>
Maybe (e :~: PhysicalDeviceFragmentDensityMap2FeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceFragmentDensityMap2FeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceFragmentDensityMapFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceFragmentDensityMapFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceFragmentDensityMapFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceFragmentDensityMapFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: DeviceMemoryOverallocationCreateInfoAMD
Refl <- (Typeable e, Typeable DeviceMemoryOverallocationCreateInfoAMD) =>
Maybe (e :~: DeviceMemoryOverallocationCreateInfoAMD)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DeviceMemoryOverallocationCreateInfoAMD = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceRayQueryFeaturesKHR
Refl <- (Typeable e, Typeable PhysicalDeviceRayQueryFeaturesKHR) =>
Maybe (e :~: PhysicalDeviceRayQueryFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceRayQueryFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceRayTracingPipelineFeaturesKHR
Refl <- (Typeable e,
 Typeable PhysicalDeviceRayTracingPipelineFeaturesKHR) =>
Maybe (e :~: PhysicalDeviceRayTracingPipelineFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceRayTracingPipelineFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceAccelerationStructureFeaturesKHR
Refl <- (Typeable e,
 Typeable PhysicalDeviceAccelerationStructureFeaturesKHR) =>
Maybe (e :~: PhysicalDeviceAccelerationStructureFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceAccelerationStructureFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceMeshShaderFeaturesNV
Refl <- (Typeable e, Typeable PhysicalDeviceMeshShaderFeaturesNV) =>
Maybe (e :~: PhysicalDeviceMeshShaderFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceMeshShaderFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceInvocationMaskFeaturesHUAWEI
Refl <- (Typeable e,
 Typeable PhysicalDeviceInvocationMaskFeaturesHUAWEI) =>
Maybe (e :~: PhysicalDeviceInvocationMaskFeaturesHUAWEI)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceInvocationMaskFeaturesHUAWEI = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShadingRateImageFeaturesNV
Refl <- (Typeable e, Typeable PhysicalDeviceShadingRateImageFeaturesNV) =>
Maybe (e :~: PhysicalDeviceShadingRateImageFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShadingRateImageFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceDedicatedAllocationImageAliasingFeaturesNV
Refl <- (Typeable e,
 Typeable
   PhysicalDeviceDedicatedAllocationImageAliasingFeaturesNV) =>
Maybe
  (e :~: PhysicalDeviceDedicatedAllocationImageAliasingFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceDedicatedAllocationImageAliasingFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderImageFootprintFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceShaderImageFootprintFeaturesNV) =>
Maybe (e :~: PhysicalDeviceShaderImageFootprintFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderImageFootprintFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceFragmentShaderBarycentricFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceFragmentShaderBarycentricFeaturesNV) =>
Maybe (e :~: PhysicalDeviceFragmentShaderBarycentricFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceFragmentShaderBarycentricFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceComputeShaderDerivativesFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceComputeShaderDerivativesFeaturesNV) =>
Maybe (e :~: PhysicalDeviceComputeShaderDerivativesFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceComputeShaderDerivativesFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceCornerSampledImageFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceCornerSampledImageFeaturesNV) =>
Maybe (e :~: PhysicalDeviceCornerSampledImageFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceCornerSampledImageFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceExclusiveScissorFeaturesNV
Refl <- (Typeable e, Typeable PhysicalDeviceExclusiveScissorFeaturesNV) =>
Maybe (e :~: PhysicalDeviceExclusiveScissorFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceExclusiveScissorFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceRepresentativeFragmentTestFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceRepresentativeFragmentTestFeaturesNV) =>
Maybe (e :~: PhysicalDeviceRepresentativeFragmentTestFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceRepresentativeFragmentTestFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceTransformFeedbackFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceTransformFeedbackFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceTransformFeedbackFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceTransformFeedbackFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceASTCDecodeFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceASTCDecodeFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceASTCDecodeFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceASTCDecodeFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceVertexAttributeDivisorFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceVertexAttributeDivisorFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceVertexAttributeDivisorFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceVertexAttributeDivisorFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderAtomicFloat2FeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceShaderAtomicFloat2FeaturesEXT) =>
Maybe (e :~: PhysicalDeviceShaderAtomicFloat2FeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderAtomicFloat2FeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderAtomicFloatFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceShaderAtomicFloatFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceShaderAtomicFloatFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderAtomicFloatFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderAtomicInt64Features
Refl <- (Typeable e, Typeable PhysicalDeviceShaderAtomicInt64Features) =>
Maybe (e :~: PhysicalDeviceShaderAtomicInt64Features)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderAtomicInt64Features = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceVulkanMemoryModelFeatures
Refl <- (Typeable e, Typeable PhysicalDeviceVulkanMemoryModelFeatures) =>
Maybe (e :~: PhysicalDeviceVulkanMemoryModelFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceVulkanMemoryModelFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceConditionalRenderingFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceConditionalRenderingFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceConditionalRenderingFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceConditionalRenderingFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevice8BitStorageFeatures
Refl <- (Typeable e, Typeable PhysicalDevice8BitStorageFeatures) =>
Maybe (e :~: PhysicalDevice8BitStorageFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevice8BitStorageFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceTimelineSemaphoreFeatures
Refl <- (Typeable e, Typeable PhysicalDeviceTimelineSemaphoreFeatures) =>
Maybe (e :~: PhysicalDeviceTimelineSemaphoreFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceTimelineSemaphoreFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceDescriptorIndexingFeatures
Refl <- (Typeable e, Typeable PhysicalDeviceDescriptorIndexingFeatures) =>
Maybe (e :~: PhysicalDeviceDescriptorIndexingFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceDescriptorIndexingFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: DeviceDeviceMemoryReportCreateInfoEXT
Refl <- (Typeable e, Typeable DeviceDeviceMemoryReportCreateInfoEXT) =>
Maybe (e :~: DeviceDeviceMemoryReportCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DeviceDeviceMemoryReportCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceDeviceMemoryReportFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceDeviceMemoryReportFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceDeviceMemoryReportFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceDeviceMemoryReportFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceGlobalPriorityQueryFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceGlobalPriorityQueryFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceGlobalPriorityQueryFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceGlobalPriorityQueryFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceHostQueryResetFeatures
Refl <- (Typeable e, Typeable PhysicalDeviceHostQueryResetFeatures) =>
Maybe (e :~: PhysicalDeviceHostQueryResetFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceHostQueryResetFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderFloat16Int8Features
Refl <- (Typeable e, Typeable PhysicalDeviceShaderFloat16Int8Features) =>
Maybe (e :~: PhysicalDeviceShaderFloat16Int8Features)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderFloat16Int8Features = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderDrawParametersFeatures
Refl <- (Typeable e,
 Typeable PhysicalDeviceShaderDrawParametersFeatures) =>
Maybe (e :~: PhysicalDeviceShaderDrawParametersFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderDrawParametersFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceInlineUniformBlockFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceInlineUniformBlockFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceInlineUniformBlockFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceInlineUniformBlockFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceMultiDrawFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDeviceMultiDrawFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceMultiDrawFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceMultiDrawFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceBlendOperationAdvancedFeaturesEXT
Refl <- (Typeable e,
 Typeable PhysicalDeviceBlendOperationAdvancedFeaturesEXT) =>
Maybe (e :~: PhysicalDeviceBlendOperationAdvancedFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceBlendOperationAdvancedFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceProtectedMemoryFeatures
Refl <- (Typeable e, Typeable PhysicalDeviceProtectedMemoryFeatures) =>
Maybe (e :~: PhysicalDeviceProtectedMemoryFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceProtectedMemoryFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceSamplerYcbcrConversionFeatures
Refl <- (Typeable e,
 Typeable PhysicalDeviceSamplerYcbcrConversionFeatures) =>
Maybe (e :~: PhysicalDeviceSamplerYcbcrConversionFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceSamplerYcbcrConversionFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceShaderSubgroupExtendedTypesFeatures
Refl <- (Typeable e,
 Typeable PhysicalDeviceShaderSubgroupExtendedTypesFeatures) =>
Maybe (e :~: PhysicalDeviceShaderSubgroupExtendedTypesFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceShaderSubgroupExtendedTypesFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevice16BitStorageFeatures
Refl <- (Typeable e, Typeable PhysicalDevice16BitStorageFeatures) =>
Maybe (e :~: PhysicalDevice16BitStorageFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevice16BitStorageFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevicePresentWaitFeaturesKHR
Refl <- (Typeable e, Typeable PhysicalDevicePresentWaitFeaturesKHR) =>
Maybe (e :~: PhysicalDevicePresentWaitFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevicePresentWaitFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevicePresentIdFeaturesKHR
Refl <- (Typeable e, Typeable PhysicalDevicePresentIdFeaturesKHR) =>
Maybe (e :~: PhysicalDevicePresentIdFeaturesKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevicePresentIdFeaturesKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: DeviceGroupDeviceCreateInfo
Refl <- (Typeable e, Typeable DeviceGroupDeviceCreateInfo) =>
Maybe (e :~: DeviceGroupDeviceCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DeviceGroupDeviceCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceMultiviewFeatures
Refl <- (Typeable e, Typeable PhysicalDeviceMultiviewFeatures) =>
Maybe (e :~: PhysicalDeviceMultiviewFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceMultiviewFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceVariablePointersFeatures
Refl <- (Typeable e, Typeable PhysicalDeviceVariablePointersFeatures) =>
Maybe (e :~: PhysicalDeviceVariablePointersFeatures)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceVariablePointersFeatures = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceFeatures2 '[]
Refl <- (Typeable e, Typeable (PhysicalDeviceFeatures2 '[])) =>
Maybe (e :~: PhysicalDeviceFeatures2 '[])
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @(PhysicalDeviceFeatures2 '[]) = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDevicePrivateDataFeaturesEXT
Refl <- (Typeable e, Typeable PhysicalDevicePrivateDataFeaturesEXT) =>
Maybe (e :~: PhysicalDevicePrivateDataFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDevicePrivateDataFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: DevicePrivateDataCreateInfoEXT
Refl <- (Typeable e, Typeable DevicePrivateDataCreateInfoEXT) =>
Maybe (e :~: DevicePrivateDataCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DevicePrivateDataCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Just e :~: PhysicalDeviceDeviceGeneratedCommandsFeaturesNV
Refl <- (Typeable e,
 Typeable PhysicalDeviceDeviceGeneratedCommandsFeaturesNV) =>
Maybe (e :~: PhysicalDeviceDeviceGeneratedCommandsFeaturesNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PhysicalDeviceDeviceGeneratedCommandsFeaturesNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DeviceCreateInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss DeviceCreateInfo es, PokeChain es) => ToCStruct (DeviceCreateInfo es) where
  withCStruct :: DeviceCreateInfo es -> (Ptr (DeviceCreateInfo es) -> IO b) -> IO b
withCStruct DeviceCreateInfo es
x Ptr (DeviceCreateInfo es) -> IO b
f = Int -> (Ptr (DeviceCreateInfo es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 ((Ptr (DeviceCreateInfo es) -> IO b) -> IO b)
-> (Ptr (DeviceCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (DeviceCreateInfo es)
p -> Ptr (DeviceCreateInfo es) -> DeviceCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (DeviceCreateInfo es)
p DeviceCreateInfo es
x (Ptr (DeviceCreateInfo es) -> IO b
f Ptr (DeviceCreateInfo es)
p)
  pokeCStruct :: Ptr (DeviceCreateInfo es) -> DeviceCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (DeviceCreateInfo es)
p DeviceCreateInfo{Maybe PhysicalDeviceFeatures
Vector ByteString
Vector (SomeStruct DeviceQueueCreateInfo)
Chain es
DeviceCreateFlags
enabledFeatures :: Maybe PhysicalDeviceFeatures
enabledExtensionNames :: Vector ByteString
enabledLayerNames :: Vector ByteString
queueCreateInfos :: Vector (SomeStruct DeviceQueueCreateInfo)
flags :: DeviceCreateFlags
next :: Chain es
$sel:enabledFeatures:DeviceCreateInfo :: forall (es :: [*]).
DeviceCreateInfo es -> Maybe PhysicalDeviceFeatures
$sel:enabledExtensionNames:DeviceCreateInfo :: forall (es :: [*]). DeviceCreateInfo es -> Vector ByteString
$sel:enabledLayerNames:DeviceCreateInfo :: forall (es :: [*]). DeviceCreateInfo es -> Vector ByteString
$sel:queueCreateInfos:DeviceCreateInfo :: forall (es :: [*]).
DeviceCreateInfo es -> Vector (SomeStruct DeviceQueueCreateInfo)
$sel:flags:DeviceCreateInfo :: forall (es :: [*]). DeviceCreateInfo es -> DeviceCreateFlags
$sel:next:DeviceCreateInfo :: forall (es :: [*]). DeviceCreateInfo es -> Chain es
..} 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 (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_CREATE_INFO)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (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 (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (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
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) 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
$ Ptr DeviceCreateFlags -> DeviceCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr DeviceCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceCreateFlags)) (DeviceCreateFlags
flags)
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (SomeStruct DeviceQueueCreateInfo) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct DeviceQueueCreateInfo) -> Int)
-> Vector (SomeStruct DeviceQueueCreateInfo) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct DeviceQueueCreateInfo)
queueCreateInfos)) :: Word32))
    Ptr (DeviceQueueCreateInfo Any)
pPQueueCreateInfos' <- ((Ptr (DeviceQueueCreateInfo Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (DeviceQueueCreateInfo Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (DeviceQueueCreateInfo Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (DeviceQueueCreateInfo Any)))
-> ((Ptr (DeviceQueueCreateInfo Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (DeviceQueueCreateInfo Any))
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (DeviceQueueCreateInfo Any) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(DeviceQueueCreateInfo _) ((Vector (SomeStruct DeviceQueueCreateInfo) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct DeviceQueueCreateInfo)
queueCreateInfos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
40)
    (Int -> SomeStruct DeviceQueueCreateInfo -> ContT b IO ())
-> Vector (SomeStruct DeviceQueueCreateInfo) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct DeviceQueueCreateInfo
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct DeviceQueueCreateInfo)
-> SomeStruct DeviceQueueCreateInfo -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (DeviceQueueCreateInfo Any)
-> Ptr (SomeStruct DeviceQueueCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (DeviceQueueCreateInfo Any)
pPQueueCreateInfos' Ptr (DeviceQueueCreateInfo Any)
-> Int -> Ptr (DeviceQueueCreateInfo _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (DeviceQueueCreateInfo _))) (SomeStruct DeviceQueueCreateInfo
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct DeviceQueueCreateInfo)
queueCreateInfos)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (DeviceQueueCreateInfo Any))
-> Ptr (DeviceQueueCreateInfo Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es)
-> Int -> Ptr (Ptr (DeviceQueueCreateInfo _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr (DeviceQueueCreateInfo _)))) (Ptr (DeviceQueueCreateInfo Any)
pPQueueCreateInfos')
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ByteString -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ByteString -> Int) -> Vector ByteString -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ByteString
enabledLayerNames)) :: Word32))
    Ptr (Ptr CChar)
pPpEnabledLayerNames' <- ((Ptr (Ptr CChar) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO (Ptr (Ptr CChar)))
-> ((Ptr (Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr (Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (Ptr CChar) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(Ptr CChar) ((Vector ByteString -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ByteString
enabledLayerNames)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
    (Int -> ByteString -> ContT b IO ())
-> Vector ByteString -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i ByteString
e -> do
      Ptr CChar
ppEnabledLayerNames'' <- ((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar))
-> ((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr CChar -> IO b) -> IO b
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
useAsCString (ByteString
e)
      IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Ptr CChar)
pPpEnabledLayerNames' Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) Ptr CChar
ppEnabledLayerNames'') (Vector ByteString
enabledLayerNames)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (Ptr CChar)) -> Ptr (Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr (Ptr (Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr (Ptr CChar)))) (Ptr (Ptr CChar)
pPpEnabledLayerNames')
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ByteString -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ByteString -> Int) -> Vector ByteString -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ByteString
enabledExtensionNames)) :: Word32))
    Ptr (Ptr CChar)
pPpEnabledExtensionNames' <- ((Ptr (Ptr CChar) -> IO b) -> IO b) -> ContT b IO (Ptr (Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Ptr CChar) -> IO b) -> IO b)
 -> ContT b IO (Ptr (Ptr CChar)))
-> ((Ptr (Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr (Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (Ptr CChar) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(Ptr CChar) ((Vector ByteString -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ByteString
enabledExtensionNames)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
    (Int -> ByteString -> ContT b IO ())
-> Vector ByteString -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i ByteString
e -> do
      Ptr CChar
ppEnabledExtensionNames'' <- ((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar))
-> ((Ptr CChar -> IO b) -> IO b) -> ContT b IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr CChar -> IO b) -> IO b
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
useAsCString (ByteString
e)
      IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Ptr CChar)
pPpEnabledExtensionNames' Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) Ptr CChar
ppEnabledExtensionNames'') (Vector ByteString
enabledExtensionNames)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (Ptr CChar)) -> Ptr (Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr (Ptr (Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr (Ptr CChar)))) (Ptr (Ptr CChar)
pPpEnabledExtensionNames')
    Ptr PhysicalDeviceFeatures
pEnabledFeatures'' <- case (Maybe PhysicalDeviceFeatures
enabledFeatures) of
      Maybe PhysicalDeviceFeatures
Nothing -> Ptr PhysicalDeviceFeatures
-> ContT b IO (Ptr PhysicalDeviceFeatures)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr PhysicalDeviceFeatures
forall a. Ptr a
nullPtr
      Just PhysicalDeviceFeatures
j -> ((Ptr PhysicalDeviceFeatures -> IO b) -> IO b)
-> ContT b IO (Ptr PhysicalDeviceFeatures)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr PhysicalDeviceFeatures -> IO b) -> IO b)
 -> ContT b IO (Ptr PhysicalDeviceFeatures))
-> ((Ptr PhysicalDeviceFeatures -> IO b) -> IO b)
-> ContT b IO (Ptr PhysicalDeviceFeatures)
forall a b. (a -> b) -> a -> b
$ PhysicalDeviceFeatures
-> (Ptr PhysicalDeviceFeatures -> IO b) -> IO b
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (PhysicalDeviceFeatures
j)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr PhysicalDeviceFeatures)
-> Ptr PhysicalDeviceFeatures -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es)
-> Int -> Ptr (Ptr PhysicalDeviceFeatures)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr PhysicalDeviceFeatures))) Ptr PhysicalDeviceFeatures
pEnabledFeatures''
    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 = Int
72
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr (DeviceCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (DeviceCreateInfo es)
p IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (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 (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_CREATE_INFO)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (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 (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (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
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    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 DeviceCreateInfo es, PeekChain es) => FromCStruct (DeviceCreateInfo es) where
  peekCStruct :: Ptr (DeviceCreateInfo es) -> IO (DeviceCreateInfo es)
peekCStruct Ptr (DeviceCreateInfo es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    DeviceCreateFlags
flags <- Ptr DeviceCreateFlags -> IO DeviceCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @DeviceCreateFlags ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr DeviceCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceCreateFlags))
    Word32
queueCreateInfoCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    Ptr (DeviceQueueCreateInfo Any)
pQueueCreateInfos <- Ptr (Ptr (DeviceQueueCreateInfo Any))
-> IO (Ptr (DeviceQueueCreateInfo Any))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (DeviceQueueCreateInfo _)) ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es)
-> Int -> Ptr (Ptr (DeviceQueueCreateInfo _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr (DeviceQueueCreateInfo _))))
    Vector (SomeStruct DeviceQueueCreateInfo)
pQueueCreateInfos' <- Int
-> (Int -> IO (SomeStruct DeviceQueueCreateInfo))
-> IO (Vector (SomeStruct DeviceQueueCreateInfo))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
queueCreateInfoCount) (\Int
i -> Ptr (SomeStruct DeviceQueueCreateInfo)
-> IO (SomeStruct DeviceQueueCreateInfo)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (DeviceQueueCreateInfo Any)
-> Ptr (SomeStruct DeviceQueueCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (DeviceQueueCreateInfo Any)
pQueueCreateInfos Ptr (DeviceQueueCreateInfo Any)
-> Int -> Ptr (DeviceQueueCreateInfo Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (DeviceQueueCreateInfo _)))))
    Word32
enabledLayerCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Ptr (Ptr CChar)
ppEnabledLayerNames <- Ptr (Ptr (Ptr CChar)) -> IO (Ptr (Ptr CChar))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr CChar)) ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr (Ptr (Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr (Ptr CChar))))
    Vector ByteString
ppEnabledLayerNames' <- Int -> (Int -> IO ByteString) -> IO (Vector ByteString)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
enabledLayerCount) (\Int
i -> Ptr CChar -> IO ByteString
packCString (Ptr CChar -> IO ByteString) -> IO (Ptr CChar) -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek ((Ptr (Ptr CChar)
ppEnabledLayerNames Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar))))
    Word32
enabledExtensionCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32))
    Ptr (Ptr CChar)
ppEnabledExtensionNames <- Ptr (Ptr (Ptr CChar)) -> IO (Ptr (Ptr CChar))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr CChar)) ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es) -> Int -> Ptr (Ptr (Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr (Ptr CChar))))
    Vector ByteString
ppEnabledExtensionNames' <- Int -> (Int -> IO ByteString) -> IO (Vector ByteString)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
enabledExtensionCount) (\Int
i -> Ptr CChar -> IO ByteString
packCString (Ptr CChar -> IO ByteString) -> IO (Ptr CChar) -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek ((Ptr (Ptr CChar)
ppEnabledExtensionNames Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar))))
    Ptr PhysicalDeviceFeatures
pEnabledFeatures <- Ptr (Ptr PhysicalDeviceFeatures) -> IO (Ptr PhysicalDeviceFeatures)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr PhysicalDeviceFeatures) ((Ptr (DeviceCreateInfo es)
p Ptr (DeviceCreateInfo es)
-> Int -> Ptr (Ptr PhysicalDeviceFeatures)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr PhysicalDeviceFeatures)))
    Maybe PhysicalDeviceFeatures
pEnabledFeatures' <- (Ptr PhysicalDeviceFeatures -> IO PhysicalDeviceFeatures)
-> Ptr PhysicalDeviceFeatures -> IO (Maybe PhysicalDeviceFeatures)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\Ptr PhysicalDeviceFeatures
j -> Ptr PhysicalDeviceFeatures -> IO PhysicalDeviceFeatures
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceFeatures (Ptr PhysicalDeviceFeatures
j)) Ptr PhysicalDeviceFeatures
pEnabledFeatures
    DeviceCreateInfo es -> IO (DeviceCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceCreateInfo es -> IO (DeviceCreateInfo es))
-> DeviceCreateInfo es -> IO (DeviceCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> DeviceCreateFlags
-> Vector (SomeStruct DeviceQueueCreateInfo)
-> Vector ByteString
-> Vector ByteString
-> Maybe PhysicalDeviceFeatures
-> DeviceCreateInfo es
forall (es :: [*]).
Chain es
-> DeviceCreateFlags
-> Vector (SomeStruct DeviceQueueCreateInfo)
-> Vector ByteString
-> Vector ByteString
-> Maybe PhysicalDeviceFeatures
-> DeviceCreateInfo es
DeviceCreateInfo
             Chain es
next DeviceCreateFlags
flags Vector (SomeStruct DeviceQueueCreateInfo)
pQueueCreateInfos' Vector ByteString
ppEnabledLayerNames' Vector ByteString
ppEnabledExtensionNames' Maybe PhysicalDeviceFeatures
pEnabledFeatures'

instance es ~ '[] => Zero (DeviceCreateInfo es) where
  zero :: DeviceCreateInfo es
zero = Chain es
-> DeviceCreateFlags
-> Vector (SomeStruct DeviceQueueCreateInfo)
-> Vector ByteString
-> Vector ByteString
-> Maybe PhysicalDeviceFeatures
-> DeviceCreateInfo es
forall (es :: [*]).
Chain es
-> DeviceCreateFlags
-> Vector (SomeStruct DeviceQueueCreateInfo)
-> Vector ByteString
-> Vector ByteString
-> Maybe PhysicalDeviceFeatures
-> DeviceCreateInfo es
DeviceCreateInfo
           ()
           DeviceCreateFlags
forall a. Zero a => a
zero
           Vector (SomeStruct DeviceQueueCreateInfo)
forall a. Monoid a => a
mempty
           Vector ByteString
forall a. Monoid a => a
mempty
           Vector ByteString
forall a. Monoid a => a
mempty
           Maybe PhysicalDeviceFeatures
forall a. Maybe a
Nothing