{-# LINE 1 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

{-# LINE 2 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
module Graphics.Vulkan.Types.Struct.PhysicalDevice
       (VkPhysicalDevice16BitStorageFeatures(..),
        VkPhysicalDevice16BitStorageFeaturesKHR,
        VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT(..),
        VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT(..),
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT(..),
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT(..),
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT(..),
        VkPhysicalDeviceDiscardRectanglePropertiesEXT(..),
        VkPhysicalDeviceExternalBufferInfo(..),
        VkPhysicalDeviceExternalBufferInfoKHR,
        VkPhysicalDeviceExternalFenceInfo(..),
        VkPhysicalDeviceExternalFenceInfoKHR,
        VkPhysicalDeviceExternalImageFormatInfo(..),
        VkPhysicalDeviceExternalImageFormatInfoKHR,
        VkPhysicalDeviceExternalMemoryHostPropertiesEXT(..),
        VkPhysicalDeviceExternalSemaphoreInfo(..),
        VkPhysicalDeviceExternalSemaphoreInfoKHR,
        VkPhysicalDeviceFeatures2(..), VkPhysicalDeviceFeatures2KHR,
        VkPhysicalDeviceGroupProperties(..),
        VkPhysicalDeviceGroupPropertiesKHR,
        VkPhysicalDeviceIDProperties(..), VkPhysicalDeviceIDPropertiesKHR,
        VkPhysicalDeviceImageFormatInfo2(..),
        VkPhysicalDeviceImageFormatInfo2KHR, VkPhysicalDeviceLimits(..),
        VkPhysicalDeviceMaintenance3Properties(..),
        VkPhysicalDeviceMaintenance3PropertiesKHR,
        VkPhysicalDeviceMemoryProperties(..),
        VkPhysicalDeviceMemoryProperties2(..),
        VkPhysicalDeviceMemoryProperties2KHR,
        VkPhysicalDeviceMultiviewFeatures(..),
        VkPhysicalDeviceMultiviewFeaturesKHR,
        VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX(..),
        VkPhysicalDeviceMultiviewProperties(..),
        VkPhysicalDeviceMultiviewPropertiesKHR,
        VkPhysicalDevicePointClippingProperties(..),
        VkPhysicalDevicePointClippingPropertiesKHR,
        VkPhysicalDeviceProperties(..), VkPhysicalDeviceProperties2(..),
        VkPhysicalDeviceProperties2KHR,
        VkPhysicalDeviceProtectedMemoryFeatures(..),
        VkPhysicalDeviceProtectedMemoryProperties(..),
        VkPhysicalDevicePushDescriptorPropertiesKHR(..),
        VkPhysicalDeviceSampleLocationsPropertiesEXT(..),
        VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT(..),
        VkPhysicalDeviceSamplerYcbcrConversionFeatures(..),
        VkPhysicalDeviceSamplerYcbcrConversionFeaturesKHR,
        VkPhysicalDeviceShaderCorePropertiesAMD(..),
        VkPhysicalDeviceShaderDrawParameterFeatures(..),
        VkPhysicalDeviceSparseImageFormatInfo2(..),
        VkPhysicalDeviceSparseImageFormatInfo2KHR,
        VkPhysicalDeviceSparseProperties(..),
        VkPhysicalDeviceSubgroupProperties(..),
        VkPhysicalDeviceSurfaceInfo2KHR(..),
        VkPhysicalDeviceVariablePointerFeatures(..),
        VkPhysicalDeviceVariablePointerFeaturesKHR,
        VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT(..))
       where
import           Foreign.Storable                                    (Storable (..))
import           GHC.Base                                            (Addr#,
                                                                      ByteArray#,
                                                                      Proxy#,
                                                                      byteArrayContents#,
                                                                      plusAddr#,
                                                                      proxy#)
import           GHC.TypeLits                                        (KnownNat,
                                                                      natVal') -- ' closing tick for hsc2hs
import           Graphics.Vulkan.Constants                           (VK_LUID_SIZE,
                                                                      pattern VK_LUID_SIZE,
                                                                      VK_MAX_DEVICE_GROUP_SIZE,
                                                                      pattern VK_MAX_DEVICE_GROUP_SIZE,
                                                                      VK_MAX_MEMORY_HEAPS,
                                                                      pattern VK_MAX_MEMORY_HEAPS,
                                                                      VK_MAX_MEMORY_TYPES,
                                                                      pattern VK_MAX_MEMORY_TYPES,
                                                                      VK_MAX_PHYSICAL_DEVICE_NAME_SIZE,
                                                                      pattern VK_MAX_PHYSICAL_DEVICE_NAME_SIZE,
                                                                      VK_UUID_SIZE,
                                                                      pattern VK_UUID_SIZE)
import           Graphics.Vulkan.Marshal
import           Graphics.Vulkan.Marshal.Internal
import           Graphics.Vulkan.Types.BaseTypes                     (VkBool32, VkDeviceSize)
import           Graphics.Vulkan.Types.Enum.Buffer                   (VkBufferCreateFlags,
                                                                      VkBufferUsageFlags)
import           Graphics.Vulkan.Types.Enum.External                 (VkExternalFenceHandleTypeFlagBits,
                                                                      VkExternalMemoryHandleTypeFlagBits,
                                                                      VkExternalSemaphoreHandleTypeFlagBits)
import           Graphics.Vulkan.Types.Enum.Format                   (VkFormat)
import           Graphics.Vulkan.Types.Enum.Image                    (VkImageCreateFlags,
                                                                      VkImageTiling,
                                                                      VkImageType,
                                                                      VkImageUsageFlags)
import           Graphics.Vulkan.Types.Enum.PhysicalDeviceType       (VkPhysicalDeviceType)
import           Graphics.Vulkan.Types.Enum.PointClippingBehavior    (VkPointClippingBehavior)
import           Graphics.Vulkan.Types.Enum.SampleCountFlags         (VkSampleCountFlagBits,
                                                                      VkSampleCountFlags)
import           Graphics.Vulkan.Types.Enum.Shader                   (VkShaderStageFlags)
import           Graphics.Vulkan.Types.Enum.StructureType            (VkStructureType)
import           Graphics.Vulkan.Types.Enum.SubgroupFeatureFlags     (VkSubgroupFeatureFlags)
import           Graphics.Vulkan.Types.Handles                       (VkPhysicalDevice,
                                                                      VkSurfaceKHR)
import           Graphics.Vulkan.Types.Struct.Device                 (VkDeviceCreateInfo)
import           Graphics.Vulkan.Types.Struct.Extent                 (VkExtent2D)
import           Graphics.Vulkan.Types.Struct.Memory                 (VkMemoryHeap,
                                                                      VkMemoryType)
import           Graphics.Vulkan.Types.Struct.PhysicalDeviceFeatures (VkPhysicalDeviceFeatures)
import           System.IO.Unsafe                                    (unsafeDupablePerformIO)

-- | > typedef struct VkPhysicalDevice16BitStorageFeatures {
--   >     VkStructureType sType;
--   >     void*      pNext;
--   >     VkBool32                         storageBuffer16BitAccess;
--   >     VkBool32                         uniformAndStorageBuffer16BitAccess;
--   >     VkBool32                         storagePushConstant16;
--   >     VkBool32                         storageInputOutput16;
--   > } VkPhysicalDevice16BitStorageFeatures;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDevice16BitStorageFeatures VkPhysicalDevice16BitStorageFeatures registry at www.khronos.org>
data VkPhysicalDevice16BitStorageFeatures = VkPhysicalDevice16BitStorageFeatures# Addr#
                                                                                  ByteArray#

instance Eq VkPhysicalDevice16BitStorageFeatures where
        (VkPhysicalDevice16BitStorageFeatures# a _) ==
          x@(VkPhysicalDevice16BitStorageFeatures# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDevice16BitStorageFeatures where
        (VkPhysicalDevice16BitStorageFeatures# a _) `compare`
          x@(VkPhysicalDevice16BitStorageFeatures# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDevice16BitStorageFeatures where
        sizeOf ~_
          = (32)
{-# LINE 150 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 154 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDevice16BitStorageFeatures
         where
        unsafeAddr (VkPhysicalDevice16BitStorageFeatures# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDevice16BitStorageFeatures# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDevice16BitStorageFeatures#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDevice16BitStorageFeatures where
        type StructFields VkPhysicalDevice16BitStorageFeatures =
             '["sType", "pNext", "storageBuffer16BitAccess", -- ' closing tick for hsc2hs
               "uniformAndStorageBuffer16BitAccess", "storagePushConstant16",
               "storageInputOutput16"]
        type CUnionType VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDevice16BitStorageFeatures =
             '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDevice16BitStorageFeatures where
        type FieldType "sType" VkPhysicalDevice16BitStorageFeatures =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDevice16BitStorageFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDevice16BitStorageFeatures =
             (0)
{-# LINE 196 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDevice16BitStorageFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 205 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDevice16BitStorageFeatures where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 212 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 216 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDevice16BitStorageFeatures where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 222 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDevice16BitStorageFeatures where
        type FieldType "pNext" VkPhysicalDevice16BitStorageFeatures =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDevice16BitStorageFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDevice16BitStorageFeatures =
             (8)
{-# LINE 231 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDevice16BitStorageFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 240 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDevice16BitStorageFeatures where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 247 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 251 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDevice16BitStorageFeatures where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 257 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "storageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        type FieldType "storageBuffer16BitAccess"
               VkPhysicalDevice16BitStorageFeatures
             = VkBool32
        type FieldOptional "storageBuffer16BitAccess"
               VkPhysicalDevice16BitStorageFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "storageBuffer16BitAccess"
               VkPhysicalDevice16BitStorageFeatures
             =
             (16)
{-# LINE 272 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "storageBuffer16BitAccess"
               VkPhysicalDevice16BitStorageFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 282 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "storageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 291 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 295 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "storageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 303 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "uniformAndStorageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        type FieldType "uniformAndStorageBuffer16BitAccess"
               VkPhysicalDevice16BitStorageFeatures
             = VkBool32
        type FieldOptional "uniformAndStorageBuffer16BitAccess"
               VkPhysicalDevice16BitStorageFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "uniformAndStorageBuffer16BitAccess"
               VkPhysicalDevice16BitStorageFeatures
             =
             (20)
{-# LINE 318 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "uniformAndStorageBuffer16BitAccess"
               VkPhysicalDevice16BitStorageFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 328 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "uniformAndStorageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 337 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 341 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "uniformAndStorageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 349 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "storagePushConstant16"
           VkPhysicalDevice16BitStorageFeatures
         where
        type FieldType "storagePushConstant16"
               VkPhysicalDevice16BitStorageFeatures
             = VkBool32
        type FieldOptional "storagePushConstant16"
               VkPhysicalDevice16BitStorageFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "storagePushConstant16"
               VkPhysicalDevice16BitStorageFeatures
             =
             (24)
{-# LINE 364 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "storagePushConstant16"
               VkPhysicalDevice16BitStorageFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 374 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "storagePushConstant16"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 383 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 387 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "storagePushConstant16"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 395 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "storageInputOutput16"
           VkPhysicalDevice16BitStorageFeatures
         where
        type FieldType "storageInputOutput16"
               VkPhysicalDevice16BitStorageFeatures
             = VkBool32
        type FieldOptional "storageInputOutput16"
               VkPhysicalDevice16BitStorageFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "storageInputOutput16"
               VkPhysicalDevice16BitStorageFeatures
             =
             (28)
{-# LINE 410 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "storageInputOutput16"
               VkPhysicalDevice16BitStorageFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 420 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "storageInputOutput16"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 429 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 433 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "storageInputOutput16"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 441 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDevice16BitStorageFeatures where
        showsPrec d x
          = showString "VkPhysicalDevice16BitStorageFeatures {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "storageBuffer16BitAccess = " .
                            showsPrec d (getField @"storageBuffer16BitAccess" x) .
                              showString ", " .
                                showString "uniformAndStorageBuffer16BitAccess = " .
                                  showsPrec d (getField @"uniformAndStorageBuffer16BitAccess" x) .
                                    showString ", " .
                                      showString "storagePushConstant16 = " .
                                        showsPrec d (getField @"storagePushConstant16" x) .
                                          showString ", " .
                                            showString "storageInputOutput16 = " .
                                              showsPrec d (getField @"storageInputOutput16" x) .
                                                showChar '}'

-- | Alias for `VkPhysicalDevice16BitStorageFeatures`
type VkPhysicalDevice16BitStorageFeaturesKHR =
     VkPhysicalDevice16BitStorageFeatures

-- | > typedef struct VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkBool32                         advancedBlendCoherentOperations;
--   > } VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT registry at www.khronos.org>
data VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# Addr#
                                                                                                            ByteArray#

instance Eq VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where
        (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# a _) ==
          x@(VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# a _) `compare`
          x@(VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        sizeOf ~_
          = (24)
{-# LINE 497 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 501 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        unsafeAddr (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# a _)
          = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        type StructFields VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = '["sType", "pNext", "advancedBlendCoherentOperations"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type StructExtends
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = '[VkPhysicalDeviceFeatures2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        type FieldType "sType"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             =
             (0)
{-# LINE 554 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 564 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 573 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 577 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 585 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        type FieldType "pNext"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             =
             (8)
{-# LINE 599 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 609 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 618 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 622 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 630 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "advancedBlendCoherentOperations"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        type FieldType "advancedBlendCoherentOperations"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = VkBool32
        type FieldOptional "advancedBlendCoherentOperations"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "advancedBlendCoherentOperations"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             =
             (16)
{-# LINE 645 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "advancedBlendCoherentOperations"
               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 655 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendCoherentOperations"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 664 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 668 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendCoherentOperations"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 676 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        showsPrec d x
          = showString "VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT {"
              .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "advancedBlendCoherentOperations = " .
                            showsPrec d (getField @"advancedBlendCoherentOperations" x) .
                              showChar '}'

-- | > typedef struct VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     uint32_t                         advancedBlendMaxColorAttachments;
--   >     VkBool32                         advancedBlendIndependentBlend;
--   >     VkBool32                         advancedBlendNonPremultipliedSrcColor;
--   >     VkBool32                         advancedBlendNonPremultipliedDstColor;
--   >     VkBool32                         advancedBlendCorrelatedOverlap;
--   >     VkBool32                         advancedBlendAllOperations;
--   > } VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT registry at www.khronos.org>
data VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# Addr#
                                                                                                                ByteArray#

instance Eq VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# a _) ==
          x@(VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# a _)
          `compare`
          x@(VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        sizeOf ~_
          = (40)
{-# LINE 729 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 733 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        unsafeAddr
          (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        type StructFields
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             =
             '["sType", "pNext", "advancedBlendMaxColorAttachments", -- ' closing tick for hsc2hs
               "advancedBlendIndependentBlend",
               "advancedBlendNonPremultipliedSrcColor",
               "advancedBlendNonPremultipliedDstColor",
               "advancedBlendCorrelatedOverlap", "advancedBlendAllOperations"]
        type CUnionType VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'True -- ' closing tick for hsc2hs
        type StructExtends
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        type FieldType "sType"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             =
             (0)
{-# LINE 794 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 804 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 813 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 817 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 825 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        type FieldType "pNext"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             =
             (8)
{-# LINE 840 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 850 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 859 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 863 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 871 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "advancedBlendMaxColorAttachments"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        type FieldType "advancedBlendMaxColorAttachments"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = Word32
        type FieldOptional "advancedBlendMaxColorAttachments"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "advancedBlendMaxColorAttachments"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             =
             (16)
{-# LINE 886 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "advancedBlendMaxColorAttachments"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 896 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendMaxColorAttachments"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 905 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 909 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendMaxColorAttachments"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 917 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "advancedBlendIndependentBlend"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        type FieldType "advancedBlendIndependentBlend"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = VkBool32
        type FieldOptional "advancedBlendIndependentBlend"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "advancedBlendIndependentBlend"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             =
             (20)
{-# LINE 932 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "advancedBlendIndependentBlend"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 942 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendIndependentBlend"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 951 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 955 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendIndependentBlend"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 963 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "advancedBlendNonPremultipliedSrcColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        type FieldType "advancedBlendNonPremultipliedSrcColor"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = VkBool32
        type FieldOptional "advancedBlendNonPremultipliedSrcColor"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "advancedBlendNonPremultipliedSrcColor"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             =
             (24)
{-# LINE 978 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "advancedBlendNonPremultipliedSrcColor"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 988 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendNonPremultipliedSrcColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 997 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 1001 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendNonPremultipliedSrcColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 1009 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "advancedBlendNonPremultipliedDstColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        type FieldType "advancedBlendNonPremultipliedDstColor"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = VkBool32
        type FieldOptional "advancedBlendNonPremultipliedDstColor"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "advancedBlendNonPremultipliedDstColor"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             =
             (28)
{-# LINE 1024 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "advancedBlendNonPremultipliedDstColor"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 1034 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendNonPremultipliedDstColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 1043 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 1047 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendNonPremultipliedDstColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 1055 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "advancedBlendCorrelatedOverlap"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        type FieldType "advancedBlendCorrelatedOverlap"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = VkBool32
        type FieldOptional "advancedBlendCorrelatedOverlap"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "advancedBlendCorrelatedOverlap"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             =
             (32)
{-# LINE 1070 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "advancedBlendCorrelatedOverlap"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (32)
{-# LINE 1080 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendCorrelatedOverlap"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 1089 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (32)
{-# LINE 1093 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendCorrelatedOverlap"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 1101 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "advancedBlendAllOperations"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        type FieldType "advancedBlendAllOperations"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = VkBool32
        type FieldOptional "advancedBlendAllOperations"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "advancedBlendAllOperations"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             =
             (36)
{-# LINE 1116 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "advancedBlendAllOperations"
               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (36)
{-# LINE 1126 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendAllOperations"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (36))
{-# LINE 1135 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (36)
{-# LINE 1139 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendAllOperations"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (36)
{-# LINE 1147 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        showsPrec d x
          = showString
              "VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT {"
              .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "advancedBlendMaxColorAttachments = " .
                            showsPrec d (getField @"advancedBlendMaxColorAttachments" x) .
                              showString ", " .
                                showString "advancedBlendIndependentBlend = " .
                                  showsPrec d (getField @"advancedBlendIndependentBlend" x) .
                                    showString ", " .
                                      showString "advancedBlendNonPremultipliedSrcColor = " .
                                        showsPrec d
                                          (getField @"advancedBlendNonPremultipliedSrcColor" x)
                                          .
                                          showString ", " .
                                            showString "advancedBlendNonPremultipliedDstColor = " .
                                              showsPrec d
                                                (getField @"advancedBlendNonPremultipliedDstColor"
                                                   x)
                                                .
                                                showString ", " .
                                                  showString "advancedBlendCorrelatedOverlap = " .
                                                    showsPrec d
                                                      (getField @"advancedBlendCorrelatedOverlap" x)
                                                      .
                                                      showString ", " .
                                                        showString "advancedBlendAllOperations = " .
                                                          showsPrec d
                                                            (getField @"advancedBlendAllOperations"
                                                               x)
                                                            . showChar '}'

-- | > typedef struct VkPhysicalDeviceConservativeRasterizationPropertiesEXT {
--   >     VkStructureType sType;
--   >     void*                  pNext;
--   >     float                  primitiveOverestimationSize;
--   >     float                  maxExtraPrimitiveOverestimationSize;
--   >     float                  extraPrimitiveOverestimationSizeGranularity;
--   >     VkBool32               primitiveUnderestimation;
--   >     VkBool32               conservativePointAndLineRasterization;
--   >     VkBool32               degenerateTrianglesRasterized;
--   >     VkBool32               degenerateLinesRasterized;
--   >     VkBool32               fullyCoveredFragmentShaderInputVariable;
--   >     VkBool32               conservativeRasterizationPostDepthCoverage;
--   > } VkPhysicalDeviceConservativeRasterizationPropertiesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceConservativeRasterizationPropertiesEXT VkPhysicalDeviceConservativeRasterizationPropertiesEXT registry at www.khronos.org>
data VkPhysicalDeviceConservativeRasterizationPropertiesEXT = VkPhysicalDeviceConservativeRasterizationPropertiesEXT# Addr#
                                                                                                                      ByteArray#

instance Eq VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        (VkPhysicalDeviceConservativeRasterizationPropertiesEXT# a _) ==
          x@(VkPhysicalDeviceConservativeRasterizationPropertiesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        (VkPhysicalDeviceConservativeRasterizationPropertiesEXT# a _)
          `compare`
          x@(VkPhysicalDeviceConservativeRasterizationPropertiesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        sizeOf ~_
          = (56)
{-# LINE 1228 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 1232 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        unsafeAddr
          (VkPhysicalDeviceConservativeRasterizationPropertiesEXT# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceConservativeRasterizationPropertiesEXT# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceConservativeRasterizationPropertiesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type StructFields
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             '["sType", "pNext", "primitiveOverestimationSize", -- ' closing tick for hsc2hs
               "maxExtraPrimitiveOverestimationSize",
               "extraPrimitiveOverestimationSizeGranularity",
               "primitiveUnderestimation",
               "conservativePointAndLineRasterization",
               "degenerateTrianglesRasterized", "degenerateLinesRasterized",
               "fullyCoveredFragmentShaderInputVariable",
               "conservativeRasterizationPostDepthCoverage"]
        type CUnionType
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type StructExtends
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "sType"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (0)
{-# LINE 1297 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 1307 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 1316 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 1320 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 1328 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "pNext"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (8)
{-# LINE 1343 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 1353 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 1362 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 1366 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 1374 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "primitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "primitiveOverestimationSize"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = Float
{-# LINE 1382 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "primitiveOverestimationSize"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "primitiveOverestimationSize"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (16)
{-# LINE 1389 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "primitiveOverestimationSize"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 1399 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "primitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 1408 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 1412 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "primitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 1420 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxExtraPrimitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "maxExtraPrimitiveOverestimationSize"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = Float
{-# LINE 1428 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "maxExtraPrimitiveOverestimationSize"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxExtraPrimitiveOverestimationSize"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (20)
{-# LINE 1435 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxExtraPrimitiveOverestimationSize"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 1445 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxExtraPrimitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 1454 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 1458 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxExtraPrimitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 1466 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "extraPrimitiveOverestimationSizeGranularity"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "extraPrimitiveOverestimationSizeGranularity"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = Float
{-# LINE 1474 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "extraPrimitiveOverestimationSizeGranularity"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "extraPrimitiveOverestimationSizeGranularity"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (24)
{-# LINE 1481 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "extraPrimitiveOverestimationSizeGranularity"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 1491 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "extraPrimitiveOverestimationSizeGranularity"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 1500 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 1504 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "extraPrimitiveOverestimationSizeGranularity"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 1512 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "primitiveUnderestimation"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "primitiveUnderestimation"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = VkBool32
        type FieldOptional "primitiveUnderestimation"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "primitiveUnderestimation"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (28)
{-# LINE 1527 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "primitiveUnderestimation"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 1537 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "primitiveUnderestimation"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 1546 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 1550 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "primitiveUnderestimation"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 1558 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "conservativePointAndLineRasterization"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "conservativePointAndLineRasterization"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = VkBool32
        type FieldOptional "conservativePointAndLineRasterization"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "conservativePointAndLineRasterization"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (32)
{-# LINE 1573 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "conservativePointAndLineRasterization"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (32)
{-# LINE 1583 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "conservativePointAndLineRasterization"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 1592 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (32)
{-# LINE 1596 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "conservativePointAndLineRasterization"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 1604 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "degenerateTrianglesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "degenerateTrianglesRasterized"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = VkBool32
        type FieldOptional "degenerateTrianglesRasterized"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "degenerateTrianglesRasterized"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (36)
{-# LINE 1619 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "degenerateTrianglesRasterized"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (36)
{-# LINE 1629 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "degenerateTrianglesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (36))
{-# LINE 1638 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (36)
{-# LINE 1642 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "degenerateTrianglesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (36)
{-# LINE 1650 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "degenerateLinesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "degenerateLinesRasterized"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = VkBool32
        type FieldOptional "degenerateLinesRasterized"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "degenerateLinesRasterized"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (40)
{-# LINE 1665 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "degenerateLinesRasterized"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (40)
{-# LINE 1675 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "degenerateLinesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (40))
{-# LINE 1684 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (40)
{-# LINE 1688 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "degenerateLinesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (40)
{-# LINE 1696 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "fullyCoveredFragmentShaderInputVariable"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "fullyCoveredFragmentShaderInputVariable"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = VkBool32
        type FieldOptional "fullyCoveredFragmentShaderInputVariable"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "fullyCoveredFragmentShaderInputVariable"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (44)
{-# LINE 1711 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "fullyCoveredFragmentShaderInputVariable"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (44)
{-# LINE 1721 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "fullyCoveredFragmentShaderInputVariable"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (44))
{-# LINE 1730 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (44)
{-# LINE 1734 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "fullyCoveredFragmentShaderInputVariable"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (44)
{-# LINE 1742 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "conservativeRasterizationPostDepthCoverage"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        type FieldType "conservativeRasterizationPostDepthCoverage"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = VkBool32
        type FieldOptional "conservativeRasterizationPostDepthCoverage"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "conservativeRasterizationPostDepthCoverage"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             =
             (48)
{-# LINE 1757 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "conservativeRasterizationPostDepthCoverage"
               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (48)
{-# LINE 1767 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "conservativeRasterizationPostDepthCoverage"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (48))
{-# LINE 1776 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (48)
{-# LINE 1780 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "conservativeRasterizationPostDepthCoverage"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (48)
{-# LINE 1788 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        showsPrec d x
          = showString
              "VkPhysicalDeviceConservativeRasterizationPropertiesEXT {"
              .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "primitiveOverestimationSize = " .
                            showsPrec d (getField @"primitiveOverestimationSize" x) .
                              showString ", " .
                                showString "maxExtraPrimitiveOverestimationSize = " .
                                  showsPrec d (getField @"maxExtraPrimitiveOverestimationSize" x) .
                                    showString ", " .
                                      showString "extraPrimitiveOverestimationSizeGranularity = " .
                                        showsPrec d
                                          (getField @"extraPrimitiveOverestimationSizeGranularity"
                                             x)
                                          .
                                          showString ", " .
                                            showString "primitiveUnderestimation = " .
                                              showsPrec d (getField @"primitiveUnderestimation" x) .
                                                showString ", " .
                                                  showString
                                                    "conservativePointAndLineRasterization = "
                                                    .
                                                    showsPrec d
                                                      (getField
                                                         @"conservativePointAndLineRasterization"
                                                         x)
                                                      .
                                                      showString ", " .
                                                        showString
                                                          "degenerateTrianglesRasterized = "
                                                          .
                                                          showsPrec d
                                                            (getField
                                                               @"degenerateTrianglesRasterized"
                                                               x)
                                                            .
                                                            showString ", " .
                                                              showString
                                                                "degenerateLinesRasterized = "
                                                                .
                                                                showsPrec d
                                                                  (getField
                                                                     @"degenerateLinesRasterized"
                                                                     x)
                                                                  .
                                                                  showString ", " .
                                                                    showString
                                                                      "fullyCoveredFragmentShaderInputVariable = "
                                                                      .
                                                                      showsPrec d
                                                                        (getField
                                                                           @"fullyCoveredFragmentShaderInputVariable"
                                                                           x)
                                                                        .
                                                                        showString ", " .
                                                                          showString
                                                                            "conservativeRasterizationPostDepthCoverage = "
                                                                            .
                                                                            showsPrec d
                                                                              (getField
                                                                                 @"conservativeRasterizationPostDepthCoverage"
                                                                                 x)
                                                                              . showChar '}'

-- | > typedef struct VkPhysicalDeviceDescriptorIndexingFeaturesEXT {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkBool32               shaderInputAttachmentArrayDynamicIndexing;
--   >     VkBool32               shaderUniformTexelBufferArrayDynamicIndexing;
--   >     VkBool32               shaderStorageTexelBufferArrayDynamicIndexing;
--   >     VkBool32               shaderUniformBufferArrayNonUniformIndexing;
--   >     VkBool32               shaderSampledImageArrayNonUniformIndexing;
--   >     VkBool32               shaderStorageBufferArrayNonUniformIndexing;
--   >     VkBool32               shaderStorageImageArrayNonUniformIndexing;
--   >     VkBool32               shaderInputAttachmentArrayNonUniformIndexing;
--   >     VkBool32               shaderUniformTexelBufferArrayNonUniformIndexing;
--   >     VkBool32               shaderStorageTexelBufferArrayNonUniformIndexing;
--   >     VkBool32               descriptorBindingUniformBufferUpdateAfterBind;
--   >     VkBool32               descriptorBindingSampledImageUpdateAfterBind;
--   >     VkBool32               descriptorBindingStorageImageUpdateAfterBind;
--   >     VkBool32               descriptorBindingStorageBufferUpdateAfterBind;
--   >     VkBool32               descriptorBindingUniformTexelBufferUpdateAfterBind;
--   >     VkBool32               descriptorBindingStorageTexelBufferUpdateAfterBind;
--   >     VkBool32               descriptorBindingUpdateUnusedWhilePending;
--   >     VkBool32               descriptorBindingPartiallyBound;
--   >     VkBool32               descriptorBindingVariableDescriptorCount;
--   >     VkBool32               runtimeDescriptorArray;
--   > } VkPhysicalDeviceDescriptorIndexingFeaturesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceDescriptorIndexingFeaturesEXT VkPhysicalDeviceDescriptorIndexingFeaturesEXT registry at www.khronos.org>
data VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkPhysicalDeviceDescriptorIndexingFeaturesEXT# Addr#
                                                                                                    ByteArray#

instance Eq VkPhysicalDeviceDescriptorIndexingFeaturesEXT where
        (VkPhysicalDeviceDescriptorIndexingFeaturesEXT# a _) ==
          x@(VkPhysicalDeviceDescriptorIndexingFeaturesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceDescriptorIndexingFeaturesEXT where
        (VkPhysicalDeviceDescriptorIndexingFeaturesEXT# a _) `compare`
          x@(VkPhysicalDeviceDescriptorIndexingFeaturesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        sizeOf ~_
          = (96)
{-# LINE 1909 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 1913 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        unsafeAddr (VkPhysicalDeviceDescriptorIndexingFeaturesEXT# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceDescriptorIndexingFeaturesEXT# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceDescriptorIndexingFeaturesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type StructFields VkPhysicalDeviceDescriptorIndexingFeaturesEXT =
             '["sType", "pNext", "shaderInputAttachmentArrayDynamicIndexing", -- ' closing tick for hsc2hs
               "shaderUniformTexelBufferArrayDynamicIndexing",
               "shaderStorageTexelBufferArrayDynamicIndexing",
               "shaderUniformBufferArrayNonUniformIndexing",
               "shaderSampledImageArrayNonUniformIndexing",
               "shaderStorageBufferArrayNonUniformIndexing",
               "shaderStorageImageArrayNonUniformIndexing",
               "shaderInputAttachmentArrayNonUniformIndexing",
               "shaderUniformTexelBufferArrayNonUniformIndexing",
               "shaderStorageTexelBufferArrayNonUniformIndexing",
               "descriptorBindingUniformBufferUpdateAfterBind",
               "descriptorBindingSampledImageUpdateAfterBind",
               "descriptorBindingStorageImageUpdateAfterBind",
               "descriptorBindingStorageBufferUpdateAfterBind",
               "descriptorBindingUniformTexelBufferUpdateAfterBind",
               "descriptorBindingStorageTexelBufferUpdateAfterBind",
               "descriptorBindingUpdateUnusedWhilePending",
               "descriptorBindingPartiallyBound",
               "descriptorBindingVariableDescriptorCount",
               "runtimeDescriptorArray"]
        type CUnionType VkPhysicalDeviceDescriptorIndexingFeaturesEXT =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceDescriptorIndexingFeaturesEXT =
             'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceDescriptorIndexingFeaturesEXT =
             '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "sType"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (0)
{-# LINE 1983 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 1993 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 2001 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 2005 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 2012 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "pNext"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (8)
{-# LINE 2026 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 2036 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 2044 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 2048 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 2055 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderInputAttachmentArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderInputAttachmentArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "shaderInputAttachmentArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderInputAttachmentArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (16)
{-# LINE 2070 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderInputAttachmentArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 2080 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderInputAttachmentArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 2089 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 2093 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderInputAttachmentArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 2101 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderUniformTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderUniformTexelBufferArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "shaderUniformTexelBufferArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderUniformTexelBufferArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (20)
{-# LINE 2116 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderUniformTexelBufferArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 2126 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderUniformTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 2135 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 2139 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderUniformTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 2147 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderStorageTexelBufferArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "shaderStorageTexelBufferArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageTexelBufferArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (24)
{-# LINE 2162 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderStorageTexelBufferArrayDynamicIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 2172 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 2181 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 2185 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 2193 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderUniformBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderUniformBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "shaderUniformBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderUniformBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (28)
{-# LINE 2208 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderUniformBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 2218 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderUniformBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 2227 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 2231 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderUniformBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 2239 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderSampledImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderSampledImageArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "shaderSampledImageArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderSampledImageArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (32)
{-# LINE 2254 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderSampledImageArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (32)
{-# LINE 2264 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderSampledImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 2273 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (32)
{-# LINE 2277 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderSampledImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 2285 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderStorageBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "shaderStorageBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (36)
{-# LINE 2300 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderStorageBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (36)
{-# LINE 2310 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (36))
{-# LINE 2319 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (36)
{-# LINE 2323 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (36)
{-# LINE 2331 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderStorageImageArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "shaderStorageImageArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageImageArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (40)
{-# LINE 2346 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderStorageImageArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (40)
{-# LINE 2356 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (40))
{-# LINE 2365 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (40)
{-# LINE 2369 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (40)
{-# LINE 2377 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderInputAttachmentArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderInputAttachmentArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "shaderInputAttachmentArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderInputAttachmentArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (44)
{-# LINE 2392 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderInputAttachmentArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (44)
{-# LINE 2402 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderInputAttachmentArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (44))
{-# LINE 2411 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (44)
{-# LINE 2415 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderInputAttachmentArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (44)
{-# LINE 2423 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderUniformTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderUniformTexelBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional
               "shaderUniformTexelBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderUniformTexelBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (48)
{-# LINE 2439 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderUniformTexelBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (48)
{-# LINE 2449 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderUniformTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (48))
{-# LINE 2458 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (48)
{-# LINE 2462 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderUniformTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (48)
{-# LINE 2470 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "shaderStorageTexelBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional
               "shaderStorageTexelBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageTexelBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (52)
{-# LINE 2486 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderStorageTexelBufferArrayNonUniformIndexing"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (52)
{-# LINE 2496 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (52))
{-# LINE 2505 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (52)
{-# LINE 2509 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (52)
{-# LINE 2517 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "descriptorBindingUniformBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "descriptorBindingUniformBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "descriptorBindingUniformBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "descriptorBindingUniformBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (56)
{-# LINE 2532 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "descriptorBindingUniformBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (56)
{-# LINE 2542 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingUniformBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (56))
{-# LINE 2551 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (56)
{-# LINE 2555 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingUniformBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (56)
{-# LINE 2563 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "descriptorBindingSampledImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "descriptorBindingSampledImageUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "descriptorBindingSampledImageUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "descriptorBindingSampledImageUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (60)
{-# LINE 2578 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "descriptorBindingSampledImageUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (60)
{-# LINE 2588 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingSampledImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (60))
{-# LINE 2597 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (60)
{-# LINE 2601 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingSampledImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (60)
{-# LINE 2609 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "descriptorBindingStorageImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "descriptorBindingStorageImageUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "descriptorBindingStorageImageUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "descriptorBindingStorageImageUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (64)
{-# LINE 2624 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "descriptorBindingStorageImageUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (64)
{-# LINE 2634 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingStorageImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (64))
{-# LINE 2643 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (64)
{-# LINE 2647 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingStorageImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (64)
{-# LINE 2655 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "descriptorBindingStorageBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "descriptorBindingStorageBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "descriptorBindingStorageBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "descriptorBindingStorageBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (68)
{-# LINE 2670 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "descriptorBindingStorageBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (68)
{-# LINE 2680 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingStorageBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (68))
{-# LINE 2689 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (68)
{-# LINE 2693 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingStorageBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (68)
{-# LINE 2701 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "descriptorBindingUniformTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "descriptorBindingUniformTexelBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional
               "descriptorBindingUniformTexelBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "descriptorBindingUniformTexelBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (72)
{-# LINE 2718 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "descriptorBindingUniformTexelBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (72)
{-# LINE 2729 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingUniformTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (72))
{-# LINE 2738 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (72)
{-# LINE 2742 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingUniformTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (72)
{-# LINE 2750 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "descriptorBindingStorageTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "descriptorBindingStorageTexelBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional
               "descriptorBindingStorageTexelBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "descriptorBindingStorageTexelBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (76)
{-# LINE 2767 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "descriptorBindingStorageTexelBufferUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (76)
{-# LINE 2778 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingStorageTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (76))
{-# LINE 2787 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (76)
{-# LINE 2791 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingStorageTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (76)
{-# LINE 2799 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "descriptorBindingUpdateUnusedWhilePending"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "descriptorBindingUpdateUnusedWhilePending"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "descriptorBindingUpdateUnusedWhilePending"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "descriptorBindingUpdateUnusedWhilePending"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (80)
{-# LINE 2814 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "descriptorBindingUpdateUnusedWhilePending"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (80)
{-# LINE 2824 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingUpdateUnusedWhilePending"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (80))
{-# LINE 2833 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (80)
{-# LINE 2837 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingUpdateUnusedWhilePending"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (80)
{-# LINE 2845 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "descriptorBindingPartiallyBound"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "descriptorBindingPartiallyBound"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "descriptorBindingPartiallyBound"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "descriptorBindingPartiallyBound"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (84)
{-# LINE 2860 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "descriptorBindingPartiallyBound"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (84)
{-# LINE 2870 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingPartiallyBound"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (84))
{-# LINE 2879 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (84)
{-# LINE 2883 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingPartiallyBound"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (84)
{-# LINE 2891 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "descriptorBindingVariableDescriptorCount"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "descriptorBindingVariableDescriptorCount"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "descriptorBindingVariableDescriptorCount"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "descriptorBindingVariableDescriptorCount"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (88)
{-# LINE 2906 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "descriptorBindingVariableDescriptorCount"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (88)
{-# LINE 2916 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingVariableDescriptorCount"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (88))
{-# LINE 2925 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (88)
{-# LINE 2929 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingVariableDescriptorCount"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (88)
{-# LINE 2937 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "runtimeDescriptorArray"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        type FieldType "runtimeDescriptorArray"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = VkBool32
        type FieldOptional "runtimeDescriptorArray"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "runtimeDescriptorArray"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             =
             (92)
{-# LINE 2952 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "runtimeDescriptorArray"
               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (92)
{-# LINE 2962 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "runtimeDescriptorArray"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (92))
{-# LINE 2971 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (92)
{-# LINE 2975 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "runtimeDescriptorArray"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (92)
{-# LINE 2983 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceDescriptorIndexingFeaturesEXT where
        showsPrec d x
          = showString "VkPhysicalDeviceDescriptorIndexingFeaturesEXT {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "shaderInputAttachmentArrayDynamicIndexing = " .
                            showsPrec d
                              (getField @"shaderInputAttachmentArrayDynamicIndexing" x)
                              .
                              showString ", " .
                                showString "shaderUniformTexelBufferArrayDynamicIndexing = " .
                                  showsPrec d
                                    (getField @"shaderUniformTexelBufferArrayDynamicIndexing" x)
                                    .
                                    showString ", " .
                                      showString "shaderStorageTexelBufferArrayDynamicIndexing = " .
                                        showsPrec d
                                          (getField @"shaderStorageTexelBufferArrayDynamicIndexing"
                                             x)
                                          .
                                          showString ", " .
                                            showString
                                              "shaderUniformBufferArrayNonUniformIndexing = "
                                              .
                                              showsPrec d
                                                (getField
                                                   @"shaderUniformBufferArrayNonUniformIndexing"
                                                   x)
                                                .
                                                showString ", " .
                                                  showString
                                                    "shaderSampledImageArrayNonUniformIndexing = "
                                                    .
                                                    showsPrec d
                                                      (getField
                                                         @"shaderSampledImageArrayNonUniformIndexing"
                                                         x)
                                                      .
                                                      showString ", " .
                                                        showString
                                                          "shaderStorageBufferArrayNonUniformIndexing = "
                                                          .
                                                          showsPrec d
                                                            (getField
                                                               @"shaderStorageBufferArrayNonUniformIndexing"
                                                               x)
                                                            .
                                                            showString ", " .
                                                              showString
                                                                "shaderStorageImageArrayNonUniformIndexing = "
                                                                .
                                                                showsPrec d
                                                                  (getField
                                                                     @"shaderStorageImageArrayNonUniformIndexing"
                                                                     x)
                                                                  .
                                                                  showString ", " .
                                                                    showString
                                                                      "shaderInputAttachmentArrayNonUniformIndexing = "
                                                                      .
                                                                      showsPrec d
                                                                        (getField
                                                                           @"shaderInputAttachmentArrayNonUniformIndexing"
                                                                           x)
                                                                        .
                                                                        showString ", " .
                                                                          showString
                                                                            "shaderUniformTexelBufferArrayNonUniformIndexing = "
                                                                            .
                                                                            showsPrec d
                                                                              (getField
                                                                                 @"shaderUniformTexelBufferArrayNonUniformIndexing"
                                                                                 x)
                                                                              .
                                                                              showString ", " .
                                                                                showString
                                                                                  "shaderStorageTexelBufferArrayNonUniformIndexing = "
                                                                                  .
                                                                                  showsPrec d
                                                                                    (getField
                                                                                       @"shaderStorageTexelBufferArrayNonUniformIndexing"
                                                                                       x)
                                                                                    .
                                                                                    showString ", "
                                                                                      .
                                                                                      showString
                                                                                        "descriptorBindingUniformBufferUpdateAfterBind = "
                                                                                        .
                                                                                        showsPrec d
                                                                                          (getField
                                                                                             @"descriptorBindingUniformBufferUpdateAfterBind"
                                                                                             x)
                                                                                          .
                                                                                          showString
                                                                                            ", "
                                                                                            .
                                                                                            showString
                                                                                              "descriptorBindingSampledImageUpdateAfterBind = "
                                                                                              .
                                                                                              showsPrec
                                                                                                d
                                                                                                (getField
                                                                                                   @"descriptorBindingSampledImageUpdateAfterBind"
                                                                                                   x)
                                                                                                .
                                                                                                showString
                                                                                                  ", "
                                                                                                  .
                                                                                                  showString
                                                                                                    "descriptorBindingStorageImageUpdateAfterBind = "
                                                                                                    .
                                                                                                    showsPrec
                                                                                                      d
                                                                                                      (getField
                                                                                                         @"descriptorBindingStorageImageUpdateAfterBind"
                                                                                                         x)
                                                                                                      .
                                                                                                      showString
                                                                                                        ", "
                                                                                                        .
                                                                                                        showString
                                                                                                          "descriptorBindingStorageBufferUpdateAfterBind = "
                                                                                                          .
                                                                                                          showsPrec
                                                                                                            d
                                                                                                            (getField
                                                                                                               @"descriptorBindingStorageBufferUpdateAfterBind"
                                                                                                               x)
                                                                                                            .
                                                                                                            showString
                                                                                                              ", "
                                                                                                              .
                                                                                                              showString
                                                                                                                "descriptorBindingUniformTexelBufferUpdateAfterBind = "
                                                                                                                .
                                                                                                                showsPrec
                                                                                                                  d
                                                                                                                  (getField
                                                                                                                     @"descriptorBindingUniformTexelBufferUpdateAfterBind"
                                                                                                                     x)
                                                                                                                  .
                                                                                                                  showString
                                                                                                                    ", "
                                                                                                                    .
                                                                                                                    showString
                                                                                                                      "descriptorBindingStorageTexelBufferUpdateAfterBind = "
                                                                                                                      .
                                                                                                                      showsPrec
                                                                                                                        d
                                                                                                                        (getField
                                                                                                                           @"descriptorBindingStorageTexelBufferUpdateAfterBind"
                                                                                                                           x)
                                                                                                                        .
                                                                                                                        showString
                                                                                                                          ", "
                                                                                                                          .
                                                                                                                          showString
                                                                                                                            "descriptorBindingUpdateUnusedWhilePending = "
                                                                                                                            .
                                                                                                                            showsPrec
                                                                                                                              d
                                                                                                                              (getField
                                                                                                                                 @"descriptorBindingUpdateUnusedWhilePending"
                                                                                                                                 x)
                                                                                                                              .
                                                                                                                              showString
                                                                                                                                ", "
                                                                                                                                .
                                                                                                                                showString
                                                                                                                                  "descriptorBindingPartiallyBound = "
                                                                                                                                  .
                                                                                                                                  showsPrec
                                                                                                                                    d
                                                                                                                                    (getField
                                                                                                                                       @"descriptorBindingPartiallyBound"
                                                                                                                                       x)
                                                                                                                                    .
                                                                                                                                    showString
                                                                                                                                      ", "
                                                                                                                                      .
                                                                                                                                      showString
                                                                                                                                        "descriptorBindingVariableDescriptorCount = "
                                                                                                                                        .
                                                                                                                                        showsPrec
                                                                                                                                          d
                                                                                                                                          (getField
                                                                                                                                             @"descriptorBindingVariableDescriptorCount"
                                                                                                                                             x)
                                                                                                                                          .
                                                                                                                                          showString
                                                                                                                                            ", "
                                                                                                                                            .
                                                                                                                                            showString
                                                                                                                                              "runtimeDescriptorArray = "
                                                                                                                                              .
                                                                                                                                              showsPrec
                                                                                                                                                d
                                                                                                                                                (getField
                                                                                                                                                   @"runtimeDescriptorArray"
                                                                                                                                                   x)
                                                                                                                                                .
                                                                                                                                                showChar
                                                                                                                                                  '}'

-- | > typedef struct VkPhysicalDeviceDescriptorIndexingPropertiesEXT {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     uint32_t               maxUpdateAfterBindDescriptorsInAllPools;
--   >     VkBool32               shaderUniformBufferArrayNonUniformIndexingNative;
--   >     VkBool32               shaderSampledImageArrayNonUniformIndexingNative;
--   >     VkBool32               shaderStorageBufferArrayNonUniformIndexingNative;
--   >     VkBool32               shaderStorageImageArrayNonUniformIndexingNative;
--   >     VkBool32               shaderInputAttachmentArrayNonUniformIndexingNative;
--   >     VkBool32               robustBufferAccessUpdateAfterBind;
--   >     VkBool32               quadDivergentImplicitLod;
--   >     uint32_t               maxPerStageDescriptorUpdateAfterBindSamplers;
--   >     uint32_t               maxPerStageDescriptorUpdateAfterBindUniformBuffers;
--   >     uint32_t               maxPerStageDescriptorUpdateAfterBindStorageBuffers;
--   >     uint32_t               maxPerStageDescriptorUpdateAfterBindSampledImages;
--   >     uint32_t               maxPerStageDescriptorUpdateAfterBindStorageImages;
--   >     uint32_t               maxPerStageDescriptorUpdateAfterBindInputAttachments;
--   >     uint32_t               maxPerStageUpdateAfterBindResources;
--   >     uint32_t               maxDescriptorSetUpdateAfterBindSamplers;
--   >     uint32_t               maxDescriptorSetUpdateAfterBindUniformBuffers;
--   >     uint32_t               maxDescriptorSetUpdateAfterBindUniformBuffersDynamic;
--   >     uint32_t               maxDescriptorSetUpdateAfterBindStorageBuffers;
--   >     uint32_t               maxDescriptorSetUpdateAfterBindStorageBuffersDynamic;
--   >     uint32_t               maxDescriptorSetUpdateAfterBindSampledImages;
--   >     uint32_t               maxDescriptorSetUpdateAfterBindStorageImages;
--   >     uint32_t               maxDescriptorSetUpdateAfterBindInputAttachments;
--   > } VkPhysicalDeviceDescriptorIndexingPropertiesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceDescriptorIndexingPropertiesEXT VkPhysicalDeviceDescriptorIndexingPropertiesEXT registry at www.khronos.org>
data VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkPhysicalDeviceDescriptorIndexingPropertiesEXT# Addr#
                                                                                                        ByteArray#

instance Eq VkPhysicalDeviceDescriptorIndexingPropertiesEXT where
        (VkPhysicalDeviceDescriptorIndexingPropertiesEXT# a _) ==
          x@(VkPhysicalDeviceDescriptorIndexingPropertiesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceDescriptorIndexingPropertiesEXT where
        (VkPhysicalDeviceDescriptorIndexingPropertiesEXT# a _) `compare`
          x@(VkPhysicalDeviceDescriptorIndexingPropertiesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        sizeOf ~_
          = (112)
{-# LINE 3242 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 3246 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        unsafeAddr (VkPhysicalDeviceDescriptorIndexingPropertiesEXT# a _)
          = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceDescriptorIndexingPropertiesEXT# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceDescriptorIndexingPropertiesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type StructFields VkPhysicalDeviceDescriptorIndexingPropertiesEXT =
             '["sType", "pNext", "maxUpdateAfterBindDescriptorsInAllPools", -- ' closing tick for hsc2hs
               "shaderUniformBufferArrayNonUniformIndexingNative",
               "shaderSampledImageArrayNonUniformIndexingNative",
               "shaderStorageBufferArrayNonUniformIndexingNative",
               "shaderStorageImageArrayNonUniformIndexingNative",
               "shaderInputAttachmentArrayNonUniformIndexingNative",
               "robustBufferAccessUpdateAfterBind", "quadDivergentImplicitLod",
               "maxPerStageDescriptorUpdateAfterBindSamplers",
               "maxPerStageDescriptorUpdateAfterBindUniformBuffers",
               "maxPerStageDescriptorUpdateAfterBindStorageBuffers",
               "maxPerStageDescriptorUpdateAfterBindSampledImages",
               "maxPerStageDescriptorUpdateAfterBindStorageImages",
               "maxPerStageDescriptorUpdateAfterBindInputAttachments",
               "maxPerStageUpdateAfterBindResources",
               "maxDescriptorSetUpdateAfterBindSamplers",
               "maxDescriptorSetUpdateAfterBindUniformBuffers",
               "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic",
               "maxDescriptorSetUpdateAfterBindStorageBuffers",
               "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic",
               "maxDescriptorSetUpdateAfterBindSampledImages",
               "maxDescriptorSetUpdateAfterBindStorageImages",
               "maxDescriptorSetUpdateAfterBindInputAttachments"]
        type CUnionType VkPhysicalDeviceDescriptorIndexingPropertiesEXT =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceDescriptorIndexingPropertiesEXT =
             'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "sType"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (0)
{-# LINE 3319 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 3329 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 3338 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 3342 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 3350 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "pNext"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (8)
{-# LINE 3364 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 3374 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 3383 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 3387 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 3395 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxUpdateAfterBindDescriptorsInAllPools"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxUpdateAfterBindDescriptorsInAllPools"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional "maxUpdateAfterBindDescriptorsInAllPools"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxUpdateAfterBindDescriptorsInAllPools"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (16)
{-# LINE 3410 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxUpdateAfterBindDescriptorsInAllPools"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 3420 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxUpdateAfterBindDescriptorsInAllPools"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 3429 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 3433 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxUpdateAfterBindDescriptorsInAllPools"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 3441 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderUniformBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "shaderUniformBufferArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = VkBool32
        type FieldOptional
               "shaderUniformBufferArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderUniformBufferArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (20)
{-# LINE 3457 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "shaderUniformBufferArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 3468 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderUniformBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 3477 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 3481 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderUniformBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 3489 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderSampledImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "shaderSampledImageArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = VkBool32
        type FieldOptional
               "shaderSampledImageArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderSampledImageArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (24)
{-# LINE 3505 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderSampledImageArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 3515 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderSampledImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 3524 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 3528 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderSampledImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 3536 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "shaderStorageBufferArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = VkBool32
        type FieldOptional
               "shaderStorageBufferArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageBufferArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (28)
{-# LINE 3552 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "shaderStorageBufferArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 3563 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 3572 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 3576 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 3584 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "shaderStorageImageArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = VkBool32
        type FieldOptional
               "shaderStorageImageArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageImageArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (32)
{-# LINE 3600 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderStorageImageArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (32)
{-# LINE 3610 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 3619 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (32)
{-# LINE 3623 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 3631 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderInputAttachmentArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "shaderInputAttachmentArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = VkBool32
        type FieldOptional
               "shaderInputAttachmentArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "shaderInputAttachmentArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (36)
{-# LINE 3648 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "shaderInputAttachmentArrayNonUniformIndexingNative"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (36)
{-# LINE 3659 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderInputAttachmentArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (36))
{-# LINE 3668 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (36)
{-# LINE 3672 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderInputAttachmentArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (36)
{-# LINE 3680 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "robustBufferAccessUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "robustBufferAccessUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = VkBool32
        type FieldOptional "robustBufferAccessUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "robustBufferAccessUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (40)
{-# LINE 3695 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "robustBufferAccessUpdateAfterBind"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (40)
{-# LINE 3705 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "robustBufferAccessUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (40))
{-# LINE 3714 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (40)
{-# LINE 3718 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "robustBufferAccessUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (40)
{-# LINE 3726 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "quadDivergentImplicitLod"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "quadDivergentImplicitLod"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = VkBool32
        type FieldOptional "quadDivergentImplicitLod"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "quadDivergentImplicitLod"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (44)
{-# LINE 3741 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "quadDivergentImplicitLod"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (44)
{-# LINE 3751 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "quadDivergentImplicitLod"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (44))
{-# LINE 3760 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (44)
{-# LINE 3764 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "quadDivergentImplicitLod"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (44)
{-# LINE 3772 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxPerStageDescriptorUpdateAfterBindSamplers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional "maxPerStageDescriptorUpdateAfterBindSamplers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerStageDescriptorUpdateAfterBindSamplers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (48)
{-# LINE 3787 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerStageDescriptorUpdateAfterBindSamplers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (48)
{-# LINE 3797 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (48))
{-# LINE 3806 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (48)
{-# LINE 3810 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (48)
{-# LINE 3818 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional
               "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (52)
{-# LINE 3835 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (52)
{-# LINE 3846 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (52))
{-# LINE 3855 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (52)
{-# LINE 3859 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (52)
{-# LINE 3867 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional
               "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (56)
{-# LINE 3884 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (56)
{-# LINE 3895 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (56))
{-# LINE 3904 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (56)
{-# LINE 3908 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (56)
{-# LINE 3916 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxPerStageDescriptorUpdateAfterBindSampledImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional
               "maxPerStageDescriptorUpdateAfterBindSampledImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "maxPerStageDescriptorUpdateAfterBindSampledImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (60)
{-# LINE 3933 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "maxPerStageDescriptorUpdateAfterBindSampledImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (60)
{-# LINE 3944 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (60))
{-# LINE 3953 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (60)
{-# LINE 3957 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (60)
{-# LINE 3965 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxPerStageDescriptorUpdateAfterBindStorageImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional
               "maxPerStageDescriptorUpdateAfterBindStorageImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "maxPerStageDescriptorUpdateAfterBindStorageImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (64)
{-# LINE 3982 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "maxPerStageDescriptorUpdateAfterBindStorageImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (64)
{-# LINE 3993 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (64))
{-# LINE 4002 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (64)
{-# LINE 4006 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (64)
{-# LINE 4014 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType
               "maxPerStageDescriptorUpdateAfterBindInputAttachments"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional
               "maxPerStageDescriptorUpdateAfterBindInputAttachments"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "maxPerStageDescriptorUpdateAfterBindInputAttachments"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (68)
{-# LINE 4032 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "maxPerStageDescriptorUpdateAfterBindInputAttachments"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (68)
{-# LINE 4043 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (68))
{-# LINE 4052 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (68)
{-# LINE 4056 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField
           "maxPerStageDescriptorUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (68)
{-# LINE 4065 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageUpdateAfterBindResources"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxPerStageUpdateAfterBindResources"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional "maxPerStageUpdateAfterBindResources"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerStageUpdateAfterBindResources"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (72)
{-# LINE 4080 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerStageUpdateAfterBindResources"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (72)
{-# LINE 4090 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageUpdateAfterBindResources"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (72))
{-# LINE 4099 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (72)
{-# LINE 4103 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageUpdateAfterBindResources"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (72)
{-# LINE 4111 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxDescriptorSetUpdateAfterBindSamplers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional "maxDescriptorSetUpdateAfterBindSamplers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetUpdateAfterBindSamplers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (76)
{-# LINE 4126 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetUpdateAfterBindSamplers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (76)
{-# LINE 4136 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (76))
{-# LINE 4145 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (76)
{-# LINE 4149 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (76)
{-# LINE 4157 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxDescriptorSetUpdateAfterBindUniformBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional "maxDescriptorSetUpdateAfterBindUniformBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetUpdateAfterBindUniformBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (80)
{-# LINE 4172 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetUpdateAfterBindUniformBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (80)
{-# LINE 4182 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (80))
{-# LINE 4191 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (80)
{-# LINE 4195 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (80)
{-# LINE 4203 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType
               "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional
               "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (84)
{-# LINE 4221 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (84)
{-# LINE 4232 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (84))
{-# LINE 4241 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (84)
{-# LINE 4245 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField
           "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (84)
{-# LINE 4254 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxDescriptorSetUpdateAfterBindStorageBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional "maxDescriptorSetUpdateAfterBindStorageBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetUpdateAfterBindStorageBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (88)
{-# LINE 4269 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetUpdateAfterBindStorageBuffers"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (88)
{-# LINE 4279 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (88))
{-# LINE 4288 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (88)
{-# LINE 4292 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (88)
{-# LINE 4300 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType
               "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional
               "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset
               "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (92)
{-# LINE 4318 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray
               "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (92)
{-# LINE 4329 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (92))
{-# LINE 4338 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (92)
{-# LINE 4342 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField
           "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (92)
{-# LINE 4351 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxDescriptorSetUpdateAfterBindSampledImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional "maxDescriptorSetUpdateAfterBindSampledImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetUpdateAfterBindSampledImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (96)
{-# LINE 4366 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetUpdateAfterBindSampledImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (96)
{-# LINE 4376 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (96))
{-# LINE 4385 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (96)
{-# LINE 4389 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (96)
{-# LINE 4397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxDescriptorSetUpdateAfterBindStorageImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional "maxDescriptorSetUpdateAfterBindStorageImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetUpdateAfterBindStorageImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (100)
{-# LINE 4412 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetUpdateAfterBindStorageImages"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (100)
{-# LINE 4422 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (100))
{-# LINE 4431 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (100)
{-# LINE 4435 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (100)
{-# LINE 4443 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        type FieldType "maxDescriptorSetUpdateAfterBindInputAttachments"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = Word32
        type FieldOptional
               "maxDescriptorSetUpdateAfterBindInputAttachments"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetUpdateAfterBindInputAttachments"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             =
             (104)
{-# LINE 4459 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetUpdateAfterBindInputAttachments"
               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (104)
{-# LINE 4469 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (104))
{-# LINE 4478 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (104)
{-# LINE 4482 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (104)
{-# LINE 4490 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceDescriptorIndexingPropertiesEXT where
        showsPrec d x
          = showString "VkPhysicalDeviceDescriptorIndexingPropertiesEXT {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "maxUpdateAfterBindDescriptorsInAllPools = " .
                            showsPrec d (getField @"maxUpdateAfterBindDescriptorsInAllPools" x)
                              .
                              showString ", " .
                                showString "shaderUniformBufferArrayNonUniformIndexingNative = " .
                                  showsPrec d
                                    (getField @"shaderUniformBufferArrayNonUniformIndexingNative" x)
                                    .
                                    showString ", " .
                                      showString
                                        "shaderSampledImageArrayNonUniformIndexingNative = "
                                        .
                                        showsPrec d
                                          (getField
                                             @"shaderSampledImageArrayNonUniformIndexingNative"
                                             x)
                                          .
                                          showString ", " .
                                            showString
                                              "shaderStorageBufferArrayNonUniformIndexingNative = "
                                              .
                                              showsPrec d
                                                (getField
                                                   @"shaderStorageBufferArrayNonUniformIndexingNative"
                                                   x)
                                                .
                                                showString ", " .
                                                  showString
                                                    "shaderStorageImageArrayNonUniformIndexingNative = "
                                                    .
                                                    showsPrec d
                                                      (getField
                                                         @"shaderStorageImageArrayNonUniformIndexingNative"
                                                         x)
                                                      .
                                                      showString ", " .
                                                        showString
                                                          "shaderInputAttachmentArrayNonUniformIndexingNative = "
                                                          .
                                                          showsPrec d
                                                            (getField
                                                               @"shaderInputAttachmentArrayNonUniformIndexingNative"
                                                               x)
                                                            .
                                                            showString ", " .
                                                              showString
                                                                "robustBufferAccessUpdateAfterBind = "
                                                                .
                                                                showsPrec d
                                                                  (getField
                                                                     @"robustBufferAccessUpdateAfterBind"
                                                                     x)
                                                                  .
                                                                  showString ", " .
                                                                    showString
                                                                      "quadDivergentImplicitLod = "
                                                                      .
                                                                      showsPrec d
                                                                        (getField
                                                                           @"quadDivergentImplicitLod"
                                                                           x)
                                                                        .
                                                                        showString ", " .
                                                                          showString
                                                                            "maxPerStageDescriptorUpdateAfterBindSamplers = "
                                                                            .
                                                                            showsPrec d
                                                                              (getField
                                                                                 @"maxPerStageDescriptorUpdateAfterBindSamplers"
                                                                                 x)
                                                                              .
                                                                              showString ", " .
                                                                                showString
                                                                                  "maxPerStageDescriptorUpdateAfterBindUniformBuffers = "
                                                                                  .
                                                                                  showsPrec d
                                                                                    (getField
                                                                                       @"maxPerStageDescriptorUpdateAfterBindUniformBuffers"
                                                                                       x)
                                                                                    .
                                                                                    showString ", "
                                                                                      .
                                                                                      showString
                                                                                        "maxPerStageDescriptorUpdateAfterBindStorageBuffers = "
                                                                                        .
                                                                                        showsPrec d
                                                                                          (getField
                                                                                             @"maxPerStageDescriptorUpdateAfterBindStorageBuffers"
                                                                                             x)
                                                                                          .
                                                                                          showString
                                                                                            ", "
                                                                                            .
                                                                                            showString
                                                                                              "maxPerStageDescriptorUpdateAfterBindSampledImages = "
                                                                                              .
                                                                                              showsPrec
                                                                                                d
                                                                                                (getField
                                                                                                   @"maxPerStageDescriptorUpdateAfterBindSampledImages"
                                                                                                   x)
                                                                                                .
                                                                                                showString
                                                                                                  ", "
                                                                                                  .
                                                                                                  showString
                                                                                                    "maxPerStageDescriptorUpdateAfterBindStorageImages = "
                                                                                                    .
                                                                                                    showsPrec
                                                                                                      d
                                                                                                      (getField
                                                                                                         @"maxPerStageDescriptorUpdateAfterBindStorageImages"
                                                                                                         x)
                                                                                                      .
                                                                                                      showString
                                                                                                        ", "
                                                                                                        .
                                                                                                        showString
                                                                                                          "maxPerStageDescriptorUpdateAfterBindInputAttachments = "
                                                                                                          .
                                                                                                          showsPrec
                                                                                                            d
                                                                                                            (getField
                                                                                                               @"maxPerStageDescriptorUpdateAfterBindInputAttachments"
                                                                                                               x)
                                                                                                            .
                                                                                                            showString
                                                                                                              ", "
                                                                                                              .
                                                                                                              showString
                                                                                                                "maxPerStageUpdateAfterBindResources = "
                                                                                                                .
                                                                                                                showsPrec
                                                                                                                  d
                                                                                                                  (getField
                                                                                                                     @"maxPerStageUpdateAfterBindResources"
                                                                                                                     x)
                                                                                                                  .
                                                                                                                  showString
                                                                                                                    ", "
                                                                                                                    .
                                                                                                                    showString
                                                                                                                      "maxDescriptorSetUpdateAfterBindSamplers = "
                                                                                                                      .
                                                                                                                      showsPrec
                                                                                                                        d
                                                                                                                        (getField
                                                                                                                           @"maxDescriptorSetUpdateAfterBindSamplers"
                                                                                                                           x)
                                                                                                                        .
                                                                                                                        showString
                                                                                                                          ", "
                                                                                                                          .
                                                                                                                          showString
                                                                                                                            "maxDescriptorSetUpdateAfterBindUniformBuffers = "
                                                                                                                            .
                                                                                                                            showsPrec
                                                                                                                              d
                                                                                                                              (getField
                                                                                                                                 @"maxDescriptorSetUpdateAfterBindUniformBuffers"
                                                                                                                                 x)
                                                                                                                              .
                                                                                                                              showString
                                                                                                                                ", "
                                                                                                                                .
                                                                                                                                showString
                                                                                                                                  "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic = "
                                                                                                                                  .
                                                                                                                                  showsPrec
                                                                                                                                    d
                                                                                                                                    (getField
                                                                                                                                       @"maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
                                                                                                                                       x)
                                                                                                                                    .
                                                                                                                                    showString
                                                                                                                                      ", "
                                                                                                                                      .
                                                                                                                                      showString
                                                                                                                                        "maxDescriptorSetUpdateAfterBindStorageBuffers = "
                                                                                                                                        .
                                                                                                                                        showsPrec
                                                                                                                                          d
                                                                                                                                          (getField
                                                                                                                                             @"maxDescriptorSetUpdateAfterBindStorageBuffers"
                                                                                                                                             x)
                                                                                                                                          .
                                                                                                                                          showString
                                                                                                                                            ", "
                                                                                                                                            .
                                                                                                                                            showString
                                                                                                                                              "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic = "
                                                                                                                                              .
                                                                                                                                              showsPrec
                                                                                                                                                d
                                                                                                                                                (getField
                                                                                                                                                   @"maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
                                                                                                                                                   x)
                                                                                                                                                .
                                                                                                                                                showString
                                                                                                                                                  ", "
                                                                                                                                                  .
                                                                                                                                                  showString
                                                                                                                                                    "maxDescriptorSetUpdateAfterBindSampledImages = "
                                                                                                                                                    .
                                                                                                                                                    showsPrec
                                                                                                                                                      d
                                                                                                                                                      (getField
                                                                                                                                                         @"maxDescriptorSetUpdateAfterBindSampledImages"
                                                                                                                                                         x)
                                                                                                                                                      .
                                                                                                                                                      showString
                                                                                                                                                        ", "
                                                                                                                                                        .
                                                                                                                                                        showString
                                                                                                                                                          "maxDescriptorSetUpdateAfterBindStorageImages = "
                                                                                                                                                          .
                                                                                                                                                          showsPrec
                                                                                                                                                            d
                                                                                                                                                            (getField
                                                                                                                                                               @"maxDescriptorSetUpdateAfterBindStorageImages"
                                                                                                                                                               x)
                                                                                                                                                            .
                                                                                                                                                            showString
                                                                                                                                                              ", "
                                                                                                                                                              .
                                                                                                                                                              showString
                                                                                                                                                                "maxDescriptorSetUpdateAfterBindInputAttachments = "
                                                                                                                                                                .
                                                                                                                                                                showsPrec
                                                                                                                                                                  d
                                                                                                                                                                  (getField
                                                                                                                                                                     @"maxDescriptorSetUpdateAfterBindInputAttachments"
                                                                                                                                                                     x)
                                                                                                                                                                  .
                                                                                                                                                                  showChar
                                                                                                                                                                    '}'

-- | > typedef struct VkPhysicalDeviceDiscardRectanglePropertiesEXT {
--   >     VkStructureType sType;
--   >     void*                  pNext;
--   >     uint32_t               maxDiscardRectangles;
--   > } VkPhysicalDeviceDiscardRectanglePropertiesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceDiscardRectanglePropertiesEXT VkPhysicalDeviceDiscardRectanglePropertiesEXT registry at www.khronos.org>
data VkPhysicalDeviceDiscardRectanglePropertiesEXT = VkPhysicalDeviceDiscardRectanglePropertiesEXT# Addr#
                                                                                                    ByteArray#

instance Eq VkPhysicalDeviceDiscardRectanglePropertiesEXT where
        (VkPhysicalDeviceDiscardRectanglePropertiesEXT# a _) ==
          x@(VkPhysicalDeviceDiscardRectanglePropertiesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceDiscardRectanglePropertiesEXT where
        (VkPhysicalDeviceDiscardRectanglePropertiesEXT# a _) `compare`
          x@(VkPhysicalDeviceDiscardRectanglePropertiesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        sizeOf ~_
          = (24)
{-# LINE 4765 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 4769 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        unsafeAddr (VkPhysicalDeviceDiscardRectanglePropertiesEXT# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceDiscardRectanglePropertiesEXT# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceDiscardRectanglePropertiesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        type StructFields VkPhysicalDeviceDiscardRectanglePropertiesEXT =
             '["sType", "pNext", "maxDiscardRectangles"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceDiscardRectanglePropertiesEXT =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceDiscardRectanglePropertiesEXT =
             'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceDiscardRectanglePropertiesEXT =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        type FieldType "sType"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             =
             (0)
{-# LINE 4820 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 4830 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 4838 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 4842 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 4849 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        type FieldType "pNext"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             =
             (8)
{-# LINE 4863 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 4873 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 4881 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 4885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 4892 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDiscardRectangles"
           VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        type FieldType "maxDiscardRectangles"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             = Word32
        type FieldOptional "maxDiscardRectangles"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDiscardRectangles"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             =
             (16)
{-# LINE 4907 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDiscardRectangles"
               VkPhysicalDeviceDiscardRectanglePropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 4917 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDiscardRectangles"
           VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 4926 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 4930 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDiscardRectangles"
           VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 4938 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceDiscardRectanglePropertiesEXT where
        showsPrec d x
          = showString "VkPhysicalDeviceDiscardRectanglePropertiesEXT {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "maxDiscardRectangles = " .
                            showsPrec d (getField @"maxDiscardRectangles" x) . showChar '}'

-- | > typedef struct VkPhysicalDeviceExternalBufferInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkBufferCreateFlags flags;
--   >     VkBufferUsageFlags               usage;
--   >     VkExternalMemoryHandleTypeFlagBits handleType;
--   > } VkPhysicalDeviceExternalBufferInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceExternalBufferInfo VkPhysicalDeviceExternalBufferInfo registry at www.khronos.org>
data VkPhysicalDeviceExternalBufferInfo = VkPhysicalDeviceExternalBufferInfo# Addr#
                                                                              ByteArray#

instance Eq VkPhysicalDeviceExternalBufferInfo where
        (VkPhysicalDeviceExternalBufferInfo# a _) ==
          x@(VkPhysicalDeviceExternalBufferInfo# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalBufferInfo where
        (VkPhysicalDeviceExternalBufferInfo# a _) `compare`
          x@(VkPhysicalDeviceExternalBufferInfo# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceExternalBufferInfo where
        sizeOf ~_ = (32)
{-# LINE 4979 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 4983 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceExternalBufferInfo where
        unsafeAddr (VkPhysicalDeviceExternalBufferInfo# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceExternalBufferInfo# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceExternalBufferInfo#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceExternalBufferInfo where
        type StructFields VkPhysicalDeviceExternalBufferInfo =
             '["sType", "pNext", "flags", "usage", "handleType"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceExternalBufferInfo = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceExternalBufferInfo where
        type FieldType "sType" VkPhysicalDeviceExternalBufferInfo =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceExternalBufferInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceExternalBufferInfo =
             (0)
{-# LINE 5021 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceExternalBufferInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 5030 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 5037 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 5041 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 5047 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceExternalBufferInfo where
        type FieldType "pNext" VkPhysicalDeviceExternalBufferInfo =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceExternalBufferInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceExternalBufferInfo =
             (8)
{-# LINE 5056 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceExternalBufferInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 5065 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 5072 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 5076 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 5082 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "flags" VkPhysicalDeviceExternalBufferInfo where
        type FieldType "flags" VkPhysicalDeviceExternalBufferInfo =
             VkBufferCreateFlags
        type FieldOptional "flags" VkPhysicalDeviceExternalBufferInfo =
             'True -- ' closing tick for hsc2hs
        type FieldOffset "flags" VkPhysicalDeviceExternalBufferInfo =
             (16)
{-# LINE 5091 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "flags" VkPhysicalDeviceExternalBufferInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 5100 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "flags" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 5107 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 5111 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 5117 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "usage" VkPhysicalDeviceExternalBufferInfo where
        type FieldType "usage" VkPhysicalDeviceExternalBufferInfo =
             VkBufferUsageFlags
        type FieldOptional "usage" VkPhysicalDeviceExternalBufferInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "usage" VkPhysicalDeviceExternalBufferInfo =
             (20)
{-# LINE 5126 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "usage" VkPhysicalDeviceExternalBufferInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 5135 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "usage" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 5142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 5146 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "usage" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 5152 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "handleType" VkPhysicalDeviceExternalBufferInfo where
        type FieldType "handleType" VkPhysicalDeviceExternalBufferInfo =
             VkExternalMemoryHandleTypeFlagBits
        type FieldOptional "handleType" VkPhysicalDeviceExternalBufferInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "handleType" VkPhysicalDeviceExternalBufferInfo =
             (24)
{-# LINE 5161 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "handleType" VkPhysicalDeviceExternalBufferInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 5170 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "handleType" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 5177 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 5181 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "handleType" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 5187 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalBufferInfo where
        showsPrec d x
          = showString "VkPhysicalDeviceExternalBufferInfo {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "flags = " .
                            showsPrec d (getField @"flags" x) .
                              showString ", " .
                                showString "usage = " .
                                  showsPrec d (getField @"usage" x) .
                                    showString ", " .
                                      showString "handleType = " .
                                        showsPrec d (getField @"handleType" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceExternalBufferInfo`
type VkPhysicalDeviceExternalBufferInfoKHR =
     VkPhysicalDeviceExternalBufferInfo

-- | > typedef struct VkPhysicalDeviceExternalFenceInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkExternalFenceHandleTypeFlagBits handleType;
--   > } VkPhysicalDeviceExternalFenceInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceExternalFenceInfo VkPhysicalDeviceExternalFenceInfo registry at www.khronos.org>
data VkPhysicalDeviceExternalFenceInfo = VkPhysicalDeviceExternalFenceInfo# Addr#
                                                                            ByteArray#

instance Eq VkPhysicalDeviceExternalFenceInfo where
        (VkPhysicalDeviceExternalFenceInfo# a _) ==
          x@(VkPhysicalDeviceExternalFenceInfo# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalFenceInfo where
        (VkPhysicalDeviceExternalFenceInfo# a _) `compare`
          x@(VkPhysicalDeviceExternalFenceInfo# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceExternalFenceInfo where
        sizeOf ~_ = (24)
{-# LINE 5236 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 5240 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceExternalFenceInfo where
        unsafeAddr (VkPhysicalDeviceExternalFenceInfo# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceExternalFenceInfo# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceExternalFenceInfo#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceExternalFenceInfo where
        type StructFields VkPhysicalDeviceExternalFenceInfo =
             '["sType", "pNext", "handleType"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceExternalFenceInfo = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceExternalFenceInfo where
        type FieldType "sType" VkPhysicalDeviceExternalFenceInfo =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceExternalFenceInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceExternalFenceInfo =
             (0)
{-# LINE 5278 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceExternalFenceInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 5287 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceExternalFenceInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 5294 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 5298 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceExternalFenceInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 5304 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceExternalFenceInfo where
        type FieldType "pNext" VkPhysicalDeviceExternalFenceInfo = Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceExternalFenceInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceExternalFenceInfo =
             (8)
{-# LINE 5312 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceExternalFenceInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 5321 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceExternalFenceInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 5328 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 5332 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceExternalFenceInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 5338 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "handleType" VkPhysicalDeviceExternalFenceInfo where
        type FieldType "handleType" VkPhysicalDeviceExternalFenceInfo =
             VkExternalFenceHandleTypeFlagBits
        type FieldOptional "handleType" VkPhysicalDeviceExternalFenceInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "handleType" VkPhysicalDeviceExternalFenceInfo =
             (16)
{-# LINE 5347 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "handleType" VkPhysicalDeviceExternalFenceInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 5356 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "handleType" VkPhysicalDeviceExternalFenceInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 5363 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 5367 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "handleType" VkPhysicalDeviceExternalFenceInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 5373 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalFenceInfo where
        showsPrec d x
          = showString "VkPhysicalDeviceExternalFenceInfo {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "handleType = " .
                            showsPrec d (getField @"handleType" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceExternalFenceInfo`
type VkPhysicalDeviceExternalFenceInfoKHR =
     VkPhysicalDeviceExternalFenceInfo

-- | > typedef struct VkPhysicalDeviceExternalImageFormatInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkExternalMemoryHandleTypeFlagBits handleType;
--   > } VkPhysicalDeviceExternalImageFormatInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceExternalImageFormatInfo VkPhysicalDeviceExternalImageFormatInfo registry at www.khronos.org>
data VkPhysicalDeviceExternalImageFormatInfo = VkPhysicalDeviceExternalImageFormatInfo# Addr#
                                                                                        ByteArray#

instance Eq VkPhysicalDeviceExternalImageFormatInfo where
        (VkPhysicalDeviceExternalImageFormatInfo# a _) ==
          x@(VkPhysicalDeviceExternalImageFormatInfo# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalImageFormatInfo where
        (VkPhysicalDeviceExternalImageFormatInfo# a _) `compare`
          x@(VkPhysicalDeviceExternalImageFormatInfo# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceExternalImageFormatInfo where
        sizeOf ~_
          = (24)
{-# LINE 5417 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 5421 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceExternalImageFormatInfo
         where
        unsafeAddr (VkPhysicalDeviceExternalImageFormatInfo# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceExternalImageFormatInfo# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceExternalImageFormatInfo#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceExternalImageFormatInfo
         where
        type StructFields VkPhysicalDeviceExternalImageFormatInfo =
             '["sType", "pNext", "handleType"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceExternalImageFormatInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceExternalImageFormatInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceExternalImageFormatInfo =
             '[VkPhysicalDeviceImageFormatInfo2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceExternalImageFormatInfo where
        type FieldType "sType" VkPhysicalDeviceExternalImageFormatInfo =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceExternalImageFormatInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceExternalImageFormatInfo =
             (0)
{-# LINE 5462 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceExternalImageFormatInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 5471 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceExternalImageFormatInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 5478 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 5482 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceExternalImageFormatInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 5488 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceExternalImageFormatInfo where
        type FieldType "pNext" VkPhysicalDeviceExternalImageFormatInfo =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceExternalImageFormatInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceExternalImageFormatInfo =
             (8)
{-# LINE 5497 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceExternalImageFormatInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 5506 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceExternalImageFormatInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 5513 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 5517 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceExternalImageFormatInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 5523 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "handleType" VkPhysicalDeviceExternalImageFormatInfo where
        type FieldType "handleType" VkPhysicalDeviceExternalImageFormatInfo
             = VkExternalMemoryHandleTypeFlagBits
        type FieldOptional "handleType"
               VkPhysicalDeviceExternalImageFormatInfo
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "handleType"
               VkPhysicalDeviceExternalImageFormatInfo
             =
             (16)
{-# LINE 5535 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "handleType"
               VkPhysicalDeviceExternalImageFormatInfo
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 5545 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "handleType" VkPhysicalDeviceExternalImageFormatInfo
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 5553 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 5557 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "handleType" VkPhysicalDeviceExternalImageFormatInfo
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 5564 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalImageFormatInfo where
        showsPrec d x
          = showString "VkPhysicalDeviceExternalImageFormatInfo {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "handleType = " .
                            showsPrec d (getField @"handleType" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceExternalImageFormatInfo`
type VkPhysicalDeviceExternalImageFormatInfoKHR =
     VkPhysicalDeviceExternalImageFormatInfo

-- | > typedef struct VkPhysicalDeviceExternalMemoryHostPropertiesEXT {
--   >     VkStructureType sType;
--   >     void* pNext;
--   >     VkDeviceSize minImportedHostPointerAlignment;
--   > } VkPhysicalDeviceExternalMemoryHostPropertiesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceExternalMemoryHostPropertiesEXT VkPhysicalDeviceExternalMemoryHostPropertiesEXT registry at www.khronos.org>
data VkPhysicalDeviceExternalMemoryHostPropertiesEXT = VkPhysicalDeviceExternalMemoryHostPropertiesEXT# Addr#
                                                                                                        ByteArray#

instance Eq VkPhysicalDeviceExternalMemoryHostPropertiesEXT where
        (VkPhysicalDeviceExternalMemoryHostPropertiesEXT# a _) ==
          x@(VkPhysicalDeviceExternalMemoryHostPropertiesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalMemoryHostPropertiesEXT where
        (VkPhysicalDeviceExternalMemoryHostPropertiesEXT# a _) `compare`
          x@(VkPhysicalDeviceExternalMemoryHostPropertiesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        sizeOf ~_
          = (24)
{-# LINE 5609 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 5613 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        unsafeAddr (VkPhysicalDeviceExternalMemoryHostPropertiesEXT# a _)
          = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceExternalMemoryHostPropertiesEXT# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceExternalMemoryHostPropertiesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        type StructFields VkPhysicalDeviceExternalMemoryHostPropertiesEXT =
             '["sType", "pNext", "minImportedHostPointerAlignment"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceExternalMemoryHostPropertiesEXT =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceExternalMemoryHostPropertiesEXT =
             'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        type FieldType "sType"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             =
             (0)
{-# LINE 5665 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 5675 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 5684 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 5688 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 5696 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        type FieldType "pNext"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             =
             (8)
{-# LINE 5710 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 5720 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 5729 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 5733 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 5741 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minImportedHostPointerAlignment"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        type FieldType "minImportedHostPointerAlignment"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = VkDeviceSize
        type FieldOptional "minImportedHostPointerAlignment"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minImportedHostPointerAlignment"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             =
             (16)
{-# LINE 5756 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minImportedHostPointerAlignment"
               VkPhysicalDeviceExternalMemoryHostPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 5766 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minImportedHostPointerAlignment"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 5775 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 5779 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minImportedHostPointerAlignment"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 5787 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalMemoryHostPropertiesEXT where
        showsPrec d x
          = showString "VkPhysicalDeviceExternalMemoryHostPropertiesEXT {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "minImportedHostPointerAlignment = " .
                            showsPrec d (getField @"minImportedHostPointerAlignment" x) .
                              showChar '}'

-- | > typedef struct VkPhysicalDeviceExternalSemaphoreInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkExternalSemaphoreHandleTypeFlagBits handleType;
--   > } VkPhysicalDeviceExternalSemaphoreInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceExternalSemaphoreInfo VkPhysicalDeviceExternalSemaphoreInfo registry at www.khronos.org>
data VkPhysicalDeviceExternalSemaphoreInfo = VkPhysicalDeviceExternalSemaphoreInfo# Addr#
                                                                                    ByteArray#

instance Eq VkPhysicalDeviceExternalSemaphoreInfo where
        (VkPhysicalDeviceExternalSemaphoreInfo# a _) ==
          x@(VkPhysicalDeviceExternalSemaphoreInfo# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalSemaphoreInfo where
        (VkPhysicalDeviceExternalSemaphoreInfo# a _) `compare`
          x@(VkPhysicalDeviceExternalSemaphoreInfo# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceExternalSemaphoreInfo where
        sizeOf ~_
          = (24)
{-# LINE 5828 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 5832 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceExternalSemaphoreInfo
         where
        unsafeAddr (VkPhysicalDeviceExternalSemaphoreInfo# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceExternalSemaphoreInfo# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceExternalSemaphoreInfo#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceExternalSemaphoreInfo where
        type StructFields VkPhysicalDeviceExternalSemaphoreInfo =
             '["sType", "pNext", "handleType"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceExternalSemaphoreInfo = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceExternalSemaphoreInfo where
        type FieldType "sType" VkPhysicalDeviceExternalSemaphoreInfo =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceExternalSemaphoreInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceExternalSemaphoreInfo =
             (0)
{-# LINE 5871 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceExternalSemaphoreInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 5880 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceExternalSemaphoreInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 5887 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 5891 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceExternalSemaphoreInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 5897 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceExternalSemaphoreInfo where
        type FieldType "pNext" VkPhysicalDeviceExternalSemaphoreInfo =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceExternalSemaphoreInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceExternalSemaphoreInfo =
             (8)
{-# LINE 5906 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceExternalSemaphoreInfo =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 5915 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceExternalSemaphoreInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 5922 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 5926 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceExternalSemaphoreInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 5932 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "handleType" VkPhysicalDeviceExternalSemaphoreInfo where
        type FieldType "handleType" VkPhysicalDeviceExternalSemaphoreInfo =
             VkExternalSemaphoreHandleTypeFlagBits
        type FieldOptional "handleType"
               VkPhysicalDeviceExternalSemaphoreInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "handleType" VkPhysicalDeviceExternalSemaphoreInfo
             =
             (16)
{-# LINE 5943 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "handleType"
               VkPhysicalDeviceExternalSemaphoreInfo
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 5953 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "handleType" VkPhysicalDeviceExternalSemaphoreInfo
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 5961 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 5965 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "handleType" VkPhysicalDeviceExternalSemaphoreInfo
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 5972 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalSemaphoreInfo where
        showsPrec d x
          = showString "VkPhysicalDeviceExternalSemaphoreInfo {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "handleType = " .
                            showsPrec d (getField @"handleType" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceExternalSemaphoreInfo`
type VkPhysicalDeviceExternalSemaphoreInfoKHR =
     VkPhysicalDeviceExternalSemaphoreInfo

-- | > typedef struct VkPhysicalDeviceFeatures2 {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkPhysicalDeviceFeatures         features;
--   > } VkPhysicalDeviceFeatures2;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceFeatures2 VkPhysicalDeviceFeatures2 registry at www.khronos.org>
data VkPhysicalDeviceFeatures2 = VkPhysicalDeviceFeatures2# Addr#
                                                            ByteArray#

instance Eq VkPhysicalDeviceFeatures2 where
        (VkPhysicalDeviceFeatures2# a _) ==
          x@(VkPhysicalDeviceFeatures2# b _) = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceFeatures2 where
        (VkPhysicalDeviceFeatures2# a _) `compare`
          x@(VkPhysicalDeviceFeatures2# b _) = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceFeatures2 where
        sizeOf ~_ = (240)
{-# LINE 6013 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_ = (8)
{-# LINE 6016 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceFeatures2 where
        unsafeAddr (VkPhysicalDeviceFeatures2# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceFeatures2# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceFeatures2# (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceFeatures2 where
        type StructFields VkPhysicalDeviceFeatures2 =
             '["sType", "pNext", "features"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceFeatures2 =
             '[VkDeviceCreateInfo] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceFeatures2 where
        type FieldType "sType" VkPhysicalDeviceFeatures2 = VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceFeatures2 =
             (0)
{-# LINE 6052 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 6060 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceFeatures2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 6067 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 6071 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceFeatures2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 6077 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceFeatures2 where
        type FieldType "pNext" VkPhysicalDeviceFeatures2 = Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceFeatures2 =
             (8)
{-# LINE 6084 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 6092 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceFeatures2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 6099 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 6103 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceFeatures2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 6109 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "features" VkPhysicalDeviceFeatures2 where
        type FieldType "features" VkPhysicalDeviceFeatures2 =
             VkPhysicalDeviceFeatures
        type FieldOptional "features" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs
        type FieldOffset "features" VkPhysicalDeviceFeatures2 =
             (16)
{-# LINE 6117 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "features" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 6125 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "features" VkPhysicalDeviceFeatures2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 6132 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 6136 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "features" VkPhysicalDeviceFeatures2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 6142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceFeatures2 where
        showsPrec d x
          = showString "VkPhysicalDeviceFeatures2 {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "features = " .
                            showsPrec d (getField @"features" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceFeatures2`
type VkPhysicalDeviceFeatures2KHR = VkPhysicalDeviceFeatures2

-- | > typedef struct VkPhysicalDeviceGroupProperties {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     uint32_t                         physicalDeviceCount;
--   >     VkPhysicalDevice                 physicalDevices[VK_MAX_DEVICE_GROUP_SIZE];
--   >     VkBool32                         subsetAllocation;
--   > } VkPhysicalDeviceGroupProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceGroupProperties VkPhysicalDeviceGroupProperties registry at www.khronos.org>
data VkPhysicalDeviceGroupProperties = VkPhysicalDeviceGroupProperties# Addr#
                                                                        ByteArray#

instance Eq VkPhysicalDeviceGroupProperties where
        (VkPhysicalDeviceGroupProperties# a _) ==
          x@(VkPhysicalDeviceGroupProperties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceGroupProperties where
        (VkPhysicalDeviceGroupProperties# a _) `compare`
          x@(VkPhysicalDeviceGroupProperties# b _) = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceGroupProperties where
        sizeOf ~_ = (288)
{-# LINE 6185 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 6189 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceGroupProperties where
        unsafeAddr (VkPhysicalDeviceGroupProperties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceGroupProperties# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceGroupProperties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceGroupProperties where
        type StructFields VkPhysicalDeviceGroupProperties =
             '["sType", "pNext", "physicalDeviceCount", "physicalDevices", -- ' closing tick for hsc2hs
               "subsetAllocation"]
        type CUnionType VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceGroupProperties = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceGroupProperties = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceGroupProperties where
        type FieldType "sType" VkPhysicalDeviceGroupProperties =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceGroupProperties =
             (0)
{-# LINE 6227 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 6235 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceGroupProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 6242 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 6246 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceGroupProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 6252 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceGroupProperties where
        type FieldType "pNext" VkPhysicalDeviceGroupProperties = Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceGroupProperties =
             (8)
{-# LINE 6259 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 6267 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceGroupProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 6274 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 6278 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceGroupProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 6284 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "physicalDeviceCount" VkPhysicalDeviceGroupProperties
         where
        type FieldType "physicalDeviceCount"
               VkPhysicalDeviceGroupProperties
             = Word32
        type FieldOptional "physicalDeviceCount"
               VkPhysicalDeviceGroupProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "physicalDeviceCount"
               VkPhysicalDeviceGroupProperties
             =
             (16)
{-# LINE 6298 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "physicalDeviceCount"
               VkPhysicalDeviceGroupProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 6308 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "physicalDeviceCount" VkPhysicalDeviceGroupProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 6316 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 6320 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "physicalDeviceCount" VkPhysicalDeviceGroupProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 6327 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "physicalDevices" VkPhysicalDeviceGroupProperties where
        type FieldType "physicalDevices" VkPhysicalDeviceGroupProperties =
             VkPhysicalDevice
        type FieldOptional "physicalDevices"
               VkPhysicalDeviceGroupProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "physicalDevices" VkPhysicalDeviceGroupProperties
             =
             (24)
{-# LINE 6338 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "physicalDevices" VkPhysicalDeviceGroupProperties
             = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 6347 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "physicalDevices" idx
            VkPhysicalDeviceGroupProperties) =>
         CanReadFieldArray "physicalDevices" idx
           VkPhysicalDeviceGroupProperties
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "physicalDevices" 0
                         VkPhysicalDeviceGroupProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "physicalDevices" 1
                         VkPhysicalDeviceGroupProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "physicalDevices" 2
                         VkPhysicalDeviceGroupProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "physicalDevices" 3
                         VkPhysicalDeviceGroupProperties
                       #-}
        type FieldArrayLength "physicalDevices"
               VkPhysicalDeviceGroupProperties
             = VK_MAX_DEVICE_GROUP_SIZE

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = VK_MAX_DEVICE_GROUP_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (24)
{-# LINE 6387 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      +
                      sizeOf (undefined :: VkPhysicalDevice) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((24)
{-# LINE 6395 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: VkPhysicalDevice) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "physicalDevices" idx
            VkPhysicalDeviceGroupProperties) =>
         CanWriteFieldArray "physicalDevices" idx
           VkPhysicalDeviceGroupProperties
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "physicalDevices" 0
                         VkPhysicalDeviceGroupProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "physicalDevices" 1
                         VkPhysicalDeviceGroupProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "physicalDevices" 2
                         VkPhysicalDeviceGroupProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "physicalDevices" 3
                         VkPhysicalDeviceGroupProperties
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((24)
{-# LINE 6430 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: VkPhysicalDevice) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "subsetAllocation" VkPhysicalDeviceGroupProperties where
        type FieldType "subsetAllocation" VkPhysicalDeviceGroupProperties =
             VkBool32
        type FieldOptional "subsetAllocation"
               VkPhysicalDeviceGroupProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "subsetAllocation" VkPhysicalDeviceGroupProperties
             =
             (280)
{-# LINE 6444 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "subsetAllocation"
               VkPhysicalDeviceGroupProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (280)
{-# LINE 6454 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "subsetAllocation" VkPhysicalDeviceGroupProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (280))
{-# LINE 6462 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (280)
{-# LINE 6466 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subsetAllocation" VkPhysicalDeviceGroupProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (280)
{-# LINE 6473 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceGroupProperties where
        showsPrec d x
          = showString "VkPhysicalDeviceGroupProperties {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "physicalDeviceCount = " .
                            showsPrec d (getField @"physicalDeviceCount" x) .
                              showString ", " .
                                (showString "physicalDevices = [" .
                                   showsPrec d
                                     (let s = sizeOf
                                                (undefined ::
                                                   FieldType "physicalDevices"
                                                     VkPhysicalDeviceGroupProperties)
                                          o = fieldOffset @"physicalDevices"
                                                @VkPhysicalDeviceGroupProperties
                                          f i
                                            = peekByteOff (unsafePtr x) i ::
                                                IO
                                                  (FieldType "physicalDevices"
                                                     VkPhysicalDeviceGroupProperties)
                                        in
                                        unsafeDupablePerformIO . mapM f $
                                          map (\ i -> o + i * s)
                                            [0 .. VK_MAX_DEVICE_GROUP_SIZE - 1])
                                     . showChar ']')
                                  .
                                  showString ", " .
                                    showString "subsetAllocation = " .
                                      showsPrec d (getField @"subsetAllocation" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceGroupProperties`
type VkPhysicalDeviceGroupPropertiesKHR =
     VkPhysicalDeviceGroupProperties

-- | > typedef struct VkPhysicalDeviceIDProperties {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     uint8_t                          deviceUUID[VK_UUID_SIZE];
--   >     uint8_t                          driverUUID[VK_UUID_SIZE];
--   >     uint8_t                          deviceLUID[VK_LUID_SIZE];
--   >     uint32_t                         deviceNodeMask;
--   >     VkBool32                         deviceLUIDValid;
--   > } VkPhysicalDeviceIDProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceIDProperties VkPhysicalDeviceIDProperties registry at www.khronos.org>
data VkPhysicalDeviceIDProperties = VkPhysicalDeviceIDProperties# Addr#
                                                                  ByteArray#

instance Eq VkPhysicalDeviceIDProperties where
        (VkPhysicalDeviceIDProperties# a _) ==
          x@(VkPhysicalDeviceIDProperties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceIDProperties where
        (VkPhysicalDeviceIDProperties# a _) `compare`
          x@(VkPhysicalDeviceIDProperties# b _) = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceIDProperties where
        sizeOf ~_ = (64)
{-# LINE 6542 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 6546 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceIDProperties where
        unsafeAddr (VkPhysicalDeviceIDProperties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceIDProperties# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceIDProperties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceIDProperties where
        type StructFields VkPhysicalDeviceIDProperties =
             '["sType", "pNext", "deviceUUID", "driverUUID", "deviceLUID", -- ' closing tick for hsc2hs
               "deviceNodeMask", "deviceLUIDValid"]
        type CUnionType VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceIDProperties = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceIDProperties =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceIDProperties where
        type FieldType "sType" VkPhysicalDeviceIDProperties =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceIDProperties =
             (0)
{-# LINE 6585 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 6593 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceIDProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 6600 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 6604 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceIDProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 6610 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceIDProperties where
        type FieldType "pNext" VkPhysicalDeviceIDProperties = Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceIDProperties =
             (8)
{-# LINE 6617 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 6625 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceIDProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 6632 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 6636 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceIDProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 6642 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "deviceUUID" VkPhysicalDeviceIDProperties where
        type FieldType "deviceUUID" VkPhysicalDeviceIDProperties = Word8
        type FieldOptional "deviceUUID" VkPhysicalDeviceIDProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "deviceUUID" VkPhysicalDeviceIDProperties =
             (16)
{-# LINE 6650 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "deviceUUID" VkPhysicalDeviceIDProperties = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 6658 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "deviceUUID" idx VkPhysicalDeviceIDProperties) =>
         CanReadFieldArray "deviceUUID" idx VkPhysicalDeviceIDProperties
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "deviceUUID" 0 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "deviceUUID" 1 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "deviceUUID" 2 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "deviceUUID" 3 VkPhysicalDeviceIDProperties #-}
        type FieldArrayLength "deviceUUID" VkPhysicalDeviceIDProperties =
             VK_UUID_SIZE

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = VK_UUID_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (16) +
{-# LINE 6687 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      sizeOf (undefined :: Word8) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((16) +
{-# LINE 6694 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Word8) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "deviceUUID" idx VkPhysicalDeviceIDProperties) =>
         CanWriteFieldArray "deviceUUID" idx VkPhysicalDeviceIDProperties
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceUUID" 0 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceUUID" 1 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceUUID" 2 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceUUID" 3 VkPhysicalDeviceIDProperties #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((16) +
{-# LINE 6718 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Word8) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "driverUUID" VkPhysicalDeviceIDProperties where
        type FieldType "driverUUID" VkPhysicalDeviceIDProperties = Word8
        type FieldOptional "driverUUID" VkPhysicalDeviceIDProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "driverUUID" VkPhysicalDeviceIDProperties =
             (32)
{-# LINE 6728 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "driverUUID" VkPhysicalDeviceIDProperties = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (32)
{-# LINE 6736 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "driverUUID" idx VkPhysicalDeviceIDProperties) =>
         CanReadFieldArray "driverUUID" idx VkPhysicalDeviceIDProperties
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "driverUUID" 0 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "driverUUID" 1 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "driverUUID" 2 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "driverUUID" 3 VkPhysicalDeviceIDProperties #-}
        type FieldArrayLength "driverUUID" VkPhysicalDeviceIDProperties =
             VK_UUID_SIZE

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = VK_UUID_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (32) +
{-# LINE 6765 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      sizeOf (undefined :: Word8) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((32) +
{-# LINE 6772 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Word8) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "driverUUID" idx VkPhysicalDeviceIDProperties) =>
         CanWriteFieldArray "driverUUID" idx VkPhysicalDeviceIDProperties
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "driverUUID" 0 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "driverUUID" 1 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "driverUUID" 2 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "driverUUID" 3 VkPhysicalDeviceIDProperties #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((32) +
{-# LINE 6796 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Word8) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "deviceLUID" VkPhysicalDeviceIDProperties where
        type FieldType "deviceLUID" VkPhysicalDeviceIDProperties = Word8
        type FieldOptional "deviceLUID" VkPhysicalDeviceIDProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "deviceLUID" VkPhysicalDeviceIDProperties =
             (48)
{-# LINE 6806 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "deviceLUID" VkPhysicalDeviceIDProperties = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (48)
{-# LINE 6814 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "deviceLUID" idx VkPhysicalDeviceIDProperties) =>
         CanReadFieldArray "deviceLUID" idx VkPhysicalDeviceIDProperties
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "deviceLUID" 0 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "deviceLUID" 1 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "deviceLUID" 2 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "deviceLUID" 3 VkPhysicalDeviceIDProperties #-}
        type FieldArrayLength "deviceLUID" VkPhysicalDeviceIDProperties =
             VK_LUID_SIZE

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = VK_LUID_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (48) +
{-# LINE 6843 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      sizeOf (undefined :: Word8) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((48) +
{-# LINE 6850 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Word8) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "deviceLUID" idx VkPhysicalDeviceIDProperties) =>
         CanWriteFieldArray "deviceLUID" idx VkPhysicalDeviceIDProperties
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceLUID" 0 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceLUID" 1 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceLUID" 2 VkPhysicalDeviceIDProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceLUID" 3 VkPhysicalDeviceIDProperties #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((48) +
{-# LINE 6874 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Word8) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "deviceNodeMask" VkPhysicalDeviceIDProperties where
        type FieldType "deviceNodeMask" VkPhysicalDeviceIDProperties =
             Word32
        type FieldOptional "deviceNodeMask" VkPhysicalDeviceIDProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "deviceNodeMask" VkPhysicalDeviceIDProperties =
             (56)
{-# LINE 6885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "deviceNodeMask" VkPhysicalDeviceIDProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (56)
{-# LINE 6894 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "deviceNodeMask" VkPhysicalDeviceIDProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (56))
{-# LINE 6901 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (56)
{-# LINE 6905 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "deviceNodeMask" VkPhysicalDeviceIDProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (56)
{-# LINE 6911 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "deviceLUIDValid" VkPhysicalDeviceIDProperties where
        type FieldType "deviceLUIDValid" VkPhysicalDeviceIDProperties =
             VkBool32
        type FieldOptional "deviceLUIDValid" VkPhysicalDeviceIDProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "deviceLUIDValid" VkPhysicalDeviceIDProperties =
             (60)
{-# LINE 6920 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "deviceLUIDValid" VkPhysicalDeviceIDProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (60)
{-# LINE 6929 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "deviceLUIDValid" VkPhysicalDeviceIDProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (60))
{-# LINE 6936 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (60)
{-# LINE 6940 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "deviceLUIDValid" VkPhysicalDeviceIDProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (60)
{-# LINE 6946 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceIDProperties where
        showsPrec d x
          = showString "VkPhysicalDeviceIDProperties {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          (showString "deviceUUID = [" .
                             showsPrec d
                               (let s = sizeOf
                                          (undefined ::
                                             FieldType "deviceUUID" VkPhysicalDeviceIDProperties)
                                    o = fieldOffset @"deviceUUID" @VkPhysicalDeviceIDProperties
                                    f i
                                      = peekByteOff (unsafePtr x) i ::
                                          IO (FieldType "deviceUUID" VkPhysicalDeviceIDProperties)
                                  in
                                  unsafeDupablePerformIO . mapM f $
                                    map (\ i -> o + i * s) [0 .. VK_UUID_SIZE - 1])
                               . showChar ']')
                            .
                            showString ", " .
                              (showString "driverUUID = [" .
                                 showsPrec d
                                   (let s = sizeOf
                                              (undefined ::
                                                 FieldType "driverUUID"
                                                   VkPhysicalDeviceIDProperties)
                                        o = fieldOffset @"driverUUID" @VkPhysicalDeviceIDProperties
                                        f i
                                          = peekByteOff (unsafePtr x) i ::
                                              IO
                                                (FieldType "driverUUID"
                                                   VkPhysicalDeviceIDProperties)
                                      in
                                      unsafeDupablePerformIO . mapM f $
                                        map (\ i -> o + i * s) [0 .. VK_UUID_SIZE - 1])
                                   . showChar ']')
                                .
                                showString ", " .
                                  (showString "deviceLUID = [" .
                                     showsPrec d
                                       (let s = sizeOf
                                                  (undefined ::
                                                     FieldType "deviceLUID"
                                                       VkPhysicalDeviceIDProperties)
                                            o = fieldOffset @"deviceLUID"
                                                  @VkPhysicalDeviceIDProperties
                                            f i
                                              = peekByteOff (unsafePtr x) i ::
                                                  IO
                                                    (FieldType "deviceLUID"
                                                       VkPhysicalDeviceIDProperties)
                                          in
                                          unsafeDupablePerformIO . mapM f $
                                            map (\ i -> o + i * s) [0 .. VK_LUID_SIZE - 1])
                                       . showChar ']')
                                    .
                                    showString ", " .
                                      showString "deviceNodeMask = " .
                                        showsPrec d (getField @"deviceNodeMask" x) .
                                          showString ", " .
                                            showString "deviceLUIDValid = " .
                                              showsPrec d (getField @"deviceLUIDValid" x) .
                                                showChar '}'

-- | Alias for `VkPhysicalDeviceIDProperties`
type VkPhysicalDeviceIDPropertiesKHR = VkPhysicalDeviceIDProperties

-- | > typedef struct VkPhysicalDeviceImageFormatInfo2 {
--   >     VkStructureType sType;
--   >     const void* pNext;
--   >     VkFormat                         format;
--   >     VkImageType                      type;
--   >     VkImageTiling                    tiling;
--   >     VkImageUsageFlags                usage;
--   >     VkImageCreateFlags flags;
--   > } VkPhysicalDeviceImageFormatInfo2;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceImageFormatInfo2 VkPhysicalDeviceImageFormatInfo2 registry at www.khronos.org>
data VkPhysicalDeviceImageFormatInfo2 = VkPhysicalDeviceImageFormatInfo2# Addr#
                                                                          ByteArray#

instance Eq VkPhysicalDeviceImageFormatInfo2 where
        (VkPhysicalDeviceImageFormatInfo2# a _) ==
          x@(VkPhysicalDeviceImageFormatInfo2# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceImageFormatInfo2 where
        (VkPhysicalDeviceImageFormatInfo2# a _) `compare`
          x@(VkPhysicalDeviceImageFormatInfo2# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceImageFormatInfo2 where
        sizeOf ~_ = (40)
{-# LINE 7048 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 7052 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceImageFormatInfo2 where
        unsafeAddr (VkPhysicalDeviceImageFormatInfo2# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceImageFormatInfo2# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceImageFormatInfo2#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceImageFormatInfo2 where
        type StructFields VkPhysicalDeviceImageFormatInfo2 =
             '["sType", "pNext", "format", "type", "tiling", "usage", "flags"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceImageFormatInfo2 = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceImageFormatInfo2 where
        type FieldType "sType" VkPhysicalDeviceImageFormatInfo2 =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceImageFormatInfo2 =
             (0)
{-# LINE 7090 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 7098 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 7105 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 7109 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 7115 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceImageFormatInfo2 where
        type FieldType "pNext" VkPhysicalDeviceImageFormatInfo2 = Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceImageFormatInfo2 =
             (8)
{-# LINE 7123 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 7131 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 7138 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 7142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 7148 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "format" VkPhysicalDeviceImageFormatInfo2 where
        type FieldType "format" VkPhysicalDeviceImageFormatInfo2 = VkFormat
        type FieldOptional "format" VkPhysicalDeviceImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "format" VkPhysicalDeviceImageFormatInfo2 =
             (16)
{-# LINE 7156 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "format" VkPhysicalDeviceImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 7165 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "format" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 7172 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 7176 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "format" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 7182 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "type" VkPhysicalDeviceImageFormatInfo2 where
        type FieldType "type" VkPhysicalDeviceImageFormatInfo2 =
             VkImageType
        type FieldOptional "type" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs
        type FieldOffset "type" VkPhysicalDeviceImageFormatInfo2 =
             (20)
{-# LINE 7190 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "type" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 7198 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "type" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 7205 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 7209 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "type" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 7215 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "tiling" VkPhysicalDeviceImageFormatInfo2 where
        type FieldType "tiling" VkPhysicalDeviceImageFormatInfo2 =
             VkImageTiling
        type FieldOptional "tiling" VkPhysicalDeviceImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "tiling" VkPhysicalDeviceImageFormatInfo2 =
             (24)
{-# LINE 7224 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "tiling" VkPhysicalDeviceImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 7233 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "tiling" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 7240 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 7244 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tiling" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 7250 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "usage" VkPhysicalDeviceImageFormatInfo2 where
        type FieldType "usage" VkPhysicalDeviceImageFormatInfo2 =
             VkImageUsageFlags
        type FieldOptional "usage" VkPhysicalDeviceImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "usage" VkPhysicalDeviceImageFormatInfo2 =
             (28)
{-# LINE 7259 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "usage" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 7267 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "usage" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 7274 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 7278 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "usage" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 7284 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "flags" VkPhysicalDeviceImageFormatInfo2 where
        type FieldType "flags" VkPhysicalDeviceImageFormatInfo2 =
             VkImageCreateFlags
        type FieldOptional "flags" VkPhysicalDeviceImageFormatInfo2 = 'True -- ' closing tick for hsc2hs
        type FieldOffset "flags" VkPhysicalDeviceImageFormatInfo2 =
             (32)
{-# LINE 7292 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "flags" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (32)
{-# LINE 7300 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "flags" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 7307 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (32)
{-# LINE 7311 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 7317 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceImageFormatInfo2 where
        showsPrec d x
          = showString "VkPhysicalDeviceImageFormatInfo2 {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "format = " .
                            showsPrec d (getField @"format" x) .
                              showString ", " .
                                showString "type = " .
                                  showsPrec d (getField @"type" x) .
                                    showString ", " .
                                      showString "tiling = " .
                                        showsPrec d (getField @"tiling" x) .
                                          showString ", " .
                                            showString "usage = " .
                                              showsPrec d (getField @"usage" x) .
                                                showString ", " .
                                                  showString "flags = " .
                                                    showsPrec d (getField @"flags" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceImageFormatInfo2`
type VkPhysicalDeviceImageFormatInfo2KHR =
     VkPhysicalDeviceImageFormatInfo2

-- | > typedef struct VkPhysicalDeviceLimits {
--   >     uint32_t               maxImageDimension1D;
--   >     uint32_t               maxImageDimension2D;
--   >     uint32_t               maxImageDimension3D;
--   >     uint32_t               maxImageDimensionCube;
--   >     uint32_t               maxImageArrayLayers;
--   >     uint32_t               maxTexelBufferElements;
--   >     uint32_t               maxUniformBufferRange;
--   >     uint32_t               maxStorageBufferRange;
--   >     uint32_t               maxPushConstantsSize;
--   >     uint32_t               maxMemoryAllocationCount;
--   >     uint32_t               maxSamplerAllocationCount;
--   >     VkDeviceSize           bufferImageGranularity;
--   >     VkDeviceSize           sparseAddressSpaceSize;
--   >     uint32_t               maxBoundDescriptorSets;
--   >     uint32_t               maxPerStageDescriptorSamplers;
--   >     uint32_t               maxPerStageDescriptorUniformBuffers;
--   >     uint32_t               maxPerStageDescriptorStorageBuffers;
--   >     uint32_t               maxPerStageDescriptorSampledImages;
--   >     uint32_t               maxPerStageDescriptorStorageImages;
--   >     uint32_t               maxPerStageDescriptorInputAttachments;
--   >     uint32_t               maxPerStageResources;
--   >     uint32_t               maxDescriptorSetSamplers;
--   >     uint32_t               maxDescriptorSetUniformBuffers;
--   >     uint32_t               maxDescriptorSetUniformBuffersDynamic;
--   >     uint32_t               maxDescriptorSetStorageBuffers;
--   >     uint32_t               maxDescriptorSetStorageBuffersDynamic;
--   >     uint32_t               maxDescriptorSetSampledImages;
--   >     uint32_t               maxDescriptorSetStorageImages;
--   >     uint32_t               maxDescriptorSetInputAttachments;
--   >     uint32_t               maxVertexInputAttributes;
--   >     uint32_t               maxVertexInputBindings;
--   >     uint32_t               maxVertexInputAttributeOffset;
--   >     uint32_t               maxVertexInputBindingStride;
--   >     uint32_t               maxVertexOutputComponents;
--   >     uint32_t               maxTessellationGenerationLevel;
--   >     uint32_t               maxTessellationPatchSize;
--   >     uint32_t               maxTessellationControlPerVertexInputComponents;
--   >     uint32_t               maxTessellationControlPerVertexOutputComponents;
--   >     uint32_t               maxTessellationControlPerPatchOutputComponents;
--   >     uint32_t               maxTessellationControlTotalOutputComponents;
--   >     uint32_t               maxTessellationEvaluationInputComponents;
--   >     uint32_t               maxTessellationEvaluationOutputComponents;
--   >     uint32_t               maxGeometryShaderInvocations;
--   >     uint32_t               maxGeometryInputComponents;
--   >     uint32_t               maxGeometryOutputComponents;
--   >     uint32_t               maxGeometryOutputVertices;
--   >     uint32_t               maxGeometryTotalOutputComponents;
--   >     uint32_t               maxFragmentInputComponents;
--   >     uint32_t               maxFragmentOutputAttachments;
--   >     uint32_t               maxFragmentDualSrcAttachments;
--   >     uint32_t               maxFragmentCombinedOutputResources;
--   >     uint32_t               maxComputeSharedMemorySize;
--   >     uint32_t               maxComputeWorkGroupCount[3];
--   >     uint32_t               maxComputeWorkGroupInvocations;
--   >     uint32_t               maxComputeWorkGroupSize[3];
--   >     uint32_t               subPixelPrecisionBits;
--   >     uint32_t               subTexelPrecisionBits;
--   >     uint32_t               mipmapPrecisionBits;
--   >     uint32_t               maxDrawIndexedIndexValue;
--   >     uint32_t               maxDrawIndirectCount;
--   >     float                  maxSamplerLodBias;
--   >     float                  maxSamplerAnisotropy;
--   >     uint32_t               maxViewports;
--   >     uint32_t               maxViewportDimensions[2];
--   >     float                  viewportBoundsRange[2];
--   >     uint32_t               viewportSubPixelBits;
--   >     size_t                 minMemoryMapAlignment;
--   >     VkDeviceSize           minTexelBufferOffsetAlignment;
--   >     VkDeviceSize           minUniformBufferOffsetAlignment;
--   >     VkDeviceSize           minStorageBufferOffsetAlignment;
--   >     int32_t                minTexelOffset;
--   >     uint32_t               maxTexelOffset;
--   >     int32_t                minTexelGatherOffset;
--   >     uint32_t               maxTexelGatherOffset;
--   >     float                  minInterpolationOffset;
--   >     float                  maxInterpolationOffset;
--   >     uint32_t               subPixelInterpolationOffsetBits;
--   >     uint32_t               maxFramebufferWidth;
--   >     uint32_t               maxFramebufferHeight;
--   >     uint32_t               maxFramebufferLayers;
--   >     VkSampleCountFlags     framebufferColorSampleCounts;
--   >     VkSampleCountFlags     framebufferDepthSampleCounts;
--   >     VkSampleCountFlags     framebufferStencilSampleCounts;
--   >     VkSampleCountFlags     framebufferNoAttachmentsSampleCounts;
--   >     uint32_t               maxColorAttachments;
--   >     VkSampleCountFlags     sampledImageColorSampleCounts;
--   >     VkSampleCountFlags     sampledImageIntegerSampleCounts;
--   >     VkSampleCountFlags     sampledImageDepthSampleCounts;
--   >     VkSampleCountFlags     sampledImageStencilSampleCounts;
--   >     VkSampleCountFlags     storageImageSampleCounts;
--   >     uint32_t               maxSampleMaskWords;
--   >     VkBool32               timestampComputeAndGraphics;
--   >     float                  timestampPeriod;
--   >     uint32_t               maxClipDistances;
--   >     uint32_t               maxCullDistances;
--   >     uint32_t               maxCombinedClipAndCullDistances;
--   >     uint32_t               discreteQueuePriorities;
--   >     float                  pointSizeRange[2];
--   >     float                  lineWidthRange[2];
--   >     float                  pointSizeGranularity;
--   >     float                  lineWidthGranularity;
--   >     VkBool32               strictLines;
--   >     VkBool32               standardSampleLocations;
--   >     VkDeviceSize           optimalBufferCopyOffsetAlignment;
--   >     VkDeviceSize           optimalBufferCopyRowPitchAlignment;
--   >     VkDeviceSize           nonCoherentAtomSize;
--   > } VkPhysicalDeviceLimits;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceLimits VkPhysicalDeviceLimits registry at www.khronos.org>
data VkPhysicalDeviceLimits = VkPhysicalDeviceLimits# Addr#
                                                      ByteArray#

instance Eq VkPhysicalDeviceLimits where
        (VkPhysicalDeviceLimits# a _) == x@(VkPhysicalDeviceLimits# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceLimits where
        (VkPhysicalDeviceLimits# a _) `compare`
          x@(VkPhysicalDeviceLimits# b _) = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceLimits where
        sizeOf ~_ = (504)
{-# LINE 7473 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_ = (8)
{-# LINE 7476 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceLimits where
        unsafeAddr (VkPhysicalDeviceLimits# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceLimits# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceLimits# (plusAddr# (byteArrayContents# b) off) b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceLimits where
        type StructFields VkPhysicalDeviceLimits =
             '["maxImageDimension1D", "maxImageDimension2D", -- ' closing tick for hsc2hs
               "maxImageDimension3D", "maxImageDimensionCube",
               "maxImageArrayLayers", "maxTexelBufferElements",
               "maxUniformBufferRange", "maxStorageBufferRange",
               "maxPushConstantsSize", "maxMemoryAllocationCount",
               "maxSamplerAllocationCount", "bufferImageGranularity",
               "sparseAddressSpaceSize", "maxBoundDescriptorSets",
               "maxPerStageDescriptorSamplers",
               "maxPerStageDescriptorUniformBuffers",
               "maxPerStageDescriptorStorageBuffers",
               "maxPerStageDescriptorSampledImages",
               "maxPerStageDescriptorStorageImages",
               "maxPerStageDescriptorInputAttachments", "maxPerStageResources",
               "maxDescriptorSetSamplers", "maxDescriptorSetUniformBuffers",
               "maxDescriptorSetUniformBuffersDynamic",
               "maxDescriptorSetStorageBuffers",
               "maxDescriptorSetStorageBuffersDynamic",
               "maxDescriptorSetSampledImages", "maxDescriptorSetStorageImages",
               "maxDescriptorSetInputAttachments", "maxVertexInputAttributes",
               "maxVertexInputBindings", "maxVertexInputAttributeOffset",
               "maxVertexInputBindingStride", "maxVertexOutputComponents",
               "maxTessellationGenerationLevel", "maxTessellationPatchSize",
               "maxTessellationControlPerVertexInputComponents",
               "maxTessellationControlPerVertexOutputComponents",
               "maxTessellationControlPerPatchOutputComponents",
               "maxTessellationControlTotalOutputComponents",
               "maxTessellationEvaluationInputComponents",
               "maxTessellationEvaluationOutputComponents",
               "maxGeometryShaderInvocations", "maxGeometryInputComponents",
               "maxGeometryOutputComponents", "maxGeometryOutputVertices",
               "maxGeometryTotalOutputComponents", "maxFragmentInputComponents",
               "maxFragmentOutputAttachments", "maxFragmentDualSrcAttachments",
               "maxFragmentCombinedOutputResources", "maxComputeSharedMemorySize",
               "maxComputeWorkGroupCount", "maxComputeWorkGroupInvocations",
               "maxComputeWorkGroupSize", "subPixelPrecisionBits",
               "subTexelPrecisionBits", "mipmapPrecisionBits",
               "maxDrawIndexedIndexValue", "maxDrawIndirectCount",
               "maxSamplerLodBias", "maxSamplerAnisotropy", "maxViewports",
               "maxViewportDimensions", "viewportBoundsRange",
               "viewportSubPixelBits", "minMemoryMapAlignment",
               "minTexelBufferOffsetAlignment", "minUniformBufferOffsetAlignment",
               "minStorageBufferOffsetAlignment", "minTexelOffset",
               "maxTexelOffset", "minTexelGatherOffset", "maxTexelGatherOffset",
               "minInterpolationOffset", "maxInterpolationOffset",
               "subPixelInterpolationOffsetBits", "maxFramebufferWidth",
               "maxFramebufferHeight", "maxFramebufferLayers",
               "framebufferColorSampleCounts", "framebufferDepthSampleCounts",
               "framebufferStencilSampleCounts",
               "framebufferNoAttachmentsSampleCounts", "maxColorAttachments",
               "sampledImageColorSampleCounts", "sampledImageIntegerSampleCounts",
               "sampledImageDepthSampleCounts", "sampledImageStencilSampleCounts",
               "storageImageSampleCounts", "maxSampleMaskWords",
               "timestampComputeAndGraphics", "timestampPeriod",
               "maxClipDistances", "maxCullDistances",
               "maxCombinedClipAndCullDistances", "discreteQueuePriorities",
               "pointSizeRange", "lineWidthRange", "pointSizeGranularity",
               "lineWidthGranularity", "strictLines", "standardSampleLocations",
               "optimalBufferCopyOffsetAlignment",
               "optimalBufferCopyRowPitchAlignment", "nonCoherentAtomSize"]
        type CUnionType VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceLimits = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "maxImageDimension1D" VkPhysicalDeviceLimits where
        type FieldType "maxImageDimension1D" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxImageDimension1D" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxImageDimension1D" VkPhysicalDeviceLimits =
             (0)
{-# LINE 7570 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxImageDimension1D" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 7579 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxImageDimension1D" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 7586 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 7590 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageDimension1D" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 7596 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxImageDimension2D" VkPhysicalDeviceLimits where
        type FieldType "maxImageDimension2D" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxImageDimension2D" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxImageDimension2D" VkPhysicalDeviceLimits =
             (4)
{-# LINE 7605 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxImageDimension2D" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (4)
{-# LINE 7614 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxImageDimension2D" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (4))
{-# LINE 7621 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (4)
{-# LINE 7625 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageDimension2D" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (4)
{-# LINE 7631 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxImageDimension3D" VkPhysicalDeviceLimits where
        type FieldType "maxImageDimension3D" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxImageDimension3D" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxImageDimension3D" VkPhysicalDeviceLimits =
             (8)
{-# LINE 7640 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxImageDimension3D" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 7649 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxImageDimension3D" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 7656 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 7660 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageDimension3D" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 7666 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxImageDimensionCube" VkPhysicalDeviceLimits where
        type FieldType "maxImageDimensionCube" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxImageDimensionCube" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxImageDimensionCube" VkPhysicalDeviceLimits =
             (12)
{-# LINE 7675 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxImageDimensionCube" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (12)
{-# LINE 7684 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxImageDimensionCube" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (12))
{-# LINE 7691 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (12)
{-# LINE 7695 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageDimensionCube" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (12)
{-# LINE 7701 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxImageArrayLayers" VkPhysicalDeviceLimits where
        type FieldType "maxImageArrayLayers" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxImageArrayLayers" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxImageArrayLayers" VkPhysicalDeviceLimits =
             (16)
{-# LINE 7710 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxImageArrayLayers" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 7719 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxImageArrayLayers" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 7726 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 7730 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageArrayLayers" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 7736 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTexelBufferElements" VkPhysicalDeviceLimits where
        type FieldType "maxTexelBufferElements" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxTexelBufferElements" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTexelBufferElements" VkPhysicalDeviceLimits =
             (20)
{-# LINE 7745 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTexelBufferElements" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 7754 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTexelBufferElements" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 7761 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 7765 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTexelBufferElements" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 7771 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxUniformBufferRange" VkPhysicalDeviceLimits where
        type FieldType "maxUniformBufferRange" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxUniformBufferRange" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxUniformBufferRange" VkPhysicalDeviceLimits =
             (24)
{-# LINE 7780 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxUniformBufferRange" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 7789 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxUniformBufferRange" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 7796 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 7800 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxUniformBufferRange" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 7806 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxStorageBufferRange" VkPhysicalDeviceLimits where
        type FieldType "maxStorageBufferRange" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxStorageBufferRange" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxStorageBufferRange" VkPhysicalDeviceLimits =
             (28)
{-# LINE 7815 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxStorageBufferRange" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 7824 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxStorageBufferRange" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 7831 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 7835 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxStorageBufferRange" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 7841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPushConstantsSize" VkPhysicalDeviceLimits where
        type FieldType "maxPushConstantsSize" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxPushConstantsSize" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPushConstantsSize" VkPhysicalDeviceLimits =
             (32)
{-# LINE 7850 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPushConstantsSize" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (32)
{-# LINE 7859 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPushConstantsSize" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 7866 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (32)
{-# LINE 7870 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPushConstantsSize" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 7876 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxMemoryAllocationCount" VkPhysicalDeviceLimits where
        type FieldType "maxMemoryAllocationCount" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxMemoryAllocationCount"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxMemoryAllocationCount" VkPhysicalDeviceLimits
             =
             (36)
{-# LINE 7887 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxMemoryAllocationCount" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (36)
{-# LINE 7896 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxMemoryAllocationCount" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (36))
{-# LINE 7904 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (36)
{-# LINE 7908 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxMemoryAllocationCount" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (36)
{-# LINE 7915 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxSamplerAllocationCount" VkPhysicalDeviceLimits where
        type FieldType "maxSamplerAllocationCount" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxSamplerAllocationCount"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxSamplerAllocationCount" VkPhysicalDeviceLimits
             =
             (40)
{-# LINE 7926 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxSamplerAllocationCount"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (40)
{-# LINE 7936 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxSamplerAllocationCount" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (40))
{-# LINE 7944 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (40)
{-# LINE 7948 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSamplerAllocationCount" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (40)
{-# LINE 7955 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "bufferImageGranularity" VkPhysicalDeviceLimits where
        type FieldType "bufferImageGranularity" VkPhysicalDeviceLimits =
             VkDeviceSize
        type FieldOptional "bufferImageGranularity" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "bufferImageGranularity" VkPhysicalDeviceLimits =
             (48)
{-# LINE 7964 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "bufferImageGranularity" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (48)
{-# LINE 7973 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "bufferImageGranularity" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (48))
{-# LINE 7980 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (48)
{-# LINE 7984 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "bufferImageGranularity" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (48)
{-# LINE 7990 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseAddressSpaceSize" VkPhysicalDeviceLimits where
        type FieldType "sparseAddressSpaceSize" VkPhysicalDeviceLimits =
             VkDeviceSize
        type FieldOptional "sparseAddressSpaceSize" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseAddressSpaceSize" VkPhysicalDeviceLimits =
             (56)
{-# LINE 7999 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sparseAddressSpaceSize" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (56)
{-# LINE 8008 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sparseAddressSpaceSize" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (56))
{-# LINE 8015 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (56)
{-# LINE 8019 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseAddressSpaceSize" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (56)
{-# LINE 8025 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxBoundDescriptorSets" VkPhysicalDeviceLimits where
        type FieldType "maxBoundDescriptorSets" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxBoundDescriptorSets" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxBoundDescriptorSets" VkPhysicalDeviceLimits =
             (64)
{-# LINE 8034 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxBoundDescriptorSets" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (64)
{-# LINE 8043 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxBoundDescriptorSets" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (64))
{-# LINE 8050 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (64)
{-# LINE 8054 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxBoundDescriptorSets" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (64)
{-# LINE 8060 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits
         where
        type FieldType "maxPerStageDescriptorSamplers"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxPerStageDescriptorSamplers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerStageDescriptorSamplers"
               VkPhysicalDeviceLimits
             =
             (68)
{-# LINE 8074 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerStageDescriptorSamplers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (68)
{-# LINE 8084 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (68))
{-# LINE 8092 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (68)
{-# LINE 8096 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorSamplers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (68)
{-# LINE 8104 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorUniformBuffers"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxPerStageDescriptorUniformBuffers"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxPerStageDescriptorUniformBuffers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerStageDescriptorUniformBuffers"
               VkPhysicalDeviceLimits
             =
             (72)
{-# LINE 8119 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerStageDescriptorUniformBuffers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (72)
{-# LINE 8129 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUniformBuffers"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (72))
{-# LINE 8138 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (72)
{-# LINE 8142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUniformBuffers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (72)
{-# LINE 8150 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorStorageBuffers"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxPerStageDescriptorStorageBuffers"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxPerStageDescriptorStorageBuffers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerStageDescriptorStorageBuffers"
               VkPhysicalDeviceLimits
             =
             (76)
{-# LINE 8165 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerStageDescriptorStorageBuffers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (76)
{-# LINE 8175 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorStorageBuffers"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (76))
{-# LINE 8184 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (76)
{-# LINE 8188 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorStorageBuffers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (76)
{-# LINE 8196 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorSampledImages"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxPerStageDescriptorSampledImages"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxPerStageDescriptorSampledImages"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerStageDescriptorSampledImages"
               VkPhysicalDeviceLimits
             =
             (80)
{-# LINE 8211 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerStageDescriptorSampledImages"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (80)
{-# LINE 8221 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorSampledImages"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (80))
{-# LINE 8230 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (80)
{-# LINE 8234 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorSampledImages"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (80)
{-# LINE 8242 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorStorageImages"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxPerStageDescriptorStorageImages"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxPerStageDescriptorStorageImages"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerStageDescriptorStorageImages"
               VkPhysicalDeviceLimits
             =
             (84)
{-# LINE 8257 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerStageDescriptorStorageImages"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (84)
{-# LINE 8267 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorStorageImages"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (84))
{-# LINE 8276 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (84)
{-# LINE 8280 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorStorageImages"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (84)
{-# LINE 8288 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageDescriptorInputAttachments"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxPerStageDescriptorInputAttachments"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxPerStageDescriptorInputAttachments"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerStageDescriptorInputAttachments"
               VkPhysicalDeviceLimits
             =
             (88)
{-# LINE 8303 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerStageDescriptorInputAttachments"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (88)
{-# LINE 8313 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorInputAttachments"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (88))
{-# LINE 8322 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (88)
{-# LINE 8326 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorInputAttachments"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (88)
{-# LINE 8334 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerStageResources" VkPhysicalDeviceLimits where
        type FieldType "maxPerStageResources" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxPerStageResources" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerStageResources" VkPhysicalDeviceLimits =
             (92)
{-# LINE 8343 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerStageResources" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (92)
{-# LINE 8352 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageResources" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (92))
{-# LINE 8359 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (92)
{-# LINE 8363 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageResources" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (92)
{-# LINE 8369 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetSamplers" VkPhysicalDeviceLimits where
        type FieldType "maxDescriptorSetSamplers" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxDescriptorSetSamplers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetSamplers" VkPhysicalDeviceLimits
             =
             (96)
{-# LINE 8380 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetSamplers" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (96)
{-# LINE 8389 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetSamplers" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (96))
{-# LINE 8397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (96)
{-# LINE 8401 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetSamplers" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (96)
{-# LINE 8408 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits
         where
        type FieldType "maxDescriptorSetUniformBuffers"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxDescriptorSetUniformBuffers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetUniformBuffers"
               VkPhysicalDeviceLimits
             =
             (100)
{-# LINE 8422 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetUniformBuffers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (100)
{-# LINE 8432 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUniformBuffers"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (100))
{-# LINE 8441 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (100)
{-# LINE 8445 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUniformBuffers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (100)
{-# LINE 8453 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetUniformBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxDescriptorSetUniformBuffersDynamic"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxDescriptorSetUniformBuffersDynamic"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetUniformBuffersDynamic"
               VkPhysicalDeviceLimits
             =
             (104)
{-# LINE 8468 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetUniformBuffersDynamic"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (104)
{-# LINE 8478 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUniformBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (104))
{-# LINE 8487 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (104)
{-# LINE 8491 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUniformBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (104)
{-# LINE 8499 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits
         where
        type FieldType "maxDescriptorSetStorageBuffers"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxDescriptorSetStorageBuffers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetStorageBuffers"
               VkPhysicalDeviceLimits
             =
             (108)
{-# LINE 8513 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetStorageBuffers"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (108)
{-# LINE 8523 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetStorageBuffers"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (108))
{-# LINE 8532 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (108)
{-# LINE 8536 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetStorageBuffers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (108)
{-# LINE 8544 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetStorageBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxDescriptorSetStorageBuffersDynamic"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxDescriptorSetStorageBuffersDynamic"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetStorageBuffersDynamic"
               VkPhysicalDeviceLimits
             =
             (112)
{-# LINE 8559 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetStorageBuffersDynamic"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (112)
{-# LINE 8569 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetStorageBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (112))
{-# LINE 8578 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (112)
{-# LINE 8582 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetStorageBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (112)
{-# LINE 8590 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits
         where
        type FieldType "maxDescriptorSetSampledImages"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxDescriptorSetSampledImages"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetSampledImages"
               VkPhysicalDeviceLimits
             =
             (116)
{-# LINE 8604 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetSampledImages"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (116)
{-# LINE 8614 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (116))
{-# LINE 8622 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (116)
{-# LINE 8626 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetSampledImages"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (116)
{-# LINE 8634 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits
         where
        type FieldType "maxDescriptorSetStorageImages"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxDescriptorSetStorageImages"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetStorageImages"
               VkPhysicalDeviceLimits
             =
             (120)
{-# LINE 8648 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetStorageImages"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (120)
{-# LINE 8658 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (120))
{-# LINE 8666 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (120)
{-# LINE 8670 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetStorageImages"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (120)
{-# LINE 8678 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits
         where
        type FieldType "maxDescriptorSetInputAttachments"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxDescriptorSetInputAttachments"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDescriptorSetInputAttachments"
               VkPhysicalDeviceLimits
             =
             (124)
{-# LINE 8692 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDescriptorSetInputAttachments"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (124)
{-# LINE 8702 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetInputAttachments"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (124))
{-# LINE 8711 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (124)
{-# LINE 8715 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetInputAttachments"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (124)
{-# LINE 8723 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxVertexInputAttributes" VkPhysicalDeviceLimits where
        type FieldType "maxVertexInputAttributes" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxVertexInputAttributes"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxVertexInputAttributes" VkPhysicalDeviceLimits
             =
             (128)
{-# LINE 8734 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxVertexInputAttributes" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (128)
{-# LINE 8743 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexInputAttributes" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (128))
{-# LINE 8751 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (128)
{-# LINE 8755 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexInputAttributes" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (128)
{-# LINE 8762 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxVertexInputBindings" VkPhysicalDeviceLimits where
        type FieldType "maxVertexInputBindings" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxVertexInputBindings" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxVertexInputBindings" VkPhysicalDeviceLimits =
             (132)
{-# LINE 8771 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxVertexInputBindings" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (132)
{-# LINE 8780 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexInputBindings" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (132))
{-# LINE 8787 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (132)
{-# LINE 8791 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexInputBindings" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (132)
{-# LINE 8797 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits
         where
        type FieldType "maxVertexInputAttributeOffset"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxVertexInputAttributeOffset"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxVertexInputAttributeOffset"
               VkPhysicalDeviceLimits
             =
             (136)
{-# LINE 8811 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxVertexInputAttributeOffset"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (136)
{-# LINE 8821 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (136))
{-# LINE 8829 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (136)
{-# LINE 8833 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexInputAttributeOffset"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (136)
{-# LINE 8841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxVertexInputBindingStride" VkPhysicalDeviceLimits where
        type FieldType "maxVertexInputBindingStride" VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxVertexInputBindingStride"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxVertexInputBindingStride"
               VkPhysicalDeviceLimits
             =
             (140)
{-# LINE 8853 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxVertexInputBindingStride"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (140)
{-# LINE 8863 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexInputBindingStride" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (140))
{-# LINE 8871 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (140)
{-# LINE 8875 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexInputBindingStride" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (140)
{-# LINE 8882 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxVertexOutputComponents" VkPhysicalDeviceLimits where
        type FieldType "maxVertexOutputComponents" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxVertexOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxVertexOutputComponents" VkPhysicalDeviceLimits
             =
             (144)
{-# LINE 8893 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxVertexOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (144)
{-# LINE 8903 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexOutputComponents" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (144))
{-# LINE 8911 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (144)
{-# LINE 8915 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexOutputComponents" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (144)
{-# LINE 8922 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTessellationGenerationLevel" VkPhysicalDeviceLimits
         where
        type FieldType "maxTessellationGenerationLevel"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxTessellationGenerationLevel"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTessellationGenerationLevel"
               VkPhysicalDeviceLimits
             =
             (148)
{-# LINE 8936 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTessellationGenerationLevel"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (148)
{-# LINE 8946 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationGenerationLevel"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (148))
{-# LINE 8955 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (148)
{-# LINE 8959 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationGenerationLevel"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (148)
{-# LINE 8967 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTessellationPatchSize" VkPhysicalDeviceLimits where
        type FieldType "maxTessellationPatchSize" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxTessellationPatchSize"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTessellationPatchSize" VkPhysicalDeviceLimits
             =
             (152)
{-# LINE 8978 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTessellationPatchSize" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (152)
{-# LINE 8987 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationPatchSize" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (152))
{-# LINE 8995 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (152)
{-# LINE 8999 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationPatchSize" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (152)
{-# LINE 9006 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTessellationControlPerVertexInputComponents"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxTessellationControlPerVertexInputComponents"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxTessellationControlPerVertexInputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTessellationControlPerVertexInputComponents"
               VkPhysicalDeviceLimits
             =
             (156)
{-# LINE 9021 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTessellationControlPerVertexInputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (156)
{-# LINE 9031 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationControlPerVertexInputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (156))
{-# LINE 9040 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (156)
{-# LINE 9044 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationControlPerVertexInputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (156)
{-# LINE 9052 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTessellationControlPerVertexOutputComponents"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxTessellationControlPerVertexOutputComponents"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional
               "maxTessellationControlPerVertexOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTessellationControlPerVertexOutputComponents"
               VkPhysicalDeviceLimits
             =
             (160)
{-# LINE 9068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTessellationControlPerVertexOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (160)
{-# LINE 9078 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationControlPerVertexOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (160))
{-# LINE 9087 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (160)
{-# LINE 9091 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationControlPerVertexOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (160)
{-# LINE 9099 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTessellationControlPerPatchOutputComponents"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxTessellationControlPerPatchOutputComponents"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxTessellationControlPerPatchOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTessellationControlPerPatchOutputComponents"
               VkPhysicalDeviceLimits
             =
             (164)
{-# LINE 9114 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTessellationControlPerPatchOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (164)
{-# LINE 9124 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationControlPerPatchOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (164))
{-# LINE 9133 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (164)
{-# LINE 9137 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationControlPerPatchOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (164)
{-# LINE 9145 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTessellationControlTotalOutputComponents"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxTessellationControlTotalOutputComponents"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxTessellationControlTotalOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTessellationControlTotalOutputComponents"
               VkPhysicalDeviceLimits
             =
             (168)
{-# LINE 9160 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTessellationControlTotalOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (168)
{-# LINE 9170 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationControlTotalOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (168))
{-# LINE 9179 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (168)
{-# LINE 9183 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationControlTotalOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (168)
{-# LINE 9191 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTessellationEvaluationInputComponents"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxTessellationEvaluationInputComponents"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxTessellationEvaluationInputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTessellationEvaluationInputComponents"
               VkPhysicalDeviceLimits
             =
             (172)
{-# LINE 9206 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTessellationEvaluationInputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (172)
{-# LINE 9216 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationEvaluationInputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (172))
{-# LINE 9225 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (172)
{-# LINE 9229 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationEvaluationInputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (172)
{-# LINE 9237 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTessellationEvaluationOutputComponents"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxTessellationEvaluationOutputComponents"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxTessellationEvaluationOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTessellationEvaluationOutputComponents"
               VkPhysicalDeviceLimits
             =
             (176)
{-# LINE 9252 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTessellationEvaluationOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (176)
{-# LINE 9262 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationEvaluationOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (176))
{-# LINE 9271 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (176)
{-# LINE 9275 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationEvaluationOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (176)
{-# LINE 9283 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxGeometryShaderInvocations" VkPhysicalDeviceLimits
         where
        type FieldType "maxGeometryShaderInvocations"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxGeometryShaderInvocations"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxGeometryShaderInvocations"
               VkPhysicalDeviceLimits
             =
             (180)
{-# LINE 9297 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxGeometryShaderInvocations"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (180)
{-# LINE 9307 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryShaderInvocations" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (180))
{-# LINE 9315 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (180)
{-# LINE 9319 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryShaderInvocations" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (180)
{-# LINE 9326 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxGeometryInputComponents" VkPhysicalDeviceLimits where
        type FieldType "maxGeometryInputComponents" VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxGeometryInputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxGeometryInputComponents"
               VkPhysicalDeviceLimits
             =
             (184)
{-# LINE 9338 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxGeometryInputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (184)
{-# LINE 9348 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryInputComponents" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (184))
{-# LINE 9356 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (184)
{-# LINE 9360 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryInputComponents" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (184)
{-# LINE 9367 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxGeometryOutputComponents" VkPhysicalDeviceLimits where
        type FieldType "maxGeometryOutputComponents" VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxGeometryOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxGeometryOutputComponents"
               VkPhysicalDeviceLimits
             =
             (188)
{-# LINE 9379 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxGeometryOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (188)
{-# LINE 9389 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryOutputComponents" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (188))
{-# LINE 9397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (188)
{-# LINE 9401 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryOutputComponents" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (188)
{-# LINE 9408 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxGeometryOutputVertices" VkPhysicalDeviceLimits where
        type FieldType "maxGeometryOutputVertices" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxGeometryOutputVertices"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxGeometryOutputVertices" VkPhysicalDeviceLimits
             =
             (192)
{-# LINE 9419 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxGeometryOutputVertices"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (192)
{-# LINE 9429 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryOutputVertices" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (192))
{-# LINE 9437 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (192)
{-# LINE 9441 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryOutputVertices" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (192)
{-# LINE 9448 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits
         where
        type FieldType "maxGeometryTotalOutputComponents"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxGeometryTotalOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxGeometryTotalOutputComponents"
               VkPhysicalDeviceLimits
             =
             (196)
{-# LINE 9462 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxGeometryTotalOutputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (196)
{-# LINE 9472 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryTotalOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (196))
{-# LINE 9481 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (196)
{-# LINE 9485 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryTotalOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (196)
{-# LINE 9493 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxFragmentInputComponents" VkPhysicalDeviceLimits where
        type FieldType "maxFragmentInputComponents" VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxFragmentInputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxFragmentInputComponents"
               VkPhysicalDeviceLimits
             =
             (200)
{-# LINE 9505 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxFragmentInputComponents"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (200)
{-# LINE 9515 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFragmentInputComponents" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (200))
{-# LINE 9523 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (200)
{-# LINE 9527 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFragmentInputComponents" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (200)
{-# LINE 9534 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxFragmentOutputAttachments" VkPhysicalDeviceLimits
         where
        type FieldType "maxFragmentOutputAttachments"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxFragmentOutputAttachments"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxFragmentOutputAttachments"
               VkPhysicalDeviceLimits
             =
             (204)
{-# LINE 9548 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxFragmentOutputAttachments"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (204)
{-# LINE 9558 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFragmentOutputAttachments" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (204))
{-# LINE 9566 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (204)
{-# LINE 9570 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFragmentOutputAttachments" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (204)
{-# LINE 9577 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits
         where
        type FieldType "maxFragmentDualSrcAttachments"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxFragmentDualSrcAttachments"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxFragmentDualSrcAttachments"
               VkPhysicalDeviceLimits
             =
             (208)
{-# LINE 9591 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxFragmentDualSrcAttachments"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (208)
{-# LINE 9601 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (208))
{-# LINE 9609 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (208)
{-# LINE 9613 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFragmentDualSrcAttachments"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (208)
{-# LINE 9621 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxFragmentCombinedOutputResources"
           VkPhysicalDeviceLimits
         where
        type FieldType "maxFragmentCombinedOutputResources"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxFragmentCombinedOutputResources"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxFragmentCombinedOutputResources"
               VkPhysicalDeviceLimits
             =
             (212)
{-# LINE 9636 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxFragmentCombinedOutputResources"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (212)
{-# LINE 9646 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFragmentCombinedOutputResources"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (212))
{-# LINE 9655 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (212)
{-# LINE 9659 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFragmentCombinedOutputResources"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (212)
{-# LINE 9667 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxComputeSharedMemorySize" VkPhysicalDeviceLimits where
        type FieldType "maxComputeSharedMemorySize" VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxComputeSharedMemorySize"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxComputeSharedMemorySize"
               VkPhysicalDeviceLimits
             =
             (216)
{-# LINE 9679 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxComputeSharedMemorySize"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (216)
{-# LINE 9689 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxComputeSharedMemorySize" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (216))
{-# LINE 9697 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (216)
{-# LINE 9701 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxComputeSharedMemorySize" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (216)
{-# LINE 9708 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxComputeWorkGroupCount" VkPhysicalDeviceLimits where
        type FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxComputeWorkGroupCount"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxComputeWorkGroupCount" VkPhysicalDeviceLimits
             =
             (220)
{-# LINE 9719 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxComputeWorkGroupCount" VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (220)
{-# LINE 9728 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "maxComputeWorkGroupCount" idx
            VkPhysicalDeviceLimits) =>
         CanReadFieldArray "maxComputeWorkGroupCount" idx
           VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "maxComputeWorkGroupCount" 0
                         VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "maxComputeWorkGroupCount" 1
                         VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "maxComputeWorkGroupCount" 2
                         VkPhysicalDeviceLimits
                       #-}
        type FieldArrayLength "maxComputeWorkGroupCount"
               VkPhysicalDeviceLimits
             = 3

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = 3

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (220)
{-# LINE 9763 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      +
                      sizeOf (undefined :: Word32) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((220)
{-# LINE 9771 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Word32) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "maxComputeWorkGroupCount" idx
            VkPhysicalDeviceLimits) =>
         CanWriteFieldArray "maxComputeWorkGroupCount" idx
           VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "maxComputeWorkGroupCount" 0
                         VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "maxComputeWorkGroupCount" 1
                         VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "maxComputeWorkGroupCount" 2
                         VkPhysicalDeviceLimits
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((220)
{-# LINE 9801 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Word32) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits
         where
        type FieldType "maxComputeWorkGroupInvocations"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxComputeWorkGroupInvocations"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxComputeWorkGroupInvocations"
               VkPhysicalDeviceLimits
             =
             (232)
{-# LINE 9818 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxComputeWorkGroupInvocations"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (232)
{-# LINE 9828 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxComputeWorkGroupInvocations"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (232))
{-# LINE 9837 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (232)
{-# LINE 9841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxComputeWorkGroupInvocations"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (232)
{-# LINE 9849 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxComputeWorkGroupSize" VkPhysicalDeviceLimits where
        type FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxComputeWorkGroupSize" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxComputeWorkGroupSize" VkPhysicalDeviceLimits =
             (236)
{-# LINE 9858 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxComputeWorkGroupSize" VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (236)
{-# LINE 9867 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "maxComputeWorkGroupSize" idx
            VkPhysicalDeviceLimits) =>
         CanReadFieldArray "maxComputeWorkGroupSize" idx
           VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "maxComputeWorkGroupSize" 0
                         VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "maxComputeWorkGroupSize" 1
                         VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "maxComputeWorkGroupSize" 2
                         VkPhysicalDeviceLimits
                       #-}
        type FieldArrayLength "maxComputeWorkGroupSize"
               VkPhysicalDeviceLimits
             = 3

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = 3

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (236)
{-# LINE 9902 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      +
                      sizeOf (undefined :: Word32) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((236)
{-# LINE 9910 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Word32) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "maxComputeWorkGroupSize" idx
            VkPhysicalDeviceLimits) =>
         CanWriteFieldArray "maxComputeWorkGroupSize" idx
           VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "maxComputeWorkGroupSize" 0
                         VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "maxComputeWorkGroupSize" 1
                         VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "maxComputeWorkGroupSize" 2
                         VkPhysicalDeviceLimits
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((236)
{-# LINE 9940 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Word32) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "subPixelPrecisionBits" VkPhysicalDeviceLimits where
        type FieldType "subPixelPrecisionBits" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "subPixelPrecisionBits" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "subPixelPrecisionBits" VkPhysicalDeviceLimits =
             (248)
{-# LINE 9952 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "subPixelPrecisionBits" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (248)
{-# LINE 9961 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "subPixelPrecisionBits" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (248))
{-# LINE 9968 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (248)
{-# LINE 9972 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subPixelPrecisionBits" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (248)
{-# LINE 9978 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "subTexelPrecisionBits" VkPhysicalDeviceLimits where
        type FieldType "subTexelPrecisionBits" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "subTexelPrecisionBits" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "subTexelPrecisionBits" VkPhysicalDeviceLimits =
             (252)
{-# LINE 9987 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "subTexelPrecisionBits" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (252)
{-# LINE 9996 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "subTexelPrecisionBits" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (252))
{-# LINE 10003 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (252)
{-# LINE 10007 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subTexelPrecisionBits" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (252)
{-# LINE 10013 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "mipmapPrecisionBits" VkPhysicalDeviceLimits where
        type FieldType "mipmapPrecisionBits" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "mipmapPrecisionBits" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "mipmapPrecisionBits" VkPhysicalDeviceLimits =
             (256)
{-# LINE 10022 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "mipmapPrecisionBits" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (256)
{-# LINE 10031 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "mipmapPrecisionBits" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (256))
{-# LINE 10038 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (256)
{-# LINE 10042 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "mipmapPrecisionBits" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (256)
{-# LINE 10048 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits where
        type FieldType "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxDrawIndexedIndexValue"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits
             =
             (260)
{-# LINE 10059 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (260)
{-# LINE 10068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (260))
{-# LINE 10076 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (260)
{-# LINE 10080 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (260)
{-# LINE 10087 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxDrawIndirectCount" VkPhysicalDeviceLimits where
        type FieldType "maxDrawIndirectCount" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxDrawIndirectCount" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxDrawIndirectCount" VkPhysicalDeviceLimits =
             (264)
{-# LINE 10096 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxDrawIndirectCount" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (264)
{-# LINE 10105 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDrawIndirectCount" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (264))
{-# LINE 10112 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (264)
{-# LINE 10116 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDrawIndirectCount" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (264)
{-# LINE 10122 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxSamplerLodBias" VkPhysicalDeviceLimits where
        type FieldType "maxSamplerLodBias" VkPhysicalDeviceLimits =
             Float
{-# LINE 10127 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "maxSamplerLodBias" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxSamplerLodBias" VkPhysicalDeviceLimits =
             (268)
{-# LINE 10131 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxSamplerLodBias" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (268)
{-# LINE 10140 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxSamplerLodBias" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (268))
{-# LINE 10147 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (268)
{-# LINE 10151 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSamplerLodBias" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (268)
{-# LINE 10157 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxSamplerAnisotropy" VkPhysicalDeviceLimits where
        type FieldType "maxSamplerAnisotropy" VkPhysicalDeviceLimits =
             Float
{-# LINE 10162 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "maxSamplerAnisotropy" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxSamplerAnisotropy" VkPhysicalDeviceLimits =
             (272)
{-# LINE 10166 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxSamplerAnisotropy" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (272)
{-# LINE 10175 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxSamplerAnisotropy" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (272))
{-# LINE 10182 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (272)
{-# LINE 10186 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSamplerAnisotropy" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (272)
{-# LINE 10192 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxViewports" VkPhysicalDeviceLimits where
        type FieldType "maxViewports" VkPhysicalDeviceLimits = Word32
        type FieldOptional "maxViewports" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxViewports" VkPhysicalDeviceLimits =
             (276)
{-# LINE 10199 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxViewports" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (276)
{-# LINE 10207 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxViewports" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (276))
{-# LINE 10214 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (276)
{-# LINE 10218 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxViewports" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (276)
{-# LINE 10224 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxViewportDimensions" VkPhysicalDeviceLimits where
        type FieldType "maxViewportDimensions" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxViewportDimensions" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxViewportDimensions" VkPhysicalDeviceLimits =
             (280)
{-# LINE 10233 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxViewportDimensions" VkPhysicalDeviceLimits =
             'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (280)
{-# LINE 10242 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "maxViewportDimensions" idx
            VkPhysicalDeviceLimits) =>
         CanReadFieldArray "maxViewportDimensions" idx
           VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "maxViewportDimensions" 0 VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "maxViewportDimensions" 1 VkPhysicalDeviceLimits
                       #-}
        type FieldArrayLength "maxViewportDimensions"
               VkPhysicalDeviceLimits
             = 2

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = 2

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (280)
{-# LINE 10270 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      +
                      sizeOf (undefined :: Word32) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((280)
{-# LINE 10278 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Word32) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "maxViewportDimensions" idx
            VkPhysicalDeviceLimits) =>
         CanWriteFieldArray "maxViewportDimensions" idx
           VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "maxViewportDimensions" 0 VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "maxViewportDimensions" 1 VkPhysicalDeviceLimits
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((280)
{-# LINE 10301 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Word32) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "viewportBoundsRange" VkPhysicalDeviceLimits where
        type FieldType "viewportBoundsRange" VkPhysicalDeviceLimits =
             Float
{-# LINE 10309 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "viewportBoundsRange" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "viewportBoundsRange" VkPhysicalDeviceLimits =
             (288)
{-# LINE 10313 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "viewportBoundsRange" VkPhysicalDeviceLimits =
             'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (288)
{-# LINE 10322 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "viewportBoundsRange" idx VkPhysicalDeviceLimits) =>
         CanReadFieldArray "viewportBoundsRange" idx VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "viewportBoundsRange" 0 VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "viewportBoundsRange" 1 VkPhysicalDeviceLimits
                       #-}
        type FieldArrayLength "viewportBoundsRange" VkPhysicalDeviceLimits
             = 2

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = 2

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (288)
{-# LINE 10347 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      +
                      sizeOf (undefined :: Float) *
{-# LINE 10349 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((288)
{-# LINE 10355 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Float) *
{-# LINE 10357 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "viewportBoundsRange" idx VkPhysicalDeviceLimits) =>
         CanWriteFieldArray "viewportBoundsRange" idx VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "viewportBoundsRange" 0 VkPhysicalDeviceLimits
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "viewportBoundsRange" 1 VkPhysicalDeviceLimits
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((288)
{-# LINE 10376 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Float) *
{-# LINE 10378 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "viewportSubPixelBits" VkPhysicalDeviceLimits where
        type FieldType "viewportSubPixelBits" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "viewportSubPixelBits" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "viewportSubPixelBits" VkPhysicalDeviceLimits =
             (296)
{-# LINE 10388 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "viewportSubPixelBits" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (296)
{-# LINE 10397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "viewportSubPixelBits" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (296))
{-# LINE 10404 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (296)
{-# LINE 10408 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "viewportSubPixelBits" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (296)
{-# LINE 10414 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minMemoryMapAlignment" VkPhysicalDeviceLimits where
        type FieldType "minMemoryMapAlignment" VkPhysicalDeviceLimits =
             CSize
        type FieldOptional "minMemoryMapAlignment" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "minMemoryMapAlignment" VkPhysicalDeviceLimits =
             (304)
{-# LINE 10423 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minMemoryMapAlignment" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (304)
{-# LINE 10432 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minMemoryMapAlignment" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (304))
{-# LINE 10439 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (304)
{-# LINE 10443 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minMemoryMapAlignment" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (304)
{-# LINE 10449 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits
         where
        type FieldType "minTexelBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             = VkDeviceSize
        type FieldOptional "minTexelBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minTexelBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             =
             (312)
{-# LINE 10463 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minTexelBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (312)
{-# LINE 10473 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (312))
{-# LINE 10481 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (312)
{-# LINE 10485 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minTexelBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (312)
{-# LINE 10493 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits
         where
        type FieldType "minUniformBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             = VkDeviceSize
        type FieldOptional "minUniformBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minUniformBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             =
             (320)
{-# LINE 10507 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minUniformBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (320)
{-# LINE 10517 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minUniformBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (320))
{-# LINE 10526 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (320)
{-# LINE 10530 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minUniformBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (320)
{-# LINE 10538 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits
         where
        type FieldType "minStorageBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             = VkDeviceSize
        type FieldOptional "minStorageBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minStorageBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             =
             (328)
{-# LINE 10552 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minStorageBufferOffsetAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (328)
{-# LINE 10562 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minStorageBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (328))
{-# LINE 10571 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (328)
{-# LINE 10575 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minStorageBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (328)
{-# LINE 10583 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minTexelOffset" VkPhysicalDeviceLimits where
        type FieldType "minTexelOffset" VkPhysicalDeviceLimits = Int32
        type FieldOptional "minTexelOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minTexelOffset" VkPhysicalDeviceLimits =
             (336)
{-# LINE 10590 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minTexelOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (336)
{-# LINE 10598 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minTexelOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (336))
{-# LINE 10605 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (336)
{-# LINE 10609 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minTexelOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (336)
{-# LINE 10615 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTexelOffset" VkPhysicalDeviceLimits where
        type FieldType "maxTexelOffset" VkPhysicalDeviceLimits = Word32
        type FieldOptional "maxTexelOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTexelOffset" VkPhysicalDeviceLimits =
             (340)
{-# LINE 10622 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTexelOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (340)
{-# LINE 10630 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTexelOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (340))
{-# LINE 10637 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (340)
{-# LINE 10641 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTexelOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (340)
{-# LINE 10647 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minTexelGatherOffset" VkPhysicalDeviceLimits where
        type FieldType "minTexelGatherOffset" VkPhysicalDeviceLimits =
             Int32
        type FieldOptional "minTexelGatherOffset" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "minTexelGatherOffset" VkPhysicalDeviceLimits =
             (344)
{-# LINE 10656 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minTexelGatherOffset" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (344)
{-# LINE 10665 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minTexelGatherOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (344))
{-# LINE 10672 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (344)
{-# LINE 10676 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minTexelGatherOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (344)
{-# LINE 10682 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxTexelGatherOffset" VkPhysicalDeviceLimits where
        type FieldType "maxTexelGatherOffset" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxTexelGatherOffset" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxTexelGatherOffset" VkPhysicalDeviceLimits =
             (348)
{-# LINE 10691 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxTexelGatherOffset" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (348)
{-# LINE 10700 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTexelGatherOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (348))
{-# LINE 10707 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (348)
{-# LINE 10711 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTexelGatherOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (348)
{-# LINE 10717 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minInterpolationOffset" VkPhysicalDeviceLimits where
        type FieldType "minInterpolationOffset" VkPhysicalDeviceLimits =
             Float
{-# LINE 10722 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "minInterpolationOffset" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minInterpolationOffset" VkPhysicalDeviceLimits =
             (352)
{-# LINE 10726 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minInterpolationOffset" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (352)
{-# LINE 10735 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minInterpolationOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (352))
{-# LINE 10742 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (352)
{-# LINE 10746 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minInterpolationOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (352)
{-# LINE 10752 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxInterpolationOffset" VkPhysicalDeviceLimits where
        type FieldType "maxInterpolationOffset" VkPhysicalDeviceLimits =
             Float
{-# LINE 10757 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "maxInterpolationOffset" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxInterpolationOffset" VkPhysicalDeviceLimits =
             (356)
{-# LINE 10761 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxInterpolationOffset" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (356)
{-# LINE 10770 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxInterpolationOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (356))
{-# LINE 10777 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (356)
{-# LINE 10781 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxInterpolationOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (356)
{-# LINE 10787 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits
         where
        type FieldType "subPixelInterpolationOffsetBits"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "subPixelInterpolationOffsetBits"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "subPixelInterpolationOffsetBits"
               VkPhysicalDeviceLimits
             =
             (360)
{-# LINE 10801 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "subPixelInterpolationOffsetBits"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (360)
{-# LINE 10811 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "subPixelInterpolationOffsetBits"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (360))
{-# LINE 10820 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (360)
{-# LINE 10824 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subPixelInterpolationOffsetBits"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (360)
{-# LINE 10832 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxFramebufferWidth" VkPhysicalDeviceLimits where
        type FieldType "maxFramebufferWidth" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxFramebufferWidth" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxFramebufferWidth" VkPhysicalDeviceLimits =
             (364)
{-# LINE 10841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxFramebufferWidth" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (364)
{-# LINE 10850 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFramebufferWidth" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (364))
{-# LINE 10857 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (364)
{-# LINE 10861 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFramebufferWidth" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (364)
{-# LINE 10867 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxFramebufferHeight" VkPhysicalDeviceLimits where
        type FieldType "maxFramebufferHeight" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxFramebufferHeight" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxFramebufferHeight" VkPhysicalDeviceLimits =
             (368)
{-# LINE 10876 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxFramebufferHeight" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (368)
{-# LINE 10885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFramebufferHeight" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (368))
{-# LINE 10892 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (368)
{-# LINE 10896 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFramebufferHeight" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (368)
{-# LINE 10902 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxFramebufferLayers" VkPhysicalDeviceLimits where
        type FieldType "maxFramebufferLayers" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxFramebufferLayers" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxFramebufferLayers" VkPhysicalDeviceLimits =
             (372)
{-# LINE 10911 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxFramebufferLayers" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (372)
{-# LINE 10920 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFramebufferLayers" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (372))
{-# LINE 10927 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (372)
{-# LINE 10931 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFramebufferLayers" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (372)
{-# LINE 10937 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "framebufferColorSampleCounts" VkPhysicalDeviceLimits
         where
        type FieldType "framebufferColorSampleCounts"
               VkPhysicalDeviceLimits
             = VkSampleCountFlags
        type FieldOptional "framebufferColorSampleCounts"
               VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "framebufferColorSampleCounts"
               VkPhysicalDeviceLimits
             =
             (376)
{-# LINE 10951 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "framebufferColorSampleCounts"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (376)
{-# LINE 10961 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "framebufferColorSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (376))
{-# LINE 10969 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (376)
{-# LINE 10973 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "framebufferColorSampleCounts" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (376)
{-# LINE 10980 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "framebufferDepthSampleCounts" VkPhysicalDeviceLimits
         where
        type FieldType "framebufferDepthSampleCounts"
               VkPhysicalDeviceLimits
             = VkSampleCountFlags
        type FieldOptional "framebufferDepthSampleCounts"
               VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "framebufferDepthSampleCounts"
               VkPhysicalDeviceLimits
             =
             (380)
{-# LINE 10994 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "framebufferDepthSampleCounts"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (380)
{-# LINE 11004 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "framebufferDepthSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (380))
{-# LINE 11012 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (380)
{-# LINE 11016 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "framebufferDepthSampleCounts" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (380)
{-# LINE 11023 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "framebufferStencilSampleCounts" VkPhysicalDeviceLimits
         where
        type FieldType "framebufferStencilSampleCounts"
               VkPhysicalDeviceLimits
             = VkSampleCountFlags
        type FieldOptional "framebufferStencilSampleCounts"
               VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "framebufferStencilSampleCounts"
               VkPhysicalDeviceLimits
             =
             (384)
{-# LINE 11037 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "framebufferStencilSampleCounts"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (384)
{-# LINE 11047 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "framebufferStencilSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (384))
{-# LINE 11056 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (384)
{-# LINE 11060 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "framebufferStencilSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (384)
{-# LINE 11068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "framebufferNoAttachmentsSampleCounts"
           VkPhysicalDeviceLimits
         where
        type FieldType "framebufferNoAttachmentsSampleCounts"
               VkPhysicalDeviceLimits
             = VkSampleCountFlags
        type FieldOptional "framebufferNoAttachmentsSampleCounts"
               VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "framebufferNoAttachmentsSampleCounts"
               VkPhysicalDeviceLimits
             =
             (388)
{-# LINE 11083 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "framebufferNoAttachmentsSampleCounts"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (388)
{-# LINE 11093 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "framebufferNoAttachmentsSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (388))
{-# LINE 11102 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (388)
{-# LINE 11106 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "framebufferNoAttachmentsSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (388)
{-# LINE 11114 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxColorAttachments" VkPhysicalDeviceLimits where
        type FieldType "maxColorAttachments" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "maxColorAttachments" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxColorAttachments" VkPhysicalDeviceLimits =
             (392)
{-# LINE 11123 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxColorAttachments" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (392)
{-# LINE 11132 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxColorAttachments" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (392))
{-# LINE 11139 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (392)
{-# LINE 11143 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxColorAttachments" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (392)
{-# LINE 11149 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sampledImageColorSampleCounts" VkPhysicalDeviceLimits
         where
        type FieldType "sampledImageColorSampleCounts"
               VkPhysicalDeviceLimits
             = VkSampleCountFlags
        type FieldOptional "sampledImageColorSampleCounts"
               VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "sampledImageColorSampleCounts"
               VkPhysicalDeviceLimits
             =
             (396)
{-# LINE 11163 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sampledImageColorSampleCounts"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (396)
{-# LINE 11173 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampledImageColorSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (396))
{-# LINE 11181 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (396)
{-# LINE 11185 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampledImageColorSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (396)
{-# LINE 11193 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits
         where
        type FieldType "sampledImageIntegerSampleCounts"
               VkPhysicalDeviceLimits
             = VkSampleCountFlags
        type FieldOptional "sampledImageIntegerSampleCounts"
               VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "sampledImageIntegerSampleCounts"
               VkPhysicalDeviceLimits
             =
             (400)
{-# LINE 11207 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sampledImageIntegerSampleCounts"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (400)
{-# LINE 11217 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampledImageIntegerSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (400))
{-# LINE 11226 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (400)
{-# LINE 11230 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampledImageIntegerSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (400)
{-# LINE 11238 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits
         where
        type FieldType "sampledImageDepthSampleCounts"
               VkPhysicalDeviceLimits
             = VkSampleCountFlags
        type FieldOptional "sampledImageDepthSampleCounts"
               VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "sampledImageDepthSampleCounts"
               VkPhysicalDeviceLimits
             =
             (404)
{-# LINE 11252 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sampledImageDepthSampleCounts"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (404)
{-# LINE 11262 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (404))
{-# LINE 11270 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (404)
{-# LINE 11274 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampledImageDepthSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (404)
{-# LINE 11282 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits
         where
        type FieldType "sampledImageStencilSampleCounts"
               VkPhysicalDeviceLimits
             = VkSampleCountFlags
        type FieldOptional "sampledImageStencilSampleCounts"
               VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "sampledImageStencilSampleCounts"
               VkPhysicalDeviceLimits
             =
             (408)
{-# LINE 11296 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sampledImageStencilSampleCounts"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (408)
{-# LINE 11306 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampledImageStencilSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (408))
{-# LINE 11315 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (408)
{-# LINE 11319 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampledImageStencilSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (408)
{-# LINE 11327 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "storageImageSampleCounts" VkPhysicalDeviceLimits where
        type FieldType "storageImageSampleCounts" VkPhysicalDeviceLimits =
             VkSampleCountFlags
        type FieldOptional "storageImageSampleCounts"
               VkPhysicalDeviceLimits
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "storageImageSampleCounts" VkPhysicalDeviceLimits
             =
             (412)
{-# LINE 11338 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "storageImageSampleCounts" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (412)
{-# LINE 11347 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "storageImageSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (412))
{-# LINE 11355 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (412)
{-# LINE 11359 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "storageImageSampleCounts" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (412)
{-# LINE 11366 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxSampleMaskWords" VkPhysicalDeviceLimits where
        type FieldType "maxSampleMaskWords" VkPhysicalDeviceLimits = Word32
        type FieldOptional "maxSampleMaskWords" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxSampleMaskWords" VkPhysicalDeviceLimits =
             (416)
{-# LINE 11374 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxSampleMaskWords" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (416)
{-# LINE 11383 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxSampleMaskWords" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (416))
{-# LINE 11390 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (416)
{-# LINE 11394 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSampleMaskWords" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (416)
{-# LINE 11400 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "timestampComputeAndGraphics" VkPhysicalDeviceLimits where
        type FieldType "timestampComputeAndGraphics" VkPhysicalDeviceLimits
             = VkBool32
        type FieldOptional "timestampComputeAndGraphics"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "timestampComputeAndGraphics"
               VkPhysicalDeviceLimits
             =
             (420)
{-# LINE 11412 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "timestampComputeAndGraphics"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (420)
{-# LINE 11422 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "timestampComputeAndGraphics" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (420))
{-# LINE 11430 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (420)
{-# LINE 11434 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "timestampComputeAndGraphics" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (420)
{-# LINE 11441 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "timestampPeriod" VkPhysicalDeviceLimits where
        type FieldType "timestampPeriod" VkPhysicalDeviceLimits =
             Float
{-# LINE 11446 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "timestampPeriod" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "timestampPeriod" VkPhysicalDeviceLimits =
             (424)
{-# LINE 11450 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "timestampPeriod" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (424)
{-# LINE 11458 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "timestampPeriod" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (424))
{-# LINE 11465 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (424)
{-# LINE 11469 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "timestampPeriod" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (424)
{-# LINE 11475 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxClipDistances" VkPhysicalDeviceLimits where
        type FieldType "maxClipDistances" VkPhysicalDeviceLimits = Word32
        type FieldOptional "maxClipDistances" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxClipDistances" VkPhysicalDeviceLimits =
             (428)
{-# LINE 11483 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxClipDistances" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (428)
{-# LINE 11492 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxClipDistances" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (428))
{-# LINE 11499 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (428)
{-# LINE 11503 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxClipDistances" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (428)
{-# LINE 11509 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxCullDistances" VkPhysicalDeviceLimits where
        type FieldType "maxCullDistances" VkPhysicalDeviceLimits = Word32
        type FieldOptional "maxCullDistances" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "maxCullDistances" VkPhysicalDeviceLimits =
             (432)
{-# LINE 11517 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxCullDistances" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (432)
{-# LINE 11526 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxCullDistances" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (432))
{-# LINE 11533 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (432)
{-# LINE 11537 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxCullDistances" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (432)
{-# LINE 11543 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits
         where
        type FieldType "maxCombinedClipAndCullDistances"
               VkPhysicalDeviceLimits
             = Word32
        type FieldOptional "maxCombinedClipAndCullDistances"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxCombinedClipAndCullDistances"
               VkPhysicalDeviceLimits
             =
             (436)
{-# LINE 11557 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxCombinedClipAndCullDistances"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (436)
{-# LINE 11567 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxCombinedClipAndCullDistances"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (436))
{-# LINE 11576 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (436)
{-# LINE 11580 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxCombinedClipAndCullDistances"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (436)
{-# LINE 11588 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "discreteQueuePriorities" VkPhysicalDeviceLimits where
        type FieldType "discreteQueuePriorities" VkPhysicalDeviceLimits =
             Word32
        type FieldOptional "discreteQueuePriorities" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "discreteQueuePriorities" VkPhysicalDeviceLimits =
             (440)
{-# LINE 11597 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "discreteQueuePriorities" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (440)
{-# LINE 11606 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "discreteQueuePriorities" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (440))
{-# LINE 11613 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (440)
{-# LINE 11617 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "discreteQueuePriorities" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (440)
{-# LINE 11624 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pointSizeRange" VkPhysicalDeviceLimits where
        type FieldType "pointSizeRange" VkPhysicalDeviceLimits =
             Float
{-# LINE 11629 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "pointSizeRange" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pointSizeRange" VkPhysicalDeviceLimits =
             (444)
{-# LINE 11632 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pointSizeRange" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (444)
{-# LINE 11640 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "pointSizeRange" idx VkPhysicalDeviceLimits) =>
         CanReadFieldArray "pointSizeRange" idx VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "pointSizeRange" 0 VkPhysicalDeviceLimits #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "pointSizeRange" 1 VkPhysicalDeviceLimits #-}
        type FieldArrayLength "pointSizeRange" VkPhysicalDeviceLimits = 2

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = 2

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (444) +
{-# LINE 11662 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      sizeOf (undefined :: Float) *
{-# LINE 11663 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((444) +
{-# LINE 11669 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Float) *
{-# LINE 11670 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "pointSizeRange" idx VkPhysicalDeviceLimits) =>
         CanWriteFieldArray "pointSizeRange" idx VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "pointSizeRange" 0 VkPhysicalDeviceLimits #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "pointSizeRange" 1 VkPhysicalDeviceLimits #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((444) +
{-# LINE 11687 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Float) *
{-# LINE 11688 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "lineWidthRange" VkPhysicalDeviceLimits where
        type FieldType "lineWidthRange" VkPhysicalDeviceLimits =
             Float
{-# LINE 11694 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "lineWidthRange" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs
        type FieldOffset "lineWidthRange" VkPhysicalDeviceLimits =
             (452)
{-# LINE 11697 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "lineWidthRange" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (452)
{-# LINE 11705 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "lineWidthRange" idx VkPhysicalDeviceLimits) =>
         CanReadFieldArray "lineWidthRange" idx VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "lineWidthRange" 0 VkPhysicalDeviceLimits #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "lineWidthRange" 1 VkPhysicalDeviceLimits #-}
        type FieldArrayLength "lineWidthRange" VkPhysicalDeviceLimits = 2

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = 2

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (452) +
{-# LINE 11727 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      sizeOf (undefined :: Float) *
{-# LINE 11728 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((452) +
{-# LINE 11734 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Float) *
{-# LINE 11735 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "lineWidthRange" idx VkPhysicalDeviceLimits) =>
         CanWriteFieldArray "lineWidthRange" idx VkPhysicalDeviceLimits
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "lineWidthRange" 0 VkPhysicalDeviceLimits #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "lineWidthRange" 1 VkPhysicalDeviceLimits #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((452) +
{-# LINE 11752 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: Float) *
{-# LINE 11753 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "pointSizeGranularity" VkPhysicalDeviceLimits where
        type FieldType "pointSizeGranularity" VkPhysicalDeviceLimits =
             Float
{-# LINE 11759 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "pointSizeGranularity" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pointSizeGranularity" VkPhysicalDeviceLimits =
             (460)
{-# LINE 11763 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pointSizeGranularity" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (460)
{-# LINE 11772 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pointSizeGranularity" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (460))
{-# LINE 11779 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (460)
{-# LINE 11783 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pointSizeGranularity" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (460)
{-# LINE 11789 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "lineWidthGranularity" VkPhysicalDeviceLimits where
        type FieldType "lineWidthGranularity" VkPhysicalDeviceLimits =
             Float
{-# LINE 11794 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "lineWidthGranularity" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "lineWidthGranularity" VkPhysicalDeviceLimits =
             (464)
{-# LINE 11798 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "lineWidthGranularity" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (464)
{-# LINE 11807 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "lineWidthGranularity" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (464))
{-# LINE 11814 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (464)
{-# LINE 11818 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "lineWidthGranularity" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (464)
{-# LINE 11824 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "strictLines" VkPhysicalDeviceLimits where
        type FieldType "strictLines" VkPhysicalDeviceLimits = VkBool32
        type FieldOptional "strictLines" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs
        type FieldOffset "strictLines" VkPhysicalDeviceLimits =
             (468)
{-# LINE 11831 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "strictLines" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (468)
{-# LINE 11839 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "strictLines" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (468))
{-# LINE 11846 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (468)
{-# LINE 11850 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "strictLines" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (468)
{-# LINE 11856 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "standardSampleLocations" VkPhysicalDeviceLimits where
        type FieldType "standardSampleLocations" VkPhysicalDeviceLimits =
             VkBool32
        type FieldOptional "standardSampleLocations" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "standardSampleLocations" VkPhysicalDeviceLimits =
             (472)
{-# LINE 11865 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "standardSampleLocations" VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (472)
{-# LINE 11874 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "standardSampleLocations" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (472))
{-# LINE 11881 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (472)
{-# LINE 11885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "standardSampleLocations" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (472)
{-# LINE 11892 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits
         where
        type FieldType "optimalBufferCopyOffsetAlignment"
               VkPhysicalDeviceLimits
             = VkDeviceSize
        type FieldOptional "optimalBufferCopyOffsetAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "optimalBufferCopyOffsetAlignment"
               VkPhysicalDeviceLimits
             =
             (480)
{-# LINE 11906 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "optimalBufferCopyOffsetAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (480)
{-# LINE 11916 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "optimalBufferCopyOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (480))
{-# LINE 11925 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (480)
{-# LINE 11929 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "optimalBufferCopyOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (480)
{-# LINE 11937 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "optimalBufferCopyRowPitchAlignment"
           VkPhysicalDeviceLimits
         where
        type FieldType "optimalBufferCopyRowPitchAlignment"
               VkPhysicalDeviceLimits
             = VkDeviceSize
        type FieldOptional "optimalBufferCopyRowPitchAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "optimalBufferCopyRowPitchAlignment"
               VkPhysicalDeviceLimits
             =
             (488)
{-# LINE 11952 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "optimalBufferCopyRowPitchAlignment"
               VkPhysicalDeviceLimits
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (488)
{-# LINE 11962 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "optimalBufferCopyRowPitchAlignment"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (488))
{-# LINE 11971 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (488)
{-# LINE 11975 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "optimalBufferCopyRowPitchAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (488)
{-# LINE 11983 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "nonCoherentAtomSize" VkPhysicalDeviceLimits where
        type FieldType "nonCoherentAtomSize" VkPhysicalDeviceLimits =
             VkDeviceSize
        type FieldOptional "nonCoherentAtomSize" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "nonCoherentAtomSize" VkPhysicalDeviceLimits =
             (496)
{-# LINE 11992 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "nonCoherentAtomSize" VkPhysicalDeviceLimits =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (496)
{-# LINE 12001 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "nonCoherentAtomSize" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (496))
{-# LINE 12008 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (496)
{-# LINE 12012 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "nonCoherentAtomSize" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (496)
{-# LINE 12018 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceLimits where
        showsPrec d x
          = showString "VkPhysicalDeviceLimits {" .
              showString "maxImageDimension1D = " .
                showsPrec d (getField @"maxImageDimension1D" x) .
                  showString ", " .
                    showString "maxImageDimension2D = " .
                      showsPrec d (getField @"maxImageDimension2D" x) .
                        showString ", " .
                          showString "maxImageDimension3D = " .
                            showsPrec d (getField @"maxImageDimension3D" x) .
                              showString ", " .
                                showString "maxImageDimensionCube = " .
                                  showsPrec d (getField @"maxImageDimensionCube" x) .
                                    showString ", " .
                                      showString "maxImageArrayLayers = " .
                                        showsPrec d (getField @"maxImageArrayLayers" x) .
                                          showString ", " .
                                            showString "maxTexelBufferElements = " .
                                              showsPrec d (getField @"maxTexelBufferElements" x) .
                                                showString ", " .
                                                  showString "maxUniformBufferRange = " .
                                                    showsPrec d
                                                      (getField @"maxUniformBufferRange" x)
                                                      .
                                                      showString ", " .
                                                        showString "maxStorageBufferRange = " .
                                                          showsPrec d
                                                            (getField @"maxStorageBufferRange" x)
                                                            .
                                                            showString ", " .
                                                              showString "maxPushConstantsSize = " .
                                                                showsPrec d
                                                                  (getField @"maxPushConstantsSize"
                                                                     x)
                                                                  .
                                                                  showString ", " .
                                                                    showString
                                                                      "maxMemoryAllocationCount = "
                                                                      .
                                                                      showsPrec d
                                                                        (getField
                                                                           @"maxMemoryAllocationCount"
                                                                           x)
                                                                        .
                                                                        showString ", " .
                                                                          showString
                                                                            "maxSamplerAllocationCount = "
                                                                            .
                                                                            showsPrec d
                                                                              (getField
                                                                                 @"maxSamplerAllocationCount"
                                                                                 x)
                                                                              .
                                                                              showString ", " .
                                                                                showString
                                                                                  "bufferImageGranularity = "
                                                                                  .
                                                                                  showsPrec d
                                                                                    (getField
                                                                                       @"bufferImageGranularity"
                                                                                       x)
                                                                                    .
                                                                                    showString ", "
                                                                                      .
                                                                                      showString
                                                                                        "sparseAddressSpaceSize = "
                                                                                        .
                                                                                        showsPrec d
                                                                                          (getField
                                                                                             @"sparseAddressSpaceSize"
                                                                                             x)
                                                                                          .
                                                                                          showString
                                                                                            ", "
                                                                                            .
                                                                                            showString
                                                                                              "maxBoundDescriptorSets = "
                                                                                              .
                                                                                              showsPrec
                                                                                                d
                                                                                                (getField
                                                                                                   @"maxBoundDescriptorSets"
                                                                                                   x)
                                                                                                .
                                                                                                showString
                                                                                                  ", "
                                                                                                  .
                                                                                                  showString
                                                                                                    "maxPerStageDescriptorSamplers = "
                                                                                                    .
                                                                                                    showsPrec
                                                                                                      d
                                                                                                      (getField
                                                                                                         @"maxPerStageDescriptorSamplers"
                                                                                                         x)
                                                                                                      .
                                                                                                      showString
                                                                                                        ", "
                                                                                                        .
                                                                                                        showString
                                                                                                          "maxPerStageDescriptorUniformBuffers = "
                                                                                                          .
                                                                                                          showsPrec
                                                                                                            d
                                                                                                            (getField
                                                                                                               @"maxPerStageDescriptorUniformBuffers"
                                                                                                               x)
                                                                                                            .
                                                                                                            showString
                                                                                                              ", "
                                                                                                              .
                                                                                                              showString
                                                                                                                "maxPerStageDescriptorStorageBuffers = "
                                                                                                                .
                                                                                                                showsPrec
                                                                                                                  d
                                                                                                                  (getField
                                                                                                                     @"maxPerStageDescriptorStorageBuffers"
                                                                                                                     x)
                                                                                                                  .
                                                                                                                  showString
                                                                                                                    ", "
                                                                                                                    .
                                                                                                                    showString
                                                                                                                      "maxPerStageDescriptorSampledImages = "
                                                                                                                      .
                                                                                                                      showsPrec
                                                                                                                        d
                                                                                                                        (getField
                                                                                                                           @"maxPerStageDescriptorSampledImages"
                                                                                                                           x)
                                                                                                                        .
                                                                                                                        showString
                                                                                                                          ", "
                                                                                                                          .
                                                                                                                          showString
                                                                                                                            "maxPerStageDescriptorStorageImages = "
                                                                                                                            .
                                                                                                                            showsPrec
                                                                                                                              d
                                                                                                                              (getField
                                                                                                                                 @"maxPerStageDescriptorStorageImages"
                                                                                                                                 x)
                                                                                                                              .
                                                                                                                              showString
                                                                                                                                ", "
                                                                                                                                .
                                                                                                                                showString
                                                                                                                                  "maxPerStageDescriptorInputAttachments = "
                                                                                                                                  .
                                                                                                                                  showsPrec
                                                                                                                                    d
                                                                                                                                    (getField
                                                                                                                                       @"maxPerStageDescriptorInputAttachments"
                                                                                                                                       x)
                                                                                                                                    .
                                                                                                                                    showString
                                                                                                                                      ", "
                                                                                                                                      .
                                                                                                                                      showString
                                                                                                                                        "maxPerStageResources = "
                                                                                                                                        .
                                                                                                                                        showsPrec
                                                                                                                                          d
                                                                                                                                          (getField
                                                                                                                                             @"maxPerStageResources"
                                                                                                                                             x)
                                                                                                                                          .
                                                                                                                                          showString
                                                                                                                                            ", "
                                                                                                                                            .
                                                                                                                                            showString
                                                                                                                                              "maxDescriptorSetSamplers = "
                                                                                                                                              .
                                                                                                                                              showsPrec
                                                                                                                                                d
                                                                                                                                                (getField
                                                                                                                                                   @"maxDescriptorSetSamplers"
                                                                                                                                                   x)
                                                                                                                                                .
                                                                                                                                                showString
                                                                                                                                                  ", "
                                                                                                                                                  .
                                                                                                                                                  showString
                                                                                                                                                    "maxDescriptorSetUniformBuffers = "
                                                                                                                                                    .
                                                                                                                                                    showsPrec
                                                                                                                                                      d
                                                                                                                                                      (getField
                                                                                                                                                         @"maxDescriptorSetUniformBuffers"
                                                                                                                                                         x)
                                                                                                                                                      .
                                                                                                                                                      showString
                                                                                                                                                        ", "
                                                                                                                                                        .
                                                                                                                                                        showString
                                                                                                                                                          "maxDescriptorSetUniformBuffersDynamic = "
                                                                                                                                                          .
                                                                                                                                                          showsPrec
                                                                                                                                                            d
                                                                                                                                                            (getField
                                                                                                                                                               @"maxDescriptorSetUniformBuffersDynamic"
                                                                                                                                                               x)
                                                                                                                                                            .
                                                                                                                                                            showString
                                                                                                                                                              ", "
                                                                                                                                                              .
                                                                                                                                                              showString
                                                                                                                                                                "maxDescriptorSetStorageBuffers = "
                                                                                                                                                                .
                                                                                                                                                                showsPrec
                                                                                                                                                                  d
                                                                                                                                                                  (getField
                                                                                                                                                                     @"maxDescriptorSetStorageBuffers"
                                                                                                                                                                     x)
                                                                                                                                                                  .
                                                                                                                                                                  showString
                                                                                                                                                                    ", "
                                                                                                                                                                    .
                                                                                                                                                                    showString
                                                                                                                                                                      "maxDescriptorSetStorageBuffersDynamic = "
                                                                                                                                                                      .
                                                                                                                                                                      showsPrec
                                                                                                                                                                        d
                                                                                                                                                                        (getField
                                                                                                                                                                           @"maxDescriptorSetStorageBuffersDynamic"
                                                                                                                                                                           x)
                                                                                                                                                                        .
                                                                                                                                                                        showString
                                                                                                                                                                          ", "
                                                                                                                                                                          .
                                                                                                                                                                          showString
                                                                                                                                                                            "maxDescriptorSetSampledImages = "
                                                                                                                                                                            .
                                                                                                                                                                            showsPrec
                                                                                                                                                                              d
                                                                                                                                                                              (getField
                                                                                                                                                                                 @"maxDescriptorSetSampledImages"
                                                                                                                                                                                 x)
                                                                                                                                                                              .
                                                                                                                                                                              showString
                                                                                                                                                                                ", "
                                                                                                                                                                                .
                                                                                                                                                                                showString
                                                                                                                                                                                  "maxDescriptorSetStorageImages = "
                                                                                                                                                                                  .
                                                                                                                                                                                  showsPrec
                                                                                                                                                                                    d
                                                                                                                                                                                    (getField
                                                                                                                                                                                       @"maxDescriptorSetStorageImages"
                                                                                                                                                                                       x)
                                                                                                                                                                                    .
                                                                                                                                                                                    showString
                                                                                                                                                                                      ", "
                                                                                                                                                                                      .
                                                                                                                                                                                      showString
                                                                                                                                                                                        "maxDescriptorSetInputAttachments = "
                                                                                                                                                                                        .
                                                                                                                                                                                        showsPrec
                                                                                                                                                                                          d
                                                                                                                                                                                          (getField
                                                                                                                                                                                             @"maxDescriptorSetInputAttachments"
                                                                                                                                                                                             x)
                                                                                                                                                                                          .
                                                                                                                                                                                          showString
                                                                                                                                                                                            ", "
                                                                                                                                                                                            .
                                                                                                                                                                                            showString
                                                                                                                                                                                              "maxVertexInputAttributes = "
                                                                                                                                                                                              .
                                                                                                                                                                                              showsPrec
                                                                                                                                                                                                d
                                                                                                                                                                                                (getField
                                                                                                                                                                                                   @"maxVertexInputAttributes"
                                                                                                                                                                                                   x)
                                                                                                                                                                                                .
                                                                                                                                                                                                showString
                                                                                                                                                                                                  ", "
                                                                                                                                                                                                  .
                                                                                                                                                                                                  showString
                                                                                                                                                                                                    "maxVertexInputBindings = "
                                                                                                                                                                                                    .
                                                                                                                                                                                                    showsPrec
                                                                                                                                                                                                      d
                                                                                                                                                                                                      (getField
                                                                                                                                                                                                         @"maxVertexInputBindings"
                                                                                                                                                                                                         x)
                                                                                                                                                                                                      .
                                                                                                                                                                                                      showString
                                                                                                                                                                                                        ", "
                                                                                                                                                                                                        .
                                                                                                                                                                                                        showString
                                                                                                                                                                                                          "maxVertexInputAttributeOffset = "
                                                                                                                                                                                                          .
                                                                                                                                                                                                          showsPrec
                                                                                                                                                                                                            d
                                                                                                                                                                                                            (getField
                                                                                                                                                                                                               @"maxVertexInputAttributeOffset"
                                                                                                                                                                                                               x)
                                                                                                                                                                                                            .
                                                                                                                                                                                                            showString
                                                                                                                                                                                                              ", "
                                                                                                                                                                                                              .
                                                                                                                                                                                                              showString
                                                                                                                                                                                                                "maxVertexInputBindingStride = "
                                                                                                                                                                                                                .
                                                                                                                                                                                                                showsPrec
                                                                                                                                                                                                                  d
                                                                                                                                                                                                                  (getField
                                                                                                                                                                                                                     @"maxVertexInputBindingStride"
                                                                                                                                                                                                                     x)
                                                                                                                                                                                                                  .
                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                    .
                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                      "maxVertexOutputComponents = "
                                                                                                                                                                                                                      .
                                                                                                                                                                                                                      showsPrec
                                                                                                                                                                                                                        d
                                                                                                                                                                                                                        (getField
                                                                                                                                                                                                                           @"maxVertexOutputComponents"
                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                        .
                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                          .
                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                            "maxTessellationGenerationLevel = "
                                                                                                                                                                                                                            .
                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                              d
                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                 @"maxTessellationGenerationLevel"
                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                              .
                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                  "maxTessellationPatchSize = "
                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                  showsPrec
                                                                                                                                                                                                                                    d
                                                                                                                                                                                                                                    (getField
                                                                                                                                                                                                                                       @"maxTessellationPatchSize"
                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                      ", "
                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                        "maxTessellationControlPerVertexInputComponents = "
                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                        showsPrec
                                                                                                                                                                                                                                          d
                                                                                                                                                                                                                                          (getField
                                                                                                                                                                                                                                             @"maxTessellationControlPerVertexInputComponents"
                                                                                                                                                                                                                                             x)
                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                            ", "
                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                              "maxTessellationControlPerVertexOutputComponents = "
                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                              showsPrec
                                                                                                                                                                                                                                                d
                                                                                                                                                                                                                                                (getField
                                                                                                                                                                                                                                                   @"maxTessellationControlPerVertexOutputComponents"
                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                  ", "
                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                    "maxTessellationControlPerPatchOutputComponents = "
                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                    showsPrec
                                                                                                                                                                                                                                                      d
                                                                                                                                                                                                                                                      (getField
                                                                                                                                                                                                                                                         @"maxTessellationControlPerPatchOutputComponents"
                                                                                                                                                                                                                                                         x)
                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                        ", "
                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                          "maxTessellationControlTotalOutputComponents = "
                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                          showsPrec
                                                                                                                                                                                                                                                            d
                                                                                                                                                                                                                                                            (getField
                                                                                                                                                                                                                                                               @"maxTessellationControlTotalOutputComponents"
                                                                                                                                                                                                                                                               x)
                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                              ", "
                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                "maxTessellationEvaluationInputComponents = "
                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                showsPrec
                                                                                                                                                                                                                                                                  d
                                                                                                                                                                                                                                                                  (getField
                                                                                                                                                                                                                                                                     @"maxTessellationEvaluationInputComponents"
                                                                                                                                                                                                                                                                     x)
                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                      "maxTessellationEvaluationOutputComponents = "
                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                      showsPrec
                                                                                                                                                                                                                                                                        d
                                                                                                                                                                                                                                                                        (getField
                                                                                                                                                                                                                                                                           @"maxTessellationEvaluationOutputComponents"
                                                                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                            "maxGeometryShaderInvocations = "
                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                                                                              d
                                                                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                                                                 @"maxGeometryShaderInvocations"
                                                                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                  "maxGeometryInputComponents = "
                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                  showsPrec
                                                                                                                                                                                                                                                                                    d
                                                                                                                                                                                                                                                                                    (getField
                                                                                                                                                                                                                                                                                       @"maxGeometryInputComponents"
                                                                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                      ", "
                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                        "maxGeometryOutputComponents = "
                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                        showsPrec
                                                                                                                                                                                                                                                                                          d
                                                                                                                                                                                                                                                                                          (getField
                                                                                                                                                                                                                                                                                             @"maxGeometryOutputComponents"
                                                                                                                                                                                                                                                                                             x)
                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                            ", "
                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                              "maxGeometryOutputVertices = "
                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                              showsPrec
                                                                                                                                                                                                                                                                                                d
                                                                                                                                                                                                                                                                                                (getField
                                                                                                                                                                                                                                                                                                   @"maxGeometryOutputVertices"
                                                                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                  ", "
                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                    "maxGeometryTotalOutputComponents = "
                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                    showsPrec
                                                                                                                                                                                                                                                                                                      d
                                                                                                                                                                                                                                                                                                      (getField
                                                                                                                                                                                                                                                                                                         @"maxGeometryTotalOutputComponents"
                                                                                                                                                                                                                                                                                                         x)
                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                        ", "
                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                          "maxFragmentInputComponents = "
                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                          showsPrec
                                                                                                                                                                                                                                                                                                            d
                                                                                                                                                                                                                                                                                                            (getField
                                                                                                                                                                                                                                                                                                               @"maxFragmentInputComponents"
                                                                                                                                                                                                                                                                                                               x)
                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                              ", "
                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                "maxFragmentOutputAttachments = "
                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                showsPrec
                                                                                                                                                                                                                                                                                                                  d
                                                                                                                                                                                                                                                                                                                  (getField
                                                                                                                                                                                                                                                                                                                     @"maxFragmentOutputAttachments"
                                                                                                                                                                                                                                                                                                                     x)
                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                      "maxFragmentDualSrcAttachments = "
                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                      showsPrec
                                                                                                                                                                                                                                                                                                                        d
                                                                                                                                                                                                                                                                                                                        (getField
                                                                                                                                                                                                                                                                                                                           @"maxFragmentDualSrcAttachments"
                                                                                                                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                            "maxFragmentCombinedOutputResources = "
                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                                                                                                                              d
                                                                                                                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                                                                                                                 @"maxFragmentCombinedOutputResources"
                                                                                                                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                  "maxComputeSharedMemorySize = "
                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                  showsPrec
                                                                                                                                                                                                                                                                                                                                    d
                                                                                                                                                                                                                                                                                                                                    (getField
                                                                                                                                                                                                                                                                                                                                       @"maxComputeSharedMemorySize"
                                                                                                                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                      ", "
                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                      (showString
                                                                                                                                                                                                                                                                                                                                         "maxComputeWorkGroupCount = ["
                                                                                                                                                                                                                                                                                                                                         .
                                                                                                                                                                                                                                                                                                                                         showsPrec
                                                                                                                                                                                                                                                                                                                                           d
                                                                                                                                                                                                                                                                                                                                           (let s = sizeOf
                                                                                                                                                                                                                                                                                                                                                      (undefined
                                                                                                                                                                                                                                                                                                                                                         ::
                                                                                                                                                                                                                                                                                                                                                         FieldType
                                                                                                                                                                                                                                                                                                                                                           "maxComputeWorkGroupCount"
                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                o = fieldOffset
                                                                                                                                                                                                                                                                                                                                                      @"maxComputeWorkGroupCount"
                                                                                                                                                                                                                                                                                                                                                      @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                f i
                                                                                                                                                                                                                                                                                                                                                  = peekByteOff
                                                                                                                                                                                                                                                                                                                                                      (unsafePtr
                                                                                                                                                                                                                                                                                                                                                         x)
                                                                                                                                                                                                                                                                                                                                                      i
                                                                                                                                                                                                                                                                                                                                                      ::
                                                                                                                                                                                                                                                                                                                                                      IO
                                                                                                                                                                                                                                                                                                                                                        (FieldType
                                                                                                                                                                                                                                                                                                                                                           "maxComputeWorkGroupCount"
                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                              in
                                                                                                                                                                                                                                                                                                                                              unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                mapM
                                                                                                                                                                                                                                                                                                                                                  f
                                                                                                                                                                                                                                                                                                                                                $
                                                                                                                                                                                                                                                                                                                                                map
                                                                                                                                                                                                                                                                                                                                                  (\ i
                                                                                                                                                                                                                                                                                                                                                     ->
                                                                                                                                                                                                                                                                                                                                                     o +
                                                                                                                                                                                                                                                                                                                                                       i *
                                                                                                                                                                                                                                                                                                                                                         s)
                                                                                                                                                                                                                                                                                                                                                  [0
                                                                                                                                                                                                                                                                                                                                                   ..
                                                                                                                                                                                                                                                                                                                                                   3 -
                                                                                                                                                                                                                                                                                                                                                     1])
                                                                                                                                                                                                                                                                                                                                           .
                                                                                                                                                                                                                                                                                                                                           showChar
                                                                                                                                                                                                                                                                                                                                             ']')
                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                            "maxComputeWorkGroupInvocations = "
                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                                                                                                                                              d
                                                                                                                                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                                                                                                                                 @"maxComputeWorkGroupInvocations"
                                                                                                                                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                (showString
                                                                                                                                                                                                                                                                                                                                                   "maxComputeWorkGroupSize = ["
                                                                                                                                                                                                                                                                                                                                                   .
                                                                                                                                                                                                                                                                                                                                                   showsPrec
                                                                                                                                                                                                                                                                                                                                                     d
                                                                                                                                                                                                                                                                                                                                                     (let s = sizeOf
                                                                                                                                                                                                                                                                                                                                                                (undefined
                                                                                                                                                                                                                                                                                                                                                                   ::
                                                                                                                                                                                                                                                                                                                                                                   FieldType
                                                                                                                                                                                                                                                                                                                                                                     "maxComputeWorkGroupSize"
                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                          o = fieldOffset
                                                                                                                                                                                                                                                                                                                                                                @"maxComputeWorkGroupSize"
                                                                                                                                                                                                                                                                                                                                                                @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                          f i
                                                                                                                                                                                                                                                                                                                                                            = peekByteOff
                                                                                                                                                                                                                                                                                                                                                                (unsafePtr
                                                                                                                                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                                                                                                                                i
                                                                                                                                                                                                                                                                                                                                                                ::
                                                                                                                                                                                                                                                                                                                                                                IO
                                                                                                                                                                                                                                                                                                                                                                  (FieldType
                                                                                                                                                                                                                                                                                                                                                                     "maxComputeWorkGroupSize"
                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                        in
                                                                                                                                                                                                                                                                                                                                                        unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                          mapM
                                                                                                                                                                                                                                                                                                                                                            f
                                                                                                                                                                                                                                                                                                                                                          $
                                                                                                                                                                                                                                                                                                                                                          map
                                                                                                                                                                                                                                                                                                                                                            (\ i
                                                                                                                                                                                                                                                                                                                                                               ->
                                                                                                                                                                                                                                                                                                                                                               o +
                                                                                                                                                                                                                                                                                                                                                                 i *
                                                                                                                                                                                                                                                                                                                                                                   s)
                                                                                                                                                                                                                                                                                                                                                            [0
                                                                                                                                                                                                                                                                                                                                                             ..
                                                                                                                                                                                                                                                                                                                                                             3 -
                                                                                                                                                                                                                                                                                                                                                               1])
                                                                                                                                                                                                                                                                                                                                                     .
                                                                                                                                                                                                                                                                                                                                                     showChar
                                                                                                                                                                                                                                                                                                                                                       ']')
                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                      "subPixelPrecisionBits = "
                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                      showsPrec
                                                                                                                                                                                                                                                                                                                                                        d
                                                                                                                                                                                                                                                                                                                                                        (getField
                                                                                                                                                                                                                                                                                                                                                           @"subPixelPrecisionBits"
                                                                                                                                                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                            "subTexelPrecisionBits = "
                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                                                                                                                                                              d
                                                                                                                                                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                                                                                                                                                 @"subTexelPrecisionBits"
                                                                                                                                                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                  "mipmapPrecisionBits = "
                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                  showsPrec
                                                                                                                                                                                                                                                                                                                                                                    d
                                                                                                                                                                                                                                                                                                                                                                    (getField
                                                                                                                                                                                                                                                                                                                                                                       @"mipmapPrecisionBits"
                                                                                                                                                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                      ", "
                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                        "maxDrawIndexedIndexValue = "
                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                        showsPrec
                                                                                                                                                                                                                                                                                                                                                                          d
                                                                                                                                                                                                                                                                                                                                                                          (getField
                                                                                                                                                                                                                                                                                                                                                                             @"maxDrawIndexedIndexValue"
                                                                                                                                                                                                                                                                                                                                                                             x)
                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                            ", "
                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                              "maxDrawIndirectCount = "
                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                              showsPrec
                                                                                                                                                                                                                                                                                                                                                                                d
                                                                                                                                                                                                                                                                                                                                                                                (getField
                                                                                                                                                                                                                                                                                                                                                                                   @"maxDrawIndirectCount"
                                                                                                                                                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                  ", "
                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                    "maxSamplerLodBias = "
                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                    showsPrec
                                                                                                                                                                                                                                                                                                                                                                                      d
                                                                                                                                                                                                                                                                                                                                                                                      (getField
                                                                                                                                                                                                                                                                                                                                                                                         @"maxSamplerLodBias"
                                                                                                                                                                                                                                                                                                                                                                                         x)
                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                        ", "
                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                          "maxSamplerAnisotropy = "
                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                          showsPrec
                                                                                                                                                                                                                                                                                                                                                                                            d
                                                                                                                                                                                                                                                                                                                                                                                            (getField
                                                                                                                                                                                                                                                                                                                                                                                               @"maxSamplerAnisotropy"
                                                                                                                                                                                                                                                                                                                                                                                               x)
                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                              ", "
                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                "maxViewports = "
                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                  d
                                                                                                                                                                                                                                                                                                                                                                                                  (getField
                                                                                                                                                                                                                                                                                                                                                                                                     @"maxViewports"
                                                                                                                                                                                                                                                                                                                                                                                                     x)
                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                    (showString
                                                                                                                                                                                                                                                                                                                                                                                                       "maxViewportDimensions = ["
                                                                                                                                                                                                                                                                                                                                                                                                       .
                                                                                                                                                                                                                                                                                                                                                                                                       showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                         d
                                                                                                                                                                                                                                                                                                                                                                                                         (let s = sizeOf
                                                                                                                                                                                                                                                                                                                                                                                                                    (undefined
                                                                                                                                                                                                                                                                                                                                                                                                                       ::
                                                                                                                                                                                                                                                                                                                                                                                                                       FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                         "maxViewportDimensions"
                                                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                              o = fieldOffset
                                                                                                                                                                                                                                                                                                                                                                                                                    @"maxViewportDimensions"
                                                                                                                                                                                                                                                                                                                                                                                                                    @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                                                                              f i
                                                                                                                                                                                                                                                                                                                                                                                                                = peekByteOff
                                                                                                                                                                                                                                                                                                                                                                                                                    (unsafePtr
                                                                                                                                                                                                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                                                                                                                                                                                                    i
                                                                                                                                                                                                                                                                                                                                                                                                                    ::
                                                                                                                                                                                                                                                                                                                                                                                                                    IO
                                                                                                                                                                                                                                                                                                                                                                                                                      (FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                         "maxViewportDimensions"
                                                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                            in
                                                                                                                                                                                                                                                                                                                                                                                                            unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                              mapM
                                                                                                                                                                                                                                                                                                                                                                                                                f
                                                                                                                                                                                                                                                                                                                                                                                                              $
                                                                                                                                                                                                                                                                                                                                                                                                              map
                                                                                                                                                                                                                                                                                                                                                                                                                (\ i
                                                                                                                                                                                                                                                                                                                                                                                                                   ->
                                                                                                                                                                                                                                                                                                                                                                                                                   o +
                                                                                                                                                                                                                                                                                                                                                                                                                     i *
                                                                                                                                                                                                                                                                                                                                                                                                                       s)
                                                                                                                                                                                                                                                                                                                                                                                                                [0
                                                                                                                                                                                                                                                                                                                                                                                                                 ..
                                                                                                                                                                                                                                                                                                                                                                                                                 2 -
                                                                                                                                                                                                                                                                                                                                                                                                                   1])
                                                                                                                                                                                                                                                                                                                                                                                                         .
                                                                                                                                                                                                                                                                                                                                                                                                         showChar
                                                                                                                                                                                                                                                                                                                                                                                                           ']')
                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                        ", "
                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                        (showString
                                                                                                                                                                                                                                                                                                                                                                                                           "viewportBoundsRange = ["
                                                                                                                                                                                                                                                                                                                                                                                                           .
                                                                                                                                                                                                                                                                                                                                                                                                           showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                             d
                                                                                                                                                                                                                                                                                                                                                                                                             (let s = sizeOf
                                                                                                                                                                                                                                                                                                                                                                                                                        (undefined
                                                                                                                                                                                                                                                                                                                                                                                                                           ::
                                                                                                                                                                                                                                                                                                                                                                                                                           FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                             "viewportBoundsRange"
                                                                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                  o = fieldOffset
                                                                                                                                                                                                                                                                                                                                                                                                                        @"viewportBoundsRange"
                                                                                                                                                                                                                                                                                                                                                                                                                        @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                                                                                  f i
                                                                                                                                                                                                                                                                                                                                                                                                                    = peekByteOff
                                                                                                                                                                                                                                                                                                                                                                                                                        (unsafePtr
                                                                                                                                                                                                                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                                                                                                                                                                                                                        i
                                                                                                                                                                                                                                                                                                                                                                                                                        ::
                                                                                                                                                                                                                                                                                                                                                                                                                        IO
                                                                                                                                                                                                                                                                                                                                                                                                                          (FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                             "viewportBoundsRange"
                                                                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                in
                                                                                                                                                                                                                                                                                                                                                                                                                unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                  mapM
                                                                                                                                                                                                                                                                                                                                                                                                                    f
                                                                                                                                                                                                                                                                                                                                                                                                                  $
                                                                                                                                                                                                                                                                                                                                                                                                                  map
                                                                                                                                                                                                                                                                                                                                                                                                                    (\ i
                                                                                                                                                                                                                                                                                                                                                                                                                       ->
                                                                                                                                                                                                                                                                                                                                                                                                                       o +
                                                                                                                                                                                                                                                                                                                                                                                                                         i *
                                                                                                                                                                                                                                                                                                                                                                                                                           s)
                                                                                                                                                                                                                                                                                                                                                                                                                    [0
                                                                                                                                                                                                                                                                                                                                                                                                                     ..
                                                                                                                                                                                                                                                                                                                                                                                                                     2 -
                                                                                                                                                                                                                                                                                                                                                                                                                       1])
                                                                                                                                                                                                                                                                                                                                                                                                             .
                                                                                                                                                                                                                                                                                                                                                                                                             showChar
                                                                                                                                                                                                                                                                                                                                                                                                               ']')
                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                            ", "
                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                                              "viewportSubPixelBits = "
                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                              showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                d
                                                                                                                                                                                                                                                                                                                                                                                                                (getField
                                                                                                                                                                                                                                                                                                                                                                                                                   @"viewportSubPixelBits"
                                                                                                                                                                                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                  ", "
                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                    "minMemoryMapAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                    showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                      d
                                                                                                                                                                                                                                                                                                                                                                                                                      (getField
                                                                                                                                                                                                                                                                                                                                                                                                                         @"minMemoryMapAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                         x)
                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                        ", "
                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                          "minTexelBufferOffsetAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                          showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                            d
                                                                                                                                                                                                                                                                                                                                                                                                                            (getField
                                                                                                                                                                                                                                                                                                                                                                                                                               @"minTexelBufferOffsetAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                               x)
                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                                                              ", "
                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                "minUniformBufferOffsetAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                  d
                                                                                                                                                                                                                                                                                                                                                                                                                                  (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                     @"minUniformBufferOffsetAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                                     x)
                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                      "minStorageBufferOffsetAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                      showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                        d
                                                                                                                                                                                                                                                                                                                                                                                                                                        (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                           @"minStorageBufferOffsetAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                            "minTexelOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                              d
                                                                                                                                                                                                                                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"minTexelOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                  "maxTexelOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                  showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                    d
                                                                                                                                                                                                                                                                                                                                                                                                                                                    (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"maxTexelOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                      ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                        "minTexelGatherOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                        showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                          d
                                                                                                                                                                                                                                                                                                                                                                                                                                                          (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"minTexelGatherOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                             x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                            ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                              "maxTexelGatherOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                              showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                   @"maxTexelGatherOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                    "minInterpolationOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                      d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                         @"minInterpolationOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                         x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                          "maxInterpolationOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                            d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                               @"maxInterpolationOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                               x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                "subPixelInterpolationOffsetBits = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     @"subPixelInterpolationOffsetBits"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      "maxFramebufferWidth = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           @"maxFramebufferWidth"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            "maxFramebufferHeight = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"maxFramebufferHeight"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  "maxFramebufferLayers = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"maxFramebufferLayers"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        "framebufferColorSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"framebufferColorSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              "framebufferDepthSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   @"framebufferDepthSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    "framebufferStencilSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         @"framebufferStencilSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          "framebufferNoAttachmentsSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               @"framebufferNoAttachmentsSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                "maxColorAttachments = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     @"maxColorAttachments"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      "sampledImageColorSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           @"sampledImageColorSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            "sampledImageIntegerSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"sampledImageIntegerSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  "sampledImageDepthSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"sampledImageDepthSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        "sampledImageStencilSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"sampledImageStencilSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              "storageImageSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   @"storageImageSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    "maxSampleMaskWords = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         @"maxSampleMaskWords"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          "timestampComputeAndGraphics = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               @"timestampComputeAndGraphics"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                "timestampPeriod = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     @"timestampPeriod"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      "maxClipDistances = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           @"maxClipDistances"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            "maxCullDistances = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"maxCullDistances"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  "maxCombinedClipAndCullDistances = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"maxCombinedClipAndCullDistances"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        "discreteQueuePriorities = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"discreteQueuePriorities"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               "pointSizeRange = ["
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 (let s = sizeOf
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (undefined
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ::
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 "pointSizeRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      o = fieldOffset
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            @"pointSizeRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      f i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        = peekByteOff
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (unsafePtr
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ::
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            IO
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 "pointSizeRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    in
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      mapM
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        f
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      $
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      map
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (\ i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ->
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           o +
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             i *
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               s)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        [0
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ..
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         2 -
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           1])
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 showChar
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   ']')
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   "lineWidthRange = ["
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     (let s = sizeOf
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (undefined
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   ::
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     "lineWidthRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          o = fieldOffset
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                @"lineWidthRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          f i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            = peekByteOff
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (unsafePtr
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ::
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                IO
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  (FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     "lineWidthRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        in
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          mapM
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            f
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          $
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          map
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (\ i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ->
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               o +
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 i *
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   s)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            [0
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ..
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             2 -
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               1])
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     showChar
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       ']')
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      "pointSizeGranularity = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           @"pointSizeGranularity"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            "lineWidthGranularity = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"lineWidthGranularity"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  "strictLines = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"strictLines"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        "standardSampleLocations = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"standardSampleLocations"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              "optimalBufferCopyOffsetAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   @"optimalBufferCopyOffsetAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    "optimalBufferCopyRowPitchAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         @"optimalBufferCopyRowPitchAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          "nonCoherentAtomSize = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               @"nonCoherentAtomSize"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            .
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            showChar
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              '}'

-- | > typedef struct VkPhysicalDeviceMaintenance3Properties {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     uint32_t                         maxPerSetDescriptors;
--   >     VkDeviceSize                     maxMemoryAllocationSize;
--   > } VkPhysicalDeviceMaintenance3Properties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceMaintenance3Properties VkPhysicalDeviceMaintenance3Properties registry at www.khronos.org>
data VkPhysicalDeviceMaintenance3Properties = VkPhysicalDeviceMaintenance3Properties# Addr#
                                                                                      ByteArray#

instance Eq VkPhysicalDeviceMaintenance3Properties where
        (VkPhysicalDeviceMaintenance3Properties# a _) ==
          x@(VkPhysicalDeviceMaintenance3Properties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMaintenance3Properties where
        (VkPhysicalDeviceMaintenance3Properties# a _) `compare`
          x@(VkPhysicalDeviceMaintenance3Properties# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMaintenance3Properties where
        sizeOf ~_
          = (32)
{-# LINE 13449 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 13453 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMaintenance3Properties
         where
        unsafeAddr (VkPhysicalDeviceMaintenance3Properties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceMaintenance3Properties# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceMaintenance3Properties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceMaintenance3Properties where
        type StructFields VkPhysicalDeviceMaintenance3Properties =
             '["sType", "pNext", "maxPerSetDescriptors", -- ' closing tick for hsc2hs
               "maxMemoryAllocationSize"]
        type CUnionType VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceMaintenance3Properties = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceMaintenance3Properties =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceMaintenance3Properties where
        type FieldType "sType" VkPhysicalDeviceMaintenance3Properties =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceMaintenance3Properties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceMaintenance3Properties =
             (0)
{-# LINE 13494 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceMaintenance3Properties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 13503 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceMaintenance3Properties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 13510 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 13514 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceMaintenance3Properties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 13520 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceMaintenance3Properties where
        type FieldType "pNext" VkPhysicalDeviceMaintenance3Properties =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceMaintenance3Properties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceMaintenance3Properties =
             (8)
{-# LINE 13529 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceMaintenance3Properties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 13538 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceMaintenance3Properties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 13545 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 13549 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceMaintenance3Properties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 13555 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPerSetDescriptors"
           VkPhysicalDeviceMaintenance3Properties
         where
        type FieldType "maxPerSetDescriptors"
               VkPhysicalDeviceMaintenance3Properties
             = Word32
        type FieldOptional "maxPerSetDescriptors"
               VkPhysicalDeviceMaintenance3Properties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPerSetDescriptors"
               VkPhysicalDeviceMaintenance3Properties
             =
             (16)
{-# LINE 13570 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPerSetDescriptors"
               VkPhysicalDeviceMaintenance3Properties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 13580 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPerSetDescriptors"
           VkPhysicalDeviceMaintenance3Properties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 13589 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 13593 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerSetDescriptors"
           VkPhysicalDeviceMaintenance3Properties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 13601 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxMemoryAllocationSize"
           VkPhysicalDeviceMaintenance3Properties
         where
        type FieldType "maxMemoryAllocationSize"
               VkPhysicalDeviceMaintenance3Properties
             = VkDeviceSize
        type FieldOptional "maxMemoryAllocationSize"
               VkPhysicalDeviceMaintenance3Properties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxMemoryAllocationSize"
               VkPhysicalDeviceMaintenance3Properties
             =
             (24)
{-# LINE 13616 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxMemoryAllocationSize"
               VkPhysicalDeviceMaintenance3Properties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 13626 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxMemoryAllocationSize"
           VkPhysicalDeviceMaintenance3Properties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 13635 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 13639 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxMemoryAllocationSize"
           VkPhysicalDeviceMaintenance3Properties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 13647 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceMaintenance3Properties where
        showsPrec d x
          = showString "VkPhysicalDeviceMaintenance3Properties {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "maxPerSetDescriptors = " .
                            showsPrec d (getField @"maxPerSetDescriptors" x) .
                              showString ", " .
                                showString "maxMemoryAllocationSize = " .
                                  showsPrec d (getField @"maxMemoryAllocationSize" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceMaintenance3Properties`
type VkPhysicalDeviceMaintenance3PropertiesKHR =
     VkPhysicalDeviceMaintenance3Properties

-- | > typedef struct VkPhysicalDeviceMemoryProperties {
--   >     uint32_t               memoryTypeCount;
--   >     VkMemoryType           memoryTypes[VK_MAX_MEMORY_TYPES];
--   >     uint32_t               memoryHeapCount;
--   >     VkMemoryHeap           memoryHeaps[VK_MAX_MEMORY_HEAPS];
--   > } VkPhysicalDeviceMemoryProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceMemoryProperties VkPhysicalDeviceMemoryProperties registry at www.khronos.org>
data VkPhysicalDeviceMemoryProperties = VkPhysicalDeviceMemoryProperties# Addr#
                                                                          ByteArray#

instance Eq VkPhysicalDeviceMemoryProperties where
        (VkPhysicalDeviceMemoryProperties# a _) ==
          x@(VkPhysicalDeviceMemoryProperties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMemoryProperties where
        (VkPhysicalDeviceMemoryProperties# a _) `compare`
          x@(VkPhysicalDeviceMemoryProperties# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMemoryProperties where
        sizeOf ~_ = (520)
{-# LINE 13694 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 13698 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMemoryProperties where
        unsafeAddr (VkPhysicalDeviceMemoryProperties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceMemoryProperties# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceMemoryProperties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceMemoryProperties where
        type StructFields VkPhysicalDeviceMemoryProperties =
             '["memoryTypeCount", "memoryTypes", "memoryHeapCount", -- ' closing tick for hsc2hs
               "memoryHeaps"]
        type CUnionType VkPhysicalDeviceMemoryProperties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceMemoryProperties = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceMemoryProperties = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "memoryTypeCount" VkPhysicalDeviceMemoryProperties where
        type FieldType "memoryTypeCount" VkPhysicalDeviceMemoryProperties =
             Word32
        type FieldOptional "memoryTypeCount"
               VkPhysicalDeviceMemoryProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "memoryTypeCount" VkPhysicalDeviceMemoryProperties
             =
             (0)
{-# LINE 13739 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "memoryTypeCount"
               VkPhysicalDeviceMemoryProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 13749 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "memoryTypeCount" VkPhysicalDeviceMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 13757 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 13761 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "memoryTypeCount" VkPhysicalDeviceMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 13768 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "memoryTypes" VkPhysicalDeviceMemoryProperties where
        type FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties =
             VkMemoryType
        type FieldOptional "memoryTypes" VkPhysicalDeviceMemoryProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "memoryTypes" VkPhysicalDeviceMemoryProperties =
             (4)
{-# LINE 13777 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "memoryTypes" VkPhysicalDeviceMemoryProperties =
             'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (4)
{-# LINE 13786 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "memoryTypes" idx
            VkPhysicalDeviceMemoryProperties) =>
         CanReadFieldArray "memoryTypes" idx
           VkPhysicalDeviceMemoryProperties
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "memoryTypes" 0 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "memoryTypes" 1 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "memoryTypes" 2 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "memoryTypes" 3 VkPhysicalDeviceMemoryProperties
                       #-}
        type FieldArrayLength "memoryTypes"
               VkPhysicalDeviceMemoryProperties
             = VK_MAX_MEMORY_TYPES

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = VK_MAX_MEMORY_TYPES

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (4)
{-# LINE 13822 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      +
                      sizeOf (undefined :: VkMemoryType) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((4)
{-# LINE 13830 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: VkMemoryType) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "memoryTypes" idx
            VkPhysicalDeviceMemoryProperties) =>
         CanWriteFieldArray "memoryTypes" idx
           VkPhysicalDeviceMemoryProperties
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "memoryTypes" 0 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "memoryTypes" 1 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "memoryTypes" 2 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "memoryTypes" 3 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((4)
{-# LINE 13861 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: VkMemoryType) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "memoryHeapCount" VkPhysicalDeviceMemoryProperties where
        type FieldType "memoryHeapCount" VkPhysicalDeviceMemoryProperties =
             Word32
        type FieldOptional "memoryHeapCount"
               VkPhysicalDeviceMemoryProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "memoryHeapCount" VkPhysicalDeviceMemoryProperties
             =
             (260)
{-# LINE 13875 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "memoryHeapCount"
               VkPhysicalDeviceMemoryProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (260)
{-# LINE 13885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "memoryHeapCount" VkPhysicalDeviceMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (260))
{-# LINE 13893 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (260)
{-# LINE 13897 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "memoryHeapCount" VkPhysicalDeviceMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (260)
{-# LINE 13904 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "memoryHeaps" VkPhysicalDeviceMemoryProperties where
        type FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties =
             VkMemoryHeap
        type FieldOptional "memoryHeaps" VkPhysicalDeviceMemoryProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "memoryHeaps" VkPhysicalDeviceMemoryProperties =
             (264)
{-# LINE 13913 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "memoryHeaps" VkPhysicalDeviceMemoryProperties =
             'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (264)
{-# LINE 13922 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "memoryHeaps" idx
            VkPhysicalDeviceMemoryProperties) =>
         CanReadFieldArray "memoryHeaps" idx
           VkPhysicalDeviceMemoryProperties
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "memoryHeaps" 0 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "memoryHeaps" 1 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "memoryHeaps" 2 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "memoryHeaps" 3 VkPhysicalDeviceMemoryProperties
                       #-}
        type FieldArrayLength "memoryHeaps"
               VkPhysicalDeviceMemoryProperties
             = VK_MAX_MEMORY_HEAPS

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = VK_MAX_MEMORY_HEAPS

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (264)
{-# LINE 13958 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      +
                      sizeOf (undefined :: VkMemoryHeap) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((264)
{-# LINE 13966 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: VkMemoryHeap) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "memoryHeaps" idx
            VkPhysicalDeviceMemoryProperties) =>
         CanWriteFieldArray "memoryHeaps" idx
           VkPhysicalDeviceMemoryProperties
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "memoryHeaps" 0 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "memoryHeaps" 1 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "memoryHeaps" 2 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "memoryHeaps" 3 VkPhysicalDeviceMemoryProperties
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((264)
{-# LINE 13997 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: VkMemoryHeap) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance Show VkPhysicalDeviceMemoryProperties where
        showsPrec d x
          = showString "VkPhysicalDeviceMemoryProperties {" .
              showString "memoryTypeCount = " .
                showsPrec d (getField @"memoryTypeCount" x) .
                  showString ", " .
                    (showString "memoryTypes = [" .
                       showsPrec d
                         (let s = sizeOf
                                    (undefined ::
                                       FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties)
                              o = fieldOffset @"memoryTypes" @VkPhysicalDeviceMemoryProperties
                              f i
                                = peekByteOff (unsafePtr x) i ::
                                    IO (FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties)
                            in
                            unsafeDupablePerformIO . mapM f $
                              map (\ i -> o + i * s) [0 .. VK_MAX_MEMORY_TYPES - 1])
                         . showChar ']')
                      .
                      showString ", " .
                        showString "memoryHeapCount = " .
                          showsPrec d (getField @"memoryHeapCount" x) .
                            showString ", " .
                              (showString "memoryHeaps = [" .
                                 showsPrec d
                                   (let s = sizeOf
                                              (undefined ::
                                                 FieldType "memoryHeaps"
                                                   VkPhysicalDeviceMemoryProperties)
                                        o = fieldOffset @"memoryHeaps"
                                              @VkPhysicalDeviceMemoryProperties
                                        f i
                                          = peekByteOff (unsafePtr x) i ::
                                              IO
                                                (FieldType "memoryHeaps"
                                                   VkPhysicalDeviceMemoryProperties)
                                      in
                                      unsafeDupablePerformIO . mapM f $
                                        map (\ i -> o + i * s) [0 .. VK_MAX_MEMORY_HEAPS - 1])
                                   . showChar ']')
                                . showChar '}'

-- | > typedef struct VkPhysicalDeviceMemoryProperties2 {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkPhysicalDeviceMemoryProperties memoryProperties;
--   > } VkPhysicalDeviceMemoryProperties2;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceMemoryProperties2 VkPhysicalDeviceMemoryProperties2 registry at www.khronos.org>
data VkPhysicalDeviceMemoryProperties2 = VkPhysicalDeviceMemoryProperties2# Addr#
                                                                            ByteArray#

instance Eq VkPhysicalDeviceMemoryProperties2 where
        (VkPhysicalDeviceMemoryProperties2# a _) ==
          x@(VkPhysicalDeviceMemoryProperties2# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMemoryProperties2 where
        (VkPhysicalDeviceMemoryProperties2# a _) `compare`
          x@(VkPhysicalDeviceMemoryProperties2# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMemoryProperties2 where
        sizeOf ~_ = (536)
{-# LINE 14070 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 14074 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMemoryProperties2 where
        unsafeAddr (VkPhysicalDeviceMemoryProperties2# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceMemoryProperties2# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceMemoryProperties2#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceMemoryProperties2 where
        type StructFields VkPhysicalDeviceMemoryProperties2 =
             '["sType", "pNext", "memoryProperties"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceMemoryProperties2 = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceMemoryProperties2 = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceMemoryProperties2 = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceMemoryProperties2 where
        type FieldType "sType" VkPhysicalDeviceMemoryProperties2 =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceMemoryProperties2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceMemoryProperties2 =
             (0)
{-# LINE 14112 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceMemoryProperties2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 14121 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceMemoryProperties2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 14128 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 14132 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceMemoryProperties2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 14138 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceMemoryProperties2 where
        type FieldType "pNext" VkPhysicalDeviceMemoryProperties2 = Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceMemoryProperties2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceMemoryProperties2 =
             (8)
{-# LINE 14146 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceMemoryProperties2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 14155 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceMemoryProperties2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 14162 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 14166 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceMemoryProperties2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 14172 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "memoryProperties" VkPhysicalDeviceMemoryProperties2 where
        type FieldType "memoryProperties" VkPhysicalDeviceMemoryProperties2
             = VkPhysicalDeviceMemoryProperties
        type FieldOptional "memoryProperties"
               VkPhysicalDeviceMemoryProperties2
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "memoryProperties"
               VkPhysicalDeviceMemoryProperties2
             =
             (16)
{-# LINE 14184 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "memoryProperties"
               VkPhysicalDeviceMemoryProperties2
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 14194 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "memoryProperties" VkPhysicalDeviceMemoryProperties2
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 14202 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 14206 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "memoryProperties" VkPhysicalDeviceMemoryProperties2
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 14213 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceMemoryProperties2 where
        showsPrec d x
          = showString "VkPhysicalDeviceMemoryProperties2 {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "memoryProperties = " .
                            showsPrec d (getField @"memoryProperties" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceMemoryProperties2`
type VkPhysicalDeviceMemoryProperties2KHR =
     VkPhysicalDeviceMemoryProperties2

-- | > typedef struct VkPhysicalDeviceMultiviewFeatures {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkBool32                         multiview;
--   >     VkBool32                         multiviewGeometryShader;
--   >     VkBool32                         multiviewTessellationShader;
--   > } VkPhysicalDeviceMultiviewFeatures;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceMultiviewFeatures VkPhysicalDeviceMultiviewFeatures registry at www.khronos.org>
data VkPhysicalDeviceMultiviewFeatures = VkPhysicalDeviceMultiviewFeatures# Addr#
                                                                            ByteArray#

instance Eq VkPhysicalDeviceMultiviewFeatures where
        (VkPhysicalDeviceMultiviewFeatures# a _) ==
          x@(VkPhysicalDeviceMultiviewFeatures# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMultiviewFeatures where
        (VkPhysicalDeviceMultiviewFeatures# a _) `compare`
          x@(VkPhysicalDeviceMultiviewFeatures# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMultiviewFeatures where
        sizeOf ~_ = (32)
{-# LINE 14258 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 14262 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMultiviewFeatures where
        unsafeAddr (VkPhysicalDeviceMultiviewFeatures# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceMultiviewFeatures# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceMultiviewFeatures#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceMultiviewFeatures where
        type StructFields VkPhysicalDeviceMultiviewFeatures =
             '["sType", "pNext", "multiview", "multiviewGeometryShader", -- ' closing tick for hsc2hs
               "multiviewTessellationShader"]
        type CUnionType VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceMultiviewFeatures =
             '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceMultiviewFeatures where
        type FieldType "sType" VkPhysicalDeviceMultiviewFeatures =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceMultiviewFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceMultiviewFeatures =
             (0)
{-# LINE 14302 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceMultiviewFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 14311 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceMultiviewFeatures where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 14318 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 14322 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceMultiviewFeatures where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 14328 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceMultiviewFeatures where
        type FieldType "pNext" VkPhysicalDeviceMultiviewFeatures = Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceMultiviewFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceMultiviewFeatures =
             (8)
{-# LINE 14336 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceMultiviewFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 14345 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceMultiviewFeatures where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 14352 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 14356 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceMultiviewFeatures where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 14362 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "multiview" VkPhysicalDeviceMultiviewFeatures where
        type FieldType "multiview" VkPhysicalDeviceMultiviewFeatures =
             VkBool32
        type FieldOptional "multiview" VkPhysicalDeviceMultiviewFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "multiview" VkPhysicalDeviceMultiviewFeatures =
             (16)
{-# LINE 14371 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "multiview" VkPhysicalDeviceMultiviewFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 14380 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "multiview" VkPhysicalDeviceMultiviewFeatures where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 14387 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 14391 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "multiview" VkPhysicalDeviceMultiviewFeatures where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 14397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "multiviewGeometryShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        type FieldType "multiviewGeometryShader"
               VkPhysicalDeviceMultiviewFeatures
             = VkBool32
        type FieldOptional "multiviewGeometryShader"
               VkPhysicalDeviceMultiviewFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "multiviewGeometryShader"
               VkPhysicalDeviceMultiviewFeatures
             =
             (20)
{-# LINE 14412 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "multiviewGeometryShader"
               VkPhysicalDeviceMultiviewFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 14422 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "multiviewGeometryShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 14431 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 14435 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "multiviewGeometryShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 14443 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "multiviewTessellationShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        type FieldType "multiviewTessellationShader"
               VkPhysicalDeviceMultiviewFeatures
             = VkBool32
        type FieldOptional "multiviewTessellationShader"
               VkPhysicalDeviceMultiviewFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "multiviewTessellationShader"
               VkPhysicalDeviceMultiviewFeatures
             =
             (24)
{-# LINE 14458 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "multiviewTessellationShader"
               VkPhysicalDeviceMultiviewFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 14468 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "multiviewTessellationShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 14477 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 14481 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "multiviewTessellationShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 14489 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceMultiviewFeatures where
        showsPrec d x
          = showString "VkPhysicalDeviceMultiviewFeatures {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "multiview = " .
                            showsPrec d (getField @"multiview" x) .
                              showString ", " .
                                showString "multiviewGeometryShader = " .
                                  showsPrec d (getField @"multiviewGeometryShader" x) .
                                    showString ", " .
                                      showString "multiviewTessellationShader = " .
                                        showsPrec d (getField @"multiviewTessellationShader" x) .
                                          showChar '}'

-- | Alias for `VkPhysicalDeviceMultiviewFeatures`
type VkPhysicalDeviceMultiviewFeaturesKHR =
     VkPhysicalDeviceMultiviewFeatures

-- | > typedef struct VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkBool32                         perViewPositionAllComponents;
--   > } VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX registry at www.khronos.org>
data VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# Addr#
                                                                                                                        ByteArray#

instance Eq VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# a _) ==
          x@(VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# a _)
          `compare`
          x@(VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        sizeOf ~_
          = (24)
{-# LINE 14546 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 14550 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        unsafeAddr
          (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        type StructFields
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = '["sType", "pNext", "perViewPositionAllComponents"] -- ' closing tick for hsc2hs
        type CUnionType
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = 'True -- ' closing tick for hsc2hs
        type StructExtends
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        type FieldType "sType"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             =
             (0)
{-# LINE 14607 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 14617 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 14626 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 14630 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 14638 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        type FieldType "pNext"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             =
             (8)
{-# LINE 14653 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 14663 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 14672 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 14676 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 14684 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "perViewPositionAllComponents"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        type FieldType "perViewPositionAllComponents"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = VkBool32
        type FieldOptional "perViewPositionAllComponents"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "perViewPositionAllComponents"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             =
             (16)
{-# LINE 14699 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "perViewPositionAllComponents"
               VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 14709 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "perViewPositionAllComponents"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 14718 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 14722 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "perViewPositionAllComponents"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 14730 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        showsPrec d x
          = showString
              "VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX {"
              .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "perViewPositionAllComponents = " .
                            showsPrec d (getField @"perViewPositionAllComponents" x) .
                              showChar '}'

-- | > typedef struct VkPhysicalDeviceMultiviewProperties {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     uint32_t                         maxMultiviewViewCount;
--   >     uint32_t                         maxMultiviewInstanceIndex;
--   > } VkPhysicalDeviceMultiviewProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceMultiviewProperties VkPhysicalDeviceMultiviewProperties registry at www.khronos.org>
data VkPhysicalDeviceMultiviewProperties = VkPhysicalDeviceMultiviewProperties# Addr#
                                                                                ByteArray#

instance Eq VkPhysicalDeviceMultiviewProperties where
        (VkPhysicalDeviceMultiviewProperties# a _) ==
          x@(VkPhysicalDeviceMultiviewProperties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMultiviewProperties where
        (VkPhysicalDeviceMultiviewProperties# a _) `compare`
          x@(VkPhysicalDeviceMultiviewProperties# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMultiviewProperties where
        sizeOf ~_ = (24)
{-# LINE 14775 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 14779 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMultiviewProperties
         where
        unsafeAddr (VkPhysicalDeviceMultiviewProperties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceMultiviewProperties# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceMultiviewProperties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceMultiviewProperties where
        type StructFields VkPhysicalDeviceMultiviewProperties =
             '["sType", "pNext", "maxMultiviewViewCount", -- ' closing tick for hsc2hs
               "maxMultiviewInstanceIndex"]
        type CUnionType VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceMultiviewProperties = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceMultiviewProperties =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceMultiviewProperties where
        type FieldType "sType" VkPhysicalDeviceMultiviewProperties =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceMultiviewProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceMultiviewProperties =
             (0)
{-# LINE 14820 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceMultiviewProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 14829 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceMultiviewProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 14836 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 14840 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceMultiviewProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 14846 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceMultiviewProperties where
        type FieldType "pNext" VkPhysicalDeviceMultiviewProperties =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceMultiviewProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceMultiviewProperties =
             (8)
{-# LINE 14855 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceMultiviewProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 14864 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceMultiviewProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 14871 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 14875 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceMultiviewProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 14881 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxMultiviewViewCount"
           VkPhysicalDeviceMultiviewProperties
         where
        type FieldType "maxMultiviewViewCount"
               VkPhysicalDeviceMultiviewProperties
             = Word32
        type FieldOptional "maxMultiviewViewCount"
               VkPhysicalDeviceMultiviewProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxMultiviewViewCount"
               VkPhysicalDeviceMultiviewProperties
             =
             (16)
{-# LINE 14896 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxMultiviewViewCount"
               VkPhysicalDeviceMultiviewProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 14906 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxMultiviewViewCount"
           VkPhysicalDeviceMultiviewProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 14915 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 14919 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxMultiviewViewCount"
           VkPhysicalDeviceMultiviewProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 14927 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxMultiviewInstanceIndex"
           VkPhysicalDeviceMultiviewProperties
         where
        type FieldType "maxMultiviewInstanceIndex"
               VkPhysicalDeviceMultiviewProperties
             = Word32
        type FieldOptional "maxMultiviewInstanceIndex"
               VkPhysicalDeviceMultiviewProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxMultiviewInstanceIndex"
               VkPhysicalDeviceMultiviewProperties
             =
             (20)
{-# LINE 14942 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxMultiviewInstanceIndex"
               VkPhysicalDeviceMultiviewProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 14952 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxMultiviewInstanceIndex"
           VkPhysicalDeviceMultiviewProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 14961 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 14965 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxMultiviewInstanceIndex"
           VkPhysicalDeviceMultiviewProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 14973 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceMultiviewProperties where
        showsPrec d x
          = showString "VkPhysicalDeviceMultiviewProperties {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "maxMultiviewViewCount = " .
                            showsPrec d (getField @"maxMultiviewViewCount" x) .
                              showString ", " .
                                showString "maxMultiviewInstanceIndex = " .
                                  showsPrec d (getField @"maxMultiviewInstanceIndex" x) .
                                    showChar '}'

-- | Alias for `VkPhysicalDeviceMultiviewProperties`
type VkPhysicalDeviceMultiviewPropertiesKHR =
     VkPhysicalDeviceMultiviewProperties

-- | > typedef struct VkPhysicalDevicePointClippingProperties {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkPointClippingBehavior      pointClippingBehavior;
--   > } VkPhysicalDevicePointClippingProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDevicePointClippingProperties VkPhysicalDevicePointClippingProperties registry at www.khronos.org>
data VkPhysicalDevicePointClippingProperties = VkPhysicalDevicePointClippingProperties# Addr#
                                                                                        ByteArray#

instance Eq VkPhysicalDevicePointClippingProperties where
        (VkPhysicalDevicePointClippingProperties# a _) ==
          x@(VkPhysicalDevicePointClippingProperties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDevicePointClippingProperties where
        (VkPhysicalDevicePointClippingProperties# a _) `compare`
          x@(VkPhysicalDevicePointClippingProperties# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDevicePointClippingProperties where
        sizeOf ~_
          = (24)
{-# LINE 15021 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 15025 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDevicePointClippingProperties
         where
        unsafeAddr (VkPhysicalDevicePointClippingProperties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDevicePointClippingProperties# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDevicePointClippingProperties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDevicePointClippingProperties
         where
        type StructFields VkPhysicalDevicePointClippingProperties =
             '["sType", "pNext", "pointClippingBehavior"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDevicePointClippingProperties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDevicePointClippingProperties = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDevicePointClippingProperties =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDevicePointClippingProperties where
        type FieldType "sType" VkPhysicalDevicePointClippingProperties =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDevicePointClippingProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDevicePointClippingProperties =
             (0)
{-# LINE 15066 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDevicePointClippingProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 15075 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDevicePointClippingProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 15082 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 15086 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDevicePointClippingProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 15092 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDevicePointClippingProperties where
        type FieldType "pNext" VkPhysicalDevicePointClippingProperties =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDevicePointClippingProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDevicePointClippingProperties =
             (8)
{-# LINE 15101 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDevicePointClippingProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 15110 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDevicePointClippingProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 15117 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 15121 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDevicePointClippingProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 15127 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pointClippingBehavior"
           VkPhysicalDevicePointClippingProperties
         where
        type FieldType "pointClippingBehavior"
               VkPhysicalDevicePointClippingProperties
             = VkPointClippingBehavior
        type FieldOptional "pointClippingBehavior"
               VkPhysicalDevicePointClippingProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pointClippingBehavior"
               VkPhysicalDevicePointClippingProperties
             =
             (16)
{-# LINE 15142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pointClippingBehavior"
               VkPhysicalDevicePointClippingProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 15152 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pointClippingBehavior"
           VkPhysicalDevicePointClippingProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 15161 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 15165 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pointClippingBehavior"
           VkPhysicalDevicePointClippingProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 15173 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDevicePointClippingProperties where
        showsPrec d x
          = showString "VkPhysicalDevicePointClippingProperties {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "pointClippingBehavior = " .
                            showsPrec d (getField @"pointClippingBehavior" x) . showChar '}'

-- | Alias for `VkPhysicalDevicePointClippingProperties`
type VkPhysicalDevicePointClippingPropertiesKHR =
     VkPhysicalDevicePointClippingProperties

-- | > typedef struct VkPhysicalDeviceProperties {
--   >     uint32_t       apiVersion;
--   >     uint32_t       driverVersion;
--   >     uint32_t       vendorID;
--   >     uint32_t       deviceID;
--   >     VkPhysicalDeviceType deviceType;
--   >     char           deviceName[VK_MAX_PHYSICAL_DEVICE_NAME_SIZE];
--   >     uint8_t        pipelineCacheUUID[VK_UUID_SIZE];
--   >     VkPhysicalDeviceLimits limits;
--   >     VkPhysicalDeviceSparseProperties sparseProperties;
--   > } VkPhysicalDeviceProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceProperties VkPhysicalDeviceProperties registry at www.khronos.org>
data VkPhysicalDeviceProperties = VkPhysicalDeviceProperties# Addr#
                                                              ByteArray#

instance Eq VkPhysicalDeviceProperties where
        (VkPhysicalDeviceProperties# a _) ==
          x@(VkPhysicalDeviceProperties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceProperties where
        (VkPhysicalDeviceProperties# a _) `compare`
          x@(VkPhysicalDeviceProperties# b _) = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceProperties where
        sizeOf ~_ = (824)
{-# LINE 15221 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_ = (8)
{-# LINE 15224 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceProperties where
        unsafeAddr (VkPhysicalDeviceProperties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceProperties# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceProperties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceProperties where
        type StructFields VkPhysicalDeviceProperties =
             '["apiVersion", "driverVersion", "vendorID", "deviceID", -- ' closing tick for hsc2hs
               "deviceType", "deviceName", "pipelineCacheUUID", "limits",
               "sparseProperties"]
        type CUnionType VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceProperties = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceProperties = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "apiVersion" VkPhysicalDeviceProperties where
        type FieldType "apiVersion" VkPhysicalDeviceProperties = Word32
        type FieldOptional "apiVersion" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "apiVersion" VkPhysicalDeviceProperties =
             (0)
{-# LINE 15262 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "apiVersion" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 15270 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "apiVersion" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 15277 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 15281 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "apiVersion" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 15287 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "driverVersion" VkPhysicalDeviceProperties where
        type FieldType "driverVersion" VkPhysicalDeviceProperties = Word32
        type FieldOptional "driverVersion" VkPhysicalDeviceProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "driverVersion" VkPhysicalDeviceProperties =
             (4)
{-# LINE 15295 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "driverVersion" VkPhysicalDeviceProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (4)
{-# LINE 15304 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "driverVersion" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (4))
{-# LINE 15311 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (4)
{-# LINE 15315 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "driverVersion" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (4)
{-# LINE 15321 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "vendorID" VkPhysicalDeviceProperties where
        type FieldType "vendorID" VkPhysicalDeviceProperties = Word32
        type FieldOptional "vendorID" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "vendorID" VkPhysicalDeviceProperties =
             (8)
{-# LINE 15328 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "vendorID" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 15336 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "vendorID" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 15343 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 15347 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "vendorID" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 15353 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "deviceID" VkPhysicalDeviceProperties where
        type FieldType "deviceID" VkPhysicalDeviceProperties = Word32
        type FieldOptional "deviceID" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "deviceID" VkPhysicalDeviceProperties =
             (12)
{-# LINE 15360 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "deviceID" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (12)
{-# LINE 15368 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "deviceID" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (12))
{-# LINE 15375 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (12)
{-# LINE 15379 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "deviceID" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (12)
{-# LINE 15385 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "deviceType" VkPhysicalDeviceProperties where
        type FieldType "deviceType" VkPhysicalDeviceProperties =
             VkPhysicalDeviceType
        type FieldOptional "deviceType" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "deviceType" VkPhysicalDeviceProperties =
             (16)
{-# LINE 15393 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "deviceType" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 15401 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "deviceType" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 15408 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 15412 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "deviceType" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 15418 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "deviceName" VkPhysicalDeviceProperties where
        type FieldType "deviceName" VkPhysicalDeviceProperties = CChar
        type FieldOptional "deviceName" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "deviceName" VkPhysicalDeviceProperties =
             (20)
{-# LINE 15425 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "deviceName" VkPhysicalDeviceProperties = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 15433 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "deviceName" idx VkPhysicalDeviceProperties) =>
         CanReadFieldArray "deviceName" idx VkPhysicalDeviceProperties
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "deviceName" 0 VkPhysicalDeviceProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "deviceName" 1 VkPhysicalDeviceProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "deviceName" 2 VkPhysicalDeviceProperties #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "deviceName" 3 VkPhysicalDeviceProperties #-}
        type FieldArrayLength "deviceName" VkPhysicalDeviceProperties =
             VK_MAX_PHYSICAL_DEVICE_NAME_SIZE

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = VK_MAX_PHYSICAL_DEVICE_NAME_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (20) +
{-# LINE 15462 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      sizeOf (undefined :: CChar) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((20) +
{-# LINE 15469 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: CChar) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "deviceName" idx VkPhysicalDeviceProperties) =>
         CanWriteFieldArray "deviceName" idx VkPhysicalDeviceProperties
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceName" 0 VkPhysicalDeviceProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceName" 1 VkPhysicalDeviceProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceName" 2 VkPhysicalDeviceProperties #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "deviceName" 3 VkPhysicalDeviceProperties #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((20) +
{-# LINE 15493 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 sizeOf (undefined :: CChar) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "pipelineCacheUUID" VkPhysicalDeviceProperties where
        type FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties =
             Word8
        type FieldOptional "pipelineCacheUUID" VkPhysicalDeviceProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pipelineCacheUUID" VkPhysicalDeviceProperties =
             (276)
{-# LINE 15504 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pipelineCacheUUID" VkPhysicalDeviceProperties =
             'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (276)
{-# LINE 15513 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "pipelineCacheUUID" idx
            VkPhysicalDeviceProperties) =>
         CanReadFieldArray "pipelineCacheUUID" idx
           VkPhysicalDeviceProperties
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "pipelineCacheUUID" 0 VkPhysicalDeviceProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "pipelineCacheUUID" 1 VkPhysicalDeviceProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "pipelineCacheUUID" 2 VkPhysicalDeviceProperties
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "pipelineCacheUUID" 3 VkPhysicalDeviceProperties
                       #-}
        type FieldArrayLength "pipelineCacheUUID"
               VkPhysicalDeviceProperties
             = VK_UUID_SIZE

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = VK_UUID_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (276)
{-# LINE 15549 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      +
                      sizeOf (undefined :: Word8) *
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((276)
{-# LINE 15557 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Word8) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "pipelineCacheUUID" idx
            VkPhysicalDeviceProperties) =>
         CanWriteFieldArray "pipelineCacheUUID" idx
           VkPhysicalDeviceProperties
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "pipelineCacheUUID" 0 VkPhysicalDeviceProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "pipelineCacheUUID" 1 VkPhysicalDeviceProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "pipelineCacheUUID" 2 VkPhysicalDeviceProperties
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "pipelineCacheUUID" 3 VkPhysicalDeviceProperties
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((276)
{-# LINE 15588 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Word8) *
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "limits" VkPhysicalDeviceProperties where
        type FieldType "limits" VkPhysicalDeviceProperties =
             VkPhysicalDeviceLimits
        type FieldOptional "limits" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs
        type FieldOffset "limits" VkPhysicalDeviceProperties =
             (296)
{-# LINE 15599 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "limits" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (296)
{-# LINE 15607 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "limits" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (296))
{-# LINE 15614 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (296)
{-# LINE 15618 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "limits" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (296)
{-# LINE 15624 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseProperties" VkPhysicalDeviceProperties where
        type FieldType "sparseProperties" VkPhysicalDeviceProperties =
             VkPhysicalDeviceSparseProperties
        type FieldOptional "sparseProperties" VkPhysicalDeviceProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseProperties" VkPhysicalDeviceProperties =
             (800)
{-# LINE 15633 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sparseProperties" VkPhysicalDeviceProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (800)
{-# LINE 15642 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sparseProperties" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (800))
{-# LINE 15649 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (800)
{-# LINE 15653 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseProperties" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (800)
{-# LINE 15659 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceProperties where
        showsPrec d x
          = showString "VkPhysicalDeviceProperties {" .
              showString "apiVersion = " .
                showsPrec d (getField @"apiVersion" x) .
                  showString ", " .
                    showString "driverVersion = " .
                      showsPrec d (getField @"driverVersion" x) .
                        showString ", " .
                          showString "vendorID = " .
                            showsPrec d (getField @"vendorID" x) .
                              showString ", " .
                                showString "deviceID = " .
                                  showsPrec d (getField @"deviceID" x) .
                                    showString ", " .
                                      showString "deviceType = " .
                                        showsPrec d (getField @"deviceType" x) .
                                          showString ", " .
                                            (showString "deviceName = [" .
                                               showsPrec d
                                                 (let s = sizeOf
                                                            (undefined ::
                                                               FieldType "deviceName"
                                                                 VkPhysicalDeviceProperties)
                                                      o = fieldOffset @"deviceName"
                                                            @VkPhysicalDeviceProperties
                                                      f i
                                                        = peekByteOff (unsafePtr x) i ::
                                                            IO
                                                              (FieldType "deviceName"
                                                                 VkPhysicalDeviceProperties)
                                                    in
                                                    unsafeDupablePerformIO . mapM f $
                                                      map (\ i -> o + i * s)
                                                        [0 .. VK_MAX_PHYSICAL_DEVICE_NAME_SIZE - 1])
                                                 . showChar ']')
                                              .
                                              showString ", " .
                                                (showString "pipelineCacheUUID = [" .
                                                   showsPrec d
                                                     (let s = sizeOf
                                                                (undefined ::
                                                                   FieldType "pipelineCacheUUID"
                                                                     VkPhysicalDeviceProperties)
                                                          o = fieldOffset @"pipelineCacheUUID"
                                                                @VkPhysicalDeviceProperties
                                                          f i
                                                            = peekByteOff (unsafePtr x) i ::
                                                                IO
                                                                  (FieldType "pipelineCacheUUID"
                                                                     VkPhysicalDeviceProperties)
                                                        in
                                                        unsafeDupablePerformIO . mapM f $
                                                          map (\ i -> o + i * s)
                                                            [0 .. VK_UUID_SIZE - 1])
                                                     . showChar ']')
                                                  .
                                                  showString ", " .
                                                    showString "limits = " .
                                                      showsPrec d (getField @"limits" x) .
                                                        showString ", " .
                                                          showString "sparseProperties = " .
                                                            showsPrec d
                                                              (getField @"sparseProperties" x)
                                                              . showChar '}'

-- | > typedef struct VkPhysicalDeviceProperties2 {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkPhysicalDeviceProperties       properties;
--   > } VkPhysicalDeviceProperties2;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceProperties2 VkPhysicalDeviceProperties2 registry at www.khronos.org>
data VkPhysicalDeviceProperties2 = VkPhysicalDeviceProperties2# Addr#
                                                                ByteArray#

instance Eq VkPhysicalDeviceProperties2 where
        (VkPhysicalDeviceProperties2# a _) ==
          x@(VkPhysicalDeviceProperties2# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceProperties2 where
        (VkPhysicalDeviceProperties2# a _) `compare`
          x@(VkPhysicalDeviceProperties2# b _) = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceProperties2 where
        sizeOf ~_ = (840)
{-# LINE 15751 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_ = (8)
{-# LINE 15754 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceProperties2 where
        unsafeAddr (VkPhysicalDeviceProperties2# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceProperties2# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceProperties2#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceProperties2 where
        type StructFields VkPhysicalDeviceProperties2 =
             '["sType", "pNext", "properties"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceProperties2 = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceProperties2 = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceProperties2 where
        type FieldType "sType" VkPhysicalDeviceProperties2 =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceProperties2 =
             (0)
{-# LINE 15791 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 15799 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceProperties2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 15806 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 15810 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceProperties2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 15816 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceProperties2 where
        type FieldType "pNext" VkPhysicalDeviceProperties2 = Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceProperties2 =
             (8)
{-# LINE 15823 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 15831 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceProperties2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 15838 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 15842 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceProperties2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 15848 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "properties" VkPhysicalDeviceProperties2 where
        type FieldType "properties" VkPhysicalDeviceProperties2 =
             VkPhysicalDeviceProperties
        type FieldOptional "properties" VkPhysicalDeviceProperties2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "properties" VkPhysicalDeviceProperties2 =
             (16)
{-# LINE 15857 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "properties" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 15865 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "properties" VkPhysicalDeviceProperties2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 15872 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 15876 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "properties" VkPhysicalDeviceProperties2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 15882 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceProperties2 where
        showsPrec d x
          = showString "VkPhysicalDeviceProperties2 {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "properties = " .
                            showsPrec d (getField @"properties" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceProperties2`
type VkPhysicalDeviceProperties2KHR = VkPhysicalDeviceProperties2

-- | > typedef struct VkPhysicalDeviceProtectedMemoryFeatures {
--   >     VkStructureType sType;
--   >     void*                               pNext;
--   >     VkBool32                            protectedMemory;
--   > } VkPhysicalDeviceProtectedMemoryFeatures;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceProtectedMemoryFeatures VkPhysicalDeviceProtectedMemoryFeatures registry at www.khronos.org>
data VkPhysicalDeviceProtectedMemoryFeatures = VkPhysicalDeviceProtectedMemoryFeatures# Addr#
                                                                                        ByteArray#

instance Eq VkPhysicalDeviceProtectedMemoryFeatures where
        (VkPhysicalDeviceProtectedMemoryFeatures# a _) ==
          x@(VkPhysicalDeviceProtectedMemoryFeatures# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceProtectedMemoryFeatures where
        (VkPhysicalDeviceProtectedMemoryFeatures# a _) `compare`
          x@(VkPhysicalDeviceProtectedMemoryFeatures# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceProtectedMemoryFeatures where
        sizeOf ~_
          = (24)
{-# LINE 15925 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 15929 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceProtectedMemoryFeatures
         where
        unsafeAddr (VkPhysicalDeviceProtectedMemoryFeatures# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceProtectedMemoryFeatures# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceProtectedMemoryFeatures#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceProtectedMemoryFeatures
         where
        type StructFields VkPhysicalDeviceProtectedMemoryFeatures =
             '["sType", "pNext", "protectedMemory"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceProtectedMemoryFeatures =
             '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceProtectedMemoryFeatures where
        type FieldType "sType" VkPhysicalDeviceProtectedMemoryFeatures =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceProtectedMemoryFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceProtectedMemoryFeatures =
             (0)
{-# LINE 15970 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceProtectedMemoryFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 15979 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceProtectedMemoryFeatures where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 15986 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 15990 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceProtectedMemoryFeatures where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 15996 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceProtectedMemoryFeatures where
        type FieldType "pNext" VkPhysicalDeviceProtectedMemoryFeatures =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceProtectedMemoryFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceProtectedMemoryFeatures =
             (8)
{-# LINE 16005 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceProtectedMemoryFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 16014 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceProtectedMemoryFeatures where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 16021 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 16025 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceProtectedMemoryFeatures where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 16031 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures
         where
        type FieldType "protectedMemory"
               VkPhysicalDeviceProtectedMemoryFeatures
             = VkBool32
        type FieldOptional "protectedMemory"
               VkPhysicalDeviceProtectedMemoryFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "protectedMemory"
               VkPhysicalDeviceProtectedMemoryFeatures
             =
             (16)
{-# LINE 16045 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "protectedMemory"
               VkPhysicalDeviceProtectedMemoryFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 16055 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "protectedMemory"
           VkPhysicalDeviceProtectedMemoryFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 16064 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 16068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "protectedMemory"
           VkPhysicalDeviceProtectedMemoryFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 16076 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceProtectedMemoryFeatures where
        showsPrec d x
          = showString "VkPhysicalDeviceProtectedMemoryFeatures {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "protectedMemory = " .
                            showsPrec d (getField @"protectedMemory" x) . showChar '}'

-- | > typedef struct VkPhysicalDeviceProtectedMemoryProperties {
--   >     VkStructureType sType;
--   >     void*                               pNext;
--   >     VkBool32                            protectedNoFault;
--   > } VkPhysicalDeviceProtectedMemoryProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceProtectedMemoryProperties VkPhysicalDeviceProtectedMemoryProperties registry at www.khronos.org>
data VkPhysicalDeviceProtectedMemoryProperties = VkPhysicalDeviceProtectedMemoryProperties# Addr#
                                                                                            ByteArray#

instance Eq VkPhysicalDeviceProtectedMemoryProperties where
        (VkPhysicalDeviceProtectedMemoryProperties# a _) ==
          x@(VkPhysicalDeviceProtectedMemoryProperties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceProtectedMemoryProperties where
        (VkPhysicalDeviceProtectedMemoryProperties# a _) `compare`
          x@(VkPhysicalDeviceProtectedMemoryProperties# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceProtectedMemoryProperties where
        sizeOf ~_
          = (24)
{-# LINE 16116 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 16120 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceProtectedMemoryProperties
         where
        unsafeAddr (VkPhysicalDeviceProtectedMemoryProperties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceProtectedMemoryProperties# _ b)
          = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceProtectedMemoryProperties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceProtectedMemoryProperties
         where
        type StructFields VkPhysicalDeviceProtectedMemoryProperties =
             '["sType", "pNext", "protectedNoFault"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceProtectedMemoryProperties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceProtectedMemoryProperties =
             'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceProtectedMemoryProperties =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceProtectedMemoryProperties where
        type FieldType "sType" VkPhysicalDeviceProtectedMemoryProperties =
             VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceProtectedMemoryProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceProtectedMemoryProperties
             =
             (0)
{-# LINE 16166 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceProtectedMemoryProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 16175 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 16183 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 16187 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 16194 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceProtectedMemoryProperties where
        type FieldType "pNext" VkPhysicalDeviceProtectedMemoryProperties =
             Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceProtectedMemoryProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceProtectedMemoryProperties
             =
             (8)
{-# LINE 16205 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceProtectedMemoryProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 16214 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 16222 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 16226 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 16233 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "protectedNoFault"
           VkPhysicalDeviceProtectedMemoryProperties
         where
        type FieldType "protectedNoFault"
               VkPhysicalDeviceProtectedMemoryProperties
             = VkBool32
        type FieldOptional "protectedNoFault"
               VkPhysicalDeviceProtectedMemoryProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "protectedNoFault"
               VkPhysicalDeviceProtectedMemoryProperties
             =
             (16)
{-# LINE 16248 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "protectedNoFault"
               VkPhysicalDeviceProtectedMemoryProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 16258 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "protectedNoFault"
           VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 16267 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 16271 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "protectedNoFault"
           VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 16279 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceProtectedMemoryProperties where
        showsPrec d x
          = showString "VkPhysicalDeviceProtectedMemoryProperties {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "protectedNoFault = " .
                            showsPrec d (getField @"protectedNoFault" x) . showChar '}'

-- | > typedef struct VkPhysicalDevicePushDescriptorPropertiesKHR {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     uint32_t                         maxPushDescriptors;
--   > } VkPhysicalDevicePushDescriptorPropertiesKHR;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDevicePushDescriptorPropertiesKHR VkPhysicalDevicePushDescriptorPropertiesKHR registry at www.khronos.org>
data VkPhysicalDevicePushDescriptorPropertiesKHR = VkPhysicalDevicePushDescriptorPropertiesKHR# Addr#
                                                                                                ByteArray#

instance Eq VkPhysicalDevicePushDescriptorPropertiesKHR where
        (VkPhysicalDevicePushDescriptorPropertiesKHR# a _) ==
          x@(VkPhysicalDevicePushDescriptorPropertiesKHR# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDevicePushDescriptorPropertiesKHR where
        (VkPhysicalDevicePushDescriptorPropertiesKHR# a _) `compare`
          x@(VkPhysicalDevicePushDescriptorPropertiesKHR# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDevicePushDescriptorPropertiesKHR where
        sizeOf ~_
          = (24)
{-# LINE 16319 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 16323 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        unsafeAddr (VkPhysicalDevicePushDescriptorPropertiesKHR# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDevicePushDescriptorPropertiesKHR# _ b)
          = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDevicePushDescriptorPropertiesKHR#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        type StructFields VkPhysicalDevicePushDescriptorPropertiesKHR =
             '["sType", "pNext", "maxPushDescriptors"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDevicePushDescriptorPropertiesKHR =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDevicePushDescriptorPropertiesKHR =
             'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDevicePushDescriptorPropertiesKHR =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDevicePushDescriptorPropertiesKHR where
        type FieldType "sType" VkPhysicalDevicePushDescriptorPropertiesKHR
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             =
             (0)
{-# LINE 16371 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 16381 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 16389 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 16393 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 16400 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR where
        type FieldType "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             =
             (8)
{-# LINE 16412 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 16422 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 16430 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 16434 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 16441 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxPushDescriptors"
           VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        type FieldType "maxPushDescriptors"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             = Word32
        type FieldOptional "maxPushDescriptors"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxPushDescriptors"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             =
             (16)
{-# LINE 16456 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxPushDescriptors"
               VkPhysicalDevicePushDescriptorPropertiesKHR
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 16466 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxPushDescriptors"
           VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 16475 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 16479 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPushDescriptors"
           VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 16487 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDevicePushDescriptorPropertiesKHR where
        showsPrec d x
          = showString "VkPhysicalDevicePushDescriptorPropertiesKHR {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "maxPushDescriptors = " .
                            showsPrec d (getField @"maxPushDescriptors" x) . showChar '}'

-- | > typedef struct VkPhysicalDeviceSampleLocationsPropertiesEXT {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkSampleCountFlags               sampleLocationSampleCounts;
--   >     VkExtent2D                       maxSampleLocationGridSize;
--   >     float                            sampleLocationCoordinateRange[2];
--   >     uint32_t                         sampleLocationSubPixelBits;
--   >     VkBool32                         variableSampleLocations;
--   > } VkPhysicalDeviceSampleLocationsPropertiesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceSampleLocationsPropertiesEXT VkPhysicalDeviceSampleLocationsPropertiesEXT registry at www.khronos.org>
data VkPhysicalDeviceSampleLocationsPropertiesEXT = VkPhysicalDeviceSampleLocationsPropertiesEXT# Addr#
                                                                                                  ByteArray#

instance Eq VkPhysicalDeviceSampleLocationsPropertiesEXT where
        (VkPhysicalDeviceSampleLocationsPropertiesEXT# a _) ==
          x@(VkPhysicalDeviceSampleLocationsPropertiesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSampleLocationsPropertiesEXT where
        (VkPhysicalDeviceSampleLocationsPropertiesEXT# a _) `compare`
          x@(VkPhysicalDeviceSampleLocationsPropertiesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        sizeOf ~_
          = (48)
{-# LINE 16532 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 16536 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        unsafeAddr (VkPhysicalDeviceSampleLocationsPropertiesEXT# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceSampleLocationsPropertiesEXT# _ b)
          = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceSampleLocationsPropertiesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        type StructFields VkPhysicalDeviceSampleLocationsPropertiesEXT =
             '["sType", "pNext", "sampleLocationSampleCounts", -- ' closing tick for hsc2hs
               "maxSampleLocationGridSize", "sampleLocationCoordinateRange",
               "sampleLocationSubPixelBits", "variableSampleLocations"]
        type CUnionType VkPhysicalDeviceSampleLocationsPropertiesEXT =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceSampleLocationsPropertiesEXT =
             'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceSampleLocationsPropertiesEXT =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT where
        type FieldType "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             =
             (0)
{-# LINE 16586 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 16596 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 16604 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 16608 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 16615 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT where
        type FieldType "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             =
             (8)
{-# LINE 16627 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 16637 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 16645 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 16649 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 16656 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sampleLocationSampleCounts"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        type FieldType "sampleLocationSampleCounts"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = VkSampleCountFlags
        type FieldOptional "sampleLocationSampleCounts"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sampleLocationSampleCounts"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             =
             (16)
{-# LINE 16671 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sampleLocationSampleCounts"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 16681 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampleLocationSampleCounts"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 16690 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 16694 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampleLocationSampleCounts"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 16702 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxSampleLocationGridSize"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        type FieldType "maxSampleLocationGridSize"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = VkExtent2D
        type FieldOptional "maxSampleLocationGridSize"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxSampleLocationGridSize"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             =
             (20)
{-# LINE 16717 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxSampleLocationGridSize"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 16727 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxSampleLocationGridSize"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 16736 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 16740 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSampleLocationGridSize"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 16748 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sampleLocationCoordinateRange"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        type FieldType "sampleLocationCoordinateRange"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = Float
{-# LINE 16756 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldOptional "sampleLocationCoordinateRange"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sampleLocationCoordinateRange"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             =
             (28)
{-# LINE 16763 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sampleLocationCoordinateRange"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'True -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 16773 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "sampleLocationCoordinateRange" idx
            VkPhysicalDeviceSampleLocationsPropertiesEXT) =>
         CanReadFieldArray "sampleLocationCoordinateRange" idx
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "sampleLocationCoordinateRange" 0
                         VkPhysicalDeviceSampleLocationsPropertiesEXT
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "sampleLocationCoordinateRange" 1
                         VkPhysicalDeviceSampleLocationsPropertiesEXT
                       #-}
        type FieldArrayLength "sampleLocationCoordinateRange"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 2

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength = 2

        {-# INLINE getFieldArray #-}
        getFieldArray = f
          where {-# NOINLINE f #-}
                f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off)
                off
                  = (28)
{-# LINE 16803 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      +
                      sizeOf (undefined :: Float) *
{-# LINE 16805 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                        fromInteger (natVal' (proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray p
          = peekByteOff p
              ((28)
{-# LINE 16811 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Float) *
{-# LINE 16813 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx,
          IndexInBounds "sampleLocationCoordinateRange" idx
            VkPhysicalDeviceSampleLocationsPropertiesEXT) =>
         CanWriteFieldArray "sampleLocationCoordinateRange" idx
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "sampleLocationCoordinateRange" 0
                         VkPhysicalDeviceSampleLocationsPropertiesEXT
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "sampleLocationCoordinateRange" 1
                         VkPhysicalDeviceSampleLocationsPropertiesEXT
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray p
          = pokeByteOff p
              ((28)
{-# LINE 16836 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 +
                 sizeOf (undefined :: Float) *
{-# LINE 16838 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   fromInteger (natVal' (proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sampleLocationSubPixelBits"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        type FieldType "sampleLocationSubPixelBits"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = Word32
        type FieldOptional "sampleLocationSubPixelBits"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sampleLocationSubPixelBits"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             =
             (36)
{-# LINE 16854 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sampleLocationSubPixelBits"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (36)
{-# LINE 16864 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampleLocationSubPixelBits"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (36))
{-# LINE 16873 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (36)
{-# LINE 16877 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampleLocationSubPixelBits"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (36)
{-# LINE 16885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "variableSampleLocations"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        type FieldType "variableSampleLocations"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = VkBool32
        type FieldOptional "variableSampleLocations"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "variableSampleLocations"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             =
             (40)
{-# LINE 16900 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "variableSampleLocations"
               VkPhysicalDeviceSampleLocationsPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (40)
{-# LINE 16910 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "variableSampleLocations"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (40))
{-# LINE 16919 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (40)
{-# LINE 16923 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "variableSampleLocations"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (40)
{-# LINE 16931 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSampleLocationsPropertiesEXT where
        showsPrec d x
          = showString "VkPhysicalDeviceSampleLocationsPropertiesEXT {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "sampleLocationSampleCounts = " .
                            showsPrec d (getField @"sampleLocationSampleCounts" x) .
                              showString ", " .
                                showString "maxSampleLocationGridSize = " .
                                  showsPrec d (getField @"maxSampleLocationGridSize" x) .
                                    showString ", " .
                                      (showString "sampleLocationCoordinateRange = [" .
                                         showsPrec d
                                           (let s = sizeOf
                                                      (undefined ::
                                                         FieldType "sampleLocationCoordinateRange"
                                                           VkPhysicalDeviceSampleLocationsPropertiesEXT)
                                                o = fieldOffset @"sampleLocationCoordinateRange"
                                                      @VkPhysicalDeviceSampleLocationsPropertiesEXT
                                                f i
                                                  = peekByteOff (unsafePtr x) i ::
                                                      IO
                                                        (FieldType "sampleLocationCoordinateRange"
                                                           VkPhysicalDeviceSampleLocationsPropertiesEXT)
                                              in
                                              unsafeDupablePerformIO . mapM f $
                                                map (\ i -> o + i * s) [0 .. 2 - 1])
                                           . showChar ']')
                                        .
                                        showString ", " .
                                          showString "sampleLocationSubPixelBits = " .
                                            showsPrec d (getField @"sampleLocationSubPixelBits" x) .
                                              showString ", " .
                                                showString "variableSampleLocations = " .
                                                  showsPrec d
                                                    (getField @"variableSampleLocations" x)
                                                    . showChar '}'

-- | > typedef struct VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT {
--   >     VkStructureType sType;
--   >     void*                  pNext;
--   >     VkBool32               filterMinmaxSingleComponentFormats;
--   >     VkBool32               filterMinmaxImageComponentMapping;
--   > } VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT registry at www.khronos.org>
data VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# Addr#
                                                                                                          ByteArray#

instance Eq VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where
        (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# a _) ==
          x@(VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where
        (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# a _) `compare`
          x@(VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        sizeOf ~_
          = (24)
{-# LINE 17003 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 17007 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        unsafeAddr (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# a _)
          = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        type StructFields VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             =
             '["sType", "pNext", "filterMinmaxSingleComponentFormats", -- ' closing tick for hsc2hs
               "filterMinmaxImageComponentMapping"]
        type CUnionType VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        type FieldType "sType"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             =
             (0)
{-# LINE 17061 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 17071 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 17080 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 17084 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 17092 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        type FieldType "pNext"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             =
             (8)
{-# LINE 17106 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 17116 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 17125 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 17129 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 17137 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "filterMinmaxSingleComponentFormats"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        type FieldType "filterMinmaxSingleComponentFormats"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = VkBool32
        type FieldOptional "filterMinmaxSingleComponentFormats"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "filterMinmaxSingleComponentFormats"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             =
             (16)
{-# LINE 17152 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "filterMinmaxSingleComponentFormats"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 17162 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "filterMinmaxSingleComponentFormats"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 17171 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 17175 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "filterMinmaxSingleComponentFormats"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 17183 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "filterMinmaxImageComponentMapping"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        type FieldType "filterMinmaxImageComponentMapping"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = VkBool32
        type FieldOptional "filterMinmaxImageComponentMapping"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "filterMinmaxImageComponentMapping"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             =
             (20)
{-# LINE 17198 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "filterMinmaxImageComponentMapping"
               VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 17208 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "filterMinmaxImageComponentMapping"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 17217 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 17221 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "filterMinmaxImageComponentMapping"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 17229 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        showsPrec d x
          = showString "VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "filterMinmaxSingleComponentFormats = " .
                            showsPrec d (getField @"filterMinmaxSingleComponentFormats" x) .
                              showString ", " .
                                showString "filterMinmaxImageComponentMapping = " .
                                  showsPrec d (getField @"filterMinmaxImageComponentMapping" x) .
                                    showChar '}'

-- | > typedef struct VkPhysicalDeviceSamplerYcbcrConversionFeatures {
--   >     VkStructureType sType;
--   >     void*      pNext;
--   >     VkBool32                         samplerYcbcrConversion;
--   > } VkPhysicalDeviceSamplerYcbcrConversionFeatures;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceSamplerYcbcrConversionFeatures VkPhysicalDeviceSamplerYcbcrConversionFeatures registry at www.khronos.org>
data VkPhysicalDeviceSamplerYcbcrConversionFeatures = VkPhysicalDeviceSamplerYcbcrConversionFeatures# Addr#
                                                                                                      ByteArray#

instance Eq VkPhysicalDeviceSamplerYcbcrConversionFeatures where
        (VkPhysicalDeviceSamplerYcbcrConversionFeatures# a _) ==
          x@(VkPhysicalDeviceSamplerYcbcrConversionFeatures# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSamplerYcbcrConversionFeatures where
        (VkPhysicalDeviceSamplerYcbcrConversionFeatures# a _) `compare`
          x@(VkPhysicalDeviceSamplerYcbcrConversionFeatures# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        sizeOf ~_
          = (24)
{-# LINE 17275 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 17279 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        unsafeAddr (VkPhysicalDeviceSamplerYcbcrConversionFeatures# a _)
          = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceSamplerYcbcrConversionFeatures# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceSamplerYcbcrConversionFeatures#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        type StructFields VkPhysicalDeviceSamplerYcbcrConversionFeatures =
             '["sType", "pNext", "samplerYcbcrConversion"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceSamplerYcbcrConversionFeatures =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceSamplerYcbcrConversionFeatures =
             'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceSamplerYcbcrConversionFeatures =
             '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        type FieldType "sType"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             =
             (0)
{-# LINE 17331 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 17341 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 17349 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 17353 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 17361 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        type FieldType "pNext"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             =
             (8)
{-# LINE 17375 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 17385 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 17393 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 17397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 17405 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "samplerYcbcrConversion"
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        type FieldType "samplerYcbcrConversion"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             = VkBool32
        type FieldOptional "samplerYcbcrConversion"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "samplerYcbcrConversion"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             =
             (16)
{-# LINE 17420 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "samplerYcbcrConversion"
               VkPhysicalDeviceSamplerYcbcrConversionFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 17430 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "samplerYcbcrConversion"
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 17439 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 17443 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "samplerYcbcrConversion"
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 17451 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSamplerYcbcrConversionFeatures where
        showsPrec d x
          = showString "VkPhysicalDeviceSamplerYcbcrConversionFeatures {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "samplerYcbcrConversion = " .
                            showsPrec d (getField @"samplerYcbcrConversion" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceSamplerYcbcrConversionFeatures`
type VkPhysicalDeviceSamplerYcbcrConversionFeaturesKHR =
     VkPhysicalDeviceSamplerYcbcrConversionFeatures

-- | > typedef struct VkPhysicalDeviceShaderCorePropertiesAMD {
--   >     VkStructureType sType;
--   >     void*    pNext;
--   >     uint32_t shaderEngineCount;
--   >     uint32_t shaderArraysPerEngineCount;
--   >     uint32_t computeUnitsPerShaderArray;
--   >     uint32_t simdPerComputeUnit;
--   >     uint32_t wavefrontsPerSimd;
--   >     uint32_t wavefrontSize;
--   >     uint32_t sgprsPerSimd;
--   >     uint32_t minSgprAllocation;
--   >     uint32_t maxSgprAllocation;
--   >     uint32_t sgprAllocationGranularity;
--   >     uint32_t vgprsPerSimd;
--   >     uint32_t minVgprAllocation;
--   >     uint32_t maxVgprAllocation;
--   >     uint32_t vgprAllocationGranularity;
--   > } VkPhysicalDeviceShaderCorePropertiesAMD;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceShaderCorePropertiesAMD VkPhysicalDeviceShaderCorePropertiesAMD registry at www.khronos.org>
data VkPhysicalDeviceShaderCorePropertiesAMD = VkPhysicalDeviceShaderCorePropertiesAMD# Addr#
                                                                                        ByteArray#

instance Eq VkPhysicalDeviceShaderCorePropertiesAMD where
        (VkPhysicalDeviceShaderCorePropertiesAMD# a _) ==
          x@(VkPhysicalDeviceShaderCorePropertiesAMD# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceShaderCorePropertiesAMD where
        (VkPhysicalDeviceShaderCorePropertiesAMD# a _) `compare`
          x@(VkPhysicalDeviceShaderCorePropertiesAMD# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceShaderCorePropertiesAMD where
        sizeOf ~_
          = (72)
{-# LINE 17508 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 17512 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceShaderCorePropertiesAMD
         where
        unsafeAddr (VkPhysicalDeviceShaderCorePropertiesAMD# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceShaderCorePropertiesAMD# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceShaderCorePropertiesAMD#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type StructFields VkPhysicalDeviceShaderCorePropertiesAMD =
             '["sType", "pNext", "shaderEngineCount", -- ' closing tick for hsc2hs
               "shaderArraysPerEngineCount", "computeUnitsPerShaderArray",
               "simdPerComputeUnit", "wavefrontsPerSimd", "wavefrontSize",
               "sgprsPerSimd", "minSgprAllocation", "maxSgprAllocation",
               "sgprAllocationGranularity", "vgprsPerSimd", "minVgprAllocation",
               "maxVgprAllocation", "vgprAllocationGranularity"]
        type CUnionType VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceShaderCorePropertiesAMD = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceShaderCorePropertiesAMD =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceShaderCorePropertiesAMD where
        type FieldType "sType" VkPhysicalDeviceShaderCorePropertiesAMD =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceShaderCorePropertiesAMD =
             (0)
{-# LINE 17558 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceShaderCorePropertiesAMD =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 17567 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceShaderCorePropertiesAMD where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 17574 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 17578 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceShaderCorePropertiesAMD where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 17584 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceShaderCorePropertiesAMD where
        type FieldType "pNext" VkPhysicalDeviceShaderCorePropertiesAMD =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceShaderCorePropertiesAMD =
             (8)
{-# LINE 17593 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceShaderCorePropertiesAMD =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 17602 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceShaderCorePropertiesAMD where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 17609 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 17613 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceShaderCorePropertiesAMD where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 17619 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "shaderEngineCount"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "shaderEngineCount"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderEngineCount"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (16)
{-# LINE 17634 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderEngineCount"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 17644 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 17653 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 17657 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 17665 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderArraysPerEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "shaderArraysPerEngineCount"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "shaderArraysPerEngineCount"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderArraysPerEngineCount"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (20)
{-# LINE 17680 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderArraysPerEngineCount"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 17690 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderArraysPerEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 17699 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 17703 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderArraysPerEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 17711 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "computeUnitsPerShaderArray"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "computeUnitsPerShaderArray"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "computeUnitsPerShaderArray"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "computeUnitsPerShaderArray"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (24)
{-# LINE 17726 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "computeUnitsPerShaderArray"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 17736 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "computeUnitsPerShaderArray"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 17745 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 17749 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "computeUnitsPerShaderArray"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 17757 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "simdPerComputeUnit"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "simdPerComputeUnit"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "simdPerComputeUnit"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "simdPerComputeUnit"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (28)
{-# LINE 17772 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "simdPerComputeUnit"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 17782 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "simdPerComputeUnit"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 17791 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 17795 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "simdPerComputeUnit"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 17803 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "wavefrontsPerSimd"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "wavefrontsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "wavefrontsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "wavefrontsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (32)
{-# LINE 17818 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "wavefrontsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (32)
{-# LINE 17828 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "wavefrontsPerSimd"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 17837 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (32)
{-# LINE 17841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "wavefrontsPerSimd"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 17849 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "wavefrontSize"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "wavefrontSize"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "wavefrontSize"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (36)
{-# LINE 17863 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "wavefrontSize"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (36)
{-# LINE 17873 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "wavefrontSize"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (36))
{-# LINE 17882 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (36)
{-# LINE 17886 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "wavefrontSize"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (36)
{-# LINE 17894 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "sgprsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "sgprsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sgprsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (40)
{-# LINE 17908 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sgprsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (40)
{-# LINE 17918 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (40))
{-# LINE 17926 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (40)
{-# LINE 17930 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sgprsPerSimd"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (40)
{-# LINE 17938 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "minSgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "minSgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minSgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (44)
{-# LINE 17953 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minSgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (44)
{-# LINE 17963 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (44))
{-# LINE 17972 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (44)
{-# LINE 17976 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (44)
{-# LINE 17984 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "maxSgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "maxSgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxSgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (48)
{-# LINE 17999 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxSgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (48)
{-# LINE 18009 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (48))
{-# LINE 18018 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (48)
{-# LINE 18022 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (48)
{-# LINE 18030 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "sgprAllocationGranularity"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "sgprAllocationGranularity"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sgprAllocationGranularity"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (52)
{-# LINE 18045 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sgprAllocationGranularity"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (52)
{-# LINE 18055 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (52))
{-# LINE 18064 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (52)
{-# LINE 18068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (52)
{-# LINE 18076 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "vgprsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "vgprsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "vgprsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (56)
{-# LINE 18090 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "vgprsPerSimd"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (56)
{-# LINE 18100 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (56))
{-# LINE 18108 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (56)
{-# LINE 18112 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "vgprsPerSimd"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (56)
{-# LINE 18120 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "minVgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "minVgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minVgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (60)
{-# LINE 18135 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "minVgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (60)
{-# LINE 18145 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (60))
{-# LINE 18154 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (60)
{-# LINE 18158 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (60)
{-# LINE 18166 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "maxVgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "maxVgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxVgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (64)
{-# LINE 18181 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxVgprAllocation"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (64)
{-# LINE 18191 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (64))
{-# LINE 18200 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (64)
{-# LINE 18204 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (64)
{-# LINE 18212 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "vgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        type FieldType "vgprAllocationGranularity"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = Word32
        type FieldOptional "vgprAllocationGranularity"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "vgprAllocationGranularity"
               VkPhysicalDeviceShaderCorePropertiesAMD
             =
             (68)
{-# LINE 18227 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "vgprAllocationGranularity"
               VkPhysicalDeviceShaderCorePropertiesAMD
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (68)
{-# LINE 18237 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "vgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (68))
{-# LINE 18246 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (68)
{-# LINE 18250 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "vgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (68)
{-# LINE 18258 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceShaderCorePropertiesAMD where
        showsPrec d x
          = showString "VkPhysicalDeviceShaderCorePropertiesAMD {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "shaderEngineCount = " .
                            showsPrec d (getField @"shaderEngineCount" x) .
                              showString ", " .
                                showString "shaderArraysPerEngineCount = " .
                                  showsPrec d (getField @"shaderArraysPerEngineCount" x) .
                                    showString ", " .
                                      showString "computeUnitsPerShaderArray = " .
                                        showsPrec d (getField @"computeUnitsPerShaderArray" x) .
                                          showString ", " .
                                            showString "simdPerComputeUnit = " .
                                              showsPrec d (getField @"simdPerComputeUnit" x) .
                                                showString ", " .
                                                  showString "wavefrontsPerSimd = " .
                                                    showsPrec d (getField @"wavefrontsPerSimd" x) .
                                                      showString ", " .
                                                        showString "wavefrontSize = " .
                                                          showsPrec d (getField @"wavefrontSize" x)
                                                            .
                                                            showString ", " .
                                                              showString "sgprsPerSimd = " .
                                                                showsPrec d
                                                                  (getField @"sgprsPerSimd" x)
                                                                  .
                                                                  showString ", " .
                                                                    showString
                                                                      "minSgprAllocation = "
                                                                      .
                                                                      showsPrec d
                                                                        (getField
                                                                           @"minSgprAllocation"
                                                                           x)
                                                                        .
                                                                        showString ", " .
                                                                          showString
                                                                            "maxSgprAllocation = "
                                                                            .
                                                                            showsPrec d
                                                                              (getField
                                                                                 @"maxSgprAllocation"
                                                                                 x)
                                                                              .
                                                                              showString ", " .
                                                                                showString
                                                                                  "sgprAllocationGranularity = "
                                                                                  .
                                                                                  showsPrec d
                                                                                    (getField
                                                                                       @"sgprAllocationGranularity"
                                                                                       x)
                                                                                    .
                                                                                    showString ", "
                                                                                      .
                                                                                      showString
                                                                                        "vgprsPerSimd = "
                                                                                        .
                                                                                        showsPrec d
                                                                                          (getField
                                                                                             @"vgprsPerSimd"
                                                                                             x)
                                                                                          .
                                                                                          showString
                                                                                            ", "
                                                                                            .
                                                                                            showString
                                                                                              "minVgprAllocation = "
                                                                                              .
                                                                                              showsPrec
                                                                                                d
                                                                                                (getField
                                                                                                   @"minVgprAllocation"
                                                                                                   x)
                                                                                                .
                                                                                                showString
                                                                                                  ", "
                                                                                                  .
                                                                                                  showString
                                                                                                    "maxVgprAllocation = "
                                                                                                    .
                                                                                                    showsPrec
                                                                                                      d
                                                                                                      (getField
                                                                                                         @"maxVgprAllocation"
                                                                                                         x)
                                                                                                      .
                                                                                                      showString
                                                                                                        ", "
                                                                                                        .
                                                                                                        showString
                                                                                                          "vgprAllocationGranularity = "
                                                                                                          .
                                                                                                          showsPrec
                                                                                                            d
                                                                                                            (getField
                                                                                                               @"vgprAllocationGranularity"
                                                                                                               x)
                                                                                                            .
                                                                                                            showChar
                                                                                                              '}'

-- | > typedef struct VkPhysicalDeviceShaderDrawParameterFeatures {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkBool32                         shaderDrawParameters;
--   > } VkPhysicalDeviceShaderDrawParameterFeatures;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceShaderDrawParameterFeatures VkPhysicalDeviceShaderDrawParameterFeatures registry at www.khronos.org>
data VkPhysicalDeviceShaderDrawParameterFeatures = VkPhysicalDeviceShaderDrawParameterFeatures# Addr#
                                                                                                ByteArray#

instance Eq VkPhysicalDeviceShaderDrawParameterFeatures where
        (VkPhysicalDeviceShaderDrawParameterFeatures# a _) ==
          x@(VkPhysicalDeviceShaderDrawParameterFeatures# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceShaderDrawParameterFeatures where
        (VkPhysicalDeviceShaderDrawParameterFeatures# a _) `compare`
          x@(VkPhysicalDeviceShaderDrawParameterFeatures# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceShaderDrawParameterFeatures where
        sizeOf ~_
          = (24)
{-# LINE 18394 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 18398 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceShaderDrawParameterFeatures
         where
        unsafeAddr (VkPhysicalDeviceShaderDrawParameterFeatures# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceShaderDrawParameterFeatures# _ b)
          = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceShaderDrawParameterFeatures#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceShaderDrawParameterFeatures
         where
        type StructFields VkPhysicalDeviceShaderDrawParameterFeatures =
             '["sType", "pNext", "shaderDrawParameters"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceShaderDrawParameterFeatures =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceShaderDrawParameterFeatures =
             'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceShaderDrawParameterFeatures =
             '[VkPhysicalDeviceFeatures2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceShaderDrawParameterFeatures where
        type FieldType "sType" VkPhysicalDeviceShaderDrawParameterFeatures
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceShaderDrawParameterFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceShaderDrawParameterFeatures
             =
             (0)
{-# LINE 18446 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceShaderDrawParameterFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 18456 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 18464 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 18468 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 18475 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceShaderDrawParameterFeatures where
        type FieldType "pNext" VkPhysicalDeviceShaderDrawParameterFeatures
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceShaderDrawParameterFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceShaderDrawParameterFeatures
             =
             (8)
{-# LINE 18487 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceShaderDrawParameterFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 18497 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 18505 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 18509 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 18516 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderDrawParameters"
           VkPhysicalDeviceShaderDrawParameterFeatures
         where
        type FieldType "shaderDrawParameters"
               VkPhysicalDeviceShaderDrawParameterFeatures
             = VkBool32
        type FieldOptional "shaderDrawParameters"
               VkPhysicalDeviceShaderDrawParameterFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderDrawParameters"
               VkPhysicalDeviceShaderDrawParameterFeatures
             =
             (16)
{-# LINE 18531 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "shaderDrawParameters"
               VkPhysicalDeviceShaderDrawParameterFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 18541 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "shaderDrawParameters"
           VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 18550 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 18554 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderDrawParameters"
           VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 18562 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceShaderDrawParameterFeatures where
        showsPrec d x
          = showString "VkPhysicalDeviceShaderDrawParameterFeatures {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "shaderDrawParameters = " .
                            showsPrec d (getField @"shaderDrawParameters" x) . showChar '}'

-- | > typedef struct VkPhysicalDeviceSparseImageFormatInfo2 {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkFormat                         format;
--   >     VkImageType                      type;
--   >     VkSampleCountFlagBits            samples;
--   >     VkImageUsageFlags                usage;
--   >     VkImageTiling                    tiling;
--   > } VkPhysicalDeviceSparseImageFormatInfo2;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceSparseImageFormatInfo2 VkPhysicalDeviceSparseImageFormatInfo2 registry at www.khronos.org>
data VkPhysicalDeviceSparseImageFormatInfo2 = VkPhysicalDeviceSparseImageFormatInfo2# Addr#
                                                                                      ByteArray#

instance Eq VkPhysicalDeviceSparseImageFormatInfo2 where
        (VkPhysicalDeviceSparseImageFormatInfo2# a _) ==
          x@(VkPhysicalDeviceSparseImageFormatInfo2# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSparseImageFormatInfo2 where
        (VkPhysicalDeviceSparseImageFormatInfo2# a _) `compare`
          x@(VkPhysicalDeviceSparseImageFormatInfo2# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSparseImageFormatInfo2 where
        sizeOf ~_
          = (40)
{-# LINE 18606 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 18610 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceSparseImageFormatInfo2
         where
        unsafeAddr (VkPhysicalDeviceSparseImageFormatInfo2# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceSparseImageFormatInfo2# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceSparseImageFormatInfo2#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceSparseImageFormatInfo2 where
        type StructFields VkPhysicalDeviceSparseImageFormatInfo2 =
             '["sType", "pNext", "format", "type", "samples", "usage", "tiling"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceSparseImageFormatInfo2 = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceSparseImageFormatInfo2 where
        type FieldType "sType" VkPhysicalDeviceSparseImageFormatInfo2 =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceSparseImageFormatInfo2 =
             (0)
{-# LINE 18649 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 18658 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 18665 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 18669 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 18675 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceSparseImageFormatInfo2 where
        type FieldType "pNext" VkPhysicalDeviceSparseImageFormatInfo2 =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceSparseImageFormatInfo2 =
             (8)
{-# LINE 18684 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 18693 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 18700 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 18704 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 18710 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "format" VkPhysicalDeviceSparseImageFormatInfo2 where
        type FieldType "format" VkPhysicalDeviceSparseImageFormatInfo2 =
             VkFormat
        type FieldOptional "format" VkPhysicalDeviceSparseImageFormatInfo2
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "format" VkPhysicalDeviceSparseImageFormatInfo2 =
             (16)
{-# LINE 18719 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "format" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 18728 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "format" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 18735 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 18739 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "format" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 18745 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "type" VkPhysicalDeviceSparseImageFormatInfo2 where
        type FieldType "type" VkPhysicalDeviceSparseImageFormatInfo2 =
             VkImageType
        type FieldOptional "type" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "type" VkPhysicalDeviceSparseImageFormatInfo2 =
             (20)
{-# LINE 18754 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "type" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 18763 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "type" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 18770 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 18774 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "type" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 18780 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "samples" VkPhysicalDeviceSparseImageFormatInfo2 where
        type FieldType "samples" VkPhysicalDeviceSparseImageFormatInfo2 =
             VkSampleCountFlagBits
        type FieldOptional "samples" VkPhysicalDeviceSparseImageFormatInfo2
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "samples" VkPhysicalDeviceSparseImageFormatInfo2 =
             (24)
{-# LINE 18789 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "samples" VkPhysicalDeviceSparseImageFormatInfo2
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 18798 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "samples" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 18805 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 18809 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "samples" VkPhysicalDeviceSparseImageFormatInfo2
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 18816 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "usage" VkPhysicalDeviceSparseImageFormatInfo2 where
        type FieldType "usage" VkPhysicalDeviceSparseImageFormatInfo2 =
             VkImageUsageFlags
        type FieldOptional "usage" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "usage" VkPhysicalDeviceSparseImageFormatInfo2 =
             (28)
{-# LINE 18825 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "usage" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 18834 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "usage" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 18841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 18845 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "usage" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 18851 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "tiling" VkPhysicalDeviceSparseImageFormatInfo2 where
        type FieldType "tiling" VkPhysicalDeviceSparseImageFormatInfo2 =
             VkImageTiling
        type FieldOptional "tiling" VkPhysicalDeviceSparseImageFormatInfo2
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "tiling" VkPhysicalDeviceSparseImageFormatInfo2 =
             (32)
{-# LINE 18860 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "tiling" VkPhysicalDeviceSparseImageFormatInfo2 =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (32)
{-# LINE 18869 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "tiling" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 18876 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (32)
{-# LINE 18880 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tiling" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 18886 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSparseImageFormatInfo2 where
        showsPrec d x
          = showString "VkPhysicalDeviceSparseImageFormatInfo2 {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "format = " .
                            showsPrec d (getField @"format" x) .
                              showString ", " .
                                showString "type = " .
                                  showsPrec d (getField @"type" x) .
                                    showString ", " .
                                      showString "samples = " .
                                        showsPrec d (getField @"samples" x) .
                                          showString ", " .
                                            showString "usage = " .
                                              showsPrec d (getField @"usage" x) .
                                                showString ", " .
                                                  showString "tiling = " .
                                                    showsPrec d (getField @"tiling" x) .
                                                      showChar '}'

-- | Alias for `VkPhysicalDeviceSparseImageFormatInfo2`
type VkPhysicalDeviceSparseImageFormatInfo2KHR =
     VkPhysicalDeviceSparseImageFormatInfo2

-- | > typedef struct VkPhysicalDeviceSparseProperties {
--   >     VkBool32               residencyStandard2DBlockShape;
--   >     VkBool32               residencyStandard2DMultisampleBlockShape;
--   >     VkBool32               residencyStandard3DBlockShape;
--   >     VkBool32               residencyAlignedMipSize;
--   >     VkBool32               residencyNonResidentStrict;
--   > } VkPhysicalDeviceSparseProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceSparseProperties VkPhysicalDeviceSparseProperties registry at www.khronos.org>
data VkPhysicalDeviceSparseProperties = VkPhysicalDeviceSparseProperties# Addr#
                                                                          ByteArray#

instance Eq VkPhysicalDeviceSparseProperties where
        (VkPhysicalDeviceSparseProperties# a _) ==
          x@(VkPhysicalDeviceSparseProperties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSparseProperties where
        (VkPhysicalDeviceSparseProperties# a _) `compare`
          x@(VkPhysicalDeviceSparseProperties# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSparseProperties where
        sizeOf ~_ = (20)
{-# LINE 18944 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (4)
{-# LINE 18948 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceSparseProperties where
        unsafeAddr (VkPhysicalDeviceSparseProperties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceSparseProperties# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceSparseProperties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceSparseProperties where
        type StructFields VkPhysicalDeviceSparseProperties =
             '["residencyStandard2DBlockShape", -- ' closing tick for hsc2hs
               "residencyStandard2DMultisampleBlockShape",
               "residencyStandard3DBlockShape", "residencyAlignedMipSize",
               "residencyNonResidentStrict"]
        type CUnionType VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceSparseProperties = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceSparseProperties = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "residencyStandard2DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        type FieldType "residencyStandard2DBlockShape"
               VkPhysicalDeviceSparseProperties
             = VkBool32
        type FieldOptional "residencyStandard2DBlockShape"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "residencyStandard2DBlockShape"
               VkPhysicalDeviceSparseProperties
             =
             (0)
{-# LINE 18995 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "residencyStandard2DBlockShape"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 19005 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "residencyStandard2DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 19014 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 19018 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyStandard2DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 19026 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "residencyStandard2DMultisampleBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        type FieldType "residencyStandard2DMultisampleBlockShape"
               VkPhysicalDeviceSparseProperties
             = VkBool32
        type FieldOptional "residencyStandard2DMultisampleBlockShape"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "residencyStandard2DMultisampleBlockShape"
               VkPhysicalDeviceSparseProperties
             =
             (4)
{-# LINE 19041 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "residencyStandard2DMultisampleBlockShape"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (4)
{-# LINE 19051 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "residencyStandard2DMultisampleBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (4))
{-# LINE 19060 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (4)
{-# LINE 19064 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyStandard2DMultisampleBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (4)
{-# LINE 19072 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "residencyStandard3DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        type FieldType "residencyStandard3DBlockShape"
               VkPhysicalDeviceSparseProperties
             = VkBool32
        type FieldOptional "residencyStandard3DBlockShape"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "residencyStandard3DBlockShape"
               VkPhysicalDeviceSparseProperties
             =
             (8)
{-# LINE 19087 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "residencyStandard3DBlockShape"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 19097 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "residencyStandard3DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 19106 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 19110 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyStandard3DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 19118 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties
         where
        type FieldType "residencyAlignedMipSize"
               VkPhysicalDeviceSparseProperties
             = VkBool32
        type FieldOptional "residencyAlignedMipSize"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "residencyAlignedMipSize"
               VkPhysicalDeviceSparseProperties
             =
             (12)
{-# LINE 19132 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "residencyAlignedMipSize"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (12)
{-# LINE 19142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "residencyAlignedMipSize"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (12))
{-# LINE 19151 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (12)
{-# LINE 19155 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyAlignedMipSize"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (12)
{-# LINE 19163 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "residencyNonResidentStrict"
           VkPhysicalDeviceSparseProperties
         where
        type FieldType "residencyNonResidentStrict"
               VkPhysicalDeviceSparseProperties
             = VkBool32
        type FieldOptional "residencyNonResidentStrict"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "residencyNonResidentStrict"
               VkPhysicalDeviceSparseProperties
             =
             (16)
{-# LINE 19178 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "residencyNonResidentStrict"
               VkPhysicalDeviceSparseProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 19188 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "residencyNonResidentStrict"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 19197 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 19201 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyNonResidentStrict"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 19209 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSparseProperties where
        showsPrec d x
          = showString "VkPhysicalDeviceSparseProperties {" .
              showString "residencyStandard2DBlockShape = " .
                showsPrec d (getField @"residencyStandard2DBlockShape" x) .
                  showString ", " .
                    showString "residencyStandard2DMultisampleBlockShape = " .
                      showsPrec d
                        (getField @"residencyStandard2DMultisampleBlockShape" x)
                        .
                        showString ", " .
                          showString "residencyStandard3DBlockShape = " .
                            showsPrec d (getField @"residencyStandard3DBlockShape" x) .
                              showString ", " .
                                showString "residencyAlignedMipSize = " .
                                  showsPrec d (getField @"residencyAlignedMipSize" x) .
                                    showString ", " .
                                      showString "residencyNonResidentStrict = " .
                                        showsPrec d (getField @"residencyNonResidentStrict" x) .
                                          showChar '}'

-- | > typedef struct VkPhysicalDeviceSubgroupProperties {
--   >     VkStructureType sType;
--   >     void*                   pNext;
--   >     uint32_t                      subgroupSize;
--   >     VkShaderStageFlags            supportedStages;
--   >     VkSubgroupFeatureFlags        supportedOperations;
--   >     VkBool32 quadOperationsInAllStages;
--   > } VkPhysicalDeviceSubgroupProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceSubgroupProperties VkPhysicalDeviceSubgroupProperties registry at www.khronos.org>
data VkPhysicalDeviceSubgroupProperties = VkPhysicalDeviceSubgroupProperties# Addr#
                                                                              ByteArray#

instance Eq VkPhysicalDeviceSubgroupProperties where
        (VkPhysicalDeviceSubgroupProperties# a _) ==
          x@(VkPhysicalDeviceSubgroupProperties# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSubgroupProperties where
        (VkPhysicalDeviceSubgroupProperties# a _) `compare`
          x@(VkPhysicalDeviceSubgroupProperties# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSubgroupProperties where
        sizeOf ~_ = (32)
{-# LINE 19260 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 19264 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceSubgroupProperties where
        unsafeAddr (VkPhysicalDeviceSubgroupProperties# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceSubgroupProperties# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceSubgroupProperties#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceSubgroupProperties where
        type StructFields VkPhysicalDeviceSubgroupProperties =
             '["sType", "pNext", "subgroupSize", "supportedStages", -- ' closing tick for hsc2hs
               "supportedOperations", "quadOperationsInAllStages"]
        type CUnionType VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceSubgroupProperties = 'True -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceSubgroupProperties =
             '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceSubgroupProperties where
        type FieldType "sType" VkPhysicalDeviceSubgroupProperties =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceSubgroupProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceSubgroupProperties =
             (0)
{-# LINE 19304 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceSubgroupProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 19313 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSubgroupProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 19320 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 19324 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceSubgroupProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 19330 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceSubgroupProperties where
        type FieldType "pNext" VkPhysicalDeviceSubgroupProperties =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceSubgroupProperties =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceSubgroupProperties =
             (8)
{-# LINE 19339 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceSubgroupProperties =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 19348 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSubgroupProperties where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 19355 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 19359 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceSubgroupProperties where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 19365 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "subgroupSize" VkPhysicalDeviceSubgroupProperties where
        type FieldType "subgroupSize" VkPhysicalDeviceSubgroupProperties =
             Word32
        type FieldOptional "subgroupSize"
               VkPhysicalDeviceSubgroupProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "subgroupSize" VkPhysicalDeviceSubgroupProperties
             =
             (16)
{-# LINE 19376 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "subgroupSize" VkPhysicalDeviceSubgroupProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 19385 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "subgroupSize" VkPhysicalDeviceSubgroupProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 19393 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 19397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subgroupSize" VkPhysicalDeviceSubgroupProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 19404 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "supportedStages" VkPhysicalDeviceSubgroupProperties where
        type FieldType "supportedStages" VkPhysicalDeviceSubgroupProperties
             = VkShaderStageFlags
        type FieldOptional "supportedStages"
               VkPhysicalDeviceSubgroupProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "supportedStages"
               VkPhysicalDeviceSubgroupProperties
             =
             (20)
{-# LINE 19416 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "supportedStages"
               VkPhysicalDeviceSubgroupProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 19426 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "supportedStages" VkPhysicalDeviceSubgroupProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 19434 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 19438 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "supportedStages" VkPhysicalDeviceSubgroupProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 19445 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "supportedOperations" VkPhysicalDeviceSubgroupProperties
         where
        type FieldType "supportedOperations"
               VkPhysicalDeviceSubgroupProperties
             = VkSubgroupFeatureFlags
        type FieldOptional "supportedOperations"
               VkPhysicalDeviceSubgroupProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "supportedOperations"
               VkPhysicalDeviceSubgroupProperties
             =
             (24)
{-# LINE 19459 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "supportedOperations"
               VkPhysicalDeviceSubgroupProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (24)
{-# LINE 19469 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "supportedOperations"
           VkPhysicalDeviceSubgroupProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 19478 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (24)
{-# LINE 19482 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "supportedOperations"
           VkPhysicalDeviceSubgroupProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 19490 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "quadOperationsInAllStages"
           VkPhysicalDeviceSubgroupProperties
         where
        type FieldType "quadOperationsInAllStages"
               VkPhysicalDeviceSubgroupProperties
             = VkBool32
        type FieldOptional "quadOperationsInAllStages"
               VkPhysicalDeviceSubgroupProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "quadOperationsInAllStages"
               VkPhysicalDeviceSubgroupProperties
             =
             (28)
{-# LINE 19505 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "quadOperationsInAllStages"
               VkPhysicalDeviceSubgroupProperties
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (28)
{-# LINE 19515 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "quadOperationsInAllStages"
           VkPhysicalDeviceSubgroupProperties
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (28))
{-# LINE 19524 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (28)
{-# LINE 19528 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "quadOperationsInAllStages"
           VkPhysicalDeviceSubgroupProperties
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (28)
{-# LINE 19536 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSubgroupProperties where
        showsPrec d x
          = showString "VkPhysicalDeviceSubgroupProperties {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "subgroupSize = " .
                            showsPrec d (getField @"subgroupSize" x) .
                              showString ", " .
                                showString "supportedStages = " .
                                  showsPrec d (getField @"supportedStages" x) .
                                    showString ", " .
                                      showString "supportedOperations = " .
                                        showsPrec d (getField @"supportedOperations" x) .
                                          showString ", " .
                                            showString "quadOperationsInAllStages = " .
                                              showsPrec d (getField @"quadOperationsInAllStages" x)
                                                . showChar '}'

-- | > typedef struct VkPhysicalDeviceSurfaceInfo2KHR {
--   >     VkStructureType sType;
--   >     const void* pNext;
--   >     VkSurfaceKHR surface;
--   > } VkPhysicalDeviceSurfaceInfo2KHR;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceSurfaceInfo2KHR VkPhysicalDeviceSurfaceInfo2KHR registry at www.khronos.org>
data VkPhysicalDeviceSurfaceInfo2KHR = VkPhysicalDeviceSurfaceInfo2KHR# Addr#
                                                                        ByteArray#

instance Eq VkPhysicalDeviceSurfaceInfo2KHR where
        (VkPhysicalDeviceSurfaceInfo2KHR# a _) ==
          x@(VkPhysicalDeviceSurfaceInfo2KHR# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSurfaceInfo2KHR where
        (VkPhysicalDeviceSurfaceInfo2KHR# a _) `compare`
          x@(VkPhysicalDeviceSurfaceInfo2KHR# b _) = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSurfaceInfo2KHR where
        sizeOf ~_ = (24)
{-# LINE 19584 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 19588 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceSurfaceInfo2KHR where
        unsafeAddr (VkPhysicalDeviceSurfaceInfo2KHR# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceSurfaceInfo2KHR# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceSurfaceInfo2KHR#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceSurfaceInfo2KHR where
        type StructFields VkPhysicalDeviceSurfaceInfo2KHR =
             '["sType", "pNext", "surface"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceSurfaceInfo2KHR = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceSurfaceInfo2KHR where
        type FieldType "sType" VkPhysicalDeviceSurfaceInfo2KHR =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceSurfaceInfo2KHR =
             (0)
{-# LINE 19625 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 19633 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 19640 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 19644 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 19650 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceSurfaceInfo2KHR where
        type FieldType "pNext" VkPhysicalDeviceSurfaceInfo2KHR = Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceSurfaceInfo2KHR =
             (8)
{-# LINE 19657 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 19665 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 19672 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 19676 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 19682 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "surface" VkPhysicalDeviceSurfaceInfo2KHR where
        type FieldType "surface" VkPhysicalDeviceSurfaceInfo2KHR =
             VkSurfaceKHR
        type FieldOptional "surface" VkPhysicalDeviceSurfaceInfo2KHR =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "surface" VkPhysicalDeviceSurfaceInfo2KHR =
             (16)
{-# LINE 19691 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "surface" VkPhysicalDeviceSurfaceInfo2KHR =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 19700 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "surface" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 19707 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 19711 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "surface" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 19717 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSurfaceInfo2KHR where
        showsPrec d x
          = showString "VkPhysicalDeviceSurfaceInfo2KHR {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "surface = " .
                            showsPrec d (getField @"surface" x) . showChar '}'

-- | > typedef struct VkPhysicalDeviceVariablePointerFeatures {
--   >     VkStructureType sType;
--   >     void*                            pNext;
--   >     VkBool32                         variablePointersStorageBuffer;
--   >     VkBool32                         variablePointers;
--   > } VkPhysicalDeviceVariablePointerFeatures;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceVariablePointerFeatures VkPhysicalDeviceVariablePointerFeatures registry at www.khronos.org>
data VkPhysicalDeviceVariablePointerFeatures = VkPhysicalDeviceVariablePointerFeatures# Addr#
                                                                                        ByteArray#

instance Eq VkPhysicalDeviceVariablePointerFeatures where
        (VkPhysicalDeviceVariablePointerFeatures# a _) ==
          x@(VkPhysicalDeviceVariablePointerFeatures# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceVariablePointerFeatures where
        (VkPhysicalDeviceVariablePointerFeatures# a _) `compare`
          x@(VkPhysicalDeviceVariablePointerFeatures# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceVariablePointerFeatures where
        sizeOf ~_
          = (24)
{-# LINE 19758 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 19762 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceVariablePointerFeatures
         where
        unsafeAddr (VkPhysicalDeviceVariablePointerFeatures# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray (VkPhysicalDeviceVariablePointerFeatures# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceVariablePointerFeatures#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceVariablePointerFeatures
         where
        type StructFields VkPhysicalDeviceVariablePointerFeatures =
             '["sType", "pNext", "variablePointersStorageBuffer", -- ' closing tick for hsc2hs
               "variablePointers"]
        type CUnionType VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceVariablePointerFeatures =
             '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkPhysicalDeviceVariablePointerFeatures where
        type FieldType "sType" VkPhysicalDeviceVariablePointerFeatures =
             VkStructureType
        type FieldOptional "sType" VkPhysicalDeviceVariablePointerFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkPhysicalDeviceVariablePointerFeatures =
             (0)
{-# LINE 19804 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType" VkPhysicalDeviceVariablePointerFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 19813 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceVariablePointerFeatures where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 19820 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 19824 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceVariablePointerFeatures where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 19830 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkPhysicalDeviceVariablePointerFeatures where
        type FieldType "pNext" VkPhysicalDeviceVariablePointerFeatures =
             Ptr Void
        type FieldOptional "pNext" VkPhysicalDeviceVariablePointerFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkPhysicalDeviceVariablePointerFeatures =
             (8)
{-# LINE 19839 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext" VkPhysicalDeviceVariablePointerFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 19848 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceVariablePointerFeatures where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 19855 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 19859 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceVariablePointerFeatures where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 19865 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "variablePointersStorageBuffer"
           VkPhysicalDeviceVariablePointerFeatures
         where
        type FieldType "variablePointersStorageBuffer"
               VkPhysicalDeviceVariablePointerFeatures
             = VkBool32
        type FieldOptional "variablePointersStorageBuffer"
               VkPhysicalDeviceVariablePointerFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "variablePointersStorageBuffer"
               VkPhysicalDeviceVariablePointerFeatures
             =
             (16)
{-# LINE 19880 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "variablePointersStorageBuffer"
               VkPhysicalDeviceVariablePointerFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 19890 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "variablePointersStorageBuffer"
           VkPhysicalDeviceVariablePointerFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 19899 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 19903 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "variablePointersStorageBuffer"
           VkPhysicalDeviceVariablePointerFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 19911 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "variablePointers" VkPhysicalDeviceVariablePointerFeatures
         where
        type FieldType "variablePointers"
               VkPhysicalDeviceVariablePointerFeatures
             = VkBool32
        type FieldOptional "variablePointers"
               VkPhysicalDeviceVariablePointerFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "variablePointers"
               VkPhysicalDeviceVariablePointerFeatures
             =
             (20)
{-# LINE 19925 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "variablePointers"
               VkPhysicalDeviceVariablePointerFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (20)
{-# LINE 19935 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "variablePointers"
           VkPhysicalDeviceVariablePointerFeatures
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (20))
{-# LINE 19944 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (20)
{-# LINE 19948 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "variablePointers"
           VkPhysicalDeviceVariablePointerFeatures
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (20)
{-# LINE 19956 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceVariablePointerFeatures where
        showsPrec d x
          = showString "VkPhysicalDeviceVariablePointerFeatures {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "variablePointersStorageBuffer = " .
                            showsPrec d (getField @"variablePointersStorageBuffer" x) .
                              showString ", " .
                                showString "variablePointers = " .
                                  showsPrec d (getField @"variablePointers" x) . showChar '}'

-- | Alias for `VkPhysicalDeviceVariablePointerFeatures`
type VkPhysicalDeviceVariablePointerFeaturesKHR =
     VkPhysicalDeviceVariablePointerFeatures

-- | > typedef struct VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT {
--   >     VkStructureType sType;
--   >     void*                  pNext;
--   >     uint32_t               maxVertexAttribDivisor;
--   > } VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT registry at www.khronos.org>
data VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# Addr#
                                                                                                                ByteArray#

instance Eq VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# a _) ==
          x@(VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# b _)
          = EQ == cmpBytes# (sizeOf x) a b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# a _)
          `compare`
          x@(VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# b _)
          = cmpBytes# (sizeOf x) a b

        {-# INLINE compare #-}

instance Storable
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        sizeOf ~_
          = (24)
{-# LINE 20008 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment ~_
          = (8)
{-# LINE 20012 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek = peekVkData#

        {-# INLINE peek #-}
        poke = pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        unsafeAddr
          (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# a _) = a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray
          (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# _ b) = b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset off b
          = VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT#
              (plusAddr# (byteArrayContents# b) off)
              b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        type StructFields
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = '["sType", "pNext", "maxVertexAttribDivisor"] -- ' closing tick for hsc2hs
        type CUnionType VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type StructExtends
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        type FieldType "sType"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = VkStructureType
        type FieldOptional "sType"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sType"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             =
             (0)
{-# LINE 20068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "sType"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (0)
{-# LINE 20078 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (0))
{-# LINE 20087 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (0)
{-# LINE 20091 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (0)
{-# LINE 20099 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        type FieldType "pNext"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = Ptr Void
        type FieldOptional "pNext"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             =
             (8)
{-# LINE 20114 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "pNext"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (8)
{-# LINE 20124 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (8))
{-# LINE 20133 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (8)
{-# LINE 20137 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (8)
{-# LINE 20145 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxVertexAttribDivisor"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        type FieldType "maxVertexAttribDivisor"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = Word32
        type FieldOptional "maxVertexAttribDivisor"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxVertexAttribDivisor"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             =
             (16)
{-# LINE 20160 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
        type FieldIsArray "maxVertexAttribDivisor"
               VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

        {-# INLINE fieldOffset #-}
        fieldOffset
          = (16)
{-# LINE 20170 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexAttribDivisor"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 20179 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField p
          = peekByteOff p (16)
{-# LINE 20183 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexAttribDivisor"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 20191 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        showsPrec d x
          = showString
              "VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT {"
              .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "maxVertexAttribDivisor = " .
                            showsPrec d (getField @"maxVertexAttribDivisor" x) . showChar '}'