{-# LINE 1 "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# Addr#
a ByteArray#
_) == :: VkPhysicalDevice16BitStorageFeatures
-> VkPhysicalDevice16BitStorageFeatures -> Bool
==
          x :: VkPhysicalDevice16BitStorageFeatures
x@(VkPhysicalDevice16BitStorageFeatures# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDevice16BitStorageFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDevice16BitStorageFeatures
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDevice16BitStorageFeatures where
        (VkPhysicalDevice16BitStorageFeatures# Addr#
a ByteArray#
_) compare :: VkPhysicalDevice16BitStorageFeatures
-> VkPhysicalDevice16BitStorageFeatures -> Ordering
`compare`
          x :: VkPhysicalDevice16BitStorageFeatures
x@(VkPhysicalDevice16BitStorageFeatures# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDevice16BitStorageFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDevice16BitStorageFeatures
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDevice16BitStorageFeatures
-> IO VkPhysicalDevice16BitStorageFeatures
peek = Ptr VkPhysicalDevice16BitStorageFeatures
-> IO VkPhysicalDevice16BitStorageFeatures
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDevice16BitStorageFeatures
-> VkPhysicalDevice16BitStorageFeatures -> IO ()
poke = Ptr VkPhysicalDevice16BitStorageFeatures
-> VkPhysicalDevice16BitStorageFeatures -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDevice16BitStorageFeatures
         where
        unsafeAddr :: VkPhysicalDevice16BitStorageFeatures -> Addr#
unsafeAddr (VkPhysicalDevice16BitStorageFeatures# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDevice16BitStorageFeatures -> ByteArray#
unsafeByteArray (VkPhysicalDevice16BitStorageFeatures# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDevice16BitStorageFeatures
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDevice16BitStorageFeatures
VkPhysicalDevice16BitStorageFeatures#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDevice16BitStorageFeatures where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevice16BitStorageFeatures
-> FieldType "sType" VkPhysicalDevice16BitStorageFeatures
getField VkPhysicalDevice16BitStorageFeatures
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevice16BitStorageFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevice16BitStorageFeatures
-> Ptr VkPhysicalDevice16BitStorageFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevice16BitStorageFeatures
x) (Int
0))
{-# LINE 212 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> IO (FieldType "sType" VkPhysicalDevice16BitStorageFeatures)
readField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
0)
{-# LINE 216 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDevice16BitStorageFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> FieldType "sType" VkPhysicalDevice16BitStorageFeatures -> IO ()
writeField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDevice16BitStorageFeatures where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevice16BitStorageFeatures
-> FieldType "pNext" VkPhysicalDevice16BitStorageFeatures
getField VkPhysicalDevice16BitStorageFeatures
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevice16BitStorageFeatures
-> Ptr VkPhysicalDevice16BitStorageFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevice16BitStorageFeatures
x) (Int
8))
{-# LINE 247 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> IO (FieldType "pNext" VkPhysicalDevice16BitStorageFeatures)
readField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
8)
{-# LINE 251 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDevice16BitStorageFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> FieldType "pNext" VkPhysicalDevice16BitStorageFeatures -> IO ()
writeField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "storageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures
getField VkPhysicalDevice16BitStorageFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevice16BitStorageFeatures
-> Ptr VkPhysicalDevice16BitStorageFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevice16BitStorageFeatures
x) (Int
16))
{-# LINE 291 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> IO
     (FieldType
        "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures)
readField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
16)
{-# LINE 295 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "storageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures
-> IO ()
writeField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "uniformAndStorageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "uniformAndStorageBuffer16BitAccess"
     VkPhysicalDevice16BitStorageFeatures
getField VkPhysicalDevice16BitStorageFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevice16BitStorageFeatures
-> Ptr VkPhysicalDevice16BitStorageFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevice16BitStorageFeatures
x) (Int
20))
{-# LINE 337 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> IO
     (FieldType
        "uniformAndStorageBuffer16BitAccess"
        VkPhysicalDevice16BitStorageFeatures)
readField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
20)
{-# LINE 341 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "uniformAndStorageBuffer16BitAccess"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "uniformAndStorageBuffer16BitAccess"
     VkPhysicalDevice16BitStorageFeatures
-> IO ()
writeField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "storagePushConstant16"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures
getField VkPhysicalDevice16BitStorageFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevice16BitStorageFeatures
-> Ptr VkPhysicalDevice16BitStorageFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevice16BitStorageFeatures
x) (Int
24))
{-# LINE 383 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> IO
     (FieldType
        "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures)
readField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
24)
{-# LINE 387 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "storagePushConstant16"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures
-> IO ()
writeField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "storageInputOutput16"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures
getField VkPhysicalDevice16BitStorageFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevice16BitStorageFeatures
-> Ptr VkPhysicalDevice16BitStorageFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevice16BitStorageFeatures
x) (Int
28))
{-# LINE 429 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> IO
     (FieldType
        "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures)
readField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
28)
{-# LINE 433 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "storageInputOutput16"
           VkPhysicalDevice16BitStorageFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures
-> IO ()
writeField Ptr VkPhysicalDevice16BitStorageFeatures
p
          = Ptr VkPhysicalDevice16BitStorageFeatures
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevice16BitStorageFeatures
p (Int
28)
{-# LINE 441 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDevice16BitStorageFeatures where
        showsPrec :: Int -> VkPhysicalDevice16BitStorageFeatures -> ShowS
showsPrec Int
d VkPhysicalDevice16BitStorageFeatures
x
          = String -> ShowS
showString String
"VkPhysicalDevice16BitStorageFeatures {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevice16BitStorageFeatures
-> FieldType "sType" VkPhysicalDevice16BitStorageFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDevice16BitStorageFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevice16BitStorageFeatures
-> FieldType "pNext" VkPhysicalDevice16BitStorageFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDevice16BitStorageFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"storageBuffer16BitAccess = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"uniformAndStorageBuffer16BitAccess = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "uniformAndStorageBuffer16BitAccess"
     VkPhysicalDevice16BitStorageFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"uniformAndStorageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"storagePushConstant16 = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"storagePushConstant16" VkPhysicalDevice16BitStorageFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"storageInputOutput16 = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevice16BitStorageFeatures
-> FieldType
     "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"storageInputOutput16" VkPhysicalDevice16BitStorageFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Bool
==
          x :: VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x@(VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Ordering
`compare`
          x :: VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x@(VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> IO VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
peek = Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> IO VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT -> IO ()
poke = Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        unsafeAddr :: VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Addr#
unsafeAddr (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# Addr#
a ByteArray#
_)
          = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT -> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int#
-> ByteArray# -> VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray# -> VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> FieldType
     "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
getField VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x) (Int
0))
{-# LINE 573 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> IO
     (FieldType
        "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p (Int
0)
{-# LINE 577 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> FieldType
     "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> FieldType
     "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
getField VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x) (Int
8))
{-# LINE 618 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> IO
     (FieldType
        "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p (Int
8)
{-# LINE 622 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> FieldType
     "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendCoherentOperations"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> FieldType
     "advancedBlendCoherentOperations"
     VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
getField VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x) (Int
16))
{-# LINE 664 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> IO
     (FieldType
        "advancedBlendCoherentOperations"
        VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p (Int
16)
{-# LINE 668 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendCoherentOperations"
           VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> FieldType
     "advancedBlendCoherentOperations"
     VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
p (Int
16)
{-# LINE 676 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
         where
        showsPrec :: Int -> VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x
          = String -> ShowS
showString String
"VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT {"
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> FieldType
     "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> FieldType
     "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"advancedBlendCoherentOperations = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> FieldType
     "advancedBlendCoherentOperations"
     VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"advancedBlendCoherentOperations" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
==
          x :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x@(VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# Addr#
a ByteArray#
_)
          compare :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Ordering
`compare`
          x :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x@(VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
peek = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT -> IO ()
poke = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        unsafeAddr :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Addr#
unsafeAddr
          (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT -> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int#
-> ByteArray#
-> VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray#
-> VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
getField VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) (Int
0))
{-# LINE 813 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO
     (FieldType
        "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
0)
{-# LINE 817 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
getField VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) (Int
8))
{-# LINE 859 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO
     (FieldType
        "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
8)
{-# LINE 863 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendMaxColorAttachments"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendMaxColorAttachments"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
getField VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) (Int
16))
{-# LINE 905 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO
     (FieldType
        "advancedBlendMaxColorAttachments"
        VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
16)
{-# LINE 909 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendMaxColorAttachments"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendMaxColorAttachments"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendIndependentBlend"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendIndependentBlend"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
getField VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) (Int
20))
{-# LINE 951 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO
     (FieldType
        "advancedBlendIndependentBlend"
        VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
20)
{-# LINE 955 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendIndependentBlend"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendIndependentBlend"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendNonPremultipliedSrcColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendNonPremultipliedSrcColor"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
getField VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) (Int
24))
{-# LINE 997 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO
     (FieldType
        "advancedBlendNonPremultipliedSrcColor"
        VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
24)
{-# LINE 1001 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendNonPremultipliedSrcColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendNonPremultipliedSrcColor"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendNonPremultipliedDstColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendNonPremultipliedDstColor"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
getField VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) (Int
28))
{-# LINE 1043 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO
     (FieldType
        "advancedBlendNonPremultipliedDstColor"
        VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
28)
{-# LINE 1047 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendNonPremultipliedDstColor"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendNonPremultipliedDstColor"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendCorrelatedOverlap"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendCorrelatedOverlap"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
getField VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) (Int
32))
{-# LINE 1089 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO
     (FieldType
        "advancedBlendCorrelatedOverlap"
        VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
32)
{-# LINE 1093 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendCorrelatedOverlap"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendCorrelatedOverlap"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "advancedBlendAllOperations"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendAllOperations"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
getField VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) (Int
36))
{-# LINE 1135 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO
     (FieldType
        "advancedBlendAllOperations"
        VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT)
readField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
36)
{-# LINE 1139 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "advancedBlendAllOperations"
           VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendAllOperations"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p
          = Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
p (Int
36)
{-# LINE 1147 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
         where
        showsPrec :: Int -> VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x
          = String -> ShowS
showString
              String
"VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT {"
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"advancedBlendMaxColorAttachments = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendMaxColorAttachments"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"advancedBlendMaxColorAttachments" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"advancedBlendIndependentBlend = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendIndependentBlend"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"advancedBlendIndependentBlend" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"advancedBlendNonPremultipliedSrcColor = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                          (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendNonPremultipliedSrcColor"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"advancedBlendNonPremultipliedSrcColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x)
                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"advancedBlendNonPremultipliedDstColor = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendNonPremultipliedDstColor"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"advancedBlendNonPremultipliedDstColor"
                                                   VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x)
                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
"advancedBlendCorrelatedOverlap = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                      (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendCorrelatedOverlap"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"advancedBlendCorrelatedOverlap" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x)
                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                        String -> ShowS
showString String
"advancedBlendAllOperations = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                            (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> FieldType
     "advancedBlendAllOperations"
     VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"advancedBlendAllOperations"
                                                               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
x)
                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> VkPhysicalDeviceConservativeRasterizationPropertiesEXT -> Bool
==
          x :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x@(VkPhysicalDeviceConservativeRasterizationPropertiesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceConservativeRasterizationPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        (VkPhysicalDeviceConservativeRasterizationPropertiesEXT# Addr#
a ByteArray#
_)
          compare :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ordering
`compare`
          x :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x@(VkPhysicalDeviceConservativeRasterizationPropertiesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceConservativeRasterizationPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO VkPhysicalDeviceConservativeRasterizationPropertiesEXT
peek = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> VkPhysicalDeviceConservativeRasterizationPropertiesEXT -> IO ()
poke = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> VkPhysicalDeviceConservativeRasterizationPropertiesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        unsafeAddr :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT -> Addr#
unsafeAddr
          (VkPhysicalDeviceConservativeRasterizationPropertiesEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceConservativeRasterizationPropertiesEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int#
-> ByteArray#
-> VkPhysicalDeviceConservativeRasterizationPropertiesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray#
-> VkPhysicalDeviceConservativeRasterizationPropertiesEXT
VkPhysicalDeviceConservativeRasterizationPropertiesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
0))
{-# LINE 1316 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
0)
{-# LINE 1320 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
8))
{-# LINE 1362 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
8)
{-# LINE 1366 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "primitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "primitiveOverestimationSize"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
16))
{-# LINE 1408 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "primitiveOverestimationSize"
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
16)
{-# LINE 1412 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "primitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "primitiveOverestimationSize"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxExtraPrimitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "maxExtraPrimitiveOverestimationSize"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
20))
{-# LINE 1454 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "maxExtraPrimitiveOverestimationSize"
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
20)
{-# LINE 1458 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxExtraPrimitiveOverestimationSize"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "maxExtraPrimitiveOverestimationSize"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "extraPrimitiveOverestimationSizeGranularity"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "extraPrimitiveOverestimationSizeGranularity"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
24))
{-# LINE 1500 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "extraPrimitiveOverestimationSizeGranularity"
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
24)
{-# LINE 1504 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "extraPrimitiveOverestimationSizeGranularity"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "extraPrimitiveOverestimationSizeGranularity"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "primitiveUnderestimation"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "primitiveUnderestimation"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
28))
{-# LINE 1546 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "primitiveUnderestimation"
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
28)
{-# LINE 1550 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "primitiveUnderestimation"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "primitiveUnderestimation"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "conservativePointAndLineRasterization"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "conservativePointAndLineRasterization"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
32))
{-# LINE 1592 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "conservativePointAndLineRasterization"
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
32)
{-# LINE 1596 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "conservativePointAndLineRasterization"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "conservativePointAndLineRasterization"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "degenerateTrianglesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "degenerateTrianglesRasterized"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
36))
{-# LINE 1638 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "degenerateTrianglesRasterized"
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
36)
{-# LINE 1642 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "degenerateTrianglesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "degenerateTrianglesRasterized"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "degenerateLinesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "degenerateLinesRasterized"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
40))
{-# LINE 1684 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "degenerateLinesRasterized"
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
40)
{-# LINE 1688 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "degenerateLinesRasterized"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "degenerateLinesRasterized"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "fullyCoveredFragmentShaderInputVariable"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "fullyCoveredFragmentShaderInputVariable"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
44))
{-# LINE 1730 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "fullyCoveredFragmentShaderInputVariable"
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
44)
{-# LINE 1734 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "fullyCoveredFragmentShaderInputVariable"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "fullyCoveredFragmentShaderInputVariable"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "conservativeRasterizationPostDepthCoverage"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "conservativeRasterizationPostDepthCoverage"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
getField VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) (Int
48))
{-# LINE 1776 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO
     (FieldType
        "conservativeRasterizationPostDepthCoverage"
        VkPhysicalDeviceConservativeRasterizationPropertiesEXT)
readField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
48)
{-# LINE 1780 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "conservativeRasterizationPostDepthCoverage"
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "conservativeRasterizationPostDepthCoverage"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p
          = Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceConservativeRasterizationPropertiesEXT
p (Int
48)
{-# LINE 1788 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show
           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
         where
        showsPrec :: Int
-> VkPhysicalDeviceConservativeRasterizationPropertiesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x
          = String -> ShowS
showString
              String
"VkPhysicalDeviceConservativeRasterizationPropertiesEXT {"
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"primitiveOverestimationSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "primitiveOverestimationSize"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"primitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"maxExtraPrimitiveOverestimationSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "maxExtraPrimitiveOverestimationSize"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxExtraPrimitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"extraPrimitiveOverestimationSizeGranularity = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                          (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "extraPrimitiveOverestimationSizeGranularity"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"extraPrimitiveOverestimationSizeGranularity"
                                             VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x)
                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"primitiveUnderestimation = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "primitiveUnderestimation"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"primitiveUnderestimation" VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString
                                                    String
"conservativePointAndLineRasterization = "
                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                      (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "conservativePointAndLineRasterization"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                         @"conservativePointAndLineRasterization"
                                                         VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x)
                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                        String -> ShowS
showString
                                                          String
"degenerateTrianglesRasterized = "
                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                            (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "degenerateTrianglesRasterized"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                               @"degenerateTrianglesRasterized"
                                                               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x)
                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                            String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                              String -> ShowS
showString
                                                                String
"degenerateLinesRasterized = "
                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                  (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "degenerateLinesRasterized"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                     @"degenerateLinesRasterized"
                                                                     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x)
                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                    String -> ShowS
showString
                                                                      String
"fullyCoveredFragmentShaderInputVariable = "
                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                      Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                        (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "fullyCoveredFragmentShaderInputVariable"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                           @"fullyCoveredFragmentShaderInputVariable"
                                                                           VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x)
                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                          String -> ShowS
showString
                                                                            String
"conservativeRasterizationPostDepthCoverage = "
                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                              (VkPhysicalDeviceConservativeRasterizationPropertiesEXT
-> FieldType
     "conservativeRasterizationPostDepthCoverage"
     VkPhysicalDeviceConservativeRasterizationPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                 @"conservativeRasterizationPostDepthCoverage"
                                                                                 VkPhysicalDeviceConservativeRasterizationPropertiesEXT
x)
                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> VkPhysicalDeviceDescriptorIndexingFeaturesEXT -> Bool
==
          x :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x@(VkPhysicalDeviceDescriptorIndexingFeaturesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceDescriptorIndexingFeaturesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceDescriptorIndexingFeaturesEXT where
        (VkPhysicalDeviceDescriptorIndexingFeaturesEXT# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> VkPhysicalDeviceDescriptorIndexingFeaturesEXT -> Ordering
`compare`
          x :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x@(VkPhysicalDeviceDescriptorIndexingFeaturesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceDescriptorIndexingFeaturesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO VkPhysicalDeviceDescriptorIndexingFeaturesEXT
peek = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> VkPhysicalDeviceDescriptorIndexingFeaturesEXT -> IO ()
poke = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> VkPhysicalDeviceDescriptorIndexingFeaturesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        unsafeAddr :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT -> Addr#
unsafeAddr (VkPhysicalDeviceDescriptorIndexingFeaturesEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT -> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceDescriptorIndexingFeaturesEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceDescriptorIndexingFeaturesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray# -> VkPhysicalDeviceDescriptorIndexingFeaturesEXT
VkPhysicalDeviceDescriptorIndexingFeaturesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 =
             '[VkPhysicalDeviceFeatures2KHR, 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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
0))
{-# LINE 2001 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
0)
{-# LINE 2005 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
8))
{-# LINE 2044 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
8)
{-# LINE 2048 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderInputAttachmentArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderInputAttachmentArrayDynamicIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
16))
{-# LINE 2089 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderInputAttachmentArrayDynamicIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
16)
{-# LINE 2093 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderInputAttachmentArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderInputAttachmentArrayDynamicIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderUniformTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderUniformTexelBufferArrayDynamicIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
20))
{-# LINE 2135 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderUniformTexelBufferArrayDynamicIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
20)
{-# LINE 2139 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderUniformTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderUniformTexelBufferArrayDynamicIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageTexelBufferArrayDynamicIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
24))
{-# LINE 2181 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderStorageTexelBufferArrayDynamicIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
24)
{-# LINE 2185 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageTexelBufferArrayDynamicIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageTexelBufferArrayDynamicIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderUniformBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderUniformBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
28))
{-# LINE 2227 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderUniformBufferArrayNonUniformIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
28)
{-# LINE 2231 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderUniformBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderUniformBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderSampledImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderSampledImageArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
32))
{-# LINE 2273 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderSampledImageArrayNonUniformIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
32)
{-# LINE 2277 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderSampledImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderSampledImageArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
36))
{-# LINE 2319 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderStorageBufferArrayNonUniformIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
36)
{-# LINE 2323 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageImageArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
40))
{-# LINE 2365 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderStorageImageArrayNonUniformIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
40)
{-# LINE 2369 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageImageArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageImageArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderInputAttachmentArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderInputAttachmentArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
44))
{-# LINE 2411 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderInputAttachmentArrayNonUniformIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
44)
{-# LINE 2415 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderInputAttachmentArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderInputAttachmentArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderUniformTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderUniformTexelBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
48))
{-# LINE 2458 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderUniformTexelBufferArrayNonUniformIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
48)
{-# LINE 2462 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderUniformTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderUniformTexelBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageTexelBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
52))
{-# LINE 2505 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "shaderStorageTexelBufferArrayNonUniformIndexing"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
52)
{-# LINE 2509 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageTexelBufferArrayNonUniformIndexing"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageTexelBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingUniformBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingUniformBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
56))
{-# LINE 2551 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "descriptorBindingUniformBufferUpdateAfterBind"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
56)
{-# LINE 2555 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingUniformBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingUniformBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingSampledImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingSampledImageUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
60))
{-# LINE 2597 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "descriptorBindingSampledImageUpdateAfterBind"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
60)
{-# LINE 2601 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingSampledImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingSampledImageUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingStorageImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingStorageImageUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
64))
{-# LINE 2643 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "descriptorBindingStorageImageUpdateAfterBind"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
64)
{-# LINE 2647 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingStorageImageUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingStorageImageUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingStorageBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingStorageBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
68))
{-# LINE 2689 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "descriptorBindingStorageBufferUpdateAfterBind"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
68)
{-# LINE 2693 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingStorageBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingStorageBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingUniformTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingUniformTexelBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
72))
{-# LINE 2738 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "descriptorBindingUniformTexelBufferUpdateAfterBind"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
72)
{-# LINE 2742 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingUniformTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingUniformTexelBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingStorageTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingStorageTexelBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
76))
{-# LINE 2787 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "descriptorBindingStorageTexelBufferUpdateAfterBind"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
76)
{-# LINE 2791 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingStorageTexelBufferUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingStorageTexelBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingUpdateUnusedWhilePending"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingUpdateUnusedWhilePending"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
80))
{-# LINE 2833 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "descriptorBindingUpdateUnusedWhilePending"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
80)
{-# LINE 2837 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingUpdateUnusedWhilePending"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingUpdateUnusedWhilePending"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingPartiallyBound"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingPartiallyBound"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
84))
{-# LINE 2879 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "descriptorBindingPartiallyBound"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
84)
{-# LINE 2883 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingPartiallyBound"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingPartiallyBound"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "descriptorBindingVariableDescriptorCount"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingVariableDescriptorCount"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
88))
{-# LINE 2925 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "descriptorBindingVariableDescriptorCount"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
88)
{-# LINE 2929 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "descriptorBindingVariableDescriptorCount"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingVariableDescriptorCount"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "runtimeDescriptorArray"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "runtimeDescriptorArray"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
getField VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) (Int
92))
{-# LINE 2971 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO
     (FieldType
        "runtimeDescriptorArray"
        VkPhysicalDeviceDescriptorIndexingFeaturesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
92)
{-# LINE 2975 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "runtimeDescriptorArray"
           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "runtimeDescriptorArray"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingFeaturesEXT
p (Int
92)
{-# LINE 2983 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceDescriptorIndexingFeaturesEXT where
        showsPrec :: Int -> VkPhysicalDeviceDescriptorIndexingFeaturesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x
          = String -> ShowS
showString String
"VkPhysicalDeviceDescriptorIndexingFeaturesEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"shaderInputAttachmentArrayDynamicIndexing = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                              (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderInputAttachmentArrayDynamicIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"shaderInputAttachmentArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"shaderUniformTexelBufferArrayDynamicIndexing = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                    (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderUniformTexelBufferArrayDynamicIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"shaderUniformTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"shaderStorageTexelBufferArrayDynamicIndexing = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                          (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageTexelBufferArrayDynamicIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"shaderStorageTexelBufferArrayDynamicIndexing"
                                             VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString
                                              String
"shaderUniformBufferArrayNonUniformIndexing = "
                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderUniformBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                   @"shaderUniformBufferArrayNonUniformIndexing"
                                                   VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString
                                                    String
"shaderSampledImageArrayNonUniformIndexing = "
                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                      (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderSampledImageArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                         @"shaderSampledImageArrayNonUniformIndexing"
                                                         VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                        String -> ShowS
showString
                                                          String
"shaderStorageBufferArrayNonUniformIndexing = "
                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                            (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                               @"shaderStorageBufferArrayNonUniformIndexing"
                                                               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                            String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                              String -> ShowS
showString
                                                                String
"shaderStorageImageArrayNonUniformIndexing = "
                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                  (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageImageArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                     @"shaderStorageImageArrayNonUniformIndexing"
                                                                     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                    String -> ShowS
showString
                                                                      String
"shaderInputAttachmentArrayNonUniformIndexing = "
                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                      Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                        (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderInputAttachmentArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                           @"shaderInputAttachmentArrayNonUniformIndexing"
                                                                           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                          String -> ShowS
showString
                                                                            String
"shaderUniformTexelBufferArrayNonUniformIndexing = "
                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                              (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderUniformTexelBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                 @"shaderUniformTexelBufferArrayNonUniformIndexing"
                                                                                 VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                String -> ShowS
showString
                                                                                  String
"shaderStorageTexelBufferArrayNonUniformIndexing = "
                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                    (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "shaderStorageTexelBufferArrayNonUniformIndexing"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                       @"shaderStorageTexelBufferArrayNonUniformIndexing"
                                                                                       VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                    String -> ShowS
showString String
", "
                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                      String -> ShowS
showString
                                                                                        String
"descriptorBindingUniformBufferUpdateAfterBind = "
                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                          (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingUniformBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                             @"descriptorBindingUniformBufferUpdateAfterBind"
                                                                                             VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                          String -> ShowS
showString
                                                                                            String
", "
                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                            String -> ShowS
showString
                                                                                              String
"descriptorBindingSampledImageUpdateAfterBind = "
                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                              Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                Int
d
                                                                                                (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingSampledImageUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                   @"descriptorBindingSampledImageUpdateAfterBind"
                                                                                                   VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                String -> ShowS
showString
                                                                                                  String
", "
                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                  String -> ShowS
showString
                                                                                                    String
"descriptorBindingStorageImageUpdateAfterBind = "
                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                    Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                      Int
d
                                                                                                      (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingStorageImageUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                         @"descriptorBindingStorageImageUpdateAfterBind"
                                                                                                         VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                      String -> ShowS
showString
                                                                                                        String
", "
                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                        String -> ShowS
showString
                                                                                                          String
"descriptorBindingStorageBufferUpdateAfterBind = "
                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                          Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                            Int
d
                                                                                                            (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingStorageBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                               @"descriptorBindingStorageBufferUpdateAfterBind"
                                                                                                               VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                            String -> ShowS
showString
                                                                                                              String
", "
                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                              String -> ShowS
showString
                                                                                                                String
"descriptorBindingUniformTexelBufferUpdateAfterBind = "
                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                  Int
d
                                                                                                                  (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingUniformTexelBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                     @"descriptorBindingUniformTexelBufferUpdateAfterBind"
                                                                                                                     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                  String -> ShowS
showString
                                                                                                                    String
", "
                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                    String -> ShowS
showString
                                                                                                                      String
"descriptorBindingStorageTexelBufferUpdateAfterBind = "
                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                      Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                        Int
d
                                                                                                                        (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingStorageTexelBufferUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                           @"descriptorBindingStorageTexelBufferUpdateAfterBind"
                                                                                                                           VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                        String -> ShowS
showString
                                                                                                                          String
", "
                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                          String -> ShowS
showString
                                                                                                                            String
"descriptorBindingUpdateUnusedWhilePending = "
                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                              Int
d
                                                                                                                              (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingUpdateUnusedWhilePending"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                 @"descriptorBindingUpdateUnusedWhilePending"
                                                                                                                                 VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                              String -> ShowS
showString
                                                                                                                                String
", "
                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                String -> ShowS
showString
                                                                                                                                  String
"descriptorBindingPartiallyBound = "
                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                    Int
d
                                                                                                                                    (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingPartiallyBound"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                       @"descriptorBindingPartiallyBound"
                                                                                                                                       VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                    String -> ShowS
showString
                                                                                                                                      String
", "
                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                      String -> ShowS
showString
                                                                                                                                        String
"descriptorBindingVariableDescriptorCount = "
                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                          Int
d
                                                                                                                                          (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "descriptorBindingVariableDescriptorCount"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                             @"descriptorBindingVariableDescriptorCount"
                                                                                                                                             VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                          String -> ShowS
showString
                                                                                                                                            String
", "
                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                            String -> ShowS
showString
                                                                                                                                              String
"runtimeDescriptorArray = "
                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                              Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                Int
d
                                                                                                                                                (VkPhysicalDeviceDescriptorIndexingFeaturesEXT
-> FieldType
     "runtimeDescriptorArray"
     VkPhysicalDeviceDescriptorIndexingFeaturesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                   @"runtimeDescriptorArray"
                                                                                                                                                   VkPhysicalDeviceDescriptorIndexingFeaturesEXT
x)
                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                Char -> ShowS
showChar
                                                                                                                                                  Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> VkPhysicalDeviceDescriptorIndexingPropertiesEXT -> Bool
==
          x :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x@(VkPhysicalDeviceDescriptorIndexingPropertiesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceDescriptorIndexingPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceDescriptorIndexingPropertiesEXT where
        (VkPhysicalDeviceDescriptorIndexingPropertiesEXT# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> VkPhysicalDeviceDescriptorIndexingPropertiesEXT -> Ordering
`compare`
          x :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x@(VkPhysicalDeviceDescriptorIndexingPropertiesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceDescriptorIndexingPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO VkPhysicalDeviceDescriptorIndexingPropertiesEXT
peek = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> VkPhysicalDeviceDescriptorIndexingPropertiesEXT -> IO ()
poke = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> VkPhysicalDeviceDescriptorIndexingPropertiesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        unsafeAddr :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT -> Addr#
unsafeAddr (VkPhysicalDeviceDescriptorIndexingPropertiesEXT# Addr#
a ByteArray#
_)
          = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT -> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceDescriptorIndexingPropertiesEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int#
-> ByteArray# -> VkPhysicalDeviceDescriptorIndexingPropertiesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray# -> VkPhysicalDeviceDescriptorIndexingPropertiesEXT
VkPhysicalDeviceDescriptorIndexingPropertiesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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
             = '[VkPhysicalDeviceProperties2KHR] -- ' 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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
0))
{-# LINE 3338 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
0)
{-# LINE 3342 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
8))
{-# LINE 3383 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
8)
{-# LINE 3387 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxUpdateAfterBindDescriptorsInAllPools"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxUpdateAfterBindDescriptorsInAllPools"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
16))
{-# LINE 3429 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxUpdateAfterBindDescriptorsInAllPools"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
16)
{-# LINE 3433 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxUpdateAfterBindDescriptorsInAllPools"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxUpdateAfterBindDescriptorsInAllPools"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderUniformBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderUniformBufferArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
20))
{-# LINE 3477 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "shaderUniformBufferArrayNonUniformIndexingNative"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
20)
{-# LINE 3481 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderUniformBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderUniformBufferArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderSampledImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderSampledImageArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
24))
{-# LINE 3524 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "shaderSampledImageArrayNonUniformIndexingNative"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
24)
{-# LINE 3528 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderSampledImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderSampledImageArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderStorageBufferArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
28))
{-# LINE 3572 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "shaderStorageBufferArrayNonUniformIndexingNative"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
28)
{-# LINE 3576 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageBufferArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderStorageBufferArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderStorageImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderStorageImageArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
32))
{-# LINE 3619 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "shaderStorageImageArrayNonUniformIndexingNative"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
32)
{-# LINE 3623 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageImageArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderStorageImageArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderInputAttachmentArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderInputAttachmentArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
36))
{-# LINE 3668 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "shaderInputAttachmentArrayNonUniformIndexingNative"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
36)
{-# LINE 3672 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderInputAttachmentArrayNonUniformIndexingNative"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderInputAttachmentArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "robustBufferAccessUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "robustBufferAccessUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
40))
{-# LINE 3714 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "robustBufferAccessUpdateAfterBind"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
40)
{-# LINE 3718 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "robustBufferAccessUpdateAfterBind"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "robustBufferAccessUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "quadDivergentImplicitLod"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "quadDivergentImplicitLod"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
44))
{-# LINE 3760 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "quadDivergentImplicitLod"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
44)
{-# LINE 3764 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "quadDivergentImplicitLod"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "quadDivergentImplicitLod"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindSamplers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
48))
{-# LINE 3806 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxPerStageDescriptorUpdateAfterBindSamplers"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
48)
{-# LINE 3810 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindSamplers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
52))
{-# LINE 3855 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
52)
{-# LINE 3859 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
56))
{-# LINE 3904 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
56)
{-# LINE 3908 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindSampledImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
60))
{-# LINE 3953 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxPerStageDescriptorUpdateAfterBindSampledImages"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
60)
{-# LINE 3957 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindSampledImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindStorageImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
64))
{-# LINE 4002 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxPerStageDescriptorUpdateAfterBindStorageImages"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
64)
{-# LINE 4006 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindStorageImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindInputAttachments"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
68))
{-# LINE 4052 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxPerStageDescriptorUpdateAfterBindInputAttachments"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
68)
{-# LINE 4056 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField
           "maxPerStageDescriptorUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindInputAttachments"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageUpdateAfterBindResources"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageUpdateAfterBindResources"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
72))
{-# LINE 4099 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxPerStageUpdateAfterBindResources"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
72)
{-# LINE 4103 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageUpdateAfterBindResources"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageUpdateAfterBindResources"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindSamplers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
76))
{-# LINE 4145 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxDescriptorSetUpdateAfterBindSamplers"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
76)
{-# LINE 4149 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindSamplers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindSamplers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindUniformBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
80))
{-# LINE 4191 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxDescriptorSetUpdateAfterBindUniformBuffers"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
80)
{-# LINE 4195 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindUniformBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindUniformBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
84))
{-# LINE 4241 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
84)
{-# LINE 4245 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField
           "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindStorageBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
88))
{-# LINE 4288 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxDescriptorSetUpdateAfterBindStorageBuffers"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
88)
{-# LINE 4292 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindStorageBuffers"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindStorageBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
92))
{-# LINE 4338 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
92)
{-# LINE 4342 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField
           "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindSampledImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
96))
{-# LINE 4385 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxDescriptorSetUpdateAfterBindSampledImages"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
96)
{-# LINE 4389 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindSampledImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindSampledImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindStorageImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
100))
{-# LINE 4431 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxDescriptorSetUpdateAfterBindStorageImages"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
100)
{-# LINE 4435 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindStorageImages"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindStorageImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindInputAttachments"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
getField VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) (Int
104))
{-# LINE 4478 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO
     (FieldType
        "maxDescriptorSetUpdateAfterBindInputAttachments"
        VkPhysicalDeviceDescriptorIndexingPropertiesEXT)
readField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
104)
{-# LINE 4482 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUpdateAfterBindInputAttachments"
           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindInputAttachments"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p
          = Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDescriptorIndexingPropertiesEXT
p (Int
104)
{-# LINE 4490 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceDescriptorIndexingPropertiesEXT where
        showsPrec :: Int -> VkPhysicalDeviceDescriptorIndexingPropertiesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x
          = String -> ShowS
showString String
"VkPhysicalDeviceDescriptorIndexingPropertiesEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"maxUpdateAfterBindDescriptorsInAllPools = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxUpdateAfterBindDescriptorsInAllPools"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxUpdateAfterBindDescriptorsInAllPools" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"shaderUniformBufferArrayNonUniformIndexingNative = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                    (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderUniformBufferArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"shaderUniformBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString
                                        String
"shaderSampledImageArrayNonUniformIndexingNative = "
                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                          (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderSampledImageArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                             @"shaderSampledImageArrayNonUniformIndexingNative"
                                             VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString
                                              String
"shaderStorageBufferArrayNonUniformIndexingNative = "
                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderStorageBufferArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                   @"shaderStorageBufferArrayNonUniformIndexingNative"
                                                   VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString
                                                    String
"shaderStorageImageArrayNonUniformIndexingNative = "
                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                      (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderStorageImageArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                         @"shaderStorageImageArrayNonUniformIndexingNative"
                                                         VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                        String -> ShowS
showString
                                                          String
"shaderInputAttachmentArrayNonUniformIndexingNative = "
                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                            (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "shaderInputAttachmentArrayNonUniformIndexingNative"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                               @"shaderInputAttachmentArrayNonUniformIndexingNative"
                                                               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                            String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                              String -> ShowS
showString
                                                                String
"robustBufferAccessUpdateAfterBind = "
                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                  (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "robustBufferAccessUpdateAfterBind"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                     @"robustBufferAccessUpdateAfterBind"
                                                                     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                    String -> ShowS
showString
                                                                      String
"quadDivergentImplicitLod = "
                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                      Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                        (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "quadDivergentImplicitLod"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                           @"quadDivergentImplicitLod"
                                                                           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                          String -> ShowS
showString
                                                                            String
"maxPerStageDescriptorUpdateAfterBindSamplers = "
                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                              (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindSamplers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                 @"maxPerStageDescriptorUpdateAfterBindSamplers"
                                                                                 VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                String -> ShowS
showString
                                                                                  String
"maxPerStageDescriptorUpdateAfterBindUniformBuffers = "
                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                    (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindUniformBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                       @"maxPerStageDescriptorUpdateAfterBindUniformBuffers"
                                                                                       VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                    String -> ShowS
showString String
", "
                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                      String -> ShowS
showString
                                                                                        String
"maxPerStageDescriptorUpdateAfterBindStorageBuffers = "
                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                          (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindStorageBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                             @"maxPerStageDescriptorUpdateAfterBindStorageBuffers"
                                                                                             VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                          String -> ShowS
showString
                                                                                            String
", "
                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                            String -> ShowS
showString
                                                                                              String
"maxPerStageDescriptorUpdateAfterBindSampledImages = "
                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                Int
d
                                                                                                (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindSampledImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                   @"maxPerStageDescriptorUpdateAfterBindSampledImages"
                                                                                                   VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                String -> ShowS
showString
                                                                                                  String
", "
                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                  String -> ShowS
showString
                                                                                                    String
"maxPerStageDescriptorUpdateAfterBindStorageImages = "
                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                      Int
d
                                                                                                      (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindStorageImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                         @"maxPerStageDescriptorUpdateAfterBindStorageImages"
                                                                                                         VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                      String -> ShowS
showString
                                                                                                        String
", "
                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                        String -> ShowS
showString
                                                                                                          String
"maxPerStageDescriptorUpdateAfterBindInputAttachments = "
                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                            Int
d
                                                                                                            (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageDescriptorUpdateAfterBindInputAttachments"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                               @"maxPerStageDescriptorUpdateAfterBindInputAttachments"
                                                                                                               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                            String -> ShowS
showString
                                                                                                              String
", "
                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                              String -> ShowS
showString
                                                                                                                String
"maxPerStageUpdateAfterBindResources = "
                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                  Int
d
                                                                                                                  (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxPerStageUpdateAfterBindResources"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                     @"maxPerStageUpdateAfterBindResources"
                                                                                                                     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                  String -> ShowS
showString
                                                                                                                    String
", "
                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                    String -> ShowS
showString
                                                                                                                      String
"maxDescriptorSetUpdateAfterBindSamplers = "
                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                        Int
d
                                                                                                                        (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindSamplers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                           @"maxDescriptorSetUpdateAfterBindSamplers"
                                                                                                                           VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                        String -> ShowS
showString
                                                                                                                          String
", "
                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                          String -> ShowS
showString
                                                                                                                            String
"maxDescriptorSetUpdateAfterBindUniformBuffers = "
                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                              Int
d
                                                                                                                              (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindUniformBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                 @"maxDescriptorSetUpdateAfterBindUniformBuffers"
                                                                                                                                 VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                              String -> ShowS
showString
                                                                                                                                String
", "
                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                String -> ShowS
showString
                                                                                                                                  String
"maxDescriptorSetUpdateAfterBindUniformBuffersDynamic = "
                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                    Int
d
                                                                                                                                    (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                       @"maxDescriptorSetUpdateAfterBindUniformBuffersDynamic"
                                                                                                                                       VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                    String -> ShowS
showString
                                                                                                                                      String
", "
                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                      String -> ShowS
showString
                                                                                                                                        String
"maxDescriptorSetUpdateAfterBindStorageBuffers = "
                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                          Int
d
                                                                                                                                          (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindStorageBuffers"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                             @"maxDescriptorSetUpdateAfterBindStorageBuffers"
                                                                                                                                             VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                          String -> ShowS
showString
                                                                                                                                            String
", "
                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                            String -> ShowS
showString
                                                                                                                                              String
"maxDescriptorSetUpdateAfterBindStorageBuffersDynamic = "
                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                Int
d
                                                                                                                                                (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                   @"maxDescriptorSetUpdateAfterBindStorageBuffersDynamic"
                                                                                                                                                   VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                String -> ShowS
showString
                                                                                                                                                  String
", "
                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                    String
"maxDescriptorSetUpdateAfterBindSampledImages = "
                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                      Int
d
                                                                                                                                                      (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindSampledImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                         @"maxDescriptorSetUpdateAfterBindSampledImages"
                                                                                                                                                         VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                        String
", "
                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                          String
"maxDescriptorSetUpdateAfterBindStorageImages = "
                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                            Int
d
                                                                                                                                                            (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindStorageImages"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                               @"maxDescriptorSetUpdateAfterBindStorageImages"
                                                                                                                                                               VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                              String
", "
                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                String
"maxDescriptorSetUpdateAfterBindInputAttachments = "
                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                  Int
d
                                                                                                                                                                  (VkPhysicalDeviceDescriptorIndexingPropertiesEXT
-> FieldType
     "maxDescriptorSetUpdateAfterBindInputAttachments"
     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                     @"maxDescriptorSetUpdateAfterBindInputAttachments"
                                                                                                                                                                     VkPhysicalDeviceDescriptorIndexingPropertiesEXT
x)
                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                  Char -> ShowS
showChar
                                                                                                                                                                    Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> VkPhysicalDeviceDiscardRectanglePropertiesEXT -> Bool
==
          x :: VkPhysicalDeviceDiscardRectanglePropertiesEXT
x@(VkPhysicalDeviceDiscardRectanglePropertiesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceDiscardRectanglePropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceDiscardRectanglePropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceDiscardRectanglePropertiesEXT where
        (VkPhysicalDeviceDiscardRectanglePropertiesEXT# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> VkPhysicalDeviceDiscardRectanglePropertiesEXT -> Ordering
`compare`
          x :: VkPhysicalDeviceDiscardRectanglePropertiesEXT
x@(VkPhysicalDeviceDiscardRectanglePropertiesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceDiscardRectanglePropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceDiscardRectanglePropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> IO VkPhysicalDeviceDiscardRectanglePropertiesEXT
peek = Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> IO VkPhysicalDeviceDiscardRectanglePropertiesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> VkPhysicalDeviceDiscardRectanglePropertiesEXT -> IO ()
poke = Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> VkPhysicalDeviceDiscardRectanglePropertiesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        unsafeAddr :: VkPhysicalDeviceDiscardRectanglePropertiesEXT -> Addr#
unsafeAddr (VkPhysicalDeviceDiscardRectanglePropertiesEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceDiscardRectanglePropertiesEXT -> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceDiscardRectanglePropertiesEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceDiscardRectanglePropertiesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray# -> VkPhysicalDeviceDiscardRectanglePropertiesEXT
VkPhysicalDeviceDiscardRectanglePropertiesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> FieldType "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT
getField VkPhysicalDeviceDiscardRectanglePropertiesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDiscardRectanglePropertiesEXT
x) (Int
0))
{-# LINE 4838 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> IO
     (FieldType "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT)
readField Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p
          = Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p (Int
0)
{-# LINE 4842 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> FieldType "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p
          = Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> FieldType "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT
getField VkPhysicalDeviceDiscardRectanglePropertiesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDiscardRectanglePropertiesEXT
x) (Int
8))
{-# LINE 4881 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> IO
     (FieldType "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT)
readField Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p
          = Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p (Int
8)
{-# LINE 4885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> FieldType "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p
          = Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDiscardRectangles"
           VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> FieldType
     "maxDiscardRectangles"
     VkPhysicalDeviceDiscardRectanglePropertiesEXT
getField VkPhysicalDeviceDiscardRectanglePropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceDiscardRectanglePropertiesEXT
x) (Int
16))
{-# LINE 4926 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> IO
     (FieldType
        "maxDiscardRectangles"
        VkPhysicalDeviceDiscardRectanglePropertiesEXT)
readField Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p
          = Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p (Int
16)
{-# LINE 4930 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDiscardRectangles"
           VkPhysicalDeviceDiscardRectanglePropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> FieldType
     "maxDiscardRectangles"
     VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p
          = Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceDiscardRectanglePropertiesEXT
p (Int
16)
{-# LINE 4938 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceDiscardRectanglePropertiesEXT where
        showsPrec :: Int -> VkPhysicalDeviceDiscardRectanglePropertiesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceDiscardRectanglePropertiesEXT
x
          = String -> ShowS
showString String
"VkPhysicalDeviceDiscardRectanglePropertiesEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> FieldType "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> FieldType "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"maxDiscardRectangles = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceDiscardRectanglePropertiesEXT
-> FieldType
     "maxDiscardRectangles"
     VkPhysicalDeviceDiscardRectanglePropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxDiscardRectangles" VkPhysicalDeviceDiscardRectanglePropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceExternalBufferInfo
-> VkPhysicalDeviceExternalBufferInfo -> Bool
==
          x :: VkPhysicalDeviceExternalBufferInfo
x@(VkPhysicalDeviceExternalBufferInfo# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalBufferInfo -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalBufferInfo
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalBufferInfo where
        (VkPhysicalDeviceExternalBufferInfo# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceExternalBufferInfo
-> VkPhysicalDeviceExternalBufferInfo -> Ordering
`compare`
          x :: VkPhysicalDeviceExternalBufferInfo
x@(VkPhysicalDeviceExternalBufferInfo# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalBufferInfo -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalBufferInfo
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceExternalBufferInfo
-> IO VkPhysicalDeviceExternalBufferInfo
peek = Ptr VkPhysicalDeviceExternalBufferInfo
-> IO VkPhysicalDeviceExternalBufferInfo
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceExternalBufferInfo
-> VkPhysicalDeviceExternalBufferInfo -> IO ()
poke = Ptr VkPhysicalDeviceExternalBufferInfo
-> VkPhysicalDeviceExternalBufferInfo -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceExternalBufferInfo where
        unsafeAddr :: VkPhysicalDeviceExternalBufferInfo -> Addr#
unsafeAddr (VkPhysicalDeviceExternalBufferInfo# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceExternalBufferInfo -> ByteArray#
unsafeByteArray (VkPhysicalDeviceExternalBufferInfo# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceExternalBufferInfo
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceExternalBufferInfo
VkPhysicalDeviceExternalBufferInfo#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalBufferInfo
-> FieldType "sType" VkPhysicalDeviceExternalBufferInfo
getField VkPhysicalDeviceExternalBufferInfo
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalBufferInfo -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalBufferInfo
-> Ptr VkPhysicalDeviceExternalBufferInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalBufferInfo
x) (Int
0))
{-# LINE 5037 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> IO (FieldType "sType" VkPhysicalDeviceExternalBufferInfo)
readField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
0)
{-# LINE 5041 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> FieldType "sType" VkPhysicalDeviceExternalBufferInfo -> IO ()
writeField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalBufferInfo
-> FieldType "pNext" VkPhysicalDeviceExternalBufferInfo
getField VkPhysicalDeviceExternalBufferInfo
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalBufferInfo -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalBufferInfo
-> Ptr VkPhysicalDeviceExternalBufferInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalBufferInfo
x) (Int
8))
{-# LINE 5072 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> IO (FieldType "pNext" VkPhysicalDeviceExternalBufferInfo)
readField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
8)
{-# LINE 5076 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> FieldType "pNext" VkPhysicalDeviceExternalBufferInfo -> IO ()
writeField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
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 :: Bool
fieldOptional = Bool
True

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

instance {-# OVERLAPPING #-}
         CanReadField "flags" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalBufferInfo
-> FieldType "flags" VkPhysicalDeviceExternalBufferInfo
getField VkPhysicalDeviceExternalBufferInfo
x
          = IO VkBufferCreateFlags -> VkBufferCreateFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> IO VkBufferCreateFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalBufferInfo
-> Ptr VkPhysicalDeviceExternalBufferInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalBufferInfo
x) (Int
16))
{-# LINE 5107 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> IO (FieldType "flags" VkPhysicalDeviceExternalBufferInfo)
readField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> IO VkBufferCreateFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
16)
{-# LINE 5111 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> FieldType "flags" VkPhysicalDeviceExternalBufferInfo -> IO ()
writeField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> VkBufferCreateFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "usage" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalBufferInfo
-> FieldType "usage" VkPhysicalDeviceExternalBufferInfo
getField VkPhysicalDeviceExternalBufferInfo
x
          = IO VkBufferUsageFlags -> VkBufferUsageFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> IO VkBufferUsageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalBufferInfo
-> Ptr VkPhysicalDeviceExternalBufferInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalBufferInfo
x) (Int
20))
{-# LINE 5142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> IO (FieldType "usage" VkPhysicalDeviceExternalBufferInfo)
readField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> IO VkBufferUsageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
20)
{-# LINE 5146 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "usage" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> FieldType "usage" VkPhysicalDeviceExternalBufferInfo -> IO ()
writeField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> VkBufferUsageFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "handleType" VkPhysicalDeviceExternalBufferInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalBufferInfo
-> FieldType "handleType" VkPhysicalDeviceExternalBufferInfo
getField VkPhysicalDeviceExternalBufferInfo
x
          = IO VkExternalMemoryHandleTypeFlagBits
-> VkExternalMemoryHandleTypeFlagBits
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> IO VkExternalMemoryHandleTypeFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalBufferInfo
-> Ptr VkPhysicalDeviceExternalBufferInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalBufferInfo
x) (Int
24))
{-# LINE 5177 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> IO (FieldType "handleType" VkPhysicalDeviceExternalBufferInfo)
readField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> IO VkExternalMemoryHandleTypeFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
24)
{-# LINE 5181 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "handleType" VkPhysicalDeviceExternalBufferInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalBufferInfo
-> FieldType "handleType" VkPhysicalDeviceExternalBufferInfo
-> IO ()
writeField Ptr VkPhysicalDeviceExternalBufferInfo
p
          = Ptr VkPhysicalDeviceExternalBufferInfo
-> Int -> VkExternalMemoryHandleTypeFlagBits -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalBufferInfo
p (Int
24)
{-# LINE 5187 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalBufferInfo where
        showsPrec :: Int -> VkPhysicalDeviceExternalBufferInfo -> ShowS
showsPrec Int
d VkPhysicalDeviceExternalBufferInfo
x
          = String -> ShowS
showString String
"VkPhysicalDeviceExternalBufferInfo {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalBufferInfo
-> FieldType "sType" VkPhysicalDeviceExternalBufferInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceExternalBufferInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalBufferInfo
-> FieldType "pNext" VkPhysicalDeviceExternalBufferInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceExternalBufferInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"flags = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBufferCreateFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalBufferInfo
-> FieldType "flags" VkPhysicalDeviceExternalBufferInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"flags" VkPhysicalDeviceExternalBufferInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"usage = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkBufferUsageFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalBufferInfo
-> FieldType "usage" VkPhysicalDeviceExternalBufferInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"usage" VkPhysicalDeviceExternalBufferInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"handleType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkExternalMemoryHandleTypeFlagBits -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalBufferInfo
-> FieldType "handleType" VkPhysicalDeviceExternalBufferInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"handleType" VkPhysicalDeviceExternalBufferInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceExternalFenceInfo
-> VkPhysicalDeviceExternalFenceInfo -> Bool
==
          x :: VkPhysicalDeviceExternalFenceInfo
x@(VkPhysicalDeviceExternalFenceInfo# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalFenceInfo -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalFenceInfo
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalFenceInfo where
        (VkPhysicalDeviceExternalFenceInfo# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceExternalFenceInfo
-> VkPhysicalDeviceExternalFenceInfo -> Ordering
`compare`
          x :: VkPhysicalDeviceExternalFenceInfo
x@(VkPhysicalDeviceExternalFenceInfo# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalFenceInfo -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalFenceInfo
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceExternalFenceInfo
-> IO VkPhysicalDeviceExternalFenceInfo
peek = Ptr VkPhysicalDeviceExternalFenceInfo
-> IO VkPhysicalDeviceExternalFenceInfo
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceExternalFenceInfo
-> VkPhysicalDeviceExternalFenceInfo -> IO ()
poke = Ptr VkPhysicalDeviceExternalFenceInfo
-> VkPhysicalDeviceExternalFenceInfo -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceExternalFenceInfo where
        unsafeAddr :: VkPhysicalDeviceExternalFenceInfo -> Addr#
unsafeAddr (VkPhysicalDeviceExternalFenceInfo# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceExternalFenceInfo -> ByteArray#
unsafeByteArray (VkPhysicalDeviceExternalFenceInfo# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceExternalFenceInfo
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceExternalFenceInfo
VkPhysicalDeviceExternalFenceInfo#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceExternalFenceInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalFenceInfo
-> FieldType "sType" VkPhysicalDeviceExternalFenceInfo
getField VkPhysicalDeviceExternalFenceInfo
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalFenceInfo -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalFenceInfo
-> Ptr VkPhysicalDeviceExternalFenceInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalFenceInfo
x) (Int
0))
{-# LINE 5294 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalFenceInfo
-> IO (FieldType "sType" VkPhysicalDeviceExternalFenceInfo)
readField Ptr VkPhysicalDeviceExternalFenceInfo
p
          = Ptr VkPhysicalDeviceExternalFenceInfo -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalFenceInfo
p (Int
0)
{-# LINE 5298 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceExternalFenceInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalFenceInfo
-> FieldType "sType" VkPhysicalDeviceExternalFenceInfo -> IO ()
writeField Ptr VkPhysicalDeviceExternalFenceInfo
p
          = Ptr VkPhysicalDeviceExternalFenceInfo
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalFenceInfo
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceExternalFenceInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalFenceInfo
-> FieldType "pNext" VkPhysicalDeviceExternalFenceInfo
getField VkPhysicalDeviceExternalFenceInfo
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalFenceInfo -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalFenceInfo
-> Ptr VkPhysicalDeviceExternalFenceInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalFenceInfo
x) (Int
8))
{-# LINE 5328 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalFenceInfo
-> IO (FieldType "pNext" VkPhysicalDeviceExternalFenceInfo)
readField Ptr VkPhysicalDeviceExternalFenceInfo
p
          = Ptr VkPhysicalDeviceExternalFenceInfo -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalFenceInfo
p (Int
8)
{-# LINE 5332 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceExternalFenceInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalFenceInfo
-> FieldType "pNext" VkPhysicalDeviceExternalFenceInfo -> IO ()
writeField Ptr VkPhysicalDeviceExternalFenceInfo
p
          = Ptr VkPhysicalDeviceExternalFenceInfo -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalFenceInfo
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "handleType" VkPhysicalDeviceExternalFenceInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalFenceInfo
-> FieldType "handleType" VkPhysicalDeviceExternalFenceInfo
getField VkPhysicalDeviceExternalFenceInfo
x
          = IO VkExternalFenceHandleTypeFlagBits
-> VkExternalFenceHandleTypeFlagBits
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalFenceInfo
-> Int -> IO VkExternalFenceHandleTypeFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalFenceInfo
-> Ptr VkPhysicalDeviceExternalFenceInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalFenceInfo
x) (Int
16))
{-# LINE 5363 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalFenceInfo
-> IO (FieldType "handleType" VkPhysicalDeviceExternalFenceInfo)
readField Ptr VkPhysicalDeviceExternalFenceInfo
p
          = Ptr VkPhysicalDeviceExternalFenceInfo
-> Int -> IO VkExternalFenceHandleTypeFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalFenceInfo
p (Int
16)
{-# LINE 5367 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "handleType" VkPhysicalDeviceExternalFenceInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalFenceInfo
-> FieldType "handleType" VkPhysicalDeviceExternalFenceInfo
-> IO ()
writeField Ptr VkPhysicalDeviceExternalFenceInfo
p
          = Ptr VkPhysicalDeviceExternalFenceInfo
-> Int -> VkExternalFenceHandleTypeFlagBits -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalFenceInfo
p (Int
16)
{-# LINE 5373 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalFenceInfo where
        showsPrec :: Int -> VkPhysicalDeviceExternalFenceInfo -> ShowS
showsPrec Int
d VkPhysicalDeviceExternalFenceInfo
x
          = String -> ShowS
showString String
"VkPhysicalDeviceExternalFenceInfo {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalFenceInfo
-> FieldType "sType" VkPhysicalDeviceExternalFenceInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceExternalFenceInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalFenceInfo
-> FieldType "pNext" VkPhysicalDeviceExternalFenceInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceExternalFenceInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"handleType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkExternalFenceHandleTypeFlagBits -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalFenceInfo
-> FieldType "handleType" VkPhysicalDeviceExternalFenceInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"handleType" VkPhysicalDeviceExternalFenceInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceExternalImageFormatInfo
-> VkPhysicalDeviceExternalImageFormatInfo -> Bool
==
          x :: VkPhysicalDeviceExternalImageFormatInfo
x@(VkPhysicalDeviceExternalImageFormatInfo# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalImageFormatInfo -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalImageFormatInfo
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalImageFormatInfo where
        (VkPhysicalDeviceExternalImageFormatInfo# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceExternalImageFormatInfo
-> VkPhysicalDeviceExternalImageFormatInfo -> Ordering
`compare`
          x :: VkPhysicalDeviceExternalImageFormatInfo
x@(VkPhysicalDeviceExternalImageFormatInfo# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalImageFormatInfo -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalImageFormatInfo
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceExternalImageFormatInfo
-> IO VkPhysicalDeviceExternalImageFormatInfo
peek = Ptr VkPhysicalDeviceExternalImageFormatInfo
-> IO VkPhysicalDeviceExternalImageFormatInfo
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceExternalImageFormatInfo
-> VkPhysicalDeviceExternalImageFormatInfo -> IO ()
poke = Ptr VkPhysicalDeviceExternalImageFormatInfo
-> VkPhysicalDeviceExternalImageFormatInfo -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceExternalImageFormatInfo
         where
        unsafeAddr :: VkPhysicalDeviceExternalImageFormatInfo -> Addr#
unsafeAddr (VkPhysicalDeviceExternalImageFormatInfo# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceExternalImageFormatInfo -> ByteArray#
unsafeByteArray (VkPhysicalDeviceExternalImageFormatInfo# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceExternalImageFormatInfo
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceExternalImageFormatInfo
VkPhysicalDeviceExternalImageFormatInfo#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceExternalImageFormatInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalImageFormatInfo
-> FieldType "sType" VkPhysicalDeviceExternalImageFormatInfo
getField VkPhysicalDeviceExternalImageFormatInfo
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalImageFormatInfo
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalImageFormatInfo
-> Ptr VkPhysicalDeviceExternalImageFormatInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalImageFormatInfo
x) (Int
0))
{-# LINE 5478 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalImageFormatInfo
-> IO (FieldType "sType" VkPhysicalDeviceExternalImageFormatInfo)
readField Ptr VkPhysicalDeviceExternalImageFormatInfo
p
          = Ptr VkPhysicalDeviceExternalImageFormatInfo
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalImageFormatInfo
p (Int
0)
{-# LINE 5482 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceExternalImageFormatInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalImageFormatInfo
-> FieldType "sType" VkPhysicalDeviceExternalImageFormatInfo
-> IO ()
writeField Ptr VkPhysicalDeviceExternalImageFormatInfo
p
          = Ptr VkPhysicalDeviceExternalImageFormatInfo
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalImageFormatInfo
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceExternalImageFormatInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalImageFormatInfo
-> FieldType "pNext" VkPhysicalDeviceExternalImageFormatInfo
getField VkPhysicalDeviceExternalImageFormatInfo
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalImageFormatInfo -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalImageFormatInfo
-> Ptr VkPhysicalDeviceExternalImageFormatInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalImageFormatInfo
x) (Int
8))
{-# LINE 5513 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalImageFormatInfo
-> IO (FieldType "pNext" VkPhysicalDeviceExternalImageFormatInfo)
readField Ptr VkPhysicalDeviceExternalImageFormatInfo
p
          = Ptr VkPhysicalDeviceExternalImageFormatInfo -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalImageFormatInfo
p (Int
8)
{-# LINE 5517 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceExternalImageFormatInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalImageFormatInfo
-> FieldType "pNext" VkPhysicalDeviceExternalImageFormatInfo
-> IO ()
writeField Ptr VkPhysicalDeviceExternalImageFormatInfo
p
          = Ptr VkPhysicalDeviceExternalImageFormatInfo
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalImageFormatInfo
p (Int
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 :: Bool
fieldOptional = Bool
True

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

instance {-# OVERLAPPING #-}
         CanReadField "handleType" VkPhysicalDeviceExternalImageFormatInfo
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalImageFormatInfo
-> FieldType "handleType" VkPhysicalDeviceExternalImageFormatInfo
getField VkPhysicalDeviceExternalImageFormatInfo
x
          = IO VkExternalMemoryHandleTypeFlagBits
-> VkExternalMemoryHandleTypeFlagBits
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalImageFormatInfo
-> Int -> IO VkExternalMemoryHandleTypeFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalImageFormatInfo
-> Ptr VkPhysicalDeviceExternalImageFormatInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalImageFormatInfo
x) (Int
16))
{-# LINE 5553 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalImageFormatInfo
-> IO
     (FieldType "handleType" VkPhysicalDeviceExternalImageFormatInfo)
readField Ptr VkPhysicalDeviceExternalImageFormatInfo
p
          = Ptr VkPhysicalDeviceExternalImageFormatInfo
-> Int -> IO VkExternalMemoryHandleTypeFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalImageFormatInfo
p (Int
16)
{-# LINE 5557 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "handleType" VkPhysicalDeviceExternalImageFormatInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalImageFormatInfo
-> FieldType "handleType" VkPhysicalDeviceExternalImageFormatInfo
-> IO ()
writeField Ptr VkPhysicalDeviceExternalImageFormatInfo
p
          = Ptr VkPhysicalDeviceExternalImageFormatInfo
-> Int -> VkExternalMemoryHandleTypeFlagBits -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalImageFormatInfo
p (Int
16)
{-# LINE 5564 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalImageFormatInfo where
        showsPrec :: Int -> VkPhysicalDeviceExternalImageFormatInfo -> ShowS
showsPrec Int
d VkPhysicalDeviceExternalImageFormatInfo
x
          = String -> ShowS
showString String
"VkPhysicalDeviceExternalImageFormatInfo {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalImageFormatInfo
-> FieldType "sType" VkPhysicalDeviceExternalImageFormatInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceExternalImageFormatInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalImageFormatInfo
-> FieldType "pNext" VkPhysicalDeviceExternalImageFormatInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceExternalImageFormatInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"handleType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkExternalMemoryHandleTypeFlagBits -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalImageFormatInfo
-> FieldType "handleType" VkPhysicalDeviceExternalImageFormatInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"handleType" VkPhysicalDeviceExternalImageFormatInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> VkPhysicalDeviceExternalMemoryHostPropertiesEXT -> Bool
==
          x :: VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x@(VkPhysicalDeviceExternalMemoryHostPropertiesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalMemoryHostPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalMemoryHostPropertiesEXT where
        (VkPhysicalDeviceExternalMemoryHostPropertiesEXT# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> VkPhysicalDeviceExternalMemoryHostPropertiesEXT -> Ordering
`compare`
          x :: VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x@(VkPhysicalDeviceExternalMemoryHostPropertiesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalMemoryHostPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> IO VkPhysicalDeviceExternalMemoryHostPropertiesEXT
peek = Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> IO VkPhysicalDeviceExternalMemoryHostPropertiesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> VkPhysicalDeviceExternalMemoryHostPropertiesEXT -> IO ()
poke = Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> VkPhysicalDeviceExternalMemoryHostPropertiesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        unsafeAddr :: VkPhysicalDeviceExternalMemoryHostPropertiesEXT -> Addr#
unsafeAddr (VkPhysicalDeviceExternalMemoryHostPropertiesEXT# Addr#
a ByteArray#
_)
          = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceExternalMemoryHostPropertiesEXT -> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceExternalMemoryHostPropertiesEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int#
-> ByteArray# -> VkPhysicalDeviceExternalMemoryHostPropertiesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray# -> VkPhysicalDeviceExternalMemoryHostPropertiesEXT
VkPhysicalDeviceExternalMemoryHostPropertiesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
getField VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x) (Int
0))
{-# LINE 5684 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> IO
     (FieldType "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT)
readField Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p
          = Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p (Int
0)
{-# LINE 5688 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p
          = Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
getField VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x) (Int
8))
{-# LINE 5729 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> IO
     (FieldType "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT)
readField Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p
          = Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p (Int
8)
{-# LINE 5733 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p
          = Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "minImportedHostPointerAlignment"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> FieldType
     "minImportedHostPointerAlignment"
     VkPhysicalDeviceExternalMemoryHostPropertiesEXT
getField VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x) (Int
16))
{-# LINE 5775 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> IO
     (FieldType
        "minImportedHostPointerAlignment"
        VkPhysicalDeviceExternalMemoryHostPropertiesEXT)
readField Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p
          = Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p (Int
16)
{-# LINE 5779 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minImportedHostPointerAlignment"
           VkPhysicalDeviceExternalMemoryHostPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> FieldType
     "minImportedHostPointerAlignment"
     VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p
          = Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalMemoryHostPropertiesEXT
p (Int
16)
{-# LINE 5787 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalMemoryHostPropertiesEXT where
        showsPrec :: Int -> VkPhysicalDeviceExternalMemoryHostPropertiesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x
          = String -> ShowS
showString String
"VkPhysicalDeviceExternalMemoryHostPropertiesEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"minImportedHostPointerAlignment = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalMemoryHostPropertiesEXT
-> FieldType
     "minImportedHostPointerAlignment"
     VkPhysicalDeviceExternalMemoryHostPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"minImportedHostPointerAlignment" VkPhysicalDeviceExternalMemoryHostPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceExternalSemaphoreInfo
-> VkPhysicalDeviceExternalSemaphoreInfo -> Bool
==
          x :: VkPhysicalDeviceExternalSemaphoreInfo
x@(VkPhysicalDeviceExternalSemaphoreInfo# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalSemaphoreInfo -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalSemaphoreInfo
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceExternalSemaphoreInfo where
        (VkPhysicalDeviceExternalSemaphoreInfo# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceExternalSemaphoreInfo
-> VkPhysicalDeviceExternalSemaphoreInfo -> Ordering
`compare`
          x :: VkPhysicalDeviceExternalSemaphoreInfo
x@(VkPhysicalDeviceExternalSemaphoreInfo# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceExternalSemaphoreInfo -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceExternalSemaphoreInfo
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> IO VkPhysicalDeviceExternalSemaphoreInfo
peek = Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> IO VkPhysicalDeviceExternalSemaphoreInfo
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> VkPhysicalDeviceExternalSemaphoreInfo -> IO ()
poke = Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> VkPhysicalDeviceExternalSemaphoreInfo -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceExternalSemaphoreInfo
         where
        unsafeAddr :: VkPhysicalDeviceExternalSemaphoreInfo -> Addr#
unsafeAddr (VkPhysicalDeviceExternalSemaphoreInfo# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceExternalSemaphoreInfo -> ByteArray#
unsafeByteArray (VkPhysicalDeviceExternalSemaphoreInfo# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceExternalSemaphoreInfo
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceExternalSemaphoreInfo
VkPhysicalDeviceExternalSemaphoreInfo#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceExternalSemaphoreInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalSemaphoreInfo
-> FieldType "sType" VkPhysicalDeviceExternalSemaphoreInfo
getField VkPhysicalDeviceExternalSemaphoreInfo
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalSemaphoreInfo
-> Ptr VkPhysicalDeviceExternalSemaphoreInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalSemaphoreInfo
x) (Int
0))
{-# LINE 5887 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> IO (FieldType "sType" VkPhysicalDeviceExternalSemaphoreInfo)
readField Ptr VkPhysicalDeviceExternalSemaphoreInfo
p
          = Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalSemaphoreInfo
p (Int
0)
{-# LINE 5891 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceExternalSemaphoreInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> FieldType "sType" VkPhysicalDeviceExternalSemaphoreInfo -> IO ()
writeField Ptr VkPhysicalDeviceExternalSemaphoreInfo
p
          = Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalSemaphoreInfo
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceExternalSemaphoreInfo where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalSemaphoreInfo
-> FieldType "pNext" VkPhysicalDeviceExternalSemaphoreInfo
getField VkPhysicalDeviceExternalSemaphoreInfo
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalSemaphoreInfo -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalSemaphoreInfo
-> Ptr VkPhysicalDeviceExternalSemaphoreInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalSemaphoreInfo
x) (Int
8))
{-# LINE 5922 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> IO (FieldType "pNext" VkPhysicalDeviceExternalSemaphoreInfo)
readField Ptr VkPhysicalDeviceExternalSemaphoreInfo
p
          = Ptr VkPhysicalDeviceExternalSemaphoreInfo -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalSemaphoreInfo
p (Int
8)
{-# LINE 5926 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceExternalSemaphoreInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> FieldType "pNext" VkPhysicalDeviceExternalSemaphoreInfo -> IO ()
writeField Ptr VkPhysicalDeviceExternalSemaphoreInfo
p
          = Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalSemaphoreInfo
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "handleType" VkPhysicalDeviceExternalSemaphoreInfo
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceExternalSemaphoreInfo
-> FieldType "handleType" VkPhysicalDeviceExternalSemaphoreInfo
getField VkPhysicalDeviceExternalSemaphoreInfo
x
          = IO VkExternalSemaphoreHandleTypeFlagBits
-> VkExternalSemaphoreHandleTypeFlagBits
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> Int -> IO VkExternalSemaphoreHandleTypeFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceExternalSemaphoreInfo
-> Ptr VkPhysicalDeviceExternalSemaphoreInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceExternalSemaphoreInfo
x) (Int
16))
{-# LINE 5961 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> IO
     (FieldType "handleType" VkPhysicalDeviceExternalSemaphoreInfo)
readField Ptr VkPhysicalDeviceExternalSemaphoreInfo
p
          = Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> Int -> IO VkExternalSemaphoreHandleTypeFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceExternalSemaphoreInfo
p (Int
16)
{-# LINE 5965 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "handleType" VkPhysicalDeviceExternalSemaphoreInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> FieldType "handleType" VkPhysicalDeviceExternalSemaphoreInfo
-> IO ()
writeField Ptr VkPhysicalDeviceExternalSemaphoreInfo
p
          = Ptr VkPhysicalDeviceExternalSemaphoreInfo
-> Int -> VkExternalSemaphoreHandleTypeFlagBits -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceExternalSemaphoreInfo
p (Int
16)
{-# LINE 5972 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceExternalSemaphoreInfo where
        showsPrec :: Int -> VkPhysicalDeviceExternalSemaphoreInfo -> ShowS
showsPrec Int
d VkPhysicalDeviceExternalSemaphoreInfo
x
          = String -> ShowS
showString String
"VkPhysicalDeviceExternalSemaphoreInfo {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalSemaphoreInfo
-> FieldType "sType" VkPhysicalDeviceExternalSemaphoreInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceExternalSemaphoreInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalSemaphoreInfo
-> FieldType "pNext" VkPhysicalDeviceExternalSemaphoreInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceExternalSemaphoreInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"handleType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkExternalSemaphoreHandleTypeFlagBits -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceExternalSemaphoreInfo
-> FieldType "handleType" VkPhysicalDeviceExternalSemaphoreInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"handleType" VkPhysicalDeviceExternalSemaphoreInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceFeatures2 -> VkPhysicalDeviceFeatures2 -> Bool
==
          x :: VkPhysicalDeviceFeatures2
x@(VkPhysicalDeviceFeatures2# Addr#
b ByteArray#
_) = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceFeatures2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceFeatures2
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceFeatures2 where
        (VkPhysicalDeviceFeatures2# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceFeatures2 -> VkPhysicalDeviceFeatures2 -> Ordering
`compare`
          x :: VkPhysicalDeviceFeatures2
x@(VkPhysicalDeviceFeatures2# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceFeatures2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceFeatures2
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceFeatures2 -> IO VkPhysicalDeviceFeatures2
peek = Ptr VkPhysicalDeviceFeatures2 -> IO VkPhysicalDeviceFeatures2
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceFeatures2 -> VkPhysicalDeviceFeatures2 -> IO ()
poke = Ptr VkPhysicalDeviceFeatures2 -> VkPhysicalDeviceFeatures2 -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceFeatures2 where
        unsafeAddr :: VkPhysicalDeviceFeatures2 -> Addr#
unsafeAddr (VkPhysicalDeviceFeatures2# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceFeatures2 -> ByteArray#
unsafeByteArray (VkPhysicalDeviceFeatures2# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceFeatures2
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceFeatures2
VkPhysicalDeviceFeatures2# (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceFeatures2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceFeatures2
-> FieldType "sType" VkPhysicalDeviceFeatures2
getField VkPhysicalDeviceFeatures2
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceFeatures2 -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceFeatures2 -> Ptr VkPhysicalDeviceFeatures2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceFeatures2
x) (Int
0))
{-# LINE 6067 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures2
-> IO (FieldType "sType" VkPhysicalDeviceFeatures2)
readField Ptr VkPhysicalDeviceFeatures2
p
          = Ptr VkPhysicalDeviceFeatures2 -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures2
p (Int
0)
{-# LINE 6071 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceFeatures2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures2
-> FieldType "sType" VkPhysicalDeviceFeatures2 -> IO ()
writeField Ptr VkPhysicalDeviceFeatures2
p
          = Ptr VkPhysicalDeviceFeatures2 -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceFeatures2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceFeatures2
-> FieldType "pNext" VkPhysicalDeviceFeatures2
getField VkPhysicalDeviceFeatures2
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceFeatures2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceFeatures2 -> Ptr VkPhysicalDeviceFeatures2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceFeatures2
x) (Int
8))
{-# LINE 6099 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures2
-> IO (FieldType "pNext" VkPhysicalDeviceFeatures2)
readField Ptr VkPhysicalDeviceFeatures2
p
          = Ptr VkPhysicalDeviceFeatures2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures2
p (Int
8)
{-# LINE 6103 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceFeatures2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures2
-> FieldType "pNext" VkPhysicalDeviceFeatures2 -> IO ()
writeField Ptr VkPhysicalDeviceFeatures2
p
          = Ptr VkPhysicalDeviceFeatures2 -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "features" VkPhysicalDeviceFeatures2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceFeatures2
-> FieldType "features" VkPhysicalDeviceFeatures2
getField VkPhysicalDeviceFeatures2
x
          = IO VkPhysicalDeviceFeatures -> VkPhysicalDeviceFeatures
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceFeatures2 -> Int -> IO VkPhysicalDeviceFeatures
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceFeatures2 -> Ptr VkPhysicalDeviceFeatures2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceFeatures2
x) (Int
16))
{-# LINE 6132 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures2
-> IO (FieldType "features" VkPhysicalDeviceFeatures2)
readField Ptr VkPhysicalDeviceFeatures2
p
          = Ptr VkPhysicalDeviceFeatures2 -> Int -> IO VkPhysicalDeviceFeatures
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures2
p (Int
16)
{-# LINE 6136 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "features" VkPhysicalDeviceFeatures2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures2
-> FieldType "features" VkPhysicalDeviceFeatures2 -> IO ()
writeField Ptr VkPhysicalDeviceFeatures2
p
          = Ptr VkPhysicalDeviceFeatures2
-> Int -> VkPhysicalDeviceFeatures -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures2
p (Int
16)
{-# LINE 6142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceFeatures2 where
        showsPrec :: Int -> VkPhysicalDeviceFeatures2 -> ShowS
showsPrec Int
d VkPhysicalDeviceFeatures2
x
          = String -> ShowS
showString String
"VkPhysicalDeviceFeatures2 {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceFeatures2
-> FieldType "sType" VkPhysicalDeviceFeatures2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceFeatures2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceFeatures2
-> FieldType "pNext" VkPhysicalDeviceFeatures2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceFeatures2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"features = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkPhysicalDeviceFeatures -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceFeatures2
-> FieldType "features" VkPhysicalDeviceFeatures2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"features" VkPhysicalDeviceFeatures2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceGroupProperties
-> VkPhysicalDeviceGroupProperties -> Bool
==
          x :: VkPhysicalDeviceGroupProperties
x@(VkPhysicalDeviceGroupProperties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceGroupProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceGroupProperties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceGroupProperties where
        (VkPhysicalDeviceGroupProperties# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceGroupProperties
-> VkPhysicalDeviceGroupProperties -> Ordering
`compare`
          x :: VkPhysicalDeviceGroupProperties
x@(VkPhysicalDeviceGroupProperties# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceGroupProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceGroupProperties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceGroupProperties
-> IO VkPhysicalDeviceGroupProperties
peek = Ptr VkPhysicalDeviceGroupProperties
-> IO VkPhysicalDeviceGroupProperties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceGroupProperties
-> VkPhysicalDeviceGroupProperties -> IO ()
poke = Ptr VkPhysicalDeviceGroupProperties
-> VkPhysicalDeviceGroupProperties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceGroupProperties where
        unsafeAddr :: VkPhysicalDeviceGroupProperties -> Addr#
unsafeAddr (VkPhysicalDeviceGroupProperties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceGroupProperties -> ByteArray#
unsafeByteArray (VkPhysicalDeviceGroupProperties# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceGroupProperties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceGroupProperties
VkPhysicalDeviceGroupProperties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceGroupProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceGroupProperties
-> FieldType "sType" VkPhysicalDeviceGroupProperties
getField VkPhysicalDeviceGroupProperties
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceGroupProperties -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceGroupProperties
-> Ptr VkPhysicalDeviceGroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceGroupProperties
x) (Int
0))
{-# LINE 6242 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceGroupProperties
-> IO (FieldType "sType" VkPhysicalDeviceGroupProperties)
readField Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceGroupProperties
p (Int
0)
{-# LINE 6246 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceGroupProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceGroupProperties
-> FieldType "sType" VkPhysicalDeviceGroupProperties -> IO ()
writeField Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceGroupProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceGroupProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceGroupProperties
-> FieldType "pNext" VkPhysicalDeviceGroupProperties
getField VkPhysicalDeviceGroupProperties
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceGroupProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceGroupProperties
-> Ptr VkPhysicalDeviceGroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceGroupProperties
x) (Int
8))
{-# LINE 6274 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceGroupProperties
-> IO (FieldType "pNext" VkPhysicalDeviceGroupProperties)
readField Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceGroupProperties
p (Int
8)
{-# LINE 6278 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceGroupProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceGroupProperties
-> FieldType "pNext" VkPhysicalDeviceGroupProperties -> IO ()
writeField Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceGroupProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "physicalDeviceCount" VkPhysicalDeviceGroupProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceGroupProperties
-> FieldType "physicalDeviceCount" VkPhysicalDeviceGroupProperties
getField VkPhysicalDeviceGroupProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceGroupProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceGroupProperties
-> Ptr VkPhysicalDeviceGroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceGroupProperties
x) (Int
16))
{-# LINE 6316 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceGroupProperties
-> IO
     (FieldType "physicalDeviceCount" VkPhysicalDeviceGroupProperties)
readField Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceGroupProperties
p (Int
16)
{-# LINE 6320 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "physicalDeviceCount" VkPhysicalDeviceGroupProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceGroupProperties
-> FieldType "physicalDeviceCount" VkPhysicalDeviceGroupProperties
-> IO ()
writeField Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceGroupProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
forall a. (Num a, Eq a) => a
VK_MAX_DEVICE_GROUP_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceGroupProperties
-> FieldType "physicalDevices" VkPhysicalDeviceGroupProperties
getFieldArray = VkPhysicalDeviceGroupProperties -> VkPhysicalDevice
VkPhysicalDeviceGroupProperties
-> FieldType "physicalDevices" VkPhysicalDeviceGroupProperties
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceGroupProperties -> VkPhysicalDevice
f VkPhysicalDeviceGroupProperties
x = IO VkPhysicalDevice -> VkPhysicalDevice
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceGroupProperties -> Int -> IO VkPhysicalDevice
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceGroupProperties
-> Ptr VkPhysicalDeviceGroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceGroupProperties
x) Int
off)
                off :: Int
off
                  = (Int
24)
{-# LINE 6387 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      VkPhysicalDevice -> Int
forall a. Storable a => a -> Int
sizeOf (VkPhysicalDevice
forall a. HasCallStack => a
undefined :: VkPhysicalDevice) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceGroupProperties
-> IO (FieldType "physicalDevices" VkPhysicalDeviceGroupProperties)
readFieldArray Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties -> Int -> IO VkPhysicalDevice
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceGroupProperties
p
              ((Int
24)
{-# LINE 6395 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 VkPhysicalDevice -> Int
forall a. Storable a => a -> Int
sizeOf (VkPhysicalDevice
forall a. HasCallStack => a
undefined :: VkPhysicalDevice) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceGroupProperties
-> FieldType "physicalDevices" VkPhysicalDeviceGroupProperties
-> IO ()
writeFieldArray Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties
-> Int -> VkPhysicalDevice -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceGroupProperties
p
              ((Int
24)
{-# LINE 6430 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 VkPhysicalDevice -> Int
forall a. Storable a => a -> Int
sizeOf (VkPhysicalDevice
forall a. HasCallStack => a
undefined :: VkPhysicalDevice) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "subsetAllocation" VkPhysicalDeviceGroupProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceGroupProperties
-> FieldType "subsetAllocation" VkPhysicalDeviceGroupProperties
getField VkPhysicalDeviceGroupProperties
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceGroupProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceGroupProperties
-> Ptr VkPhysicalDeviceGroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceGroupProperties
x) (Int
280))
{-# LINE 6462 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceGroupProperties
-> IO
     (FieldType "subsetAllocation" VkPhysicalDeviceGroupProperties)
readField Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceGroupProperties
p (Int
280)
{-# LINE 6466 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subsetAllocation" VkPhysicalDeviceGroupProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceGroupProperties
-> FieldType "subsetAllocation" VkPhysicalDeviceGroupProperties
-> IO ()
writeField Ptr VkPhysicalDeviceGroupProperties
p
          = Ptr VkPhysicalDeviceGroupProperties -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceGroupProperties
p (Int
280)
{-# LINE 6473 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceGroupProperties where
        showsPrec :: Int -> VkPhysicalDeviceGroupProperties -> ShowS
showsPrec Int
d VkPhysicalDeviceGroupProperties
x
          = String -> ShowS
showString String
"VkPhysicalDeviceGroupProperties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceGroupProperties
-> FieldType "sType" VkPhysicalDeviceGroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceGroupProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceGroupProperties
-> FieldType "pNext" VkPhysicalDeviceGroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceGroupProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"physicalDeviceCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceGroupProperties
-> FieldType "physicalDeviceCount" VkPhysicalDeviceGroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"physicalDeviceCount" VkPhysicalDeviceGroupProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                (String -> ShowS
showString String
"physicalDevices = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   Int -> [VkPhysicalDevice] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                     (let s :: Int
s = VkPhysicalDevice -> Int
forall a. Storable a => a -> Int
sizeOf
                                                (FieldType "physicalDevices" VkPhysicalDeviceGroupProperties
forall a. HasCallStack => a
undefined ::
                                                   FieldType "physicalDevices"
                                                     VkPhysicalDeviceGroupProperties)
                                          o :: Int
o = HasField "physicalDevices" VkPhysicalDeviceGroupProperties => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"physicalDevices"
                                                @VkPhysicalDeviceGroupProperties
                                          f :: Int
-> IO (FieldType "physicalDevices" VkPhysicalDeviceGroupProperties)
f Int
i
                                            = Ptr VkPhysicalDeviceGroupProperties -> Int -> IO VkPhysicalDevice
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceGroupProperties
-> Ptr VkPhysicalDeviceGroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceGroupProperties
x) Int
i ::
                                                IO
                                                  (FieldType "physicalDevices"
                                                     VkPhysicalDeviceGroupProperties)
                                        in
                                        IO [VkPhysicalDevice] -> [VkPhysicalDevice]
forall a. IO a -> a
unsafeDupablePerformIO (IO [VkPhysicalDevice] -> [VkPhysicalDevice])
-> ([Int] -> IO [VkPhysicalDevice]) -> [Int] -> [VkPhysicalDevice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO VkPhysicalDevice) -> [Int] -> IO [VkPhysicalDevice]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO VkPhysicalDevice
Int
-> IO (FieldType "physicalDevices" VkPhysicalDeviceGroupProperties)
f ([Int] -> [VkPhysicalDevice]) -> [Int] -> [VkPhysicalDevice]
forall a b. (a -> b) -> a -> b
$
                                          (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s)
                                            [Int
0 .. Int
forall a. (Num a, Eq a) => a
VK_MAX_DEVICE_GROUP_SIZE Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
"subsetAllocation = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceGroupProperties
-> FieldType "subsetAllocation" VkPhysicalDeviceGroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"subsetAllocation" VkPhysicalDeviceGroupProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceIDProperties
-> VkPhysicalDeviceIDProperties -> Bool
==
          x :: VkPhysicalDeviceIDProperties
x@(VkPhysicalDeviceIDProperties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceIDProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceIDProperties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceIDProperties where
        (VkPhysicalDeviceIDProperties# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceIDProperties
-> VkPhysicalDeviceIDProperties -> Ordering
`compare`
          x :: VkPhysicalDeviceIDProperties
x@(VkPhysicalDeviceIDProperties# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceIDProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceIDProperties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceIDProperties -> IO VkPhysicalDeviceIDProperties
peek = Ptr VkPhysicalDeviceIDProperties -> IO VkPhysicalDeviceIDProperties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceIDProperties
-> VkPhysicalDeviceIDProperties -> IO ()
poke = Ptr VkPhysicalDeviceIDProperties
-> VkPhysicalDeviceIDProperties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceIDProperties where
        unsafeAddr :: VkPhysicalDeviceIDProperties -> Addr#
unsafeAddr (VkPhysicalDeviceIDProperties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceIDProperties -> ByteArray#
unsafeByteArray (VkPhysicalDeviceIDProperties# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceIDProperties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceIDProperties
VkPhysicalDeviceIDProperties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceIDProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceIDProperties
-> FieldType "sType" VkPhysicalDeviceIDProperties
getField VkPhysicalDeviceIDProperties
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceIDProperties -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) (Int
0))
{-# LINE 6600 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceIDProperties
-> IO (FieldType "sType" VkPhysicalDeviceIDProperties)
readField Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceIDProperties
p (Int
0)
{-# LINE 6604 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceIDProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceIDProperties
-> FieldType "sType" VkPhysicalDeviceIDProperties -> IO ()
writeField Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceIDProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceIDProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceIDProperties
-> FieldType "pNext" VkPhysicalDeviceIDProperties
getField VkPhysicalDeviceIDProperties
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceIDProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) (Int
8))
{-# LINE 6632 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceIDProperties
-> IO (FieldType "pNext" VkPhysicalDeviceIDProperties)
readField Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceIDProperties
p (Int
8)
{-# LINE 6636 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceIDProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceIDProperties
-> FieldType "pNext" VkPhysicalDeviceIDProperties -> IO ()
writeField Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceIDProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
forall a. (Num a, Eq a) => a
VK_UUID_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceIDProperties
-> FieldType "deviceUUID" VkPhysicalDeviceIDProperties
getFieldArray = VkPhysicalDeviceIDProperties -> Word8
VkPhysicalDeviceIDProperties
-> FieldType "deviceUUID" VkPhysicalDeviceIDProperties
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceIDProperties -> Word8
f VkPhysicalDeviceIDProperties
x = IO Word8 -> Word8
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) Int
off)
                off :: Int
off
                  = (Int
16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 6687 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceIDProperties
-> IO (FieldType "deviceUUID" VkPhysicalDeviceIDProperties)
readFieldArray Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceIDProperties
p
              ((Int
16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 6694 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceIDProperties
-> FieldType "deviceUUID" VkPhysicalDeviceIDProperties -> IO ()
writeFieldArray Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceIDProperties
p
              ((Int
16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 6718 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
forall a. (Num a, Eq a) => a
VK_UUID_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceIDProperties
-> FieldType "driverUUID" VkPhysicalDeviceIDProperties
getFieldArray = VkPhysicalDeviceIDProperties -> Word8
VkPhysicalDeviceIDProperties
-> FieldType "driverUUID" VkPhysicalDeviceIDProperties
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceIDProperties -> Word8
f VkPhysicalDeviceIDProperties
x = IO Word8 -> Word8
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) Int
off)
                off :: Int
off
                  = (Int
32) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 6765 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceIDProperties
-> IO (FieldType "driverUUID" VkPhysicalDeviceIDProperties)
readFieldArray Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceIDProperties
p
              ((Int
32) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 6772 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceIDProperties
-> FieldType "driverUUID" VkPhysicalDeviceIDProperties -> IO ()
writeFieldArray Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceIDProperties
p
              ((Int
32) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 6796 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
forall a. (Num a, Eq a) => a
VK_LUID_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceIDProperties
-> FieldType "deviceLUID" VkPhysicalDeviceIDProperties
getFieldArray = VkPhysicalDeviceIDProperties -> Word8
VkPhysicalDeviceIDProperties
-> FieldType "deviceLUID" VkPhysicalDeviceIDProperties
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceIDProperties -> Word8
f VkPhysicalDeviceIDProperties
x = IO Word8 -> Word8
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) Int
off)
                off :: Int
off
                  = (Int
48) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 6843 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceIDProperties
-> IO (FieldType "deviceLUID" VkPhysicalDeviceIDProperties)
readFieldArray Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceIDProperties
p
              ((Int
48) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 6850 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceIDProperties
-> FieldType "deviceLUID" VkPhysicalDeviceIDProperties -> IO ()
writeFieldArray Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceIDProperties
p
              ((Int
48) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 6874 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "deviceNodeMask" VkPhysicalDeviceIDProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceIDProperties
-> FieldType "deviceNodeMask" VkPhysicalDeviceIDProperties
getField VkPhysicalDeviceIDProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) (Int
56))
{-# LINE 6901 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceIDProperties
-> IO (FieldType "deviceNodeMask" VkPhysicalDeviceIDProperties)
readField Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceIDProperties
p (Int
56)
{-# LINE 6905 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "deviceNodeMask" VkPhysicalDeviceIDProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceIDProperties
-> FieldType "deviceNodeMask" VkPhysicalDeviceIDProperties -> IO ()
writeField Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceIDProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "deviceLUIDValid" VkPhysicalDeviceIDProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceIDProperties
-> FieldType "deviceLUIDValid" VkPhysicalDeviceIDProperties
getField VkPhysicalDeviceIDProperties
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceIDProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) (Int
60))
{-# LINE 6936 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceIDProperties
-> IO (FieldType "deviceLUIDValid" VkPhysicalDeviceIDProperties)
readField Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceIDProperties
p (Int
60)
{-# LINE 6940 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "deviceLUIDValid" VkPhysicalDeviceIDProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceIDProperties
-> FieldType "deviceLUIDValid" VkPhysicalDeviceIDProperties
-> IO ()
writeField Ptr VkPhysicalDeviceIDProperties
p
          = Ptr VkPhysicalDeviceIDProperties -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceIDProperties
p (Int
60)
{-# LINE 6946 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceIDProperties where
        showsPrec :: Int -> VkPhysicalDeviceIDProperties -> ShowS
showsPrec Int
d VkPhysicalDeviceIDProperties
x
          = String -> ShowS
showString String
"VkPhysicalDeviceIDProperties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceIDProperties
-> FieldType "sType" VkPhysicalDeviceIDProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceIDProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceIDProperties
-> FieldType "pNext" VkPhysicalDeviceIDProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceIDProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          (String -> ShowS
showString String
"deviceUUID = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                             Int -> [Word8] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                               (let s :: Int
s = Word8 -> Int
forall a. Storable a => a -> Int
sizeOf
                                          (FieldType "deviceUUID" VkPhysicalDeviceIDProperties
forall a. HasCallStack => a
undefined ::
                                             FieldType "deviceUUID" VkPhysicalDeviceIDProperties)
                                    o :: Int
o = HasField "deviceUUID" VkPhysicalDeviceIDProperties => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"deviceUUID" @VkPhysicalDeviceIDProperties
                                    f :: Int -> IO (FieldType "deviceUUID" VkPhysicalDeviceIDProperties)
f Int
i
                                      = Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) Int
i ::
                                          IO (FieldType "deviceUUID" VkPhysicalDeviceIDProperties)
                                  in
                                  IO [Word8] -> [Word8]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Word8] -> [Word8])
-> ([Int] -> IO [Word8]) -> [Int] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Word8) -> [Int] -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Word8
Int -> IO (FieldType "deviceUUID" VkPhysicalDeviceIDProperties)
f ([Int] -> [Word8]) -> [Int] -> [Word8]
forall a b. (a -> b) -> a -> b
$
                                    (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
forall a. (Num a, Eq a) => a
VK_UUID_SIZE Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                               ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              (String -> ShowS
showString String
"driverUUID = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 Int -> [Word8] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                   (let s :: Int
s = Word8 -> Int
forall a. Storable a => a -> Int
sizeOf
                                              (FieldType "driverUUID" VkPhysicalDeviceIDProperties
forall a. HasCallStack => a
undefined ::
                                                 FieldType "driverUUID"
                                                   VkPhysicalDeviceIDProperties)
                                        o :: Int
o = HasField "driverUUID" VkPhysicalDeviceIDProperties => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"driverUUID" @VkPhysicalDeviceIDProperties
                                        f :: Int -> IO (FieldType "driverUUID" VkPhysicalDeviceIDProperties)
f Int
i
                                          = Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) Int
i ::
                                              IO
                                                (FieldType "driverUUID"
                                                   VkPhysicalDeviceIDProperties)
                                      in
                                      IO [Word8] -> [Word8]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Word8] -> [Word8])
-> ([Int] -> IO [Word8]) -> [Int] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Word8) -> [Int] -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Word8
Int -> IO (FieldType "driverUUID" VkPhysicalDeviceIDProperties)
f ([Int] -> [Word8]) -> [Int] -> [Word8]
forall a b. (a -> b) -> a -> b
$
                                        (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
forall a. (Num a, Eq a) => a
VK_UUID_SIZE Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                                   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  (String -> ShowS
showString String
"deviceLUID = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     Int -> [Word8] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                       (let s :: Int
s = Word8 -> Int
forall a. Storable a => a -> Int
sizeOf
                                                  (FieldType "deviceLUID" VkPhysicalDeviceIDProperties
forall a. HasCallStack => a
undefined ::
                                                     FieldType "deviceLUID"
                                                       VkPhysicalDeviceIDProperties)
                                            o :: Int
o = HasField "deviceLUID" VkPhysicalDeviceIDProperties => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"deviceLUID"
                                                  @VkPhysicalDeviceIDProperties
                                            f :: Int -> IO (FieldType "deviceLUID" VkPhysicalDeviceIDProperties)
f Int
i
                                              = Ptr VkPhysicalDeviceIDProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceIDProperties -> Ptr VkPhysicalDeviceIDProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceIDProperties
x) Int
i ::
                                                  IO
                                                    (FieldType "deviceLUID"
                                                       VkPhysicalDeviceIDProperties)
                                          in
                                          IO [Word8] -> [Word8]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Word8] -> [Word8])
-> ([Int] -> IO [Word8]) -> [Int] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Word8) -> [Int] -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Word8
Int -> IO (FieldType "deviceLUID" VkPhysicalDeviceIDProperties)
f ([Int] -> [Word8]) -> [Int] -> [Word8]
forall a b. (a -> b) -> a -> b
$
                                            (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
forall a. (Num a, Eq a) => a
VK_LUID_SIZE Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                                       ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"deviceNodeMask = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceIDProperties
-> FieldType "deviceNodeMask" VkPhysicalDeviceIDProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"deviceNodeMask" VkPhysicalDeviceIDProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"deviceLUIDValid = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceIDProperties
-> FieldType "deviceLUIDValid" VkPhysicalDeviceIDProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"deviceLUIDValid" VkPhysicalDeviceIDProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceImageFormatInfo2
-> VkPhysicalDeviceImageFormatInfo2 -> Bool
==
          x :: VkPhysicalDeviceImageFormatInfo2
x@(VkPhysicalDeviceImageFormatInfo2# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceImageFormatInfo2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceImageFormatInfo2
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceImageFormatInfo2 where
        (VkPhysicalDeviceImageFormatInfo2# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceImageFormatInfo2
-> VkPhysicalDeviceImageFormatInfo2 -> Ordering
`compare`
          x :: VkPhysicalDeviceImageFormatInfo2
x@(VkPhysicalDeviceImageFormatInfo2# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceImageFormatInfo2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceImageFormatInfo2
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

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

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

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceImageFormatInfo2
-> IO VkPhysicalDeviceImageFormatInfo2
peek = Ptr VkPhysicalDeviceImageFormatInfo2
-> IO VkPhysicalDeviceImageFormatInfo2
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceImageFormatInfo2
-> VkPhysicalDeviceImageFormatInfo2 -> IO ()
poke = Ptr VkPhysicalDeviceImageFormatInfo2
-> VkPhysicalDeviceImageFormatInfo2 -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceImageFormatInfo2 where
        unsafeAddr :: VkPhysicalDeviceImageFormatInfo2 -> Addr#
unsafeAddr (VkPhysicalDeviceImageFormatInfo2# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceImageFormatInfo2 -> ByteArray#
unsafeByteArray (VkPhysicalDeviceImageFormatInfo2# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceImageFormatInfo2
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceImageFormatInfo2
VkPhysicalDeviceImageFormatInfo2#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceImageFormatInfo2
-> FieldType "sType" VkPhysicalDeviceImageFormatInfo2
getField VkPhysicalDeviceImageFormatInfo2
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceImageFormatInfo2
-> Ptr VkPhysicalDeviceImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceImageFormatInfo2
x) (Int
0))
{-# LINE 7105 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> IO (FieldType "sType" VkPhysicalDeviceImageFormatInfo2)
readField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
0)
{-# LINE 7109 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> FieldType "sType" VkPhysicalDeviceImageFormatInfo2 -> IO ()
writeField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceImageFormatInfo2
-> FieldType "pNext" VkPhysicalDeviceImageFormatInfo2
getField VkPhysicalDeviceImageFormatInfo2
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceImageFormatInfo2
-> Ptr VkPhysicalDeviceImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceImageFormatInfo2
x) (Int
8))
{-# LINE 7138 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> IO (FieldType "pNext" VkPhysicalDeviceImageFormatInfo2)
readField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
8)
{-# LINE 7142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> FieldType "pNext" VkPhysicalDeviceImageFormatInfo2 -> IO ()
writeField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "format" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceImageFormatInfo2
-> FieldType "format" VkPhysicalDeviceImageFormatInfo2
getField VkPhysicalDeviceImageFormatInfo2
x
          = IO VkFormat -> VkFormat
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkFormat
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceImageFormatInfo2
-> Ptr VkPhysicalDeviceImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceImageFormatInfo2
x) (Int
16))
{-# LINE 7172 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> IO (FieldType "format" VkPhysicalDeviceImageFormatInfo2)
readField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkFormat
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
16)
{-# LINE 7176 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "format" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> FieldType "format" VkPhysicalDeviceImageFormatInfo2 -> IO ()
writeField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> VkFormat -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "type" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceImageFormatInfo2
-> FieldType "type" VkPhysicalDeviceImageFormatInfo2
getField VkPhysicalDeviceImageFormatInfo2
x
          = IO VkImageType -> VkImageType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkImageType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceImageFormatInfo2
-> Ptr VkPhysicalDeviceImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceImageFormatInfo2
x) (Int
20))
{-# LINE 7205 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> IO (FieldType "type" VkPhysicalDeviceImageFormatInfo2)
readField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkImageType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
20)
{-# LINE 7209 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "type" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> FieldType "type" VkPhysicalDeviceImageFormatInfo2 -> IO ()
writeField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> VkImageType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "tiling" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceImageFormatInfo2
-> FieldType "tiling" VkPhysicalDeviceImageFormatInfo2
getField VkPhysicalDeviceImageFormatInfo2
x
          = IO VkImageTiling -> VkImageTiling
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkImageTiling
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceImageFormatInfo2
-> Ptr VkPhysicalDeviceImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceImageFormatInfo2
x) (Int
24))
{-# LINE 7240 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> IO (FieldType "tiling" VkPhysicalDeviceImageFormatInfo2)
readField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkImageTiling
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
24)
{-# LINE 7244 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tiling" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> FieldType "tiling" VkPhysicalDeviceImageFormatInfo2 -> IO ()
writeField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2
-> Int -> VkImageTiling -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "usage" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceImageFormatInfo2
-> FieldType "usage" VkPhysicalDeviceImageFormatInfo2
getField VkPhysicalDeviceImageFormatInfo2
x
          = IO VkImageUsageFlags -> VkImageUsageFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkImageUsageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceImageFormatInfo2
-> Ptr VkPhysicalDeviceImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceImageFormatInfo2
x) (Int
28))
{-# LINE 7274 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> IO (FieldType "usage" VkPhysicalDeviceImageFormatInfo2)
readField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2 -> Int -> IO VkImageUsageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
28)
{-# LINE 7278 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "usage" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> FieldType "usage" VkPhysicalDeviceImageFormatInfo2 -> IO ()
writeField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2
-> Int -> VkImageUsageFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
True

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

instance {-# OVERLAPPING #-}
         CanReadField "flags" VkPhysicalDeviceImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceImageFormatInfo2
-> FieldType "flags" VkPhysicalDeviceImageFormatInfo2
getField VkPhysicalDeviceImageFormatInfo2
x
          = IO VkImageCreateFlags -> VkImageCreateFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceImageFormatInfo2
-> Int -> IO VkImageCreateFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceImageFormatInfo2
-> Ptr VkPhysicalDeviceImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceImageFormatInfo2
x) (Int
32))
{-# LINE 7307 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> IO (FieldType "flags" VkPhysicalDeviceImageFormatInfo2)
readField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2
-> Int -> IO VkImageCreateFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
32)
{-# LINE 7311 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkPhysicalDeviceImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceImageFormatInfo2
-> FieldType "flags" VkPhysicalDeviceImageFormatInfo2 -> IO ()
writeField Ptr VkPhysicalDeviceImageFormatInfo2
p
          = Ptr VkPhysicalDeviceImageFormatInfo2
-> Int -> VkImageCreateFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceImageFormatInfo2
p (Int
32)
{-# LINE 7317 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceImageFormatInfo2 where
        showsPrec :: Int -> VkPhysicalDeviceImageFormatInfo2 -> ShowS
showsPrec Int
d VkPhysicalDeviceImageFormatInfo2
x
          = String -> ShowS
showString String
"VkPhysicalDeviceImageFormatInfo2 {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceImageFormatInfo2
-> FieldType "sType" VkPhysicalDeviceImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceImageFormatInfo2
-> FieldType "pNext" VkPhysicalDeviceImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"format = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkFormat -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceImageFormatInfo2
-> FieldType "format" VkPhysicalDeviceImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"format" VkPhysicalDeviceImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"type = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkImageType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceImageFormatInfo2
-> FieldType "type" VkPhysicalDeviceImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"type" VkPhysicalDeviceImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"tiling = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkImageTiling -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceImageFormatInfo2
-> FieldType "tiling" VkPhysicalDeviceImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tiling" VkPhysicalDeviceImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"usage = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkImageUsageFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceImageFormatInfo2
-> FieldType "usage" VkPhysicalDeviceImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"usage" VkPhysicalDeviceImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
"flags = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> VkImageCreateFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceImageFormatInfo2
-> FieldType "flags" VkPhysicalDeviceImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"flags" VkPhysicalDeviceImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceLimits -> VkPhysicalDeviceLimits -> Bool
== x :: VkPhysicalDeviceLimits
x@(VkPhysicalDeviceLimits# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceLimits -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceLimits
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceLimits where
        (VkPhysicalDeviceLimits# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceLimits -> VkPhysicalDeviceLimits -> Ordering
`compare`
          x :: VkPhysicalDeviceLimits
x@(VkPhysicalDeviceLimits# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceLimits -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceLimits
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceLimits where
        sizeOf :: VkPhysicalDeviceLimits -> Int
sizeOf ~VkPhysicalDeviceLimits
_ = (Int
504)
{-# LINE 7473 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceLimits -> Int
alignment ~VkPhysicalDeviceLimits
_ = Int
8
{-# LINE 7476 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceLimits -> IO VkPhysicalDeviceLimits
peek = Ptr VkPhysicalDeviceLimits -> IO VkPhysicalDeviceLimits
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceLimits -> VkPhysicalDeviceLimits -> IO ()
poke = Ptr VkPhysicalDeviceLimits -> VkPhysicalDeviceLimits -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceLimits where
        unsafeAddr :: VkPhysicalDeviceLimits -> Addr#
unsafeAddr (VkPhysicalDeviceLimits# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceLimits -> ByteArray#
unsafeByteArray (VkPhysicalDeviceLimits# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceLimits
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceLimits
VkPhysicalDeviceLimits# (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off) ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxImageDimension1D" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxImageDimension1D" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
0))
{-# LINE 7586 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxImageDimension1D" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
0)
{-# LINE 7590 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageDimension1D" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxImageDimension1D" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
4)
{-# LINE 7614 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxImageDimension2D" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxImageDimension2D" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
4))
{-# LINE 7621 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxImageDimension2D" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
4)
{-# LINE 7625 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageDimension2D" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxImageDimension2D" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxImageDimension3D" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxImageDimension3D" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
8))
{-# LINE 7656 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxImageDimension3D" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
8)
{-# LINE 7660 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageDimension3D" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxImageDimension3D" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
12)
{-# LINE 7684 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxImageDimensionCube" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxImageDimensionCube" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
12))
{-# LINE 7691 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxImageDimensionCube" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
12)
{-# LINE 7695 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageDimensionCube" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxImageDimensionCube" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxImageArrayLayers" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxImageArrayLayers" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
16))
{-# LINE 7726 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxImageArrayLayers" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
16)
{-# LINE 7730 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxImageArrayLayers" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxImageArrayLayers" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxTexelBufferElements" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxTexelBufferElements" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
20))
{-# LINE 7761 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxTexelBufferElements" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
20)
{-# LINE 7765 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTexelBufferElements" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxTexelBufferElements" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxUniformBufferRange" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxUniformBufferRange" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
24))
{-# LINE 7796 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxUniformBufferRange" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
24)
{-# LINE 7800 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxUniformBufferRange" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxUniformBufferRange" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxStorageBufferRange" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxStorageBufferRange" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
28))
{-# LINE 7831 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxStorageBufferRange" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
28)
{-# LINE 7835 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxStorageBufferRange" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxStorageBufferRange" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPushConstantsSize" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxPushConstantsSize" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
32))
{-# LINE 7866 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxPushConstantsSize" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
32)
{-# LINE 7870 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPushConstantsSize" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxPushConstantsSize" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxMemoryAllocationCount" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxMemoryAllocationCount" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
36))
{-# LINE 7904 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxMemoryAllocationCount" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
36)
{-# LINE 7908 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxMemoryAllocationCount" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxMemoryAllocationCount" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxSamplerAllocationCount" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxSamplerAllocationCount" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
40))
{-# LINE 7944 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxSamplerAllocationCount" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
40)
{-# LINE 7948 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSamplerAllocationCount" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxSamplerAllocationCount" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "bufferImageGranularity" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "bufferImageGranularity" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
48))
{-# LINE 7980 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "bufferImageGranularity" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
48)
{-# LINE 7984 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "bufferImageGranularity" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "bufferImageGranularity" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sparseAddressSpaceSize" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "sparseAddressSpaceSize" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
56))
{-# LINE 8015 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "sparseAddressSpaceSize" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
56)
{-# LINE 8019 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseAddressSpaceSize" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "sparseAddressSpaceSize" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxBoundDescriptorSets" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxBoundDescriptorSets" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
64))
{-# LINE 8050 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxBoundDescriptorSets" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
64)
{-# LINE 8054 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxBoundDescriptorSets" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxBoundDescriptorSets" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
68))
{-# LINE 8092 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
68)
{-# LINE 8096 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorSamplers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorUniformBuffers"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
72))
{-# LINE 8138 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
72)
{-# LINE 8142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorUniformBuffers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorStorageBuffers"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
76))
{-# LINE 8184 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
76)
{-# LINE 8188 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorStorageBuffers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorSampledImages"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
80))
{-# LINE 8230 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
80)
{-# LINE 8234 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorSampledImages"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorStorageImages"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
84))
{-# LINE 8276 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
84)
{-# LINE 8280 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorStorageImages"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageDescriptorInputAttachments"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
88))
{-# LINE 8322 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
88)
{-# LINE 8326 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageDescriptorInputAttachments"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerStageResources" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxPerStageResources" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
92))
{-# LINE 8359 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxPerStageResources" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
92)
{-# LINE 8363 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerStageResources" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxPerStageResources" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetSamplers" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxDescriptorSetSamplers" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
96))
{-# LINE 8397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxDescriptorSetSamplers" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
96)
{-# LINE 8401 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetSamplers" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxDescriptorSetSamplers" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUniformBuffers"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
100))
{-# LINE 8441 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
100)
{-# LINE 8445 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUniformBuffers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetUniformBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
104))
{-# LINE 8487 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
104)
{-# LINE 8491 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetUniformBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
108)
{-# LINE 8523 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetStorageBuffers"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
108))
{-# LINE 8532 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
108)
{-# LINE 8536 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetStorageBuffers"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
112)
{-# LINE 8569 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetStorageBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
112))
{-# LINE 8578 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
112)
{-# LINE 8582 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetStorageBuffersDynamic"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
116)
{-# LINE 8614 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
116))
{-# LINE 8622 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
116)
{-# LINE 8626 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetSampledImages"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
120)
{-# LINE 8658 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
120))
{-# LINE 8666 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
120)
{-# LINE 8670 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetStorageImages"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
124)
{-# LINE 8702 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDescriptorSetInputAttachments"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
124))
{-# LINE 8711 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
124)
{-# LINE 8715 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDescriptorSetInputAttachments"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
128)
{-# LINE 8743 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexInputAttributes" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxVertexInputAttributes" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
128))
{-# LINE 8751 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxVertexInputAttributes" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
128)
{-# LINE 8755 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexInputAttributes" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxVertexInputAttributes" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
132)
{-# LINE 8780 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexInputBindings" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxVertexInputBindings" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
132))
{-# LINE 8787 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxVertexInputBindings" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
132)
{-# LINE 8791 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexInputBindings" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxVertexInputBindings" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
136)
{-# LINE 8821 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
136))
{-# LINE 8829 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
136)
{-# LINE 8833 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexInputAttributeOffset"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
140)
{-# LINE 8863 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexInputBindingStride" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxVertexInputBindingStride" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
140))
{-# LINE 8871 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxVertexInputBindingStride" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
140)
{-# LINE 8875 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexInputBindingStride" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxVertexInputBindingStride" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
144)
{-# LINE 8903 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexOutputComponents" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxVertexOutputComponents" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
144))
{-# LINE 8911 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxVertexOutputComponents" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
144)
{-# LINE 8915 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexOutputComponents" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxVertexOutputComponents" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
148)
{-# LINE 8946 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationGenerationLevel"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationGenerationLevel" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
148))
{-# LINE 8955 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxTessellationGenerationLevel" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
148)
{-# LINE 8959 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationGenerationLevel"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationGenerationLevel" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
152)
{-# LINE 8987 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationPatchSize" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxTessellationPatchSize" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
152))
{-# LINE 8995 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxTessellationPatchSize" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
152)
{-# LINE 8999 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationPatchSize" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxTessellationPatchSize" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
156)
{-# LINE 9031 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationControlPerVertexInputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlPerVertexInputComponents"
     VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
156))
{-# LINE 9040 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxTessellationControlPerVertexInputComponents"
        VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
156)
{-# LINE 9044 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationControlPerVertexInputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlPerVertexInputComponents"
     VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
160)
{-# LINE 9078 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationControlPerVertexOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlPerVertexOutputComponents"
     VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
160))
{-# LINE 9087 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxTessellationControlPerVertexOutputComponents"
        VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
160)
{-# LINE 9091 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationControlPerVertexOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlPerVertexOutputComponents"
     VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
164)
{-# LINE 9124 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationControlPerPatchOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlPerPatchOutputComponents"
     VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
164))
{-# LINE 9133 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxTessellationControlPerPatchOutputComponents"
        VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
164)
{-# LINE 9137 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationControlPerPatchOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlPerPatchOutputComponents"
     VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
168)
{-# LINE 9170 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationControlTotalOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlTotalOutputComponents"
     VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
168))
{-# LINE 9179 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxTessellationControlTotalOutputComponents"
        VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
168)
{-# LINE 9183 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationControlTotalOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlTotalOutputComponents"
     VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
172)
{-# LINE 9216 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationEvaluationInputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
172))
{-# LINE 9225 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
172)
{-# LINE 9229 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationEvaluationInputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
176)
{-# LINE 9262 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTessellationEvaluationOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
176))
{-# LINE 9271 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
176)
{-# LINE 9275 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTessellationEvaluationOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
180)
{-# LINE 9307 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryShaderInvocations" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxGeometryShaderInvocations" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
180))
{-# LINE 9315 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxGeometryShaderInvocations" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
180)
{-# LINE 9319 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryShaderInvocations" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxGeometryShaderInvocations" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
184)
{-# LINE 9348 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryInputComponents" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxGeometryInputComponents" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
184))
{-# LINE 9356 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxGeometryInputComponents" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
184)
{-# LINE 9360 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryInputComponents" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxGeometryInputComponents" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
188)
{-# LINE 9389 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryOutputComponents" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxGeometryOutputComponents" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
188))
{-# LINE 9397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxGeometryOutputComponents" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
188)
{-# LINE 9401 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryOutputComponents" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxGeometryOutputComponents" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
192)
{-# LINE 9429 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryOutputVertices" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxGeometryOutputVertices" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
192))
{-# LINE 9437 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxGeometryOutputVertices" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
192)
{-# LINE 9441 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryOutputVertices" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxGeometryOutputVertices" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
196)
{-# LINE 9472 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxGeometryTotalOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
196))
{-# LINE 9481 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
196)
{-# LINE 9485 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxGeometryTotalOutputComponents"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
200)
{-# LINE 9515 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFragmentInputComponents" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxFragmentInputComponents" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
200))
{-# LINE 9523 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxFragmentInputComponents" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
200)
{-# LINE 9527 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFragmentInputComponents" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxFragmentInputComponents" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
204)
{-# LINE 9558 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFragmentOutputAttachments" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxFragmentOutputAttachments" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
204))
{-# LINE 9566 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxFragmentOutputAttachments" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
204)
{-# LINE 9570 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFragmentOutputAttachments" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxFragmentOutputAttachments" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
208)
{-# LINE 9601 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
208))
{-# LINE 9609 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
208)
{-# LINE 9613 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFragmentDualSrcAttachments"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
212)
{-# LINE 9646 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFragmentCombinedOutputResources"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
212))
{-# LINE 9655 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
212)
{-# LINE 9659 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFragmentCombinedOutputResources"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
216)
{-# LINE 9689 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxComputeSharedMemorySize" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxComputeSharedMemorySize" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
216))
{-# LINE 9697 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxComputeSharedMemorySize" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
216)
{-# LINE 9701 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxComputeSharedMemorySize" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxComputeSharedMemorySize" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
3

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceLimits
-> FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits
getFieldArray = VkPhysicalDeviceLimits -> Word32
VkPhysicalDeviceLimits
-> FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceLimits -> Word32
f VkPhysicalDeviceLimits
x = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) Int
off)
                off :: Int
off
                  = (Int
220)
{-# LINE 9763 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits)
readFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
220)
{-# LINE 9771 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits
-> IO ()
writeFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
220)
{-# LINE 9801 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
232)
{-# LINE 9828 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxComputeWorkGroupInvocations"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
232))
{-# LINE 9837 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
232)
{-# LINE 9841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxComputeWorkGroupInvocations"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
3

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceLimits
-> FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits
getFieldArray = VkPhysicalDeviceLimits -> Word32
VkPhysicalDeviceLimits
-> FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceLimits -> Word32
f VkPhysicalDeviceLimits
x = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) Int
off)
                off :: Int
off
                  = (Int
236)
{-# LINE 9902 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits)
readFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
236)
{-# LINE 9910 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits
-> IO ()
writeFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
236)
{-# LINE 9940 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
248)
{-# LINE 9961 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "subPixelPrecisionBits" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "subPixelPrecisionBits" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
248))
{-# LINE 9968 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "subPixelPrecisionBits" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
248)
{-# LINE 9972 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subPixelPrecisionBits" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "subPixelPrecisionBits" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
252)
{-# LINE 9996 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "subTexelPrecisionBits" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "subTexelPrecisionBits" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
252))
{-# LINE 10003 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "subTexelPrecisionBits" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
252)
{-# LINE 10007 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subTexelPrecisionBits" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "subTexelPrecisionBits" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
256)
{-# LINE 10031 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "mipmapPrecisionBits" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "mipmapPrecisionBits" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
256))
{-# LINE 10038 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "mipmapPrecisionBits" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
256)
{-# LINE 10042 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "mipmapPrecisionBits" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "mipmapPrecisionBits" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
260)
{-# LINE 10068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
260))
{-# LINE 10076 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
260)
{-# LINE 10080 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
264)
{-# LINE 10105 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxDrawIndirectCount" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxDrawIndirectCount" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
264))
{-# LINE 10112 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxDrawIndirectCount" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
264)
{-# LINE 10116 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxDrawIndirectCount" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxDrawIndirectCount" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
268)
{-# LINE 10140 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxSamplerLodBias" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxSamplerLodBias" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
268))
{-# LINE 10147 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxSamplerLodBias" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
268)
{-# LINE 10151 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSamplerLodBias" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxSamplerLodBias" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
272)
{-# LINE 10175 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxSamplerAnisotropy" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxSamplerAnisotropy" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
272))
{-# LINE 10182 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxSamplerAnisotropy" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
272)
{-# LINE 10186 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSamplerAnisotropy" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxSamplerAnisotropy" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
276)
{-# LINE 10207 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxViewports" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxViewports" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
276))
{-# LINE 10214 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxViewports" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
276)
{-# LINE 10218 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxViewports" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxViewports" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
2

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceLimits
-> FieldType "maxViewportDimensions" VkPhysicalDeviceLimits
getFieldArray = VkPhysicalDeviceLimits -> Word32
VkPhysicalDeviceLimits
-> FieldType "maxViewportDimensions" VkPhysicalDeviceLimits
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceLimits -> Word32
f VkPhysicalDeviceLimits
x = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) Int
off)
                off :: Int
off
                  = (Int
280)
{-# LINE 10270 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxViewportDimensions" VkPhysicalDeviceLimits)
readFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
280)
{-# LINE 10278 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxViewportDimensions" VkPhysicalDeviceLimits
-> IO ()
writeFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
280)
{-# LINE 10301 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
2

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceLimits
-> FieldType "viewportBoundsRange" VkPhysicalDeviceLimits
getFieldArray = VkPhysicalDeviceLimits -> Float
VkPhysicalDeviceLimits
-> FieldType "viewportBoundsRange" VkPhysicalDeviceLimits
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceLimits -> Float
f VkPhysicalDeviceLimits
x = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) Int
off)
                off :: Int
off
                  = (Int
288)
{-# LINE 10347 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 10349 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "viewportBoundsRange" VkPhysicalDeviceLimits)
readFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
288)
{-# LINE 10355 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 10357 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceLimits
-> FieldType "viewportBoundsRange" VkPhysicalDeviceLimits -> IO ()
writeFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
288)
{-# LINE 10376 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 10378 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
296)
{-# LINE 10397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "viewportSubPixelBits" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "viewportSubPixelBits" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
296))
{-# LINE 10404 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "viewportSubPixelBits" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
296)
{-# LINE 10408 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "viewportSubPixelBits" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "viewportSubPixelBits" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
304)
{-# LINE 10432 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minMemoryMapAlignment" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "minMemoryMapAlignment" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO CSize -> CSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
304))
{-# LINE 10439 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "minMemoryMapAlignment" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
304)
{-# LINE 10443 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minMemoryMapAlignment" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "minMemoryMapAlignment" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
312)
{-# LINE 10473 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
312))
{-# LINE 10481 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
312)
{-# LINE 10485 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minTexelBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
320)
{-# LINE 10517 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minUniformBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
320))
{-# LINE 10526 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
320)
{-# LINE 10530 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minUniformBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "minStorageBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
328))
{-# LINE 10571 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
328)
{-# LINE 10575 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minStorageBufferOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
336)
{-# LINE 10598 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minTexelOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "minTexelOffset" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Int32 -> Int32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
336))
{-# LINE 10605 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "minTexelOffset" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
336)
{-# LINE 10609 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minTexelOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "minTexelOffset" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
340)
{-# LINE 10630 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTexelOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxTexelOffset" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
340))
{-# LINE 10637 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxTexelOffset" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
340)
{-# LINE 10641 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTexelOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxTexelOffset" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
344)
{-# LINE 10665 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minTexelGatherOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "minTexelGatherOffset" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Int32 -> Int32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
344))
{-# LINE 10672 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "minTexelGatherOffset" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
344)
{-# LINE 10676 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minTexelGatherOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "minTexelGatherOffset" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
348)
{-# LINE 10700 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxTexelGatherOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxTexelGatherOffset" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
348))
{-# LINE 10707 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxTexelGatherOffset" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
348)
{-# LINE 10711 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxTexelGatherOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxTexelGatherOffset" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
352)
{-# LINE 10735 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minInterpolationOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "minInterpolationOffset" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
352))
{-# LINE 10742 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "minInterpolationOffset" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
352)
{-# LINE 10746 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minInterpolationOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "minInterpolationOffset" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
356)
{-# LINE 10770 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxInterpolationOffset" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxInterpolationOffset" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
356))
{-# LINE 10777 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxInterpolationOffset" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
356)
{-# LINE 10781 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxInterpolationOffset" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxInterpolationOffset" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
360)
{-# LINE 10811 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "subPixelInterpolationOffsetBits"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
360))
{-# LINE 10820 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
360)
{-# LINE 10824 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subPixelInterpolationOffsetBits"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
364)
{-# LINE 10850 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFramebufferWidth" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxFramebufferWidth" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
364))
{-# LINE 10857 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxFramebufferWidth" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
364)
{-# LINE 10861 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFramebufferWidth" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxFramebufferWidth" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
368)
{-# LINE 10885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFramebufferHeight" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxFramebufferHeight" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
368))
{-# LINE 10892 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxFramebufferHeight" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
368)
{-# LINE 10896 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFramebufferHeight" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxFramebufferHeight" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
372)
{-# LINE 10920 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxFramebufferLayers" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxFramebufferLayers" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
372))
{-# LINE 10927 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxFramebufferLayers" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
372)
{-# LINE 10931 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxFramebufferLayers" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxFramebufferLayers" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
376)
{-# LINE 10961 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "framebufferColorSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "framebufferColorSampleCounts" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
376))
{-# LINE 10969 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "framebufferColorSampleCounts" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
376)
{-# LINE 10973 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "framebufferColorSampleCounts" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "framebufferColorSampleCounts" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
380)
{-# LINE 11004 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "framebufferDepthSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "framebufferDepthSampleCounts" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
380))
{-# LINE 11012 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "framebufferDepthSampleCounts" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
380)
{-# LINE 11016 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "framebufferDepthSampleCounts" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "framebufferDepthSampleCounts" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
384)
{-# LINE 11047 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "framebufferStencilSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "framebufferStencilSampleCounts" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
384))
{-# LINE 11056 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "framebufferStencilSampleCounts" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
384)
{-# LINE 11060 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "framebufferStencilSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "framebufferStencilSampleCounts" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
388)
{-# LINE 11093 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "framebufferNoAttachmentsSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
388))
{-# LINE 11102 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
388)
{-# LINE 11106 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "framebufferNoAttachmentsSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
392)
{-# LINE 11132 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxColorAttachments" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxColorAttachments" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
392))
{-# LINE 11139 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxColorAttachments" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
392)
{-# LINE 11143 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxColorAttachments" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxColorAttachments" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
396)
{-# LINE 11173 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampledImageColorSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "sampledImageColorSampleCounts" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
396))
{-# LINE 11181 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "sampledImageColorSampleCounts" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
396)
{-# LINE 11185 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampledImageColorSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "sampledImageColorSampleCounts" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
400)
{-# LINE 11217 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampledImageIntegerSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
400))
{-# LINE 11226 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
400)
{-# LINE 11230 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampledImageIntegerSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
404)
{-# LINE 11262 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
404))
{-# LINE 11270 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
404)
{-# LINE 11274 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampledImageDepthSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
408)
{-# LINE 11306 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sampledImageStencilSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
408))
{-# LINE 11315 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
408)
{-# LINE 11319 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampledImageStencilSampleCounts"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
True

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
412)
{-# LINE 11347 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "storageImageSampleCounts" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "storageImageSampleCounts" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
412))
{-# LINE 11355 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "storageImageSampleCounts" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
412)
{-# LINE 11359 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "storageImageSampleCounts" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "storageImageSampleCounts" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
416)
{-# LINE 11383 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxSampleMaskWords" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxSampleMaskWords" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
416))
{-# LINE 11390 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxSampleMaskWords" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
416)
{-# LINE 11394 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSampleMaskWords" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxSampleMaskWords" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "timestampComputeAndGraphics" VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "timestampComputeAndGraphics" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
420))
{-# LINE 11430 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType "timestampComputeAndGraphics" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
420)
{-# LINE 11434 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "timestampComputeAndGraphics" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "timestampComputeAndGraphics" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
424)
{-# LINE 11458 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "timestampPeriod" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "timestampPeriod" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
424))
{-# LINE 11465 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "timestampPeriod" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
424)
{-# LINE 11469 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "timestampPeriod" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "timestampPeriod" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
428)
{-# LINE 11492 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxClipDistances" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxClipDistances" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
428))
{-# LINE 11499 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxClipDistances" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
428)
{-# LINE 11503 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxClipDistances" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxClipDistances" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
432)
{-# LINE 11526 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxCullDistances" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "maxCullDistances" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
432))
{-# LINE 11533 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "maxCullDistances" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
432)
{-# LINE 11537 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxCullDistances" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "maxCullDistances" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
436)
{-# LINE 11567 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxCombinedClipAndCullDistances"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
436))
{-# LINE 11576 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
436)
{-# LINE 11580 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxCombinedClipAndCullDistances"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
440)
{-# LINE 11606 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "discreteQueuePriorities" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "discreteQueuePriorities" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
440))
{-# LINE 11613 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "discreteQueuePriorities" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
440)
{-# LINE 11617 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "discreteQueuePriorities" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "discreteQueuePriorities" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
2

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceLimits
-> FieldType "pointSizeRange" VkPhysicalDeviceLimits
getFieldArray = VkPhysicalDeviceLimits -> Float
VkPhysicalDeviceLimits
-> FieldType "pointSizeRange" VkPhysicalDeviceLimits
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceLimits -> Float
f VkPhysicalDeviceLimits
x = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) Int
off)
                off :: Int
off
                  = (Int
444) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 11662 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 11663 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "pointSizeRange" VkPhysicalDeviceLimits)
readFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
444) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 11669 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 11670 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceLimits
-> FieldType "pointSizeRange" VkPhysicalDeviceLimits -> IO ()
writeFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
444) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 11687 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 11688 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
2

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceLimits
-> FieldType "lineWidthRange" VkPhysicalDeviceLimits
getFieldArray = VkPhysicalDeviceLimits -> Float
VkPhysicalDeviceLimits
-> FieldType "lineWidthRange" VkPhysicalDeviceLimits
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceLimits -> Float
f VkPhysicalDeviceLimits
x = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) Int
off)
                off :: Int
off
                  = (Int
452) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 11727 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 11728 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "lineWidthRange" VkPhysicalDeviceLimits)
readFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
452) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 11734 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 11735 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceLimits
-> FieldType "lineWidthRange" VkPhysicalDeviceLimits -> IO ()
writeFieldArray Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p
              ((Int
452) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 11752 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 11753 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
460)
{-# LINE 11772 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pointSizeGranularity" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "pointSizeGranularity" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
460))
{-# LINE 11779 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "pointSizeGranularity" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
460)
{-# LINE 11783 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pointSizeGranularity" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "pointSizeGranularity" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
464)
{-# LINE 11807 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "lineWidthGranularity" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "lineWidthGranularity" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
464))
{-# LINE 11814 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "lineWidthGranularity" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
464)
{-# LINE 11818 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "lineWidthGranularity" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "lineWidthGranularity" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
468)
{-# LINE 11839 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "strictLines" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "strictLines" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
468))
{-# LINE 11846 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "strictLines" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
468)
{-# LINE 11850 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "strictLines" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "strictLines" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
472)
{-# LINE 11874 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "standardSampleLocations" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "standardSampleLocations" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
472))
{-# LINE 11881 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "standardSampleLocations" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
472)
{-# LINE 11885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "standardSampleLocations" VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "standardSampleLocations" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
480)
{-# LINE 11916 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "optimalBufferCopyOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
480))
{-# LINE 11925 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
480)
{-# LINE 11929 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "optimalBufferCopyOffsetAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
488)
{-# LINE 11962 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "optimalBufferCopyRowPitchAlignment"
           VkPhysicalDeviceLimits
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType
     "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
488))
{-# LINE 11971 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO
     (FieldType
        "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
488)
{-# LINE 11975 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "optimalBufferCopyRowPitchAlignment"
           VkPhysicalDeviceLimits
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType
     "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits
-> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
496)
{-# LINE 12001 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "nonCoherentAtomSize" VkPhysicalDeviceLimits where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceLimits
-> FieldType "nonCoherentAtomSize" VkPhysicalDeviceLimits
getField VkPhysicalDeviceLimits
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceLimits
x) (Int
496))
{-# LINE 12008 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceLimits
-> IO (FieldType "nonCoherentAtomSize" VkPhysicalDeviceLimits)
readField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceLimits
p (Int
496)
{-# LINE 12012 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "nonCoherentAtomSize" VkPhysicalDeviceLimits where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceLimits
-> FieldType "nonCoherentAtomSize" VkPhysicalDeviceLimits -> IO ()
writeField Ptr VkPhysicalDeviceLimits
p
          = Ptr VkPhysicalDeviceLimits -> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceLimits
p (Int
496)
{-# LINE 12018 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceLimits where
        showsPrec :: Int -> VkPhysicalDeviceLimits -> ShowS
showsPrec Int
d VkPhysicalDeviceLimits
x
          = String -> ShowS
showString String
"VkPhysicalDeviceLimits {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"maxImageDimension1D = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceLimits
-> FieldType "maxImageDimension1D" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxImageDimension1D" VkPhysicalDeviceLimits
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"maxImageDimension2D = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceLimits
-> FieldType "maxImageDimension2D" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxImageDimension2D" VkPhysicalDeviceLimits
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"maxImageDimension3D = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceLimits
-> FieldType "maxImageDimension3D" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxImageDimension3D" VkPhysicalDeviceLimits
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"maxImageDimensionCube = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceLimits
-> FieldType "maxImageDimensionCube" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxImageDimensionCube" VkPhysicalDeviceLimits
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"maxImageArrayLayers = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceLimits
-> FieldType "maxImageArrayLayers" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxImageArrayLayers" VkPhysicalDeviceLimits
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"maxTexelBufferElements = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceLimits
-> FieldType "maxTexelBufferElements" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxTexelBufferElements" VkPhysicalDeviceLimits
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
"maxUniformBufferRange = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                      (VkPhysicalDeviceLimits
-> FieldType "maxUniformBufferRange" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxUniformBufferRange" VkPhysicalDeviceLimits
x)
                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                        String -> ShowS
showString String
"maxStorageBufferRange = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                            (VkPhysicalDeviceLimits
-> FieldType "maxStorageBufferRange" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxStorageBufferRange" VkPhysicalDeviceLimits
x)
                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                            String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                              String -> ShowS
showString String
"maxPushConstantsSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                  (VkPhysicalDeviceLimits
-> FieldType "maxPushConstantsSize" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxPushConstantsSize"
                                                                     VkPhysicalDeviceLimits
x)
                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                    String -> ShowS
showString
                                                                      String
"maxMemoryAllocationCount = "
                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                        (VkPhysicalDeviceLimits
-> FieldType "maxMemoryAllocationCount" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                           @"maxMemoryAllocationCount"
                                                                           VkPhysicalDeviceLimits
x)
                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                          String -> ShowS
showString
                                                                            String
"maxSamplerAllocationCount = "
                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                              (VkPhysicalDeviceLimits
-> FieldType "maxSamplerAllocationCount" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                 @"maxSamplerAllocationCount"
                                                                                 VkPhysicalDeviceLimits
x)
                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                String -> ShowS
showString
                                                                                  String
"bufferImageGranularity = "
                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                  Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                    (VkPhysicalDeviceLimits
-> FieldType "bufferImageGranularity" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                       @"bufferImageGranularity"
                                                                                       VkPhysicalDeviceLimits
x)
                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                    String -> ShowS
showString String
", "
                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                      String -> ShowS
showString
                                                                                        String
"sparseAddressSpaceSize = "
                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                        Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                          (VkPhysicalDeviceLimits
-> FieldType "sparseAddressSpaceSize" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                             @"sparseAddressSpaceSize"
                                                                                             VkPhysicalDeviceLimits
x)
                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                          String -> ShowS
showString
                                                                                            String
", "
                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                            String -> ShowS
showString
                                                                                              String
"maxBoundDescriptorSets = "
                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                Int
d
                                                                                                (VkPhysicalDeviceLimits
-> FieldType "maxBoundDescriptorSets" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                   @"maxBoundDescriptorSets"
                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                String -> ShowS
showString
                                                                                                  String
", "
                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                  String -> ShowS
showString
                                                                                                    String
"maxPerStageDescriptorSamplers = "
                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                      Int
d
                                                                                                      (VkPhysicalDeviceLimits
-> FieldType "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                         @"maxPerStageDescriptorSamplers"
                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                      String -> ShowS
showString
                                                                                                        String
", "
                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                        String -> ShowS
showString
                                                                                                          String
"maxPerStageDescriptorUniformBuffers = "
                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                            Int
d
                                                                                                            (VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                               @"maxPerStageDescriptorUniformBuffers"
                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                            String -> ShowS
showString
                                                                                                              String
", "
                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                              String -> ShowS
showString
                                                                                                                String
"maxPerStageDescriptorStorageBuffers = "
                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                  Int
d
                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                     @"maxPerStageDescriptorStorageBuffers"
                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                  String -> ShowS
showString
                                                                                                                    String
", "
                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                    String -> ShowS
showString
                                                                                                                      String
"maxPerStageDescriptorSampledImages = "
                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                        Int
d
                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                           @"maxPerStageDescriptorSampledImages"
                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                        String -> ShowS
showString
                                                                                                                          String
", "
                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                          String -> ShowS
showString
                                                                                                                            String
"maxPerStageDescriptorStorageImages = "
                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                              Int
d
                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                 @"maxPerStageDescriptorStorageImages"
                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                              String -> ShowS
showString
                                                                                                                                String
", "
                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                String -> ShowS
showString
                                                                                                                                  String
"maxPerStageDescriptorInputAttachments = "
                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                    Int
d
                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType
     "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                       @"maxPerStageDescriptorInputAttachments"
                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                    String -> ShowS
showString
                                                                                                                                      String
", "
                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                      String -> ShowS
showString
                                                                                                                                        String
"maxPerStageResources = "
                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                          Int
d
                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType "maxPerStageResources" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                             @"maxPerStageResources"
                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                          String -> ShowS
showString
                                                                                                                                            String
", "
                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                            String -> ShowS
showString
                                                                                                                                              String
"maxDescriptorSetSamplers = "
                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                Int
d
                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType "maxDescriptorSetSamplers" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                   @"maxDescriptorSetSamplers"
                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                String -> ShowS
showString
                                                                                                                                                  String
", "
                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                    String
"maxDescriptorSetUniformBuffers = "
                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                      Int
d
                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                         @"maxDescriptorSetUniformBuffers"
                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                        String
", "
                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                          String
"maxDescriptorSetUniformBuffersDynamic = "
                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                            Int
d
                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                               @"maxDescriptorSetUniformBuffersDynamic"
                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                              String
", "
                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                String
"maxDescriptorSetStorageBuffers = "
                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                  Int
d
                                                                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                     @"maxDescriptorSetStorageBuffers"
                                                                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                    String
", "
                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                      String
"maxDescriptorSetStorageBuffersDynamic = "
                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                        Int
d
                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                           @"maxDescriptorSetStorageBuffersDynamic"
                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                          String
", "
                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                            String
"maxDescriptorSetSampledImages = "
                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                              Int
d
                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                 @"maxDescriptorSetSampledImages"
                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                String
", "
                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                  String
"maxDescriptorSetStorageImages = "
                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                    Int
d
                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                       @"maxDescriptorSetStorageImages"
                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                      String
", "
                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                        String
"maxDescriptorSetInputAttachments = "
                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                          Int
d
                                                                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType
     "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                             @"maxDescriptorSetInputAttachments"
                                                                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                            String
", "
                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                              String
"maxVertexInputAttributes = "
                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                Int
d
                                                                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType "maxVertexInputAttributes" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                   @"maxVertexInputAttributes"
                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                    String
"maxVertexInputBindings = "
                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                      Int
d
                                                                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType "maxVertexInputBindings" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                         @"maxVertexInputBindings"
                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                          String
"maxVertexInputAttributeOffset = "
                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                            Int
d
                                                                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                               @"maxVertexInputAttributeOffset"
                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                String
"maxVertexInputBindingStride = "
                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                  Int
d
                                                                                                                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType "maxVertexInputBindingStride" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                     @"maxVertexInputBindingStride"
                                                                                                                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                      String
"maxVertexOutputComponents = "
                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                        Int
d
                                                                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType "maxVertexOutputComponents" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                           @"maxVertexOutputComponents"
                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                            String
"maxTessellationGenerationLevel = "
                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationGenerationLevel" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                 @"maxTessellationGenerationLevel"
                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                  String
"maxTessellationPatchSize = "
                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                    Int
d
                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType "maxTessellationPatchSize" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                       @"maxTessellationPatchSize"
                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                        String
"maxTessellationControlPerVertexInputComponents = "
                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                          Int
d
                                                                                                                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlPerVertexInputComponents"
     VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                             @"maxTessellationControlPerVertexInputComponents"
                                                                                                                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                              String
"maxTessellationControlPerVertexOutputComponents = "
                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                Int
d
                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlPerVertexOutputComponents"
     VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                   @"maxTessellationControlPerVertexOutputComponents"
                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                    String
"maxTessellationControlPerPatchOutputComponents = "
                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                      Int
d
                                                                                                                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlPerPatchOutputComponents"
     VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                         @"maxTessellationControlPerPatchOutputComponents"
                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                          String
"maxTessellationControlTotalOutputComponents = "
                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                            Int
d
                                                                                                                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationControlTotalOutputComponents"
     VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                               @"maxTessellationControlTotalOutputComponents"
                                                                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                String
"maxTessellationEvaluationInputComponents = "
                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                  Int
d
                                                                                                                                                                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                     @"maxTessellationEvaluationInputComponents"
                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                      String
"maxTessellationEvaluationOutputComponents = "
                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                        Int
d
                                                                                                                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType
     "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                           @"maxTessellationEvaluationOutputComponents"
                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                            String
"maxGeometryShaderInvocations = "
                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType "maxGeometryShaderInvocations" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                 @"maxGeometryShaderInvocations"
                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                  String
"maxGeometryInputComponents = "
                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                    Int
d
                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType "maxGeometryInputComponents" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                       @"maxGeometryInputComponents"
                                                                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                        String
"maxGeometryOutputComponents = "
                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                          Int
d
                                                                                                                                                                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType "maxGeometryOutputComponents" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                             @"maxGeometryOutputComponents"
                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                              String
"maxGeometryOutputVertices = "
                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                Int
d
                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType "maxGeometryOutputVertices" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                   @"maxGeometryOutputVertices"
                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                    String
"maxGeometryTotalOutputComponents = "
                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                      Int
d
                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType
     "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                         @"maxGeometryTotalOutputComponents"
                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                          String
"maxFragmentInputComponents = "
                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                            Int
d
                                                                                                                                                                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType "maxFragmentInputComponents" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                               @"maxFragmentInputComponents"
                                                                                                                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                String
"maxFragmentOutputAttachments = "
                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                  Int
d
                                                                                                                                                                                                                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType "maxFragmentOutputAttachments" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                     @"maxFragmentOutputAttachments"
                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                      String
"maxFragmentDualSrcAttachments = "
                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                        Int
d
                                                                                                                                                                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                           @"maxFragmentDualSrcAttachments"
                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                            String
"maxFragmentCombinedOutputResources = "
                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType
     "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                 @"maxFragmentCombinedOutputResources"
                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                  String
"maxComputeSharedMemorySize = "
                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                    Int
d
                                                                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType "maxComputeSharedMemorySize" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                       @"maxComputeSharedMemorySize"
                                                                                                                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                      (String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                         String
"maxComputeWorkGroupCount = ["
                                                                                                                                                                                                                                                                                                                                         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                         Int -> [Word32] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                           Int
d
                                                                                                                                                                                                                                                                                                                                           (let s :: Int
s = Word32 -> Int
forall a. Storable a => a -> Int
sizeOf
                                                                                                                                                                                                                                                                                                                                                      (FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits
forall a. HasCallStack => a
undefined
                                                                                                                                                                                                                                                                                                                                                         ::
                                                                                                                                                                                                                                                                                                                                                         FieldType
                                                                                                                                                                                                                                                                                                                                                           "maxComputeWorkGroupCount"
                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                o :: Int
o = HasField "maxComputeWorkGroupCount" VkPhysicalDeviceLimits => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset
                                                                                                                                                                                                                                                                                                                                                      @"maxComputeWorkGroupCount"
                                                                                                                                                                                                                                                                                                                                                      @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                f :: Int
-> IO (FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits)
f Int
i
                                                                                                                                                                                                                                                                                                                                                  = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff
                                                                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr
                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                      Int
i
                                                                                                                                                                                                                                                                                                                                                      ::
                                                                                                                                                                                                                                                                                                                                                      IO
                                                                                                                                                                                                                                                                                                                                                        (FieldType
                                                                                                                                                                                                                                                                                                                                                           "maxComputeWorkGroupCount"
                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                              in
                                                                                                                                                                                                                                                                                                                                              IO [Word32] -> [Word32]
forall a. IO a -> a
unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                (IO [Word32] -> [Word32])
-> ([Int] -> IO [Word32]) -> [Int] -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                (Int -> IO Word32) -> [Int] -> IO [Word32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                                                                                                                                                                                                                                                                                                                                                  Int -> IO Word32
Int
-> IO (FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits)
f
                                                                                                                                                                                                                                                                                                                                                ([Int] -> [Word32]) -> [Int] -> [Word32]
forall a b. (a -> b) -> a -> b
$
                                                                                                                                                                                                                                                                                                                                                (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map
                                                                                                                                                                                                                                                                                                                                                  (\ Int
i
                                                                                                                                                                                                                                                                                                                                                     ->
                                                                                                                                                                                                                                                                                                                                                     Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                                                                                                                                                                                                                                                                                                                                                       Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                                                                                                                                                                                                                                                                                                                                                         Int
s)
                                                                                                                                                                                                                                                                                                                                                  [Int
0
                                                                                                                                                                                                                                                                                                                                                   ..
                                                                                                                                                                                                                                                                                                                                                   Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
-
                                                                                                                                                                                                                                                                                                                                                     Int
1])
                                                                                                                                                                                                                                                                                                                                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                           Char -> ShowS
showChar
                                                                                                                                                                                                                                                                                                                                             Char
']')
                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                            String
"maxComputeWorkGroupInvocations = "
                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType
     "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                 @"maxComputeWorkGroupInvocations"
                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                (String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                   String
"maxComputeWorkGroupSize = ["
                                                                                                                                                                                                                                                                                                                                                   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                   Int -> [Word32] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                     Int
d
                                                                                                                                                                                                                                                                                                                                                     (let s :: Int
s = Word32 -> Int
forall a. Storable a => a -> Int
sizeOf
                                                                                                                                                                                                                                                                                                                                                                (FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits
forall a. HasCallStack => a
undefined
                                                                                                                                                                                                                                                                                                                                                                   ::
                                                                                                                                                                                                                                                                                                                                                                   FieldType
                                                                                                                                                                                                                                                                                                                                                                     "maxComputeWorkGroupSize"
                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                          o :: Int
o = HasField "maxComputeWorkGroupSize" VkPhysicalDeviceLimits => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset
                                                                                                                                                                                                                                                                                                                                                                @"maxComputeWorkGroupSize"
                                                                                                                                                                                                                                                                                                                                                                @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                          f :: Int
-> IO (FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits)
f Int
i
                                                                                                                                                                                                                                                                                                                                                            = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff
                                                                                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr
                                                                                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                Int
i
                                                                                                                                                                                                                                                                                                                                                                ::
                                                                                                                                                                                                                                                                                                                                                                IO
                                                                                                                                                                                                                                                                                                                                                                  (FieldType
                                                                                                                                                                                                                                                                                                                                                                     "maxComputeWorkGroupSize"
                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                        in
                                                                                                                                                                                                                                                                                                                                                        IO [Word32] -> [Word32]
forall a. IO a -> a
unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                          (IO [Word32] -> [Word32])
-> ([Int] -> IO [Word32]) -> [Int] -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                          (Int -> IO Word32) -> [Int] -> IO [Word32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                                                                                                                                                                                                                                                                                                                                                            Int -> IO Word32
Int
-> IO (FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits)
f
                                                                                                                                                                                                                                                                                                                                                          ([Int] -> [Word32]) -> [Int] -> [Word32]
forall a b. (a -> b) -> a -> b
$
                                                                                                                                                                                                                                                                                                                                                          (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map
                                                                                                                                                                                                                                                                                                                                                            (\ Int
i
                                                                                                                                                                                                                                                                                                                                                               ->
                                                                                                                                                                                                                                                                                                                                                               Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                                                                                                                                                                                                                                                                                                                                                                 Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                                                                                                                                                                                                                                                                                                                                                                   Int
s)
                                                                                                                                                                                                                                                                                                                                                            [Int
0
                                                                                                                                                                                                                                                                                                                                                             ..
                                                                                                                                                                                                                                                                                                                                                             Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
-
                                                                                                                                                                                                                                                                                                                                                               Int
1])
                                                                                                                                                                                                                                                                                                                                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                     Char -> ShowS
showChar
                                                                                                                                                                                                                                                                                                                                                       Char
']')
                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                      String
"subPixelPrecisionBits = "
                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                        Int
d
                                                                                                                                                                                                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType "subPixelPrecisionBits" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                           @"subPixelPrecisionBits"
                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                            String
"subTexelPrecisionBits = "
                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType "subTexelPrecisionBits" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                 @"subTexelPrecisionBits"
                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                  String
"mipmapPrecisionBits = "
                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                    Int
d
                                                                                                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType "mipmapPrecisionBits" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                       @"mipmapPrecisionBits"
                                                                                                                                                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                        String
"maxDrawIndexedIndexValue = "
                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                          Int
d
                                                                                                                                                                                                                                                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                             @"maxDrawIndexedIndexValue"
                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                              String
"maxDrawIndirectCount = "
                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                Int
d
                                                                                                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType "maxDrawIndirectCount" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                   @"maxDrawIndirectCount"
                                                                                                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                    String
"maxSamplerLodBias = "
                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                    Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                      Int
d
                                                                                                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType "maxSamplerLodBias" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                         @"maxSamplerLodBias"
                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                          String
"maxSamplerAnisotropy = "
                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                          Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                            Int
d
                                                                                                                                                                                                                                                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType "maxSamplerAnisotropy" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                               @"maxSamplerAnisotropy"
                                                                                                                                                                                                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                String
"maxViewports = "
                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                  Int
d
                                                                                                                                                                                                                                                                                                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType "maxViewports" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                     @"maxViewports"
                                                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                    (String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                       String
"maxViewportDimensions = ["
                                                                                                                                                                                                                                                                                                                                                                                                       ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                       Int -> [Word32] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                         Int
d
                                                                                                                                                                                                                                                                                                                                                                                                         (let s :: Int
s = Word32 -> Int
forall a. Storable a => a -> Int
sizeOf
                                                                                                                                                                                                                                                                                                                                                                                                                    (FieldType "maxViewportDimensions" VkPhysicalDeviceLimits
forall a. HasCallStack => a
undefined
                                                                                                                                                                                                                                                                                                                                                                                                                       ::
                                                                                                                                                                                                                                                                                                                                                                                                                       FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                         "maxViewportDimensions"
                                                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                              o :: Int
o = HasField "maxViewportDimensions" VkPhysicalDeviceLimits => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset
                                                                                                                                                                                                                                                                                                                                                                                                                    @"maxViewportDimensions"
                                                                                                                                                                                                                                                                                                                                                                                                                    @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                                                                              f :: Int
-> IO (FieldType "maxViewportDimensions" VkPhysicalDeviceLimits)
f Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                = Ptr VkPhysicalDeviceLimits -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff
                                                                                                                                                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr
                                                                                                                                                                                                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                    Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                    ::
                                                                                                                                                                                                                                                                                                                                                                                                                    IO
                                                                                                                                                                                                                                                                                                                                                                                                                      (FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                         "maxViewportDimensions"
                                                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                            in
                                                                                                                                                                                                                                                                                                                                                                                                            IO [Word32] -> [Word32]
forall a. IO a -> a
unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                                                                              (IO [Word32] -> [Word32])
-> ([Int] -> IO [Word32]) -> [Int] -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                              (Int -> IO Word32) -> [Int] -> IO [Word32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                                                                                                                                                                                                                                                                                                                                                                                                                Int -> IO Word32
Int
-> IO (FieldType "maxViewportDimensions" VkPhysicalDeviceLimits)
f
                                                                                                                                                                                                                                                                                                                                                                                                              ([Int] -> [Word32]) -> [Int] -> [Word32]
forall a b. (a -> b) -> a -> b
$
                                                                                                                                                                                                                                                                                                                                                                                                              (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map
                                                                                                                                                                                                                                                                                                                                                                                                                (\ Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                   ->
                                                                                                                                                                                                                                                                                                                                                                                                                   Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                                                                                                                                                                                                                                                                                                                                                                                                                     Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                                                                                                                                                                                                                                                                                                                                                                                                                       Int
s)
                                                                                                                                                                                                                                                                                                                                                                                                                [Int
0
                                                                                                                                                                                                                                                                                                                                                                                                                 ..
                                                                                                                                                                                                                                                                                                                                                                                                                 Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
-
                                                                                                                                                                                                                                                                                                                                                                                                                   Int
1])
                                                                                                                                                                                                                                                                                                                                                                                                         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                         Char -> ShowS
showChar
                                                                                                                                                                                                                                                                                                                                                                                                           Char
']')
                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                        (String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                           String
"viewportBoundsRange = ["
                                                                                                                                                                                                                                                                                                                                                                                                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                           Int -> [Float] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                             Int
d
                                                                                                                                                                                                                                                                                                                                                                                                             (let s :: Int
s = Float -> Int
forall a. Storable a => a -> Int
sizeOf
                                                                                                                                                                                                                                                                                                                                                                                                                        (FieldType "viewportBoundsRange" VkPhysicalDeviceLimits
forall a. HasCallStack => a
undefined
                                                                                                                                                                                                                                                                                                                                                                                                                           ::
                                                                                                                                                                                                                                                                                                                                                                                                                           FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                             "viewportBoundsRange"
                                                                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                  o :: Int
o = HasField "viewportBoundsRange" VkPhysicalDeviceLimits => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset
                                                                                                                                                                                                                                                                                                                                                                                                                        @"viewportBoundsRange"
                                                                                                                                                                                                                                                                                                                                                                                                                        @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                                                                                  f :: Int -> IO (FieldType "viewportBoundsRange" VkPhysicalDeviceLimits)
f Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                    = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff
                                                                                                                                                                                                                                                                                                                                                                                                                        (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr
                                                                                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                        Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                        ::
                                                                                                                                                                                                                                                                                                                                                                                                                        IO
                                                                                                                                                                                                                                                                                                                                                                                                                          (FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                             "viewportBoundsRange"
                                                                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                in
                                                                                                                                                                                                                                                                                                                                                                                                                IO [Float] -> [Float]
forall a. IO a -> a
unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                                                                                  (IO [Float] -> [Float])
-> ([Int] -> IO [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                  (Int -> IO Float) -> [Int] -> IO [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                                                                                                                                                                                                                                                                                                                                                                                                                    Int -> IO Float
Int -> IO (FieldType "viewportBoundsRange" VkPhysicalDeviceLimits)
f
                                                                                                                                                                                                                                                                                                                                                                                                                  ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$
                                                                                                                                                                                                                                                                                                                                                                                                                  (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map
                                                                                                                                                                                                                                                                                                                                                                                                                    (\ Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                       ->
                                                                                                                                                                                                                                                                                                                                                                                                                       Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                                                                                                                                                                                                                                                                                                                                                                                                                         Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                                                                                                                                                                                                                                                                                                                                                                                                                           Int
s)
                                                                                                                                                                                                                                                                                                                                                                                                                    [Int
0
                                                                                                                                                                                                                                                                                                                                                                                                                     ..
                                                                                                                                                                                                                                                                                                                                                                                                                     Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
-
                                                                                                                                                                                                                                                                                                                                                                                                                       Int
1])
                                                                                                                                                                                                                                                                                                                                                                                                             ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                             Char -> ShowS
showChar
                                                                                                                                                                                                                                                                                                                                                                                                               Char
']')
                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                              String
"viewportSubPixelBits = "
                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType "viewportSubPixelBits" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                   @"viewportSubPixelBits"
                                                                                                                                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                    String
"minMemoryMapAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                    Int -> CSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                      Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType "minMemoryMapAlignment" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                         @"minMemoryMapAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                          String
"minTexelBufferOffsetAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                          Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                            Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                               @"minTexelBufferOffsetAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                String
"minUniformBufferOffsetAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                  Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType
     "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                     @"minUniformBufferOffsetAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                      String
"minStorageBufferOffsetAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                      Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                        Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType
     "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                           @"minStorageBufferOffsetAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                            String
"minTexelOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                            Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType "minTexelOffset" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"minTexelOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                  String
"maxTexelOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                    Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType "maxTexelOffset" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"maxTexelOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                        String
"minTexelGatherOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                          Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType "minTexelGatherOffset" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"minTexelGatherOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                              String
"maxTexelGatherOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType "maxTexelGatherOffset" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                   @"maxTexelGatherOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String
"minInterpolationOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                    Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType "minInterpolationOffset" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                         @"minInterpolationOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String
"maxInterpolationOffset = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                          Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType "maxInterpolationOffset" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                               @"maxInterpolationOffset"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String
"subPixelInterpolationOffsetBits = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType
     "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     @"subPixelInterpolationOffsetBits"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String
"maxFramebufferWidth = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType "maxFramebufferWidth" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           @"maxFramebufferWidth"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String
"maxFramebufferHeight = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType "maxFramebufferHeight" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"maxFramebufferHeight"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String
"maxFramebufferLayers = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType "maxFramebufferLayers" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"maxFramebufferLayers"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String
"framebufferColorSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType "framebufferColorSampleCounts" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"framebufferColorSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String
"framebufferDepthSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType "framebufferDepthSampleCounts" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   @"framebufferDepthSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String
"framebufferStencilSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType
     "framebufferStencilSampleCounts" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         @"framebufferStencilSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String
"framebufferNoAttachmentsSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType
     "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               @"framebufferNoAttachmentsSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String
"maxColorAttachments = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType "maxColorAttachments" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     @"maxColorAttachments"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String
"sampledImageColorSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType "sampledImageColorSampleCounts" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           @"sampledImageColorSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String
"sampledImageIntegerSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType
     "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"sampledImageIntegerSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String
"sampledImageDepthSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"sampledImageDepthSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String
"sampledImageStencilSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType
     "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"sampledImageStencilSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String
"storageImageSampleCounts = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType "storageImageSampleCounts" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   @"storageImageSampleCounts"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String
"maxSampleMaskWords = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType "maxSampleMaskWords" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         @"maxSampleMaskWords"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String
"timestampComputeAndGraphics = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType "timestampComputeAndGraphics" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               @"timestampComputeAndGraphics"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String
"timestampPeriod = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  (VkPhysicalDeviceLimits
-> FieldType "timestampPeriod" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     @"timestampPeriod"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String
"maxClipDistances = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType "maxClipDistances" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           @"maxClipDistances"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String
"maxCullDistances = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType "maxCullDistances" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"maxCullDistances"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String
"maxCombinedClipAndCullDistances = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType
     "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"maxCombinedClipAndCullDistances"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String
"discreteQueuePriorities = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType "discreteQueuePriorities" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"discreteQueuePriorities"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               String
"pointSizeRange = ["
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               Int -> [Float] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 (let s :: Int
s = Float -> Int
forall a. Storable a => a -> Int
sizeOf
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (FieldType "pointSizeRange" VkPhysicalDeviceLimits
forall a. HasCallStack => a
undefined
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ::
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 "pointSizeRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      o :: Int
o = HasField "pointSizeRange" VkPhysicalDeviceLimits => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            @"pointSizeRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      f :: Int -> IO (FieldType "pointSizeRange" VkPhysicalDeviceLimits)
f Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ::
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            IO
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 "pointSizeRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    in
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    IO [Float] -> [Float]
forall a. IO a -> a
unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (IO [Float] -> [Float])
-> ([Int] -> IO [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (Int -> IO Float) -> [Int] -> IO [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int -> IO Float
Int -> IO (FieldType "pointSizeRange" VkPhysicalDeviceLimits)
f
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (\ Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ->
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               Int
s)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        [Int
0
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ..
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
-
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           Int
1])
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 Char -> ShowS
showChar
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   Char
']')
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   String
"lineWidthRange = ["
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   Int -> [Float] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     (let s :: Int
s = Float -> Int
forall a. Storable a => a -> Int
sizeOf
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (FieldType "lineWidthRange" VkPhysicalDeviceLimits
forall a. HasCallStack => a
undefined
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   ::
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     "lineWidthRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          o :: Int
o = HasField "lineWidthRange" VkPhysicalDeviceLimits => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                @"lineWidthRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                @VkPhysicalDeviceLimits
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          f :: Int -> IO (FieldType "lineWidthRange" VkPhysicalDeviceLimits)
f Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            = Ptr VkPhysicalDeviceLimits -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits -> Ptr VkPhysicalDeviceLimits
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ::
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                IO
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  (FieldType
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     "lineWidthRange"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceLimits)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        in
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        IO [Float] -> [Float]
forall a. IO a -> a
unsafeDupablePerformIO
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (IO [Float] -> [Float])
-> ([Int] -> IO [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (Int -> IO Float) -> [Int] -> IO [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int -> IO Float
Int -> IO (FieldType "lineWidthRange" VkPhysicalDeviceLimits)
f
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (\ Int
i
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ->
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   Int
s)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            [Int
0
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ..
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
-
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               Int
1])
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     Char -> ShowS
showChar
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       Char
']')
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String
"pointSizeGranularity = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (VkPhysicalDeviceLimits
-> FieldType "pointSizeGranularity" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           @"pointSizeGranularity"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String
"lineWidthGranularity = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (VkPhysicalDeviceLimits
-> FieldType "lineWidthGranularity" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 @"lineWidthGranularity"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String
"strictLines = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceLimits
-> FieldType "strictLines" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       @"strictLines"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String
"standardSampleLocations = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          (VkPhysicalDeviceLimits
-> FieldType "standardSampleLocations" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             @"standardSampleLocations"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              String
"optimalBufferCopyOffsetAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceLimits
-> FieldType
     "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   @"optimalBufferCopyOffsetAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    String
"optimalBufferCopyRowPitchAlignment = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceLimits
-> FieldType
     "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         @"optimalBufferCopyRowPitchAlignment"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          String
"nonCoherentAtomSize = "
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Int
d
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (VkPhysicalDeviceLimits
-> FieldType "nonCoherentAtomSize" VkPhysicalDeviceLimits
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               @"nonCoherentAtomSize"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               VkPhysicalDeviceLimits
x)
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Char -> ShowS
showChar
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceMaintenance3Properties
-> VkPhysicalDeviceMaintenance3Properties -> Bool
==
          x :: VkPhysicalDeviceMaintenance3Properties
x@(VkPhysicalDeviceMaintenance3Properties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMaintenance3Properties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMaintenance3Properties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMaintenance3Properties where
        (VkPhysicalDeviceMaintenance3Properties# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceMaintenance3Properties
-> VkPhysicalDeviceMaintenance3Properties -> Ordering
`compare`
          x :: VkPhysicalDeviceMaintenance3Properties
x@(VkPhysicalDeviceMaintenance3Properties# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMaintenance3Properties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMaintenance3Properties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMaintenance3Properties where
        sizeOf :: VkPhysicalDeviceMaintenance3Properties -> Int
sizeOf ~VkPhysicalDeviceMaintenance3Properties
_
          = (Int
32)
{-# LINE 13449 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceMaintenance3Properties -> Int
alignment ~VkPhysicalDeviceMaintenance3Properties
_
          = Int
8
{-# LINE 13453 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceMaintenance3Properties
-> IO VkPhysicalDeviceMaintenance3Properties
peek = Ptr VkPhysicalDeviceMaintenance3Properties
-> IO VkPhysicalDeviceMaintenance3Properties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceMaintenance3Properties
-> VkPhysicalDeviceMaintenance3Properties -> IO ()
poke = Ptr VkPhysicalDeviceMaintenance3Properties
-> VkPhysicalDeviceMaintenance3Properties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMaintenance3Properties
         where
        unsafeAddr :: VkPhysicalDeviceMaintenance3Properties -> Addr#
unsafeAddr (VkPhysicalDeviceMaintenance3Properties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceMaintenance3Properties -> ByteArray#
unsafeByteArray (VkPhysicalDeviceMaintenance3Properties# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceMaintenance3Properties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceMaintenance3Properties
VkPhysicalDeviceMaintenance3Properties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceMaintenance3Properties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMaintenance3Properties
-> FieldType "sType" VkPhysicalDeviceMaintenance3Properties
getField VkPhysicalDeviceMaintenance3Properties
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMaintenance3Properties
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMaintenance3Properties
-> Ptr VkPhysicalDeviceMaintenance3Properties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMaintenance3Properties
x) (Int
0))
{-# LINE 13510 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMaintenance3Properties
-> IO (FieldType "sType" VkPhysicalDeviceMaintenance3Properties)
readField Ptr VkPhysicalDeviceMaintenance3Properties
p
          = Ptr VkPhysicalDeviceMaintenance3Properties
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMaintenance3Properties
p (Int
0)
{-# LINE 13514 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceMaintenance3Properties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMaintenance3Properties
-> FieldType "sType" VkPhysicalDeviceMaintenance3Properties
-> IO ()
writeField Ptr VkPhysicalDeviceMaintenance3Properties
p
          = Ptr VkPhysicalDeviceMaintenance3Properties
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMaintenance3Properties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceMaintenance3Properties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMaintenance3Properties
-> FieldType "pNext" VkPhysicalDeviceMaintenance3Properties
getField VkPhysicalDeviceMaintenance3Properties
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMaintenance3Properties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMaintenance3Properties
-> Ptr VkPhysicalDeviceMaintenance3Properties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMaintenance3Properties
x) (Int
8))
{-# LINE 13545 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMaintenance3Properties
-> IO (FieldType "pNext" VkPhysicalDeviceMaintenance3Properties)
readField Ptr VkPhysicalDeviceMaintenance3Properties
p
          = Ptr VkPhysicalDeviceMaintenance3Properties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMaintenance3Properties
p (Int
8)
{-# LINE 13549 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceMaintenance3Properties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMaintenance3Properties
-> FieldType "pNext" VkPhysicalDeviceMaintenance3Properties
-> IO ()
writeField Ptr VkPhysicalDeviceMaintenance3Properties
p
          = Ptr VkPhysicalDeviceMaintenance3Properties
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMaintenance3Properties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPerSetDescriptors"
           VkPhysicalDeviceMaintenance3Properties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMaintenance3Properties
-> FieldType
     "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties
getField VkPhysicalDeviceMaintenance3Properties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMaintenance3Properties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMaintenance3Properties
-> Ptr VkPhysicalDeviceMaintenance3Properties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMaintenance3Properties
x) (Int
16))
{-# LINE 13589 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMaintenance3Properties
-> IO
     (FieldType
        "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties)
readField Ptr VkPhysicalDeviceMaintenance3Properties
p
          = Ptr VkPhysicalDeviceMaintenance3Properties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMaintenance3Properties
p (Int
16)
{-# LINE 13593 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPerSetDescriptors"
           VkPhysicalDeviceMaintenance3Properties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMaintenance3Properties
-> FieldType
     "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties
-> IO ()
writeField Ptr VkPhysicalDeviceMaintenance3Properties
p
          = Ptr VkPhysicalDeviceMaintenance3Properties
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMaintenance3Properties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxMemoryAllocationSize"
           VkPhysicalDeviceMaintenance3Properties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMaintenance3Properties
-> FieldType
     "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties
getField VkPhysicalDeviceMaintenance3Properties
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMaintenance3Properties
-> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMaintenance3Properties
-> Ptr VkPhysicalDeviceMaintenance3Properties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMaintenance3Properties
x) (Int
24))
{-# LINE 13635 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMaintenance3Properties
-> IO
     (FieldType
        "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties)
readField Ptr VkPhysicalDeviceMaintenance3Properties
p
          = Ptr VkPhysicalDeviceMaintenance3Properties
-> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMaintenance3Properties
p (Int
24)
{-# LINE 13639 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxMemoryAllocationSize"
           VkPhysicalDeviceMaintenance3Properties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMaintenance3Properties
-> FieldType
     "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties
-> IO ()
writeField Ptr VkPhysicalDeviceMaintenance3Properties
p
          = Ptr VkPhysicalDeviceMaintenance3Properties
-> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMaintenance3Properties
p (Int
24)
{-# LINE 13647 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceMaintenance3Properties where
        showsPrec :: Int -> VkPhysicalDeviceMaintenance3Properties -> ShowS
showsPrec Int
d VkPhysicalDeviceMaintenance3Properties
x
          = String -> ShowS
showString String
"VkPhysicalDeviceMaintenance3Properties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMaintenance3Properties
-> FieldType "sType" VkPhysicalDeviceMaintenance3Properties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceMaintenance3Properties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMaintenance3Properties
-> FieldType "pNext" VkPhysicalDeviceMaintenance3Properties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceMaintenance3Properties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"maxPerSetDescriptors = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMaintenance3Properties
-> FieldType
     "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"maxMemoryAllocationSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMaintenance3Properties
-> FieldType
     "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceMemoryProperties
-> VkPhysicalDeviceMemoryProperties -> Bool
==
          x :: VkPhysicalDeviceMemoryProperties
x@(VkPhysicalDeviceMemoryProperties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMemoryProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMemoryProperties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMemoryProperties where
        (VkPhysicalDeviceMemoryProperties# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceMemoryProperties
-> VkPhysicalDeviceMemoryProperties -> Ordering
`compare`
          x :: VkPhysicalDeviceMemoryProperties
x@(VkPhysicalDeviceMemoryProperties# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMemoryProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMemoryProperties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMemoryProperties where
        sizeOf :: VkPhysicalDeviceMemoryProperties -> Int
sizeOf ~VkPhysicalDeviceMemoryProperties
_ = (Int
520)
{-# LINE 13694 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceMemoryProperties -> Int
alignment ~VkPhysicalDeviceMemoryProperties
_
          = Int
8
{-# LINE 13698 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceMemoryProperties
-> IO VkPhysicalDeviceMemoryProperties
peek = Ptr VkPhysicalDeviceMemoryProperties
-> IO VkPhysicalDeviceMemoryProperties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceMemoryProperties
-> VkPhysicalDeviceMemoryProperties -> IO ()
poke = Ptr VkPhysicalDeviceMemoryProperties
-> VkPhysicalDeviceMemoryProperties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMemoryProperties where
        unsafeAddr :: VkPhysicalDeviceMemoryProperties -> Addr#
unsafeAddr (VkPhysicalDeviceMemoryProperties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceMemoryProperties -> ByteArray#
unsafeByteArray (VkPhysicalDeviceMemoryProperties# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceMemoryProperties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceMemoryProperties
VkPhysicalDeviceMemoryProperties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "memoryTypeCount" VkPhysicalDeviceMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMemoryProperties
-> FieldType "memoryTypeCount" VkPhysicalDeviceMemoryProperties
getField VkPhysicalDeviceMemoryProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMemoryProperties
-> Ptr VkPhysicalDeviceMemoryProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMemoryProperties
x) (Int
0))
{-# LINE 13757 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMemoryProperties
-> IO
     (FieldType "memoryTypeCount" VkPhysicalDeviceMemoryProperties)
readField Ptr VkPhysicalDeviceMemoryProperties
p
          = Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMemoryProperties
p (Int
0)
{-# LINE 13761 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "memoryTypeCount" VkPhysicalDeviceMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMemoryProperties
-> FieldType "memoryTypeCount" VkPhysicalDeviceMemoryProperties
-> IO ()
writeField Ptr VkPhysicalDeviceMemoryProperties
p
          = Ptr VkPhysicalDeviceMemoryProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMemoryProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
forall a. (Num a, Eq a) => a
VK_MAX_MEMORY_TYPES

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceMemoryProperties
-> FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties
getFieldArray = VkPhysicalDeviceMemoryProperties
-> FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties
VkPhysicalDeviceMemoryProperties -> VkMemoryType
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceMemoryProperties -> VkMemoryType
f VkPhysicalDeviceMemoryProperties
x = IO VkMemoryType -> VkMemoryType
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO VkMemoryType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMemoryProperties
-> Ptr VkPhysicalDeviceMemoryProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMemoryProperties
x) Int
off)
                off :: Int
off
                  = (Int
4)
{-# LINE 13822 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      VkMemoryType -> Int
forall a. Storable a => a -> Int
sizeOf (VkMemoryType
forall a. HasCallStack => a
undefined :: VkMemoryType) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceMemoryProperties
-> IO (FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties)
readFieldArray Ptr VkPhysicalDeviceMemoryProperties
p
          = Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO VkMemoryType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMemoryProperties
p
              ((Int
4)
{-# LINE 13830 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 VkMemoryType -> Int
forall a. Storable a => a -> Int
sizeOf (VkMemoryType
forall a. HasCallStack => a
undefined :: VkMemoryType) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceMemoryProperties
-> FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties
-> IO ()
writeFieldArray Ptr VkPhysicalDeviceMemoryProperties
p
          = Ptr VkPhysicalDeviceMemoryProperties
-> Int -> VkMemoryType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMemoryProperties
p
              ((Int
4)
{-# LINE 13861 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 VkMemoryType -> Int
forall a. Storable a => a -> Int
sizeOf (VkMemoryType
forall a. HasCallStack => a
undefined :: VkMemoryType) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
260)
{-# LINE 13885 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "memoryHeapCount" VkPhysicalDeviceMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMemoryProperties
-> FieldType "memoryHeapCount" VkPhysicalDeviceMemoryProperties
getField VkPhysicalDeviceMemoryProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMemoryProperties
-> Ptr VkPhysicalDeviceMemoryProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMemoryProperties
x) (Int
260))
{-# LINE 13893 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMemoryProperties
-> IO
     (FieldType "memoryHeapCount" VkPhysicalDeviceMemoryProperties)
readField Ptr VkPhysicalDeviceMemoryProperties
p
          = Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMemoryProperties
p (Int
260)
{-# LINE 13897 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "memoryHeapCount" VkPhysicalDeviceMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMemoryProperties
-> FieldType "memoryHeapCount" VkPhysicalDeviceMemoryProperties
-> IO ()
writeField Ptr VkPhysicalDeviceMemoryProperties
p
          = Ptr VkPhysicalDeviceMemoryProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMemoryProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
forall a. (Num a, Eq a) => a
VK_MAX_MEMORY_HEAPS

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceMemoryProperties
-> FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties
getFieldArray = VkPhysicalDeviceMemoryProperties
-> FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties
VkPhysicalDeviceMemoryProperties -> VkMemoryHeap
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceMemoryProperties -> VkMemoryHeap
f VkPhysicalDeviceMemoryProperties
x = IO VkMemoryHeap -> VkMemoryHeap
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO VkMemoryHeap
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMemoryProperties
-> Ptr VkPhysicalDeviceMemoryProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMemoryProperties
x) Int
off)
                off :: Int
off
                  = (Int
264)
{-# LINE 13958 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      VkMemoryHeap -> Int
forall a. Storable a => a -> Int
sizeOf (VkMemoryHeap
forall a. HasCallStack => a
undefined :: VkMemoryHeap) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceMemoryProperties
-> IO (FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties)
readFieldArray Ptr VkPhysicalDeviceMemoryProperties
p
          = Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO VkMemoryHeap
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMemoryProperties
p
              ((Int
264)
{-# LINE 13966 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 VkMemoryHeap -> Int
forall a. Storable a => a -> Int
sizeOf (VkMemoryHeap
forall a. HasCallStack => a
undefined :: VkMemoryHeap) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceMemoryProperties
-> FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties
-> IO ()
writeFieldArray Ptr VkPhysicalDeviceMemoryProperties
p
          = Ptr VkPhysicalDeviceMemoryProperties
-> Int -> VkMemoryHeap -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMemoryProperties
p
              ((Int
264)
{-# LINE 13997 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 VkMemoryHeap -> Int
forall a. Storable a => a -> Int
sizeOf (VkMemoryHeap
forall a. HasCallStack => a
undefined :: VkMemoryHeap) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance Show VkPhysicalDeviceMemoryProperties where
        showsPrec :: Int -> VkPhysicalDeviceMemoryProperties -> ShowS
showsPrec Int
d VkPhysicalDeviceMemoryProperties
x
          = String -> ShowS
showString String
"VkPhysicalDeviceMemoryProperties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"memoryTypeCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMemoryProperties
-> FieldType "memoryTypeCount" VkPhysicalDeviceMemoryProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"memoryTypeCount" VkPhysicalDeviceMemoryProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (String -> ShowS
showString String
"memoryTypes = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       Int -> [VkMemoryType] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                         (let s :: Int
s = VkMemoryType -> Int
forall a. Storable a => a -> Int
sizeOf
                                    (FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties
forall a. HasCallStack => a
undefined ::
                                       FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties)
                              o :: Int
o = HasField "memoryTypes" VkPhysicalDeviceMemoryProperties => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"memoryTypes" @VkPhysicalDeviceMemoryProperties
                              f :: Int
-> IO (FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties)
f Int
i
                                = Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO VkMemoryType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMemoryProperties
-> Ptr VkPhysicalDeviceMemoryProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMemoryProperties
x) Int
i ::
                                    IO (FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties)
                            in
                            IO [VkMemoryType] -> [VkMemoryType]
forall a. IO a -> a
unsafeDupablePerformIO (IO [VkMemoryType] -> [VkMemoryType])
-> ([Int] -> IO [VkMemoryType]) -> [Int] -> [VkMemoryType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO VkMemoryType) -> [Int] -> IO [VkMemoryType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int
-> IO (FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties)
Int -> IO VkMemoryType
f ([Int] -> [VkMemoryType]) -> [Int] -> [VkMemoryType]
forall a b. (a -> b) -> a -> b
$
                              (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
forall a. (Num a, Eq a) => a
VK_MAX_MEMORY_TYPES Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                         ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
"memoryHeapCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMemoryProperties
-> FieldType "memoryHeapCount" VkPhysicalDeviceMemoryProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"memoryHeapCount" VkPhysicalDeviceMemoryProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              (String -> ShowS
showString String
"memoryHeaps = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 Int -> [VkMemoryHeap] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                   (let s :: Int
s = VkMemoryHeap -> Int
forall a. Storable a => a -> Int
sizeOf
                                              (FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties
forall a. HasCallStack => a
undefined ::
                                                 FieldType "memoryHeaps"
                                                   VkPhysicalDeviceMemoryProperties)
                                        o :: Int
o = HasField "memoryHeaps" VkPhysicalDeviceMemoryProperties => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"memoryHeaps"
                                              @VkPhysicalDeviceMemoryProperties
                                        f :: Int
-> IO (FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties)
f Int
i
                                          = Ptr VkPhysicalDeviceMemoryProperties -> Int -> IO VkMemoryHeap
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMemoryProperties
-> Ptr VkPhysicalDeviceMemoryProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMemoryProperties
x) Int
i ::
                                              IO
                                                (FieldType "memoryHeaps"
                                                   VkPhysicalDeviceMemoryProperties)
                                      in
                                      IO [VkMemoryHeap] -> [VkMemoryHeap]
forall a. IO a -> a
unsafeDupablePerformIO (IO [VkMemoryHeap] -> [VkMemoryHeap])
-> ([Int] -> IO [VkMemoryHeap]) -> [Int] -> [VkMemoryHeap]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO VkMemoryHeap) -> [Int] -> IO [VkMemoryHeap]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int
-> IO (FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties)
Int -> IO VkMemoryHeap
f ([Int] -> [VkMemoryHeap]) -> [Int] -> [VkMemoryHeap]
forall a b. (a -> b) -> a -> b
$
                                        (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
forall a. (Num a, Eq a) => a
VK_MAX_MEMORY_HEAPS Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                                   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceMemoryProperties2
-> VkPhysicalDeviceMemoryProperties2 -> Bool
==
          x :: VkPhysicalDeviceMemoryProperties2
x@(VkPhysicalDeviceMemoryProperties2# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMemoryProperties2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMemoryProperties2
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMemoryProperties2 where
        (VkPhysicalDeviceMemoryProperties2# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceMemoryProperties2
-> VkPhysicalDeviceMemoryProperties2 -> Ordering
`compare`
          x :: VkPhysicalDeviceMemoryProperties2
x@(VkPhysicalDeviceMemoryProperties2# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMemoryProperties2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMemoryProperties2
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMemoryProperties2 where
        sizeOf :: VkPhysicalDeviceMemoryProperties2 -> Int
sizeOf ~VkPhysicalDeviceMemoryProperties2
_ = (Int
536)
{-# LINE 14070 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceMemoryProperties2 -> Int
alignment ~VkPhysicalDeviceMemoryProperties2
_
          = Int
8
{-# LINE 14074 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceMemoryProperties2
-> IO VkPhysicalDeviceMemoryProperties2
peek = Ptr VkPhysicalDeviceMemoryProperties2
-> IO VkPhysicalDeviceMemoryProperties2
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceMemoryProperties2
-> VkPhysicalDeviceMemoryProperties2 -> IO ()
poke = Ptr VkPhysicalDeviceMemoryProperties2
-> VkPhysicalDeviceMemoryProperties2 -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMemoryProperties2 where
        unsafeAddr :: VkPhysicalDeviceMemoryProperties2 -> Addr#
unsafeAddr (VkPhysicalDeviceMemoryProperties2# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceMemoryProperties2 -> ByteArray#
unsafeByteArray (VkPhysicalDeviceMemoryProperties2# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceMemoryProperties2
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceMemoryProperties2
VkPhysicalDeviceMemoryProperties2#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceMemoryProperties2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMemoryProperties2
-> FieldType "sType" VkPhysicalDeviceMemoryProperties2
getField VkPhysicalDeviceMemoryProperties2
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMemoryProperties2 -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMemoryProperties2
-> Ptr VkPhysicalDeviceMemoryProperties2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMemoryProperties2
x) (Int
0))
{-# LINE 14128 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMemoryProperties2
-> IO (FieldType "sType" VkPhysicalDeviceMemoryProperties2)
readField Ptr VkPhysicalDeviceMemoryProperties2
p
          = Ptr VkPhysicalDeviceMemoryProperties2 -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMemoryProperties2
p (Int
0)
{-# LINE 14132 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceMemoryProperties2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMemoryProperties2
-> FieldType "sType" VkPhysicalDeviceMemoryProperties2 -> IO ()
writeField Ptr VkPhysicalDeviceMemoryProperties2
p
          = Ptr VkPhysicalDeviceMemoryProperties2
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMemoryProperties2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceMemoryProperties2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMemoryProperties2
-> FieldType "pNext" VkPhysicalDeviceMemoryProperties2
getField VkPhysicalDeviceMemoryProperties2
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMemoryProperties2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMemoryProperties2
-> Ptr VkPhysicalDeviceMemoryProperties2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMemoryProperties2
x) (Int
8))
{-# LINE 14162 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMemoryProperties2
-> IO (FieldType "pNext" VkPhysicalDeviceMemoryProperties2)
readField Ptr VkPhysicalDeviceMemoryProperties2
p
          = Ptr VkPhysicalDeviceMemoryProperties2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMemoryProperties2
p (Int
8)
{-# LINE 14166 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceMemoryProperties2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMemoryProperties2
-> FieldType "pNext" VkPhysicalDeviceMemoryProperties2 -> IO ()
writeField Ptr VkPhysicalDeviceMemoryProperties2
p
          = Ptr VkPhysicalDeviceMemoryProperties2 -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMemoryProperties2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "memoryProperties" VkPhysicalDeviceMemoryProperties2
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMemoryProperties2
-> FieldType "memoryProperties" VkPhysicalDeviceMemoryProperties2
getField VkPhysicalDeviceMemoryProperties2
x
          = IO VkPhysicalDeviceMemoryProperties
-> VkPhysicalDeviceMemoryProperties
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMemoryProperties2
-> Int -> IO VkPhysicalDeviceMemoryProperties
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMemoryProperties2
-> Ptr VkPhysicalDeviceMemoryProperties2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMemoryProperties2
x) (Int
16))
{-# LINE 14202 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMemoryProperties2
-> IO
     (FieldType "memoryProperties" VkPhysicalDeviceMemoryProperties2)
readField Ptr VkPhysicalDeviceMemoryProperties2
p
          = Ptr VkPhysicalDeviceMemoryProperties2
-> Int -> IO VkPhysicalDeviceMemoryProperties
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMemoryProperties2
p (Int
16)
{-# LINE 14206 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "memoryProperties" VkPhysicalDeviceMemoryProperties2
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMemoryProperties2
-> FieldType "memoryProperties" VkPhysicalDeviceMemoryProperties2
-> IO ()
writeField Ptr VkPhysicalDeviceMemoryProperties2
p
          = Ptr VkPhysicalDeviceMemoryProperties2
-> Int -> VkPhysicalDeviceMemoryProperties -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMemoryProperties2
p (Int
16)
{-# LINE 14213 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceMemoryProperties2 where
        showsPrec :: Int -> VkPhysicalDeviceMemoryProperties2 -> ShowS
showsPrec Int
d VkPhysicalDeviceMemoryProperties2
x
          = String -> ShowS
showString String
"VkPhysicalDeviceMemoryProperties2 {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMemoryProperties2
-> FieldType "sType" VkPhysicalDeviceMemoryProperties2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceMemoryProperties2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMemoryProperties2
-> FieldType "pNext" VkPhysicalDeviceMemoryProperties2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceMemoryProperties2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"memoryProperties = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkPhysicalDeviceMemoryProperties -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMemoryProperties2
-> FieldType "memoryProperties" VkPhysicalDeviceMemoryProperties2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"memoryProperties" VkPhysicalDeviceMemoryProperties2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceMultiviewFeatures
-> VkPhysicalDeviceMultiviewFeatures -> Bool
==
          x :: VkPhysicalDeviceMultiviewFeatures
x@(VkPhysicalDeviceMultiviewFeatures# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMultiviewFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMultiviewFeatures
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMultiviewFeatures where
        (VkPhysicalDeviceMultiviewFeatures# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceMultiviewFeatures
-> VkPhysicalDeviceMultiviewFeatures -> Ordering
`compare`
          x :: VkPhysicalDeviceMultiviewFeatures
x@(VkPhysicalDeviceMultiviewFeatures# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMultiviewFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMultiviewFeatures
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMultiviewFeatures where
        sizeOf :: VkPhysicalDeviceMultiviewFeatures -> Int
sizeOf ~VkPhysicalDeviceMultiviewFeatures
_ = (Int
32)
{-# LINE 14258 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceMultiviewFeatures -> Int
alignment ~VkPhysicalDeviceMultiviewFeatures
_
          = Int
8
{-# LINE 14262 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceMultiviewFeatures
-> IO VkPhysicalDeviceMultiviewFeatures
peek = Ptr VkPhysicalDeviceMultiviewFeatures
-> IO VkPhysicalDeviceMultiviewFeatures
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceMultiviewFeatures
-> VkPhysicalDeviceMultiviewFeatures -> IO ()
poke = Ptr VkPhysicalDeviceMultiviewFeatures
-> VkPhysicalDeviceMultiviewFeatures -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMultiviewFeatures where
        unsafeAddr :: VkPhysicalDeviceMultiviewFeatures -> Addr#
unsafeAddr (VkPhysicalDeviceMultiviewFeatures# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceMultiviewFeatures -> ByteArray#
unsafeByteArray (VkPhysicalDeviceMultiviewFeatures# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceMultiviewFeatures
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceMultiviewFeatures
VkPhysicalDeviceMultiviewFeatures#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceMultiviewFeatures where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewFeatures
-> FieldType "sType" VkPhysicalDeviceMultiviewFeatures
getField VkPhysicalDeviceMultiviewFeatures
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewFeatures
-> Ptr VkPhysicalDeviceMultiviewFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewFeatures
x) (Int
0))
{-# LINE 14318 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> IO (FieldType "sType" VkPhysicalDeviceMultiviewFeatures)
readField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
0)
{-# LINE 14322 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceMultiviewFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> FieldType "sType" VkPhysicalDeviceMultiviewFeatures -> IO ()
writeField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceMultiviewFeatures where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewFeatures
-> FieldType "pNext" VkPhysicalDeviceMultiviewFeatures
getField VkPhysicalDeviceMultiviewFeatures
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewFeatures
-> Ptr VkPhysicalDeviceMultiviewFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewFeatures
x) (Int
8))
{-# LINE 14352 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> IO (FieldType "pNext" VkPhysicalDeviceMultiviewFeatures)
readField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
8)
{-# LINE 14356 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceMultiviewFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> FieldType "pNext" VkPhysicalDeviceMultiviewFeatures -> IO ()
writeField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "multiview" VkPhysicalDeviceMultiviewFeatures where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewFeatures
-> FieldType "multiview" VkPhysicalDeviceMultiviewFeatures
getField VkPhysicalDeviceMultiviewFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewFeatures
-> Ptr VkPhysicalDeviceMultiviewFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewFeatures
x) (Int
16))
{-# LINE 14387 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> IO (FieldType "multiview" VkPhysicalDeviceMultiviewFeatures)
readField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
16)
{-# LINE 14391 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "multiview" VkPhysicalDeviceMultiviewFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> FieldType "multiview" VkPhysicalDeviceMultiviewFeatures -> IO ()
writeField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "multiviewGeometryShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewFeatures
-> FieldType
     "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures
getField VkPhysicalDeviceMultiviewFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewFeatures
-> Ptr VkPhysicalDeviceMultiviewFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewFeatures
x) (Int
20))
{-# LINE 14431 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> IO
     (FieldType
        "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures)
readField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
20)
{-# LINE 14435 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "multiviewGeometryShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> FieldType
     "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "multiviewTessellationShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewFeatures
-> FieldType
     "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures
getField VkPhysicalDeviceMultiviewFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewFeatures
-> Ptr VkPhysicalDeviceMultiviewFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewFeatures
x) (Int
24))
{-# LINE 14477 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> IO
     (FieldType
        "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures)
readField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
24)
{-# LINE 14481 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "multiviewTessellationShader"
           VkPhysicalDeviceMultiviewFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewFeatures
-> FieldType
     "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceMultiviewFeatures
p
          = Ptr VkPhysicalDeviceMultiviewFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewFeatures
p (Int
24)
{-# LINE 14489 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceMultiviewFeatures where
        showsPrec :: Int -> VkPhysicalDeviceMultiviewFeatures -> ShowS
showsPrec Int
d VkPhysicalDeviceMultiviewFeatures
x
          = String -> ShowS
showString String
"VkPhysicalDeviceMultiviewFeatures {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewFeatures
-> FieldType "sType" VkPhysicalDeviceMultiviewFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceMultiviewFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewFeatures
-> FieldType "pNext" VkPhysicalDeviceMultiviewFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceMultiviewFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"multiview = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewFeatures
-> FieldType "multiview" VkPhysicalDeviceMultiviewFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"multiview" VkPhysicalDeviceMultiviewFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"multiviewGeometryShader = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewFeatures
-> FieldType
     "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"multiviewTessellationShader = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewFeatures
-> FieldType
     "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX -> Bool
==
          x :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x@(VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# Addr#
a ByteArray#
_)
          compare :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Ordering
`compare`
          x :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x@(VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        sizeOf :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX -> Int
sizeOf ~VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
_
          = (Int
24)
{-# LINE 14546 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX -> Int
alignment ~VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
_
          = Int
8
{-# LINE 14550 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> IO VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
peek = Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> IO VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX -> IO ()
poke = Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        unsafeAddr :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX -> Addr#
unsafeAddr
          (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int#
-> ByteArray#
-> VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray#
-> VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> FieldType
     "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
getField VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x) (Int
0))
{-# LINE 14626 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> IO
     (FieldType
        "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX)
readField Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p
          = Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p (Int
0)
{-# LINE 14630 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> FieldType
     "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> IO ()
writeField Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p
          = Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> FieldType
     "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
getField VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x) (Int
8))
{-# LINE 14672 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> IO
     (FieldType
        "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX)
readField Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p
          = Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p (Int
8)
{-# LINE 14676 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> FieldType
     "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> IO ()
writeField Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p
          = Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "perViewPositionAllComponents"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> FieldType
     "perViewPositionAllComponents"
     VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
getField VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x) (Int
16))
{-# LINE 14718 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> IO
     (FieldType
        "perViewPositionAllComponents"
        VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX)
readField Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p
          = Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p (Int
16)
{-# LINE 14722 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "perViewPositionAllComponents"
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> FieldType
     "perViewPositionAllComponents"
     VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> IO ()
writeField Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p
          = Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
p (Int
16)
{-# LINE 14730 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show
           VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
         where
        showsPrec :: Int
-> VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX -> ShowS
showsPrec Int
d VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x
          = String -> ShowS
showString
              String
"VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX {"
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> FieldType
     "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> FieldType
     "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"perViewPositionAllComponents = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
-> FieldType
     "perViewPositionAllComponents"
     VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"perViewPositionAllComponents" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceMultiviewProperties
-> VkPhysicalDeviceMultiviewProperties -> Bool
==
          x :: VkPhysicalDeviceMultiviewProperties
x@(VkPhysicalDeviceMultiviewProperties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMultiviewProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMultiviewProperties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceMultiviewProperties where
        (VkPhysicalDeviceMultiviewProperties# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceMultiviewProperties
-> VkPhysicalDeviceMultiviewProperties -> Ordering
`compare`
          x :: VkPhysicalDeviceMultiviewProperties
x@(VkPhysicalDeviceMultiviewProperties# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceMultiviewProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceMultiviewProperties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceMultiviewProperties where
        sizeOf :: VkPhysicalDeviceMultiviewProperties -> Int
sizeOf ~VkPhysicalDeviceMultiviewProperties
_ = (Int
24)
{-# LINE 14775 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceMultiviewProperties -> Int
alignment ~VkPhysicalDeviceMultiviewProperties
_
          = Int
8
{-# LINE 14779 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceMultiviewProperties
-> IO VkPhysicalDeviceMultiviewProperties
peek = Ptr VkPhysicalDeviceMultiviewProperties
-> IO VkPhysicalDeviceMultiviewProperties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceMultiviewProperties
-> VkPhysicalDeviceMultiviewProperties -> IO ()
poke = Ptr VkPhysicalDeviceMultiviewProperties
-> VkPhysicalDeviceMultiviewProperties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceMultiviewProperties
         where
        unsafeAddr :: VkPhysicalDeviceMultiviewProperties -> Addr#
unsafeAddr (VkPhysicalDeviceMultiviewProperties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceMultiviewProperties -> ByteArray#
unsafeByteArray (VkPhysicalDeviceMultiviewProperties# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceMultiviewProperties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceMultiviewProperties
VkPhysicalDeviceMultiviewProperties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceMultiviewProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewProperties
-> FieldType "sType" VkPhysicalDeviceMultiviewProperties
getField VkPhysicalDeviceMultiviewProperties
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewProperties
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewProperties
-> Ptr VkPhysicalDeviceMultiviewProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewProperties
x) (Int
0))
{-# LINE 14836 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewProperties
-> IO (FieldType "sType" VkPhysicalDeviceMultiviewProperties)
readField Ptr VkPhysicalDeviceMultiviewProperties
p
          = Ptr VkPhysicalDeviceMultiviewProperties
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewProperties
p (Int
0)
{-# LINE 14840 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceMultiviewProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewProperties
-> FieldType "sType" VkPhysicalDeviceMultiviewProperties -> IO ()
writeField Ptr VkPhysicalDeviceMultiviewProperties
p
          = Ptr VkPhysicalDeviceMultiviewProperties
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceMultiviewProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewProperties
-> FieldType "pNext" VkPhysicalDeviceMultiviewProperties
getField VkPhysicalDeviceMultiviewProperties
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewProperties
-> Ptr VkPhysicalDeviceMultiviewProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewProperties
x) (Int
8))
{-# LINE 14871 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewProperties
-> IO (FieldType "pNext" VkPhysicalDeviceMultiviewProperties)
readField Ptr VkPhysicalDeviceMultiviewProperties
p
          = Ptr VkPhysicalDeviceMultiviewProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewProperties
p (Int
8)
{-# LINE 14875 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceMultiviewProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewProperties
-> FieldType "pNext" VkPhysicalDeviceMultiviewProperties -> IO ()
writeField Ptr VkPhysicalDeviceMultiviewProperties
p
          = Ptr VkPhysicalDeviceMultiviewProperties -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxMultiviewViewCount"
           VkPhysicalDeviceMultiviewProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewProperties
-> FieldType
     "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties
getField VkPhysicalDeviceMultiviewProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewProperties
-> Ptr VkPhysicalDeviceMultiviewProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewProperties
x) (Int
16))
{-# LINE 14915 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewProperties
-> IO
     (FieldType
        "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties)
readField Ptr VkPhysicalDeviceMultiviewProperties
p
          = Ptr VkPhysicalDeviceMultiviewProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewProperties
p (Int
16)
{-# LINE 14919 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxMultiviewViewCount"
           VkPhysicalDeviceMultiviewProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewProperties
-> FieldType
     "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties
-> IO ()
writeField Ptr VkPhysicalDeviceMultiviewProperties
p
          = Ptr VkPhysicalDeviceMultiviewProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxMultiviewInstanceIndex"
           VkPhysicalDeviceMultiviewProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceMultiviewProperties
-> FieldType
     "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties
getField VkPhysicalDeviceMultiviewProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceMultiviewProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceMultiviewProperties
-> Ptr VkPhysicalDeviceMultiviewProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceMultiviewProperties
x) (Int
20))
{-# LINE 14961 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceMultiviewProperties
-> IO
     (FieldType
        "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties)
readField Ptr VkPhysicalDeviceMultiviewProperties
p
          = Ptr VkPhysicalDeviceMultiviewProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceMultiviewProperties
p (Int
20)
{-# LINE 14965 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxMultiviewInstanceIndex"
           VkPhysicalDeviceMultiviewProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceMultiviewProperties
-> FieldType
     "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties
-> IO ()
writeField Ptr VkPhysicalDeviceMultiviewProperties
p
          = Ptr VkPhysicalDeviceMultiviewProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceMultiviewProperties
p (Int
20)
{-# LINE 14973 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceMultiviewProperties where
        showsPrec :: Int -> VkPhysicalDeviceMultiviewProperties -> ShowS
showsPrec Int
d VkPhysicalDeviceMultiviewProperties
x
          = String -> ShowS
showString String
"VkPhysicalDeviceMultiviewProperties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewProperties
-> FieldType "sType" VkPhysicalDeviceMultiviewProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceMultiviewProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewProperties
-> FieldType "pNext" VkPhysicalDeviceMultiviewProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceMultiviewProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"maxMultiviewViewCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewProperties
-> FieldType
     "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"maxMultiviewInstanceIndex = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceMultiviewProperties
-> FieldType
     "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDevicePointClippingProperties
-> VkPhysicalDevicePointClippingProperties -> Bool
==
          x :: VkPhysicalDevicePointClippingProperties
x@(VkPhysicalDevicePointClippingProperties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDevicePointClippingProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDevicePointClippingProperties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDevicePointClippingProperties where
        (VkPhysicalDevicePointClippingProperties# Addr#
a ByteArray#
_) compare :: VkPhysicalDevicePointClippingProperties
-> VkPhysicalDevicePointClippingProperties -> Ordering
`compare`
          x :: VkPhysicalDevicePointClippingProperties
x@(VkPhysicalDevicePointClippingProperties# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDevicePointClippingProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDevicePointClippingProperties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDevicePointClippingProperties where
        sizeOf :: VkPhysicalDevicePointClippingProperties -> Int
sizeOf ~VkPhysicalDevicePointClippingProperties
_
          = (Int
24)
{-# LINE 15021 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDevicePointClippingProperties -> Int
alignment ~VkPhysicalDevicePointClippingProperties
_
          = Int
8
{-# LINE 15025 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDevicePointClippingProperties
-> IO VkPhysicalDevicePointClippingProperties
peek = Ptr VkPhysicalDevicePointClippingProperties
-> IO VkPhysicalDevicePointClippingProperties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDevicePointClippingProperties
-> VkPhysicalDevicePointClippingProperties -> IO ()
poke = Ptr VkPhysicalDevicePointClippingProperties
-> VkPhysicalDevicePointClippingProperties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDevicePointClippingProperties
         where
        unsafeAddr :: VkPhysicalDevicePointClippingProperties -> Addr#
unsafeAddr (VkPhysicalDevicePointClippingProperties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDevicePointClippingProperties -> ByteArray#
unsafeByteArray (VkPhysicalDevicePointClippingProperties# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDevicePointClippingProperties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDevicePointClippingProperties
VkPhysicalDevicePointClippingProperties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDevicePointClippingProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevicePointClippingProperties
-> FieldType "sType" VkPhysicalDevicePointClippingProperties
getField VkPhysicalDevicePointClippingProperties
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevicePointClippingProperties
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevicePointClippingProperties
-> Ptr VkPhysicalDevicePointClippingProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevicePointClippingProperties
x) (Int
0))
{-# LINE 15082 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevicePointClippingProperties
-> IO (FieldType "sType" VkPhysicalDevicePointClippingProperties)
readField Ptr VkPhysicalDevicePointClippingProperties
p
          = Ptr VkPhysicalDevicePointClippingProperties
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevicePointClippingProperties
p (Int
0)
{-# LINE 15086 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDevicePointClippingProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevicePointClippingProperties
-> FieldType "sType" VkPhysicalDevicePointClippingProperties
-> IO ()
writeField Ptr VkPhysicalDevicePointClippingProperties
p
          = Ptr VkPhysicalDevicePointClippingProperties
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevicePointClippingProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDevicePointClippingProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevicePointClippingProperties
-> FieldType "pNext" VkPhysicalDevicePointClippingProperties
getField VkPhysicalDevicePointClippingProperties
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevicePointClippingProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevicePointClippingProperties
-> Ptr VkPhysicalDevicePointClippingProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevicePointClippingProperties
x) (Int
8))
{-# LINE 15117 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevicePointClippingProperties
-> IO (FieldType "pNext" VkPhysicalDevicePointClippingProperties)
readField Ptr VkPhysicalDevicePointClippingProperties
p
          = Ptr VkPhysicalDevicePointClippingProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevicePointClippingProperties
p (Int
8)
{-# LINE 15121 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDevicePointClippingProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevicePointClippingProperties
-> FieldType "pNext" VkPhysicalDevicePointClippingProperties
-> IO ()
writeField Ptr VkPhysicalDevicePointClippingProperties
p
          = Ptr VkPhysicalDevicePointClippingProperties
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevicePointClippingProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pointClippingBehavior"
           VkPhysicalDevicePointClippingProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevicePointClippingProperties
-> FieldType
     "pointClippingBehavior" VkPhysicalDevicePointClippingProperties
getField VkPhysicalDevicePointClippingProperties
x
          = IO VkPointClippingBehavior -> VkPointClippingBehavior
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevicePointClippingProperties
-> Int -> IO VkPointClippingBehavior
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevicePointClippingProperties
-> Ptr VkPhysicalDevicePointClippingProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevicePointClippingProperties
x) (Int
16))
{-# LINE 15161 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevicePointClippingProperties
-> IO
     (FieldType
        "pointClippingBehavior" VkPhysicalDevicePointClippingProperties)
readField Ptr VkPhysicalDevicePointClippingProperties
p
          = Ptr VkPhysicalDevicePointClippingProperties
-> Int -> IO VkPointClippingBehavior
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevicePointClippingProperties
p (Int
16)
{-# LINE 15165 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pointClippingBehavior"
           VkPhysicalDevicePointClippingProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevicePointClippingProperties
-> FieldType
     "pointClippingBehavior" VkPhysicalDevicePointClippingProperties
-> IO ()
writeField Ptr VkPhysicalDevicePointClippingProperties
p
          = Ptr VkPhysicalDevicePointClippingProperties
-> Int -> VkPointClippingBehavior -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevicePointClippingProperties
p (Int
16)
{-# LINE 15173 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDevicePointClippingProperties where
        showsPrec :: Int -> VkPhysicalDevicePointClippingProperties -> ShowS
showsPrec Int
d VkPhysicalDevicePointClippingProperties
x
          = String -> ShowS
showString String
"VkPhysicalDevicePointClippingProperties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevicePointClippingProperties
-> FieldType "sType" VkPhysicalDevicePointClippingProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDevicePointClippingProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevicePointClippingProperties
-> FieldType "pNext" VkPhysicalDevicePointClippingProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDevicePointClippingProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"pointClippingBehavior = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkPointClippingBehavior -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevicePointClippingProperties
-> FieldType
     "pointClippingBehavior" VkPhysicalDevicePointClippingProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pointClippingBehavior" VkPhysicalDevicePointClippingProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceProperties -> VkPhysicalDeviceProperties -> Bool
==
          x :: VkPhysicalDeviceProperties
x@(VkPhysicalDeviceProperties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceProperties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceProperties where
        (VkPhysicalDeviceProperties# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceProperties
-> VkPhysicalDeviceProperties -> Ordering
`compare`
          x :: VkPhysicalDeviceProperties
x@(VkPhysicalDeviceProperties# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceProperties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceProperties where
        sizeOf :: VkPhysicalDeviceProperties -> Int
sizeOf ~VkPhysicalDeviceProperties
_ = (Int
824)
{-# LINE 15221 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceProperties -> Int
alignment ~VkPhysicalDeviceProperties
_ = Int
8
{-# LINE 15224 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceProperties -> IO VkPhysicalDeviceProperties
peek = Ptr VkPhysicalDeviceProperties -> IO VkPhysicalDeviceProperties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceProperties
-> VkPhysicalDeviceProperties -> IO ()
poke = Ptr VkPhysicalDeviceProperties
-> VkPhysicalDeviceProperties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceProperties where
        unsafeAddr :: VkPhysicalDeviceProperties -> Addr#
unsafeAddr (VkPhysicalDeviceProperties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceProperties -> ByteArray#
unsafeByteArray (VkPhysicalDeviceProperties# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceProperties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceProperties
VkPhysicalDeviceProperties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "apiVersion" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties
-> FieldType "apiVersion" VkPhysicalDeviceProperties
getField VkPhysicalDeviceProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) (Int
0))
{-# LINE 15277 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties
-> IO (FieldType "apiVersion" VkPhysicalDeviceProperties)
readField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties
p (Int
0)
{-# LINE 15281 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "apiVersion" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties
-> FieldType "apiVersion" VkPhysicalDeviceProperties -> IO ()
writeField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
4)
{-# LINE 15304 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "driverVersion" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties
-> FieldType "driverVersion" VkPhysicalDeviceProperties
getField VkPhysicalDeviceProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) (Int
4))
{-# LINE 15311 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties
-> IO (FieldType "driverVersion" VkPhysicalDeviceProperties)
readField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties
p (Int
4)
{-# LINE 15315 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "driverVersion" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties
-> FieldType "driverVersion" VkPhysicalDeviceProperties -> IO ()
writeField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "vendorID" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties
-> FieldType "vendorID" VkPhysicalDeviceProperties
getField VkPhysicalDeviceProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) (Int
8))
{-# LINE 15343 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties
-> IO (FieldType "vendorID" VkPhysicalDeviceProperties)
readField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties
p (Int
8)
{-# LINE 15347 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "vendorID" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties
-> FieldType "vendorID" VkPhysicalDeviceProperties -> IO ()
writeField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
12)
{-# LINE 15368 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "deviceID" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties
-> FieldType "deviceID" VkPhysicalDeviceProperties
getField VkPhysicalDeviceProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) (Int
12))
{-# LINE 15375 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties
-> IO (FieldType "deviceID" VkPhysicalDeviceProperties)
readField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties
p (Int
12)
{-# LINE 15379 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "deviceID" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties
-> FieldType "deviceID" VkPhysicalDeviceProperties -> IO ()
writeField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "deviceType" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties
-> FieldType "deviceType" VkPhysicalDeviceProperties
getField VkPhysicalDeviceProperties
x
          = IO VkPhysicalDeviceType -> VkPhysicalDeviceType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties -> Int -> IO VkPhysicalDeviceType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) (Int
16))
{-# LINE 15408 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties
-> IO (FieldType "deviceType" VkPhysicalDeviceProperties)
readField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> IO VkPhysicalDeviceType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties
p (Int
16)
{-# LINE 15412 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "deviceType" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties
-> FieldType "deviceType" VkPhysicalDeviceProperties -> IO ()
writeField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties
-> Int -> VkPhysicalDeviceType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
forall a. (Num a, Eq a) => a
VK_MAX_PHYSICAL_DEVICE_NAME_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceProperties
-> FieldType "deviceName" VkPhysicalDeviceProperties
getFieldArray = VkPhysicalDeviceProperties -> CChar
VkPhysicalDeviceProperties
-> FieldType "deviceName" VkPhysicalDeviceProperties
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceProperties -> CChar
f VkPhysicalDeviceProperties
x = IO CChar -> CChar
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceProperties -> Int -> IO CChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) Int
off)
                off :: Int
off
                  = (Int
20) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 15462 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      CChar -> Int
forall a. Storable a => a -> Int
sizeOf (CChar
forall a. HasCallStack => a
undefined :: CChar) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceProperties
-> IO (FieldType "deviceName" VkPhysicalDeviceProperties)
readFieldArray Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> IO CChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties
p
              ((Int
20) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 15469 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 CChar -> Int
forall a. Storable a => a -> Int
sizeOf (CChar
forall a. HasCallStack => a
undefined :: CChar) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceProperties
-> FieldType "deviceName" VkPhysicalDeviceProperties -> IO ()
writeFieldArray Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties
p
              ((Int
20) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 15493 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 CChar -> Int
forall a. Storable a => a -> Int
sizeOf (CChar
forall a. HasCallStack => a
undefined :: CChar) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
forall a. (Num a, Eq a) => a
VK_UUID_SIZE

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceProperties
-> FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties
getFieldArray = VkPhysicalDeviceProperties -> Word8
VkPhysicalDeviceProperties
-> FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceProperties -> Word8
f VkPhysicalDeviceProperties
x = IO Word8 -> Word8
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) Int
off)
                off :: Int
off
                  = (Int
276)
{-# LINE 15549 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceProperties
-> IO (FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties)
readFieldArray Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties
p
              ((Int
276)
{-# LINE 15557 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceProperties
-> FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties
-> IO ()
writeFieldArray Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties
p
              ((Int
276)
{-# LINE 15588 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
296)
{-# LINE 15607 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "limits" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties
-> FieldType "limits" VkPhysicalDeviceProperties
getField VkPhysicalDeviceProperties
x
          = IO VkPhysicalDeviceLimits -> VkPhysicalDeviceLimits
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties -> Int -> IO VkPhysicalDeviceLimits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) (Int
296))
{-# LINE 15614 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties
-> IO (FieldType "limits" VkPhysicalDeviceProperties)
readField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties -> Int -> IO VkPhysicalDeviceLimits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties
p (Int
296)
{-# LINE 15618 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "limits" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties
-> FieldType "limits" VkPhysicalDeviceProperties -> IO ()
writeField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties
-> Int -> VkPhysicalDeviceLimits -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
800)
{-# LINE 15642 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sparseProperties" VkPhysicalDeviceProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties
-> FieldType "sparseProperties" VkPhysicalDeviceProperties
getField VkPhysicalDeviceProperties
x
          = IO VkPhysicalDeviceSparseProperties
-> VkPhysicalDeviceSparseProperties
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties
-> Int -> IO VkPhysicalDeviceSparseProperties
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) (Int
800))
{-# LINE 15649 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties
-> IO (FieldType "sparseProperties" VkPhysicalDeviceProperties)
readField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties
-> Int -> IO VkPhysicalDeviceSparseProperties
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties
p (Int
800)
{-# LINE 15653 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseProperties" VkPhysicalDeviceProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties
-> FieldType "sparseProperties" VkPhysicalDeviceProperties -> IO ()
writeField Ptr VkPhysicalDeviceProperties
p
          = Ptr VkPhysicalDeviceProperties
-> Int -> VkPhysicalDeviceSparseProperties -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties
p (Int
800)
{-# LINE 15659 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceProperties where
        showsPrec :: Int -> VkPhysicalDeviceProperties -> ShowS
showsPrec Int
d VkPhysicalDeviceProperties
x
          = String -> ShowS
showString String
"VkPhysicalDeviceProperties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"apiVersion = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProperties
-> FieldType "apiVersion" VkPhysicalDeviceProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"apiVersion" VkPhysicalDeviceProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"driverVersion = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProperties
-> FieldType "driverVersion" VkPhysicalDeviceProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"driverVersion" VkPhysicalDeviceProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"vendorID = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProperties
-> FieldType "vendorID" VkPhysicalDeviceProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"vendorID" VkPhysicalDeviceProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"deviceID = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProperties
-> FieldType "deviceID" VkPhysicalDeviceProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"deviceID" VkPhysicalDeviceProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"deviceType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkPhysicalDeviceType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProperties
-> FieldType "deviceType" VkPhysicalDeviceProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"deviceType" VkPhysicalDeviceProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            (String -> ShowS
showString String
"deviceName = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                               Int -> [CChar] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                 (let s :: Int
s = CChar -> Int
forall a. Storable a => a -> Int
sizeOf
                                                            (FieldType "deviceName" VkPhysicalDeviceProperties
forall a. HasCallStack => a
undefined ::
                                                               FieldType "deviceName"
                                                                 VkPhysicalDeviceProperties)
                                                      o :: Int
o = HasField "deviceName" VkPhysicalDeviceProperties => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"deviceName"
                                                            @VkPhysicalDeviceProperties
                                                      f :: Int -> IO (FieldType "deviceName" VkPhysicalDeviceProperties)
f Int
i
                                                        = Ptr VkPhysicalDeviceProperties -> Int -> IO CChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) Int
i ::
                                                            IO
                                                              (FieldType "deviceName"
                                                                 VkPhysicalDeviceProperties)
                                                    in
                                                    IO [CChar] -> [CChar]
forall a. IO a -> a
unsafeDupablePerformIO (IO [CChar] -> [CChar])
-> ([Int] -> IO [CChar]) -> [Int] -> [CChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO CChar) -> [Int] -> IO [CChar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO CChar
Int -> IO (FieldType "deviceName" VkPhysicalDeviceProperties)
f ([Int] -> [CChar]) -> [Int] -> [CChar]
forall a b. (a -> b) -> a -> b
$
                                                      (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s)
                                                        [Int
0 .. Int
forall a. (Num a, Eq a) => a
VK_MAX_PHYSICAL_DEVICE_NAME_SIZE Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                                                 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                (String -> ShowS
showString String
"pipelineCacheUUID = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                   Int -> [Word8] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                     (let s :: Int
s = Word8 -> Int
forall a. Storable a => a -> Int
sizeOf
                                                                (FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties
forall a. HasCallStack => a
undefined ::
                                                                   FieldType "pipelineCacheUUID"
                                                                     VkPhysicalDeviceProperties)
                                                          o :: Int
o = HasField "pipelineCacheUUID" VkPhysicalDeviceProperties => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"pipelineCacheUUID"
                                                                @VkPhysicalDeviceProperties
                                                          f :: Int
-> IO (FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties)
f Int
i
                                                            = Ptr VkPhysicalDeviceProperties -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties -> Ptr VkPhysicalDeviceProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties
x) Int
i ::
                                                                IO
                                                                  (FieldType "pipelineCacheUUID"
                                                                     VkPhysicalDeviceProperties)
                                                        in
                                                        IO [Word8] -> [Word8]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Word8] -> [Word8])
-> ([Int] -> IO [Word8]) -> [Int] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Word8) -> [Int] -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Word8
Int
-> IO (FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties)
f ([Int] -> [Word8]) -> [Int] -> [Word8]
forall a b. (a -> b) -> a -> b
$
                                                          (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s)
                                                            [Int
0 .. Int
forall a. (Num a, Eq a) => a
VK_UUID_SIZE Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    String -> ShowS
showString String
"limits = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      Int -> VkPhysicalDeviceLimits -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProperties
-> FieldType "limits" VkPhysicalDeviceProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"limits" VkPhysicalDeviceProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          String -> ShowS
showString String
"sparseProperties = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                            Int -> VkPhysicalDeviceSparseProperties -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                              (VkPhysicalDeviceProperties
-> FieldType "sparseProperties" VkPhysicalDeviceProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sparseProperties" VkPhysicalDeviceProperties
x)
                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceProperties2 -> VkPhysicalDeviceProperties2 -> Bool
==
          x :: VkPhysicalDeviceProperties2
x@(VkPhysicalDeviceProperties2# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceProperties2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceProperties2
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceProperties2 where
        (VkPhysicalDeviceProperties2# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceProperties2
-> VkPhysicalDeviceProperties2 -> Ordering
`compare`
          x :: VkPhysicalDeviceProperties2
x@(VkPhysicalDeviceProperties2# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceProperties2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceProperties2
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceProperties2 where
        sizeOf :: VkPhysicalDeviceProperties2 -> Int
sizeOf ~VkPhysicalDeviceProperties2
_ = (Int
840)
{-# LINE 15751 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceProperties2 -> Int
alignment ~VkPhysicalDeviceProperties2
_ = Int
8
{-# LINE 15754 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceProperties2 -> IO VkPhysicalDeviceProperties2
peek = Ptr VkPhysicalDeviceProperties2 -> IO VkPhysicalDeviceProperties2
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceProperties2
-> VkPhysicalDeviceProperties2 -> IO ()
poke = Ptr VkPhysicalDeviceProperties2
-> VkPhysicalDeviceProperties2 -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceProperties2 where
        unsafeAddr :: VkPhysicalDeviceProperties2 -> Addr#
unsafeAddr (VkPhysicalDeviceProperties2# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceProperties2 -> ByteArray#
unsafeByteArray (VkPhysicalDeviceProperties2# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceProperties2
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceProperties2
VkPhysicalDeviceProperties2#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceProperties2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties2
-> FieldType "sType" VkPhysicalDeviceProperties2
getField VkPhysicalDeviceProperties2
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties2 -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties2 -> Ptr VkPhysicalDeviceProperties2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties2
x) (Int
0))
{-# LINE 15806 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties2
-> IO (FieldType "sType" VkPhysicalDeviceProperties2)
readField Ptr VkPhysicalDeviceProperties2
p
          = Ptr VkPhysicalDeviceProperties2 -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties2
p (Int
0)
{-# LINE 15810 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceProperties2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties2
-> FieldType "sType" VkPhysicalDeviceProperties2 -> IO ()
writeField Ptr VkPhysicalDeviceProperties2
p
          = Ptr VkPhysicalDeviceProperties2 -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceProperties2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties2
-> FieldType "pNext" VkPhysicalDeviceProperties2
getField VkPhysicalDeviceProperties2
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties2 -> Ptr VkPhysicalDeviceProperties2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties2
x) (Int
8))
{-# LINE 15838 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties2
-> IO (FieldType "pNext" VkPhysicalDeviceProperties2)
readField Ptr VkPhysicalDeviceProperties2
p
          = Ptr VkPhysicalDeviceProperties2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties2
p (Int
8)
{-# LINE 15842 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceProperties2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties2
-> FieldType "pNext" VkPhysicalDeviceProperties2 -> IO ()
writeField Ptr VkPhysicalDeviceProperties2
p
          = Ptr VkPhysicalDeviceProperties2 -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "properties" VkPhysicalDeviceProperties2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProperties2
-> FieldType "properties" VkPhysicalDeviceProperties2
getField VkPhysicalDeviceProperties2
x
          = IO VkPhysicalDeviceProperties -> VkPhysicalDeviceProperties
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProperties2
-> Int -> IO VkPhysicalDeviceProperties
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProperties2 -> Ptr VkPhysicalDeviceProperties2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProperties2
x) (Int
16))
{-# LINE 15872 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProperties2
-> IO (FieldType "properties" VkPhysicalDeviceProperties2)
readField Ptr VkPhysicalDeviceProperties2
p
          = Ptr VkPhysicalDeviceProperties2
-> Int -> IO VkPhysicalDeviceProperties
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProperties2
p (Int
16)
{-# LINE 15876 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "properties" VkPhysicalDeviceProperties2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProperties2
-> FieldType "properties" VkPhysicalDeviceProperties2 -> IO ()
writeField Ptr VkPhysicalDeviceProperties2
p
          = Ptr VkPhysicalDeviceProperties2
-> Int -> VkPhysicalDeviceProperties -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProperties2
p (Int
16)
{-# LINE 15882 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceProperties2 where
        showsPrec :: Int -> VkPhysicalDeviceProperties2 -> ShowS
showsPrec Int
d VkPhysicalDeviceProperties2
x
          = String -> ShowS
showString String
"VkPhysicalDeviceProperties2 {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProperties2
-> FieldType "sType" VkPhysicalDeviceProperties2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceProperties2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProperties2
-> FieldType "pNext" VkPhysicalDeviceProperties2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceProperties2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"properties = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkPhysicalDeviceProperties -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProperties2
-> FieldType "properties" VkPhysicalDeviceProperties2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"properties" VkPhysicalDeviceProperties2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceProtectedMemoryFeatures
-> VkPhysicalDeviceProtectedMemoryFeatures -> Bool
==
          x :: VkPhysicalDeviceProtectedMemoryFeatures
x@(VkPhysicalDeviceProtectedMemoryFeatures# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceProtectedMemoryFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceProtectedMemoryFeatures
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceProtectedMemoryFeatures where
        (VkPhysicalDeviceProtectedMemoryFeatures# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceProtectedMemoryFeatures
-> VkPhysicalDeviceProtectedMemoryFeatures -> Ordering
`compare`
          x :: VkPhysicalDeviceProtectedMemoryFeatures
x@(VkPhysicalDeviceProtectedMemoryFeatures# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceProtectedMemoryFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceProtectedMemoryFeatures
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceProtectedMemoryFeatures where
        sizeOf :: VkPhysicalDeviceProtectedMemoryFeatures -> Int
sizeOf ~VkPhysicalDeviceProtectedMemoryFeatures
_
          = (Int
24)
{-# LINE 15925 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceProtectedMemoryFeatures -> Int
alignment ~VkPhysicalDeviceProtectedMemoryFeatures
_
          = Int
8
{-# LINE 15929 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> IO VkPhysicalDeviceProtectedMemoryFeatures
peek = Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> IO VkPhysicalDeviceProtectedMemoryFeatures
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> VkPhysicalDeviceProtectedMemoryFeatures -> IO ()
poke = Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> VkPhysicalDeviceProtectedMemoryFeatures -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceProtectedMemoryFeatures
         where
        unsafeAddr :: VkPhysicalDeviceProtectedMemoryFeatures -> Addr#
unsafeAddr (VkPhysicalDeviceProtectedMemoryFeatures# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceProtectedMemoryFeatures -> ByteArray#
unsafeByteArray (VkPhysicalDeviceProtectedMemoryFeatures# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceProtectedMemoryFeatures
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceProtectedMemoryFeatures
VkPhysicalDeviceProtectedMemoryFeatures#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceProtectedMemoryFeatures where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProtectedMemoryFeatures
-> FieldType "sType" VkPhysicalDeviceProtectedMemoryFeatures
getField VkPhysicalDeviceProtectedMemoryFeatures
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProtectedMemoryFeatures
-> Ptr VkPhysicalDeviceProtectedMemoryFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProtectedMemoryFeatures
x) (Int
0))
{-# LINE 15986 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> IO (FieldType "sType" VkPhysicalDeviceProtectedMemoryFeatures)
readField Ptr VkPhysicalDeviceProtectedMemoryFeatures
p
          = Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProtectedMemoryFeatures
p (Int
0)
{-# LINE 15990 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceProtectedMemoryFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> FieldType "sType" VkPhysicalDeviceProtectedMemoryFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceProtectedMemoryFeatures
p
          = Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProtectedMemoryFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceProtectedMemoryFeatures where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProtectedMemoryFeatures
-> FieldType "pNext" VkPhysicalDeviceProtectedMemoryFeatures
getField VkPhysicalDeviceProtectedMemoryFeatures
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProtectedMemoryFeatures -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProtectedMemoryFeatures
-> Ptr VkPhysicalDeviceProtectedMemoryFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProtectedMemoryFeatures
x) (Int
8))
{-# LINE 16021 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> IO (FieldType "pNext" VkPhysicalDeviceProtectedMemoryFeatures)
readField Ptr VkPhysicalDeviceProtectedMemoryFeatures
p
          = Ptr VkPhysicalDeviceProtectedMemoryFeatures -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProtectedMemoryFeatures
p (Int
8)
{-# LINE 16025 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceProtectedMemoryFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> FieldType "pNext" VkPhysicalDeviceProtectedMemoryFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceProtectedMemoryFeatures
p
          = Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProtectedMemoryFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "protectedMemory"
           VkPhysicalDeviceProtectedMemoryFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProtectedMemoryFeatures
-> FieldType
     "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures
getField VkPhysicalDeviceProtectedMemoryFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProtectedMemoryFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProtectedMemoryFeatures
-> Ptr VkPhysicalDeviceProtectedMemoryFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProtectedMemoryFeatures
x) (Int
16))
{-# LINE 16064 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> IO
     (FieldType
        "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures)
readField Ptr VkPhysicalDeviceProtectedMemoryFeatures
p
          = Ptr VkPhysicalDeviceProtectedMemoryFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProtectedMemoryFeatures
p (Int
16)
{-# LINE 16068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "protectedMemory"
           VkPhysicalDeviceProtectedMemoryFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> FieldType
     "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceProtectedMemoryFeatures
p
          = Ptr VkPhysicalDeviceProtectedMemoryFeatures
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProtectedMemoryFeatures
p (Int
16)
{-# LINE 16076 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceProtectedMemoryFeatures where
        showsPrec :: Int -> VkPhysicalDeviceProtectedMemoryFeatures -> ShowS
showsPrec Int
d VkPhysicalDeviceProtectedMemoryFeatures
x
          = String -> ShowS
showString String
"VkPhysicalDeviceProtectedMemoryFeatures {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProtectedMemoryFeatures
-> FieldType "sType" VkPhysicalDeviceProtectedMemoryFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceProtectedMemoryFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProtectedMemoryFeatures
-> FieldType "pNext" VkPhysicalDeviceProtectedMemoryFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceProtectedMemoryFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"protectedMemory = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProtectedMemoryFeatures
-> FieldType
     "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceProtectedMemoryProperties
-> VkPhysicalDeviceProtectedMemoryProperties -> Bool
==
          x :: VkPhysicalDeviceProtectedMemoryProperties
x@(VkPhysicalDeviceProtectedMemoryProperties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceProtectedMemoryProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceProtectedMemoryProperties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceProtectedMemoryProperties where
        (VkPhysicalDeviceProtectedMemoryProperties# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceProtectedMemoryProperties
-> VkPhysicalDeviceProtectedMemoryProperties -> Ordering
`compare`
          x :: VkPhysicalDeviceProtectedMemoryProperties
x@(VkPhysicalDeviceProtectedMemoryProperties# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceProtectedMemoryProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceProtectedMemoryProperties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceProtectedMemoryProperties where
        sizeOf :: VkPhysicalDeviceProtectedMemoryProperties -> Int
sizeOf ~VkPhysicalDeviceProtectedMemoryProperties
_
          = (Int
24)
{-# LINE 16116 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceProtectedMemoryProperties -> Int
alignment ~VkPhysicalDeviceProtectedMemoryProperties
_
          = Int
8
{-# LINE 16120 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceProtectedMemoryProperties
-> IO VkPhysicalDeviceProtectedMemoryProperties
peek = Ptr VkPhysicalDeviceProtectedMemoryProperties
-> IO VkPhysicalDeviceProtectedMemoryProperties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceProtectedMemoryProperties
-> VkPhysicalDeviceProtectedMemoryProperties -> IO ()
poke = Ptr VkPhysicalDeviceProtectedMemoryProperties
-> VkPhysicalDeviceProtectedMemoryProperties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceProtectedMemoryProperties
         where
        unsafeAddr :: VkPhysicalDeviceProtectedMemoryProperties -> Addr#
unsafeAddr (VkPhysicalDeviceProtectedMemoryProperties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceProtectedMemoryProperties -> ByteArray#
unsafeByteArray (VkPhysicalDeviceProtectedMemoryProperties# Addr#
_ ByteArray#
b)
          = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceProtectedMemoryProperties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceProtectedMemoryProperties
VkPhysicalDeviceProtectedMemoryProperties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProtectedMemoryProperties
-> FieldType "sType" VkPhysicalDeviceProtectedMemoryProperties
getField VkPhysicalDeviceProtectedMemoryProperties
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProtectedMemoryProperties
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProtectedMemoryProperties
-> Ptr VkPhysicalDeviceProtectedMemoryProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProtectedMemoryProperties
x) (Int
0))
{-# LINE 16183 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProtectedMemoryProperties
-> IO (FieldType "sType" VkPhysicalDeviceProtectedMemoryProperties)
readField Ptr VkPhysicalDeviceProtectedMemoryProperties
p
          = Ptr VkPhysicalDeviceProtectedMemoryProperties
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProtectedMemoryProperties
p (Int
0)
{-# LINE 16187 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProtectedMemoryProperties
-> FieldType "sType" VkPhysicalDeviceProtectedMemoryProperties
-> IO ()
writeField Ptr VkPhysicalDeviceProtectedMemoryProperties
p
          = Ptr VkPhysicalDeviceProtectedMemoryProperties
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProtectedMemoryProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProtectedMemoryProperties
-> FieldType "pNext" VkPhysicalDeviceProtectedMemoryProperties
getField VkPhysicalDeviceProtectedMemoryProperties
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProtectedMemoryProperties
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProtectedMemoryProperties
-> Ptr VkPhysicalDeviceProtectedMemoryProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProtectedMemoryProperties
x) (Int
8))
{-# LINE 16222 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProtectedMemoryProperties
-> IO (FieldType "pNext" VkPhysicalDeviceProtectedMemoryProperties)
readField Ptr VkPhysicalDeviceProtectedMemoryProperties
p
          = Ptr VkPhysicalDeviceProtectedMemoryProperties
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProtectedMemoryProperties
p (Int
8)
{-# LINE 16226 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProtectedMemoryProperties
-> FieldType "pNext" VkPhysicalDeviceProtectedMemoryProperties
-> IO ()
writeField Ptr VkPhysicalDeviceProtectedMemoryProperties
p
          = Ptr VkPhysicalDeviceProtectedMemoryProperties
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProtectedMemoryProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "protectedNoFault"
           VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceProtectedMemoryProperties
-> FieldType
     "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties
getField VkPhysicalDeviceProtectedMemoryProperties
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceProtectedMemoryProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceProtectedMemoryProperties
-> Ptr VkPhysicalDeviceProtectedMemoryProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceProtectedMemoryProperties
x) (Int
16))
{-# LINE 16267 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceProtectedMemoryProperties
-> IO
     (FieldType
        "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties)
readField Ptr VkPhysicalDeviceProtectedMemoryProperties
p
          = Ptr VkPhysicalDeviceProtectedMemoryProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceProtectedMemoryProperties
p (Int
16)
{-# LINE 16271 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "protectedNoFault"
           VkPhysicalDeviceProtectedMemoryProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceProtectedMemoryProperties
-> FieldType
     "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties
-> IO ()
writeField Ptr VkPhysicalDeviceProtectedMemoryProperties
p
          = Ptr VkPhysicalDeviceProtectedMemoryProperties
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceProtectedMemoryProperties
p (Int
16)
{-# LINE 16279 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceProtectedMemoryProperties where
        showsPrec :: Int -> VkPhysicalDeviceProtectedMemoryProperties -> ShowS
showsPrec Int
d VkPhysicalDeviceProtectedMemoryProperties
x
          = String -> ShowS
showString String
"VkPhysicalDeviceProtectedMemoryProperties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProtectedMemoryProperties
-> FieldType "sType" VkPhysicalDeviceProtectedMemoryProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceProtectedMemoryProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProtectedMemoryProperties
-> FieldType "pNext" VkPhysicalDeviceProtectedMemoryProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceProtectedMemoryProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"protectedNoFault = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceProtectedMemoryProperties
-> FieldType
     "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDevicePushDescriptorPropertiesKHR
-> VkPhysicalDevicePushDescriptorPropertiesKHR -> Bool
==
          x :: VkPhysicalDevicePushDescriptorPropertiesKHR
x@(VkPhysicalDevicePushDescriptorPropertiesKHR# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDevicePushDescriptorPropertiesKHR -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDevicePushDescriptorPropertiesKHR
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDevicePushDescriptorPropertiesKHR where
        (VkPhysicalDevicePushDescriptorPropertiesKHR# Addr#
a ByteArray#
_) compare :: VkPhysicalDevicePushDescriptorPropertiesKHR
-> VkPhysicalDevicePushDescriptorPropertiesKHR -> Ordering
`compare`
          x :: VkPhysicalDevicePushDescriptorPropertiesKHR
x@(VkPhysicalDevicePushDescriptorPropertiesKHR# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDevicePushDescriptorPropertiesKHR -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDevicePushDescriptorPropertiesKHR
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDevicePushDescriptorPropertiesKHR where
        sizeOf :: VkPhysicalDevicePushDescriptorPropertiesKHR -> Int
sizeOf ~VkPhysicalDevicePushDescriptorPropertiesKHR
_
          = (Int
24)
{-# LINE 16319 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDevicePushDescriptorPropertiesKHR -> Int
alignment ~VkPhysicalDevicePushDescriptorPropertiesKHR
_
          = Int
8
{-# LINE 16323 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> IO VkPhysicalDevicePushDescriptorPropertiesKHR
peek = Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> IO VkPhysicalDevicePushDescriptorPropertiesKHR
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> VkPhysicalDevicePushDescriptorPropertiesKHR -> IO ()
poke = Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> VkPhysicalDevicePushDescriptorPropertiesKHR -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        unsafeAddr :: VkPhysicalDevicePushDescriptorPropertiesKHR -> Addr#
unsafeAddr (VkPhysicalDevicePushDescriptorPropertiesKHR# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDevicePushDescriptorPropertiesKHR -> ByteArray#
unsafeByteArray (VkPhysicalDevicePushDescriptorPropertiesKHR# Addr#
_ ByteArray#
b)
          = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDevicePushDescriptorPropertiesKHR
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDevicePushDescriptorPropertiesKHR
VkPhysicalDevicePushDescriptorPropertiesKHR#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevicePushDescriptorPropertiesKHR
-> FieldType "sType" VkPhysicalDevicePushDescriptorPropertiesKHR
getField VkPhysicalDevicePushDescriptorPropertiesKHR
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevicePushDescriptorPropertiesKHR
-> Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevicePushDescriptorPropertiesKHR
x) (Int
0))
{-# LINE 16389 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> IO
     (FieldType "sType" VkPhysicalDevicePushDescriptorPropertiesKHR)
readField Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p
          = Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p (Int
0)
{-# LINE 16393 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> FieldType "sType" VkPhysicalDevicePushDescriptorPropertiesKHR
-> IO ()
writeField Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p
          = Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevicePushDescriptorPropertiesKHR
-> FieldType "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR
getField VkPhysicalDevicePushDescriptorPropertiesKHR
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevicePushDescriptorPropertiesKHR
-> Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevicePushDescriptorPropertiesKHR
x) (Int
8))
{-# LINE 16430 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> IO
     (FieldType "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR)
readField Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p
          = Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p (Int
8)
{-# LINE 16434 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> FieldType "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR
-> IO ()
writeField Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p
          = Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxPushDescriptors"
           VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDevicePushDescriptorPropertiesKHR
-> FieldType
     "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR
getField VkPhysicalDevicePushDescriptorPropertiesKHR
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDevicePushDescriptorPropertiesKHR -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDevicePushDescriptorPropertiesKHR
-> Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDevicePushDescriptorPropertiesKHR
x) (Int
16))
{-# LINE 16475 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> IO
     (FieldType
        "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR)
readField Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p
          = Ptr VkPhysicalDevicePushDescriptorPropertiesKHR -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p (Int
16)
{-# LINE 16479 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxPushDescriptors"
           VkPhysicalDevicePushDescriptorPropertiesKHR
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> FieldType
     "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR
-> IO ()
writeField Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p
          = Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDevicePushDescriptorPropertiesKHR
p (Int
16)
{-# LINE 16487 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDevicePushDescriptorPropertiesKHR where
        showsPrec :: Int -> VkPhysicalDevicePushDescriptorPropertiesKHR -> ShowS
showsPrec Int
d VkPhysicalDevicePushDescriptorPropertiesKHR
x
          = String -> ShowS
showString String
"VkPhysicalDevicePushDescriptorPropertiesKHR {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevicePushDescriptorPropertiesKHR
-> FieldType "sType" VkPhysicalDevicePushDescriptorPropertiesKHR
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDevicePushDescriptorPropertiesKHR
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevicePushDescriptorPropertiesKHR
-> FieldType "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDevicePushDescriptorPropertiesKHR
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"maxPushDescriptors = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDevicePushDescriptorPropertiesKHR
-> FieldType
     "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceSampleLocationsPropertiesEXT
-> VkPhysicalDeviceSampleLocationsPropertiesEXT -> Bool
==
          x :: VkPhysicalDeviceSampleLocationsPropertiesEXT
x@(VkPhysicalDeviceSampleLocationsPropertiesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSampleLocationsPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSampleLocationsPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSampleLocationsPropertiesEXT where
        (VkPhysicalDeviceSampleLocationsPropertiesEXT# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceSampleLocationsPropertiesEXT
-> VkPhysicalDeviceSampleLocationsPropertiesEXT -> Ordering
`compare`
          x :: VkPhysicalDeviceSampleLocationsPropertiesEXT
x@(VkPhysicalDeviceSampleLocationsPropertiesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSampleLocationsPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSampleLocationsPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        sizeOf :: VkPhysicalDeviceSampleLocationsPropertiesEXT -> Int
sizeOf ~VkPhysicalDeviceSampleLocationsPropertiesEXT
_
          = (Int
48)
{-# LINE 16532 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceSampleLocationsPropertiesEXT -> Int
alignment ~VkPhysicalDeviceSampleLocationsPropertiesEXT
_
          = Int
8
{-# LINE 16536 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO VkPhysicalDeviceSampleLocationsPropertiesEXT
peek = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> VkPhysicalDeviceSampleLocationsPropertiesEXT -> IO ()
poke = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> VkPhysicalDeviceSampleLocationsPropertiesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        unsafeAddr :: VkPhysicalDeviceSampleLocationsPropertiesEXT -> Addr#
unsafeAddr (VkPhysicalDeviceSampleLocationsPropertiesEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceSampleLocationsPropertiesEXT -> ByteArray#
unsafeByteArray (VkPhysicalDeviceSampleLocationsPropertiesEXT# Addr#
_ ByteArray#
b)
          = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceSampleLocationsPropertiesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceSampleLocationsPropertiesEXT
VkPhysicalDeviceSampleLocationsPropertiesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT
getField VkPhysicalDeviceSampleLocationsPropertiesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSampleLocationsPropertiesEXT
x) (Int
0))
{-# LINE 16604 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO
     (FieldType "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT)
readField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
0)
{-# LINE 16608 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT
getField VkPhysicalDeviceSampleLocationsPropertiesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSampleLocationsPropertiesEXT
x) (Int
8))
{-# LINE 16645 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO
     (FieldType "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT)
readField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
8)
{-# LINE 16649 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sampleLocationSampleCounts"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "sampleLocationSampleCounts"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
getField VkPhysicalDeviceSampleLocationsPropertiesEXT
x
          = IO VkSampleCountFlags -> VkSampleCountFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSampleLocationsPropertiesEXT
x) (Int
16))
{-# LINE 16690 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO
     (FieldType
        "sampleLocationSampleCounts"
        VkPhysicalDeviceSampleLocationsPropertiesEXT)
readField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO VkSampleCountFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
16)
{-# LINE 16694 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampleLocationSampleCounts"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "sampleLocationSampleCounts"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> VkSampleCountFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxSampleLocationGridSize"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "maxSampleLocationGridSize"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
getField VkPhysicalDeviceSampleLocationsPropertiesEXT
x
          = IO VkExtent2D -> VkExtent2D
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO VkExtent2D
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSampleLocationsPropertiesEXT
x) (Int
20))
{-# LINE 16736 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO
     (FieldType
        "maxSampleLocationGridSize"
        VkPhysicalDeviceSampleLocationsPropertiesEXT)
readField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO VkExtent2D
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
20)
{-# LINE 16740 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSampleLocationGridSize"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "maxSampleLocationGridSize"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> VkExtent2D -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
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 :: Int
fieldArrayLength = Int
2

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "sampleLocationCoordinateRange"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
getFieldArray = VkPhysicalDeviceSampleLocationsPropertiesEXT -> Float
VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "sampleLocationCoordinateRange"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
f
          where {-# NOINLINE f #-}
                f :: VkPhysicalDeviceSampleLocationsPropertiesEXT -> Float
f VkPhysicalDeviceSampleLocationsPropertiesEXT
x = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSampleLocationsPropertiesEXT
x) Int
off)
                off :: Int
off
                  = (Int
28)
{-# LINE 16803 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                      Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 16805 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO
     (FieldType
        "sampleLocationCoordinateRange"
        VkPhysicalDeviceSampleLocationsPropertiesEXT)
readFieldArray Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
              ((Int
28)
{-# LINE 16811 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 16813 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "sampleLocationCoordinateRange"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO ()
writeFieldArray Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
              ((Int
28)
{-# LINE 16836 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 16838 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sampleLocationSubPixelBits"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "sampleLocationSubPixelBits"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
getField VkPhysicalDeviceSampleLocationsPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSampleLocationsPropertiesEXT
x) (Int
36))
{-# LINE 16873 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO
     (FieldType
        "sampleLocationSubPixelBits"
        VkPhysicalDeviceSampleLocationsPropertiesEXT)
readField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
36)
{-# LINE 16877 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sampleLocationSubPixelBits"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "sampleLocationSubPixelBits"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "variableSampleLocations"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "variableSampleLocations"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
getField VkPhysicalDeviceSampleLocationsPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSampleLocationsPropertiesEXT
x) (Int
40))
{-# LINE 16919 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO
     (FieldType
        "variableSampleLocations"
        VkPhysicalDeviceSampleLocationsPropertiesEXT)
readField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
40)
{-# LINE 16923 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "variableSampleLocations"
           VkPhysicalDeviceSampleLocationsPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "variableSampleLocations"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p
          = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
p (Int
40)
{-# LINE 16931 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSampleLocationsPropertiesEXT where
        showsPrec :: Int -> VkPhysicalDeviceSampleLocationsPropertiesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceSampleLocationsPropertiesEXT
x
          = String -> ShowS
showString String
"VkPhysicalDeviceSampleLocationsPropertiesEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceSampleLocationsPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"sampleLocationSampleCounts = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkSampleCountFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "sampleLocationSampleCounts"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sampleLocationSampleCounts" VkPhysicalDeviceSampleLocationsPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"maxSampleLocationGridSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkExtent2D -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "maxSampleLocationGridSize"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxSampleLocationGridSize" VkPhysicalDeviceSampleLocationsPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      (String -> ShowS
showString String
"sampleLocationCoordinateRange = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                         Int -> [Float] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                           (let s :: Int
s = Float -> Int
forall a. Storable a => a -> Int
sizeOf
                                                      (FieldType
  "sampleLocationCoordinateRange"
  VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. HasCallStack => a
undefined ::
                                                         FieldType "sampleLocationCoordinateRange"
                                                           VkPhysicalDeviceSampleLocationsPropertiesEXT)
                                                o :: Int
o = HasField
  "sampleLocationCoordinateRange"
  VkPhysicalDeviceSampleLocationsPropertiesEXT =>
Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"sampleLocationCoordinateRange"
                                                      @VkPhysicalDeviceSampleLocationsPropertiesEXT
                                                f :: Int
-> IO
     (FieldType
        "sampleLocationCoordinateRange"
        VkPhysicalDeviceSampleLocationsPropertiesEXT)
f Int
i
                                                  = Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> Ptr VkPhysicalDeviceSampleLocationsPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSampleLocationsPropertiesEXT
x) Int
i ::
                                                      IO
                                                        (FieldType "sampleLocationCoordinateRange"
                                                           VkPhysicalDeviceSampleLocationsPropertiesEXT)
                                              in
                                              IO [Float] -> [Float]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Float] -> [Float])
-> ([Int] -> IO [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Float) -> [Int] -> IO [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Float
Int
-> IO
     (FieldType
        "sampleLocationCoordinateRange"
        VkPhysicalDeviceSampleLocationsPropertiesEXT)
f ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$
                                                (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
"sampleLocationSubPixelBits = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "sampleLocationSubPixelBits"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sampleLocationSubPixelBits" VkPhysicalDeviceSampleLocationsPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
"variableSampleLocations = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                    (VkPhysicalDeviceSampleLocationsPropertiesEXT
-> FieldType
     "variableSampleLocations"
     VkPhysicalDeviceSampleLocationsPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"variableSampleLocations" VkPhysicalDeviceSampleLocationsPropertiesEXT
x)
                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> Bool
==
          x :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x@(VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where
        (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> Ordering
`compare`
          x :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x@(VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        sizeOf :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> Int
sizeOf ~VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
_
          = (Int
24)
{-# LINE 17003 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> Int
alignment ~VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
_
          = Int
8
{-# LINE 17007 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
peek = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> IO ()
poke = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        unsafeAddr :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> Addr#
unsafeAddr (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# Addr#
a ByteArray#
_)
          = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int#
-> ByteArray# -> VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray# -> VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
getField VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) (Int
0))
{-# LINE 17080 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO
     (FieldType
        "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT)
readField Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p
          = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p (Int
0)
{-# LINE 17084 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p
          = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
getField VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) (Int
8))
{-# LINE 17125 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO
     (FieldType
        "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT)
readField Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p
          = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p (Int
8)
{-# LINE 17129 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p
          = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "filterMinmaxSingleComponentFormats"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "filterMinmaxSingleComponentFormats"
     VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
getField VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) (Int
16))
{-# LINE 17171 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO
     (FieldType
        "filterMinmaxSingleComponentFormats"
        VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT)
readField Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p
          = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p (Int
16)
{-# LINE 17175 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "filterMinmaxSingleComponentFormats"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "filterMinmaxSingleComponentFormats"
     VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p
          = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "filterMinmaxImageComponentMapping"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "filterMinmaxImageComponentMapping"
     VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
getField VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) (Int
20))
{-# LINE 17217 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO
     (FieldType
        "filterMinmaxImageComponentMapping"
        VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT)
readField Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p
          = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p (Int
20)
{-# LINE 17221 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "filterMinmaxImageComponentMapping"
           VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "filterMinmaxImageComponentMapping"
     VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p
          = Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
p (Int
20)
{-# LINE 17229 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
         where
        showsPrec :: Int -> VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x
          = String -> ShowS
showString String
"VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"filterMinmaxSingleComponentFormats = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "filterMinmaxSingleComponentFormats"
     VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"filterMinmaxSingleComponentFormats" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"filterMinmaxImageComponentMapping = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
-> FieldType
     "filterMinmaxImageComponentMapping"
     VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"filterMinmaxImageComponentMapping" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> VkPhysicalDeviceSamplerYcbcrConversionFeatures -> Bool
==
          x :: VkPhysicalDeviceSamplerYcbcrConversionFeatures
x@(VkPhysicalDeviceSamplerYcbcrConversionFeatures# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSamplerYcbcrConversionFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSamplerYcbcrConversionFeatures
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSamplerYcbcrConversionFeatures where
        (VkPhysicalDeviceSamplerYcbcrConversionFeatures# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> VkPhysicalDeviceSamplerYcbcrConversionFeatures -> Ordering
`compare`
          x :: VkPhysicalDeviceSamplerYcbcrConversionFeatures
x@(VkPhysicalDeviceSamplerYcbcrConversionFeatures# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSamplerYcbcrConversionFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSamplerYcbcrConversionFeatures
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        sizeOf :: VkPhysicalDeviceSamplerYcbcrConversionFeatures -> Int
sizeOf ~VkPhysicalDeviceSamplerYcbcrConversionFeatures
_
          = (Int
24)
{-# LINE 17275 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceSamplerYcbcrConversionFeatures -> Int
alignment ~VkPhysicalDeviceSamplerYcbcrConversionFeatures
_
          = Int
8
{-# LINE 17279 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> IO VkPhysicalDeviceSamplerYcbcrConversionFeatures
peek = Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> IO VkPhysicalDeviceSamplerYcbcrConversionFeatures
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> VkPhysicalDeviceSamplerYcbcrConversionFeatures -> IO ()
poke = Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> VkPhysicalDeviceSamplerYcbcrConversionFeatures -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        unsafeAddr :: VkPhysicalDeviceSamplerYcbcrConversionFeatures -> Addr#
unsafeAddr (VkPhysicalDeviceSamplerYcbcrConversionFeatures# Addr#
a ByteArray#
_)
          = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceSamplerYcbcrConversionFeatures -> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceSamplerYcbcrConversionFeatures# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int#
-> ByteArray# -> VkPhysicalDeviceSamplerYcbcrConversionFeatures
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray# -> VkPhysicalDeviceSamplerYcbcrConversionFeatures
VkPhysicalDeviceSamplerYcbcrConversionFeatures#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> FieldType "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures
getField VkPhysicalDeviceSamplerYcbcrConversionFeatures
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSamplerYcbcrConversionFeatures
x) (Int
0))
{-# LINE 17349 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> IO
     (FieldType "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures)
readField Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p
          = Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p (Int
0)
{-# LINE 17353 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> FieldType "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p
          = Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> FieldType "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures
getField VkPhysicalDeviceSamplerYcbcrConversionFeatures
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSamplerYcbcrConversionFeatures
x) (Int
8))
{-# LINE 17393 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> IO
     (FieldType "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures)
readField Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p
          = Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p (Int
8)
{-# LINE 17397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> FieldType "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p
          = Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "samplerYcbcrConversion"
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> FieldType
     "samplerYcbcrConversion"
     VkPhysicalDeviceSamplerYcbcrConversionFeatures
getField VkPhysicalDeviceSamplerYcbcrConversionFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSamplerYcbcrConversionFeatures
x) (Int
16))
{-# LINE 17439 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> IO
     (FieldType
        "samplerYcbcrConversion"
        VkPhysicalDeviceSamplerYcbcrConversionFeatures)
readField Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p
          = Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p (Int
16)
{-# LINE 17443 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "samplerYcbcrConversion"
           VkPhysicalDeviceSamplerYcbcrConversionFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> FieldType
     "samplerYcbcrConversion"
     VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p
          = Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSamplerYcbcrConversionFeatures
p (Int
16)
{-# LINE 17451 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSamplerYcbcrConversionFeatures where
        showsPrec :: Int -> VkPhysicalDeviceSamplerYcbcrConversionFeatures -> ShowS
showsPrec Int
d VkPhysicalDeviceSamplerYcbcrConversionFeatures
x
          = String -> ShowS
showString String
"VkPhysicalDeviceSamplerYcbcrConversionFeatures {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> FieldType "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> FieldType "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"samplerYcbcrConversion = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSamplerYcbcrConversionFeatures
-> FieldType
     "samplerYcbcrConversion"
     VkPhysicalDeviceSamplerYcbcrConversionFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"samplerYcbcrConversion" VkPhysicalDeviceSamplerYcbcrConversionFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceShaderCorePropertiesAMD
-> VkPhysicalDeviceShaderCorePropertiesAMD -> Bool
==
          x :: VkPhysicalDeviceShaderCorePropertiesAMD
x@(VkPhysicalDeviceShaderCorePropertiesAMD# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceShaderCorePropertiesAMD -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceShaderCorePropertiesAMD
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceShaderCorePropertiesAMD where
        (VkPhysicalDeviceShaderCorePropertiesAMD# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceShaderCorePropertiesAMD
-> VkPhysicalDeviceShaderCorePropertiesAMD -> Ordering
`compare`
          x :: VkPhysicalDeviceShaderCorePropertiesAMD
x@(VkPhysicalDeviceShaderCorePropertiesAMD# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceShaderCorePropertiesAMD -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceShaderCorePropertiesAMD
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceShaderCorePropertiesAMD where
        sizeOf :: VkPhysicalDeviceShaderCorePropertiesAMD -> Int
sizeOf ~VkPhysicalDeviceShaderCorePropertiesAMD
_
          = (Int
72)
{-# LINE 17508 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceShaderCorePropertiesAMD -> Int
alignment ~VkPhysicalDeviceShaderCorePropertiesAMD
_
          = Int
8
{-# LINE 17512 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO VkPhysicalDeviceShaderCorePropertiesAMD
peek = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO VkPhysicalDeviceShaderCorePropertiesAMD
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> VkPhysicalDeviceShaderCorePropertiesAMD -> IO ()
poke = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> VkPhysicalDeviceShaderCorePropertiesAMD -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceShaderCorePropertiesAMD
         where
        unsafeAddr :: VkPhysicalDeviceShaderCorePropertiesAMD -> Addr#
unsafeAddr (VkPhysicalDeviceShaderCorePropertiesAMD# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceShaderCorePropertiesAMD -> ByteArray#
unsafeByteArray (VkPhysicalDeviceShaderCorePropertiesAMD# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceShaderCorePropertiesAMD
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceShaderCorePropertiesAMD
VkPhysicalDeviceShaderCorePropertiesAMD#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceShaderCorePropertiesAMD where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "sType" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
0))
{-# LINE 17574 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO (FieldType "sType" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
0)
{-# LINE 17578 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceShaderCorePropertiesAMD where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "sType" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceShaderCorePropertiesAMD where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "pNext" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
8))
{-# LINE 17609 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO (FieldType "pNext" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
8)
{-# LINE 17613 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceShaderCorePropertiesAMD where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "pNext" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
16))
{-# LINE 17653 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
16)
{-# LINE 17657 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderArraysPerEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "shaderArraysPerEngineCount"
     VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
20))
{-# LINE 17699 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "shaderArraysPerEngineCount"
        VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
20)
{-# LINE 17703 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderArraysPerEngineCount"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "shaderArraysPerEngineCount"
     VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "computeUnitsPerShaderArray"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "computeUnitsPerShaderArray"
     VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
24))
{-# LINE 17745 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "computeUnitsPerShaderArray"
        VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
24)
{-# LINE 17749 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "computeUnitsPerShaderArray"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "computeUnitsPerShaderArray"
     VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "simdPerComputeUnit"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
28))
{-# LINE 17791 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
28)
{-# LINE 17795 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "simdPerComputeUnit"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "wavefrontsPerSimd"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
32))
{-# LINE 17837 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
32)
{-# LINE 17841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "wavefrontsPerSimd"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "wavefrontSize"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
36))
{-# LINE 17882 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
36)
{-# LINE 17886 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "wavefrontSize"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
40))
{-# LINE 17926 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
40)
{-# LINE 17930 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sgprsPerSimd"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "minSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
44))
{-# LINE 17972 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
44)
{-# LINE 17976 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
48))
{-# LINE 18018 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
48)
{-# LINE 18022 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxSgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
52))
{-# LINE 18064 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "sgprAllocationGranularity"
        VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
52)
{-# LINE 18068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
56))
{-# LINE 18108 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
56)
{-# LINE 18112 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "vgprsPerSimd"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "minVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
60))
{-# LINE 18154 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
60)
{-# LINE 18158 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
64))
{-# LINE 18200 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
64)
{-# LINE 18204 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVgprAllocation"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "vgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD
getField VkPhysicalDeviceShaderCorePropertiesAMD
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderCorePropertiesAMD
-> Ptr VkPhysicalDeviceShaderCorePropertiesAMD
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderCorePropertiesAMD
x) (Int
68))
{-# LINE 18246 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> IO
     (FieldType
        "vgprAllocationGranularity"
        VkPhysicalDeviceShaderCorePropertiesAMD)
readField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
68)
{-# LINE 18250 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "vgprAllocationGranularity"
           VkPhysicalDeviceShaderCorePropertiesAMD
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD
-> IO ()
writeField Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p
          = Ptr VkPhysicalDeviceShaderCorePropertiesAMD
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderCorePropertiesAMD
p (Int
68)
{-# LINE 18258 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceShaderCorePropertiesAMD where
        showsPrec :: Int -> VkPhysicalDeviceShaderCorePropertiesAMD -> ShowS
showsPrec Int
d VkPhysicalDeviceShaderCorePropertiesAMD
x
          = String -> ShowS
showString String
"VkPhysicalDeviceShaderCorePropertiesAMD {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "sType" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceShaderCorePropertiesAMD
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "pNext" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceShaderCorePropertiesAMD
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"shaderEngineCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"shaderArraysPerEngineCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "shaderArraysPerEngineCount"
     VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"shaderArraysPerEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"computeUnitsPerShaderArray = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "computeUnitsPerShaderArray"
     VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"computeUnitsPerShaderArray" VkPhysicalDeviceShaderCorePropertiesAMD
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"simdPerComputeUnit = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
"wavefrontsPerSimd = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                        String -> ShowS
showString String
"wavefrontSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD
x)
                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                            String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                              String -> ShowS
showString String
"sgprsPerSimd = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                  (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
x)
                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                    String -> ShowS
showString
                                                                      String
"minSgprAllocation = "
                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                        (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                           @"minSgprAllocation"
                                                                           VkPhysicalDeviceShaderCorePropertiesAMD
x)
                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                          String -> ShowS
showString
                                                                            String
"maxSgprAllocation = "
                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                              (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                 @"maxSgprAllocation"
                                                                                 VkPhysicalDeviceShaderCorePropertiesAMD
x)
                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                String -> ShowS
showString
                                                                                  String
"sgprAllocationGranularity = "
                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                    (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                       @"sgprAllocationGranularity"
                                                                                       VkPhysicalDeviceShaderCorePropertiesAMD
x)
                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                    String -> ShowS
showString String
", "
                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                      String -> ShowS
showString
                                                                                        String
"vgprsPerSimd = "
                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                          (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                             @"vgprsPerSimd"
                                                                                             VkPhysicalDeviceShaderCorePropertiesAMD
x)
                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                          String -> ShowS
showString
                                                                                            String
", "
                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                            String -> ShowS
showString
                                                                                              String
"minVgprAllocation = "
                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                Int
d
                                                                                                (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                   @"minVgprAllocation"
                                                                                                   VkPhysicalDeviceShaderCorePropertiesAMD
x)
                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                String -> ShowS
showString
                                                                                                  String
", "
                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                  String -> ShowS
showString
                                                                                                    String
"maxVgprAllocation = "
                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                    Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                      Int
d
                                                                                                      (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                         @"maxVgprAllocation"
                                                                                                         VkPhysicalDeviceShaderCorePropertiesAMD
x)
                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                      String -> ShowS
showString
                                                                                                        String
", "
                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                        String -> ShowS
showString
                                                                                                          String
"vgprAllocationGranularity = "
                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                            Int
d
                                                                                                            (VkPhysicalDeviceShaderCorePropertiesAMD
-> FieldType
     "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                               @"vgprAllocationGranularity"
                                                                                                               VkPhysicalDeviceShaderCorePropertiesAMD
x)
                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                            Char -> ShowS
showChar
                                                                                                              Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceShaderDrawParameterFeatures
-> VkPhysicalDeviceShaderDrawParameterFeatures -> Bool
==
          x :: VkPhysicalDeviceShaderDrawParameterFeatures
x@(VkPhysicalDeviceShaderDrawParameterFeatures# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceShaderDrawParameterFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceShaderDrawParameterFeatures
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceShaderDrawParameterFeatures where
        (VkPhysicalDeviceShaderDrawParameterFeatures# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceShaderDrawParameterFeatures
-> VkPhysicalDeviceShaderDrawParameterFeatures -> Ordering
`compare`
          x :: VkPhysicalDeviceShaderDrawParameterFeatures
x@(VkPhysicalDeviceShaderDrawParameterFeatures# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceShaderDrawParameterFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceShaderDrawParameterFeatures
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceShaderDrawParameterFeatures where
        sizeOf :: VkPhysicalDeviceShaderDrawParameterFeatures -> Int
sizeOf ~VkPhysicalDeviceShaderDrawParameterFeatures
_
          = (Int
24)
{-# LINE 18394 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceShaderDrawParameterFeatures -> Int
alignment ~VkPhysicalDeviceShaderDrawParameterFeatures
_
          = Int
8
{-# LINE 18398 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> IO VkPhysicalDeviceShaderDrawParameterFeatures
peek = Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> IO VkPhysicalDeviceShaderDrawParameterFeatures
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> VkPhysicalDeviceShaderDrawParameterFeatures -> IO ()
poke = Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> VkPhysicalDeviceShaderDrawParameterFeatures -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceShaderDrawParameterFeatures
         where
        unsafeAddr :: VkPhysicalDeviceShaderDrawParameterFeatures -> Addr#
unsafeAddr (VkPhysicalDeviceShaderDrawParameterFeatures# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceShaderDrawParameterFeatures -> ByteArray#
unsafeByteArray (VkPhysicalDeviceShaderDrawParameterFeatures# Addr#
_ ByteArray#
b)
          = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceShaderDrawParameterFeatures
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceShaderDrawParameterFeatures
VkPhysicalDeviceShaderDrawParameterFeatures#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderDrawParameterFeatures
-> FieldType "sType" VkPhysicalDeviceShaderDrawParameterFeatures
getField VkPhysicalDeviceShaderDrawParameterFeatures
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderDrawParameterFeatures
-> Ptr VkPhysicalDeviceShaderDrawParameterFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderDrawParameterFeatures
x) (Int
0))
{-# LINE 18464 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> IO
     (FieldType "sType" VkPhysicalDeviceShaderDrawParameterFeatures)
readField Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p
          = Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p (Int
0)
{-# LINE 18468 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> FieldType "sType" VkPhysicalDeviceShaderDrawParameterFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p
          = Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderDrawParameterFeatures
-> FieldType "pNext" VkPhysicalDeviceShaderDrawParameterFeatures
getField VkPhysicalDeviceShaderDrawParameterFeatures
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderDrawParameterFeatures
-> Ptr VkPhysicalDeviceShaderDrawParameterFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderDrawParameterFeatures
x) (Int
8))
{-# LINE 18505 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> IO
     (FieldType "pNext" VkPhysicalDeviceShaderDrawParameterFeatures)
readField Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p
          = Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p (Int
8)
{-# LINE 18509 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> FieldType "pNext" VkPhysicalDeviceShaderDrawParameterFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p
          = Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "shaderDrawParameters"
           VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceShaderDrawParameterFeatures
-> FieldType
     "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures
getField VkPhysicalDeviceShaderDrawParameterFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceShaderDrawParameterFeatures
-> Ptr VkPhysicalDeviceShaderDrawParameterFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceShaderDrawParameterFeatures
x) (Int
16))
{-# LINE 18550 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> IO
     (FieldType
        "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures)
readField Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p
          = Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p (Int
16)
{-# LINE 18554 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderDrawParameters"
           VkPhysicalDeviceShaderDrawParameterFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> FieldType
     "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p
          = Ptr VkPhysicalDeviceShaderDrawParameterFeatures
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceShaderDrawParameterFeatures
p (Int
16)
{-# LINE 18562 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceShaderDrawParameterFeatures where
        showsPrec :: Int -> VkPhysicalDeviceShaderDrawParameterFeatures -> ShowS
showsPrec Int
d VkPhysicalDeviceShaderDrawParameterFeatures
x
          = String -> ShowS
showString String
"VkPhysicalDeviceShaderDrawParameterFeatures {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderDrawParameterFeatures
-> FieldType "sType" VkPhysicalDeviceShaderDrawParameterFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceShaderDrawParameterFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderDrawParameterFeatures
-> FieldType "pNext" VkPhysicalDeviceShaderDrawParameterFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceShaderDrawParameterFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"shaderDrawParameters = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceShaderDrawParameterFeatures
-> FieldType
     "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceSparseImageFormatInfo2
-> VkPhysicalDeviceSparseImageFormatInfo2 -> Bool
==
          x :: VkPhysicalDeviceSparseImageFormatInfo2
x@(VkPhysicalDeviceSparseImageFormatInfo2# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSparseImageFormatInfo2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSparseImageFormatInfo2
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSparseImageFormatInfo2 where
        (VkPhysicalDeviceSparseImageFormatInfo2# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceSparseImageFormatInfo2
-> VkPhysicalDeviceSparseImageFormatInfo2 -> Ordering
`compare`
          x :: VkPhysicalDeviceSparseImageFormatInfo2
x@(VkPhysicalDeviceSparseImageFormatInfo2# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSparseImageFormatInfo2 -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSparseImageFormatInfo2
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSparseImageFormatInfo2 where
        sizeOf :: VkPhysicalDeviceSparseImageFormatInfo2 -> Int
sizeOf ~VkPhysicalDeviceSparseImageFormatInfo2
_
          = (Int
40)
{-# LINE 18606 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceSparseImageFormatInfo2 -> Int
alignment ~VkPhysicalDeviceSparseImageFormatInfo2
_
          = Int
8
{-# LINE 18610 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> IO VkPhysicalDeviceSparseImageFormatInfo2
peek = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> IO VkPhysicalDeviceSparseImageFormatInfo2
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> VkPhysicalDeviceSparseImageFormatInfo2 -> IO ()
poke = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> VkPhysicalDeviceSparseImageFormatInfo2 -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceSparseImageFormatInfo2
         where
        unsafeAddr :: VkPhysicalDeviceSparseImageFormatInfo2 -> Addr#
unsafeAddr (VkPhysicalDeviceSparseImageFormatInfo2# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceSparseImageFormatInfo2 -> ByteArray#
unsafeByteArray (VkPhysicalDeviceSparseImageFormatInfo2# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceSparseImageFormatInfo2
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceSparseImageFormatInfo2
VkPhysicalDeviceSparseImageFormatInfo2#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "sType" VkPhysicalDeviceSparseImageFormatInfo2
getField VkPhysicalDeviceSparseImageFormatInfo2
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseImageFormatInfo2
-> Ptr VkPhysicalDeviceSparseImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseImageFormatInfo2
x) (Int
0))
{-# LINE 18665 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> IO (FieldType "sType" VkPhysicalDeviceSparseImageFormatInfo2)
readField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
0)
{-# LINE 18669 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "sType" VkPhysicalDeviceSparseImageFormatInfo2
-> IO ()
writeField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "pNext" VkPhysicalDeviceSparseImageFormatInfo2
getField VkPhysicalDeviceSparseImageFormatInfo2
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseImageFormatInfo2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseImageFormatInfo2
-> Ptr VkPhysicalDeviceSparseImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseImageFormatInfo2
x) (Int
8))
{-# LINE 18700 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> IO (FieldType "pNext" VkPhysicalDeviceSparseImageFormatInfo2)
readField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2 -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
8)
{-# LINE 18704 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "pNext" VkPhysicalDeviceSparseImageFormatInfo2
-> IO ()
writeField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "format" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "format" VkPhysicalDeviceSparseImageFormatInfo2
getField VkPhysicalDeviceSparseImageFormatInfo2
x
          = IO VkFormat -> VkFormat
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseImageFormatInfo2 -> Int -> IO VkFormat
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseImageFormatInfo2
-> Ptr VkPhysicalDeviceSparseImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseImageFormatInfo2
x) (Int
16))
{-# LINE 18735 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> IO (FieldType "format" VkPhysicalDeviceSparseImageFormatInfo2)
readField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2 -> Int -> IO VkFormat
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
16)
{-# LINE 18739 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "format" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "format" VkPhysicalDeviceSparseImageFormatInfo2
-> IO ()
writeField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> VkFormat -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "type" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "type" VkPhysicalDeviceSparseImageFormatInfo2
getField VkPhysicalDeviceSparseImageFormatInfo2
x
          = IO VkImageType -> VkImageType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseImageFormatInfo2 -> Int -> IO VkImageType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseImageFormatInfo2
-> Ptr VkPhysicalDeviceSparseImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseImageFormatInfo2
x) (Int
20))
{-# LINE 18770 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> IO (FieldType "type" VkPhysicalDeviceSparseImageFormatInfo2)
readField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2 -> Int -> IO VkImageType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
20)
{-# LINE 18774 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "type" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "type" VkPhysicalDeviceSparseImageFormatInfo2 -> IO ()
writeField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> VkImageType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "samples" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "samples" VkPhysicalDeviceSparseImageFormatInfo2
getField VkPhysicalDeviceSparseImageFormatInfo2
x
          = IO VkSampleCountFlagBits -> VkSampleCountFlagBits
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> IO VkSampleCountFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseImageFormatInfo2
-> Ptr VkPhysicalDeviceSparseImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseImageFormatInfo2
x) (Int
24))
{-# LINE 18805 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> IO (FieldType "samples" VkPhysicalDeviceSparseImageFormatInfo2)
readField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> IO VkSampleCountFlagBits
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
24)
{-# LINE 18809 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "samples" VkPhysicalDeviceSparseImageFormatInfo2
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "samples" VkPhysicalDeviceSparseImageFormatInfo2
-> IO ()
writeField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> VkSampleCountFlagBits -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "usage" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "usage" VkPhysicalDeviceSparseImageFormatInfo2
getField VkPhysicalDeviceSparseImageFormatInfo2
x
          = IO VkImageUsageFlags -> VkImageUsageFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> IO VkImageUsageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseImageFormatInfo2
-> Ptr VkPhysicalDeviceSparseImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseImageFormatInfo2
x) (Int
28))
{-# LINE 18841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> IO (FieldType "usage" VkPhysicalDeviceSparseImageFormatInfo2)
readField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> IO VkImageUsageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
28)
{-# LINE 18845 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "usage" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "usage" VkPhysicalDeviceSparseImageFormatInfo2
-> IO ()
writeField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> VkImageUsageFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "tiling" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "tiling" VkPhysicalDeviceSparseImageFormatInfo2
getField VkPhysicalDeviceSparseImageFormatInfo2
x
          = IO VkImageTiling -> VkImageTiling
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> IO VkImageTiling
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseImageFormatInfo2
-> Ptr VkPhysicalDeviceSparseImageFormatInfo2
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseImageFormatInfo2
x) (Int
32))
{-# LINE 18876 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> IO (FieldType "tiling" VkPhysicalDeviceSparseImageFormatInfo2)
readField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> IO VkImageTiling
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
32)
{-# LINE 18880 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tiling" VkPhysicalDeviceSparseImageFormatInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "tiling" VkPhysicalDeviceSparseImageFormatInfo2
-> IO ()
writeField Ptr VkPhysicalDeviceSparseImageFormatInfo2
p
          = Ptr VkPhysicalDeviceSparseImageFormatInfo2
-> Int -> VkImageTiling -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseImageFormatInfo2
p (Int
32)
{-# LINE 18886 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSparseImageFormatInfo2 where
        showsPrec :: Int -> VkPhysicalDeviceSparseImageFormatInfo2 -> ShowS
showsPrec Int
d VkPhysicalDeviceSparseImageFormatInfo2
x
          = String -> ShowS
showString String
"VkPhysicalDeviceSparseImageFormatInfo2 {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "sType" VkPhysicalDeviceSparseImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceSparseImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "pNext" VkPhysicalDeviceSparseImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceSparseImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"format = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkFormat -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "format" VkPhysicalDeviceSparseImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"format" VkPhysicalDeviceSparseImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"type = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkImageType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "type" VkPhysicalDeviceSparseImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"type" VkPhysicalDeviceSparseImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"samples = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkSampleCountFlagBits -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "samples" VkPhysicalDeviceSparseImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"samples" VkPhysicalDeviceSparseImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"usage = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkImageUsageFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "usage" VkPhysicalDeviceSparseImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"usage" VkPhysicalDeviceSparseImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
"tiling = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> VkImageTiling -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseImageFormatInfo2
-> FieldType "tiling" VkPhysicalDeviceSparseImageFormatInfo2
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tiling" VkPhysicalDeviceSparseImageFormatInfo2
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceSparseProperties
-> VkPhysicalDeviceSparseProperties -> Bool
==
          x :: VkPhysicalDeviceSparseProperties
x@(VkPhysicalDeviceSparseProperties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSparseProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSparseProperties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSparseProperties where
        (VkPhysicalDeviceSparseProperties# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceSparseProperties
-> VkPhysicalDeviceSparseProperties -> Ordering
`compare`
          x :: VkPhysicalDeviceSparseProperties
x@(VkPhysicalDeviceSparseProperties# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSparseProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSparseProperties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSparseProperties where
        sizeOf :: VkPhysicalDeviceSparseProperties -> Int
sizeOf ~VkPhysicalDeviceSparseProperties
_ = (Int
20)
{-# LINE 18944 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceSparseProperties -> Int
alignment ~VkPhysicalDeviceSparseProperties
_
          = Int
4
{-# LINE 18948 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceSparseProperties
-> IO VkPhysicalDeviceSparseProperties
peek = Ptr VkPhysicalDeviceSparseProperties
-> IO VkPhysicalDeviceSparseProperties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceSparseProperties
-> VkPhysicalDeviceSparseProperties -> IO ()
poke = Ptr VkPhysicalDeviceSparseProperties
-> VkPhysicalDeviceSparseProperties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceSparseProperties where
        unsafeAddr :: VkPhysicalDeviceSparseProperties -> Addr#
unsafeAddr (VkPhysicalDeviceSparseProperties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceSparseProperties -> ByteArray#
unsafeByteArray (VkPhysicalDeviceSparseProperties# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceSparseProperties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceSparseProperties
VkPhysicalDeviceSparseProperties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "residencyStandard2DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties
getField VkPhysicalDeviceSparseProperties
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseProperties
-> Ptr VkPhysicalDeviceSparseProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseProperties
x) (Int
0))
{-# LINE 19014 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseProperties
-> IO
     (FieldType
        "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties)
readField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
0)
{-# LINE 19018 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyStandard2DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties
-> IO ()
writeField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
4)
{-# LINE 19051 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "residencyStandard2DMultisampleBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyStandard2DMultisampleBlockShape"
     VkPhysicalDeviceSparseProperties
getField VkPhysicalDeviceSparseProperties
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseProperties
-> Ptr VkPhysicalDeviceSparseProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseProperties
x) (Int
4))
{-# LINE 19060 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseProperties
-> IO
     (FieldType
        "residencyStandard2DMultisampleBlockShape"
        VkPhysicalDeviceSparseProperties)
readField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
4)
{-# LINE 19064 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyStandard2DMultisampleBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyStandard2DMultisampleBlockShape"
     VkPhysicalDeviceSparseProperties
-> IO ()
writeField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "residencyStandard3DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties
getField VkPhysicalDeviceSparseProperties
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseProperties
-> Ptr VkPhysicalDeviceSparseProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseProperties
x) (Int
8))
{-# LINE 19106 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseProperties
-> IO
     (FieldType
        "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties)
readField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
8)
{-# LINE 19110 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyStandard3DBlockShape"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties
-> IO ()
writeField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
12)
{-# LINE 19142 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "residencyAlignedMipSize"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties
getField VkPhysicalDeviceSparseProperties
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseProperties
-> Ptr VkPhysicalDeviceSparseProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseProperties
x) (Int
12))
{-# LINE 19151 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseProperties
-> IO
     (FieldType
        "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties)
readField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
12)
{-# LINE 19155 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyAlignedMipSize"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties
-> IO ()
writeField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "residencyNonResidentStrict"
           VkPhysicalDeviceSparseProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties
getField VkPhysicalDeviceSparseProperties
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSparseProperties
-> Ptr VkPhysicalDeviceSparseProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSparseProperties
x) (Int
16))
{-# LINE 19197 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSparseProperties
-> IO
     (FieldType
        "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties)
readField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
16)
{-# LINE 19201 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "residencyNonResidentStrict"
           VkPhysicalDeviceSparseProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties
-> IO ()
writeField Ptr VkPhysicalDeviceSparseProperties
p
          = Ptr VkPhysicalDeviceSparseProperties -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSparseProperties
p (Int
16)
{-# LINE 19209 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSparseProperties where
        showsPrec :: Int -> VkPhysicalDeviceSparseProperties -> ShowS
showsPrec Int
d VkPhysicalDeviceSparseProperties
x
          = String -> ShowS
showString String
"VkPhysicalDeviceSparseProperties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"residencyStandard2DBlockShape = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"residencyStandard2DMultisampleBlockShape = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                        (VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyStandard2DMultisampleBlockShape"
     VkPhysicalDeviceSparseProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"residencyStandard2DMultisampleBlockShape" VkPhysicalDeviceSparseProperties
x)
                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"residencyStandard3DBlockShape = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"residencyAlignedMipSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"residencyAlignedMipSize" VkPhysicalDeviceSparseProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"residencyNonResidentStrict = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSparseProperties
-> FieldType
     "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"residencyNonResidentStrict" VkPhysicalDeviceSparseProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceSubgroupProperties
-> VkPhysicalDeviceSubgroupProperties -> Bool
==
          x :: VkPhysicalDeviceSubgroupProperties
x@(VkPhysicalDeviceSubgroupProperties# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSubgroupProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSubgroupProperties
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSubgroupProperties where
        (VkPhysicalDeviceSubgroupProperties# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceSubgroupProperties
-> VkPhysicalDeviceSubgroupProperties -> Ordering
`compare`
          x :: VkPhysicalDeviceSubgroupProperties
x@(VkPhysicalDeviceSubgroupProperties# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSubgroupProperties -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSubgroupProperties
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSubgroupProperties where
        sizeOf :: VkPhysicalDeviceSubgroupProperties -> Int
sizeOf ~VkPhysicalDeviceSubgroupProperties
_ = (Int
32)
{-# LINE 19260 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceSubgroupProperties -> Int
alignment ~VkPhysicalDeviceSubgroupProperties
_
          = Int
8
{-# LINE 19264 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceSubgroupProperties
-> IO VkPhysicalDeviceSubgroupProperties
peek = Ptr VkPhysicalDeviceSubgroupProperties
-> IO VkPhysicalDeviceSubgroupProperties
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceSubgroupProperties
-> VkPhysicalDeviceSubgroupProperties -> IO ()
poke = Ptr VkPhysicalDeviceSubgroupProperties
-> VkPhysicalDeviceSubgroupProperties -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceSubgroupProperties where
        unsafeAddr :: VkPhysicalDeviceSubgroupProperties -> Addr#
unsafeAddr (VkPhysicalDeviceSubgroupProperties# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceSubgroupProperties -> ByteArray#
unsafeByteArray (VkPhysicalDeviceSubgroupProperties# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceSubgroupProperties
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceSubgroupProperties
VkPhysicalDeviceSubgroupProperties#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSubgroupProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSubgroupProperties
-> FieldType "sType" VkPhysicalDeviceSubgroupProperties
getField VkPhysicalDeviceSubgroupProperties
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSubgroupProperties -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSubgroupProperties
-> Ptr VkPhysicalDeviceSubgroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSubgroupProperties
x) (Int
0))
{-# LINE 19320 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSubgroupProperties
-> IO (FieldType "sType" VkPhysicalDeviceSubgroupProperties)
readField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
0)
{-# LINE 19324 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceSubgroupProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSubgroupProperties
-> FieldType "sType" VkPhysicalDeviceSubgroupProperties -> IO ()
writeField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSubgroupProperties where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSubgroupProperties
-> FieldType "pNext" VkPhysicalDeviceSubgroupProperties
getField VkPhysicalDeviceSubgroupProperties
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSubgroupProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSubgroupProperties
-> Ptr VkPhysicalDeviceSubgroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSubgroupProperties
x) (Int
8))
{-# LINE 19355 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSubgroupProperties
-> IO (FieldType "pNext" VkPhysicalDeviceSubgroupProperties)
readField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
8)
{-# LINE 19359 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceSubgroupProperties where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSubgroupProperties
-> FieldType "pNext" VkPhysicalDeviceSubgroupProperties -> IO ()
writeField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "subgroupSize" VkPhysicalDeviceSubgroupProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSubgroupProperties
-> FieldType "subgroupSize" VkPhysicalDeviceSubgroupProperties
getField VkPhysicalDeviceSubgroupProperties
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSubgroupProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSubgroupProperties
-> Ptr VkPhysicalDeviceSubgroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSubgroupProperties
x) (Int
16))
{-# LINE 19393 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSubgroupProperties
-> IO (FieldType "subgroupSize" VkPhysicalDeviceSubgroupProperties)
readField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
16)
{-# LINE 19397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "subgroupSize" VkPhysicalDeviceSubgroupProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSubgroupProperties
-> FieldType "subgroupSize" VkPhysicalDeviceSubgroupProperties
-> IO ()
writeField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "supportedStages" VkPhysicalDeviceSubgroupProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSubgroupProperties
-> FieldType "supportedStages" VkPhysicalDeviceSubgroupProperties
getField VkPhysicalDeviceSubgroupProperties
x
          = IO VkShaderStageFlags -> VkShaderStageFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSubgroupProperties
-> Int -> IO VkShaderStageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSubgroupProperties
-> Ptr VkPhysicalDeviceSubgroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSubgroupProperties
x) (Int
20))
{-# LINE 19434 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSubgroupProperties
-> IO
     (FieldType "supportedStages" VkPhysicalDeviceSubgroupProperties)
readField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties
-> Int -> IO VkShaderStageFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
20)
{-# LINE 19438 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "supportedStages" VkPhysicalDeviceSubgroupProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSubgroupProperties
-> FieldType "supportedStages" VkPhysicalDeviceSubgroupProperties
-> IO ()
writeField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties
-> Int -> VkShaderStageFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "supportedOperations"
           VkPhysicalDeviceSubgroupProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSubgroupProperties
-> FieldType
     "supportedOperations" VkPhysicalDeviceSubgroupProperties
getField VkPhysicalDeviceSubgroupProperties
x
          = IO VkSubgroupFeatureFlags -> VkSubgroupFeatureFlags
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSubgroupProperties
-> Int -> IO VkSubgroupFeatureFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSubgroupProperties
-> Ptr VkPhysicalDeviceSubgroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSubgroupProperties
x) (Int
24))
{-# LINE 19478 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSubgroupProperties
-> IO
     (FieldType
        "supportedOperations" VkPhysicalDeviceSubgroupProperties)
readField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties
-> Int -> IO VkSubgroupFeatureFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
24)
{-# LINE 19482 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "supportedOperations"
           VkPhysicalDeviceSubgroupProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSubgroupProperties
-> FieldType
     "supportedOperations" VkPhysicalDeviceSubgroupProperties
-> IO ()
writeField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties
-> Int -> VkSubgroupFeatureFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "quadOperationsInAllStages"
           VkPhysicalDeviceSubgroupProperties
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSubgroupProperties
-> FieldType
     "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties
getField VkPhysicalDeviceSubgroupProperties
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSubgroupProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSubgroupProperties
-> Ptr VkPhysicalDeviceSubgroupProperties
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSubgroupProperties
x) (Int
28))
{-# LINE 19524 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSubgroupProperties
-> IO
     (FieldType
        "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties)
readField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
28)
{-# LINE 19528 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "quadOperationsInAllStages"
           VkPhysicalDeviceSubgroupProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSubgroupProperties
-> FieldType
     "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties
-> IO ()
writeField Ptr VkPhysicalDeviceSubgroupProperties
p
          = Ptr VkPhysicalDeviceSubgroupProperties -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSubgroupProperties
p (Int
28)
{-# LINE 19536 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSubgroupProperties where
        showsPrec :: Int -> VkPhysicalDeviceSubgroupProperties -> ShowS
showsPrec Int
d VkPhysicalDeviceSubgroupProperties
x
          = String -> ShowS
showString String
"VkPhysicalDeviceSubgroupProperties {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSubgroupProperties
-> FieldType "sType" VkPhysicalDeviceSubgroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceSubgroupProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSubgroupProperties
-> FieldType "pNext" VkPhysicalDeviceSubgroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceSubgroupProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"subgroupSize = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSubgroupProperties
-> FieldType "subgroupSize" VkPhysicalDeviceSubgroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"subgroupSize" VkPhysicalDeviceSubgroupProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"supportedStages = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkShaderStageFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSubgroupProperties
-> FieldType "supportedStages" VkPhysicalDeviceSubgroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"supportedStages" VkPhysicalDeviceSubgroupProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"supportedOperations = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkSubgroupFeatureFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSubgroupProperties
-> FieldType
     "supportedOperations" VkPhysicalDeviceSubgroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"supportedOperations" VkPhysicalDeviceSubgroupProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"quadOperationsInAllStages = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSubgroupProperties
-> FieldType
     "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties
x)
                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceSurfaceInfo2KHR
-> VkPhysicalDeviceSurfaceInfo2KHR -> Bool
==
          x :: VkPhysicalDeviceSurfaceInfo2KHR
x@(VkPhysicalDeviceSurfaceInfo2KHR# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSurfaceInfo2KHR -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSurfaceInfo2KHR
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceSurfaceInfo2KHR where
        (VkPhysicalDeviceSurfaceInfo2KHR# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceSurfaceInfo2KHR
-> VkPhysicalDeviceSurfaceInfo2KHR -> Ordering
`compare`
          x :: VkPhysicalDeviceSurfaceInfo2KHR
x@(VkPhysicalDeviceSurfaceInfo2KHR# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceSurfaceInfo2KHR -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceSurfaceInfo2KHR
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceSurfaceInfo2KHR where
        sizeOf :: VkPhysicalDeviceSurfaceInfo2KHR -> Int
sizeOf ~VkPhysicalDeviceSurfaceInfo2KHR
_ = (Int
24)
{-# LINE 19584 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceSurfaceInfo2KHR -> Int
alignment ~VkPhysicalDeviceSurfaceInfo2KHR
_
          = Int
8
{-# LINE 19588 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> IO VkPhysicalDeviceSurfaceInfo2KHR
peek = Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> IO VkPhysicalDeviceSurfaceInfo2KHR
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> VkPhysicalDeviceSurfaceInfo2KHR -> IO ()
poke = Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> VkPhysicalDeviceSurfaceInfo2KHR -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceSurfaceInfo2KHR where
        unsafeAddr :: VkPhysicalDeviceSurfaceInfo2KHR -> Addr#
unsafeAddr (VkPhysicalDeviceSurfaceInfo2KHR# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceSurfaceInfo2KHR -> ByteArray#
unsafeByteArray (VkPhysicalDeviceSurfaceInfo2KHR# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceSurfaceInfo2KHR
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceSurfaceInfo2KHR
VkPhysicalDeviceSurfaceInfo2KHR#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSurfaceInfo2KHR
-> FieldType "sType" VkPhysicalDeviceSurfaceInfo2KHR
getField VkPhysicalDeviceSurfaceInfo2KHR
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSurfaceInfo2KHR -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSurfaceInfo2KHR
-> Ptr VkPhysicalDeviceSurfaceInfo2KHR
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSurfaceInfo2KHR
x) (Int
0))
{-# LINE 19640 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> IO (FieldType "sType" VkPhysicalDeviceSurfaceInfo2KHR)
readField Ptr VkPhysicalDeviceSurfaceInfo2KHR
p
          = Ptr VkPhysicalDeviceSurfaceInfo2KHR -> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSurfaceInfo2KHR
p (Int
0)
{-# LINE 19644 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> FieldType "sType" VkPhysicalDeviceSurfaceInfo2KHR -> IO ()
writeField Ptr VkPhysicalDeviceSurfaceInfo2KHR
p
          = Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSurfaceInfo2KHR
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSurfaceInfo2KHR
-> FieldType "pNext" VkPhysicalDeviceSurfaceInfo2KHR
getField VkPhysicalDeviceSurfaceInfo2KHR
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSurfaceInfo2KHR -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSurfaceInfo2KHR
-> Ptr VkPhysicalDeviceSurfaceInfo2KHR
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSurfaceInfo2KHR
x) (Int
8))
{-# LINE 19672 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> IO (FieldType "pNext" VkPhysicalDeviceSurfaceInfo2KHR)
readField Ptr VkPhysicalDeviceSurfaceInfo2KHR
p
          = Ptr VkPhysicalDeviceSurfaceInfo2KHR -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSurfaceInfo2KHR
p (Int
8)
{-# LINE 19676 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> FieldType "pNext" VkPhysicalDeviceSurfaceInfo2KHR -> IO ()
writeField Ptr VkPhysicalDeviceSurfaceInfo2KHR
p
          = Ptr VkPhysicalDeviceSurfaceInfo2KHR -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSurfaceInfo2KHR
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "surface" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceSurfaceInfo2KHR
-> FieldType "surface" VkPhysicalDeviceSurfaceInfo2KHR
getField VkPhysicalDeviceSurfaceInfo2KHR
x
          = IO VkSurfaceKHR -> VkSurfaceKHR
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceSurfaceInfo2KHR -> Int -> IO VkSurfaceKHR
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceSurfaceInfo2KHR
-> Ptr VkPhysicalDeviceSurfaceInfo2KHR
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceSurfaceInfo2KHR
x) (Int
16))
{-# LINE 19707 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> IO (FieldType "surface" VkPhysicalDeviceSurfaceInfo2KHR)
readField Ptr VkPhysicalDeviceSurfaceInfo2KHR
p
          = Ptr VkPhysicalDeviceSurfaceInfo2KHR -> Int -> IO VkSurfaceKHR
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceSurfaceInfo2KHR
p (Int
16)
{-# LINE 19711 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "surface" VkPhysicalDeviceSurfaceInfo2KHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceSurfaceInfo2KHR
-> FieldType "surface" VkPhysicalDeviceSurfaceInfo2KHR -> IO ()
writeField Ptr VkPhysicalDeviceSurfaceInfo2KHR
p
          = Ptr VkPhysicalDeviceSurfaceInfo2KHR -> Int -> VkSurfaceKHR -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceSurfaceInfo2KHR
p (Int
16)
{-# LINE 19717 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceSurfaceInfo2KHR where
        showsPrec :: Int -> VkPhysicalDeviceSurfaceInfo2KHR -> ShowS
showsPrec Int
d VkPhysicalDeviceSurfaceInfo2KHR
x
          = String -> ShowS
showString String
"VkPhysicalDeviceSurfaceInfo2KHR {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSurfaceInfo2KHR
-> FieldType "sType" VkPhysicalDeviceSurfaceInfo2KHR
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceSurfaceInfo2KHR
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSurfaceInfo2KHR
-> FieldType "pNext" VkPhysicalDeviceSurfaceInfo2KHR
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceSurfaceInfo2KHR
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"surface = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkSurfaceKHR -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceSurfaceInfo2KHR
-> FieldType "surface" VkPhysicalDeviceSurfaceInfo2KHR
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"surface" VkPhysicalDeviceSurfaceInfo2KHR
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceVariablePointerFeatures
-> VkPhysicalDeviceVariablePointerFeatures -> Bool
==
          x :: VkPhysicalDeviceVariablePointerFeatures
x@(VkPhysicalDeviceVariablePointerFeatures# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceVariablePointerFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceVariablePointerFeatures
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceVariablePointerFeatures where
        (VkPhysicalDeviceVariablePointerFeatures# Addr#
a ByteArray#
_) compare :: VkPhysicalDeviceVariablePointerFeatures
-> VkPhysicalDeviceVariablePointerFeatures -> Ordering
`compare`
          x :: VkPhysicalDeviceVariablePointerFeatures
x@(VkPhysicalDeviceVariablePointerFeatures# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceVariablePointerFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceVariablePointerFeatures
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceVariablePointerFeatures where
        sizeOf :: VkPhysicalDeviceVariablePointerFeatures -> Int
sizeOf ~VkPhysicalDeviceVariablePointerFeatures
_
          = (Int
24)
{-# LINE 19758 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceVariablePointerFeatures -> Int
alignment ~VkPhysicalDeviceVariablePointerFeatures
_
          = Int
8
{-# LINE 19762 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> IO VkPhysicalDeviceVariablePointerFeatures
peek = Ptr VkPhysicalDeviceVariablePointerFeatures
-> IO VkPhysicalDeviceVariablePointerFeatures
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> VkPhysicalDeviceVariablePointerFeatures -> IO ()
poke = Ptr VkPhysicalDeviceVariablePointerFeatures
-> VkPhysicalDeviceVariablePointerFeatures -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkPhysicalDeviceVariablePointerFeatures
         where
        unsafeAddr :: VkPhysicalDeviceVariablePointerFeatures -> Addr#
unsafeAddr (VkPhysicalDeviceVariablePointerFeatures# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceVariablePointerFeatures -> ByteArray#
unsafeByteArray (VkPhysicalDeviceVariablePointerFeatures# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceVariablePointerFeatures
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceVariablePointerFeatures
VkPhysicalDeviceVariablePointerFeatures#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkPhysicalDeviceVariablePointerFeatures where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceVariablePointerFeatures
-> FieldType "sType" VkPhysicalDeviceVariablePointerFeatures
getField VkPhysicalDeviceVariablePointerFeatures
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceVariablePointerFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceVariablePointerFeatures
-> Ptr VkPhysicalDeviceVariablePointerFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceVariablePointerFeatures
x) (Int
0))
{-# LINE 19820 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> IO (FieldType "sType" VkPhysicalDeviceVariablePointerFeatures)
readField Ptr VkPhysicalDeviceVariablePointerFeatures
p
          = Ptr VkPhysicalDeviceVariablePointerFeatures
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceVariablePointerFeatures
p (Int
0)
{-# LINE 19824 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkPhysicalDeviceVariablePointerFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> FieldType "sType" VkPhysicalDeviceVariablePointerFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceVariablePointerFeatures
p
          = Ptr VkPhysicalDeviceVariablePointerFeatures
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceVariablePointerFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkPhysicalDeviceVariablePointerFeatures where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceVariablePointerFeatures
-> FieldType "pNext" VkPhysicalDeviceVariablePointerFeatures
getField VkPhysicalDeviceVariablePointerFeatures
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceVariablePointerFeatures -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceVariablePointerFeatures
-> Ptr VkPhysicalDeviceVariablePointerFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceVariablePointerFeatures
x) (Int
8))
{-# LINE 19855 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> IO (FieldType "pNext" VkPhysicalDeviceVariablePointerFeatures)
readField Ptr VkPhysicalDeviceVariablePointerFeatures
p
          = Ptr VkPhysicalDeviceVariablePointerFeatures -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceVariablePointerFeatures
p (Int
8)
{-# LINE 19859 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkPhysicalDeviceVariablePointerFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> FieldType "pNext" VkPhysicalDeviceVariablePointerFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceVariablePointerFeatures
p
          = Ptr VkPhysicalDeviceVariablePointerFeatures
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceVariablePointerFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "variablePointersStorageBuffer"
           VkPhysicalDeviceVariablePointerFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceVariablePointerFeatures
-> FieldType
     "variablePointersStorageBuffer"
     VkPhysicalDeviceVariablePointerFeatures
getField VkPhysicalDeviceVariablePointerFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceVariablePointerFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceVariablePointerFeatures
-> Ptr VkPhysicalDeviceVariablePointerFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceVariablePointerFeatures
x) (Int
16))
{-# LINE 19899 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> IO
     (FieldType
        "variablePointersStorageBuffer"
        VkPhysicalDeviceVariablePointerFeatures)
readField Ptr VkPhysicalDeviceVariablePointerFeatures
p
          = Ptr VkPhysicalDeviceVariablePointerFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceVariablePointerFeatures
p (Int
16)
{-# LINE 19903 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "variablePointersStorageBuffer"
           VkPhysicalDeviceVariablePointerFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> FieldType
     "variablePointersStorageBuffer"
     VkPhysicalDeviceVariablePointerFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceVariablePointerFeatures
p
          = Ptr VkPhysicalDeviceVariablePointerFeatures
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceVariablePointerFeatures
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "variablePointers"
           VkPhysicalDeviceVariablePointerFeatures
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceVariablePointerFeatures
-> FieldType
     "variablePointers" VkPhysicalDeviceVariablePointerFeatures
getField VkPhysicalDeviceVariablePointerFeatures
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceVariablePointerFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceVariablePointerFeatures
-> Ptr VkPhysicalDeviceVariablePointerFeatures
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceVariablePointerFeatures
x) (Int
20))
{-# LINE 19944 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> IO
     (FieldType
        "variablePointers" VkPhysicalDeviceVariablePointerFeatures)
readField Ptr VkPhysicalDeviceVariablePointerFeatures
p
          = Ptr VkPhysicalDeviceVariablePointerFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceVariablePointerFeatures
p (Int
20)
{-# LINE 19948 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "variablePointers"
           VkPhysicalDeviceVariablePointerFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceVariablePointerFeatures
-> FieldType
     "variablePointers" VkPhysicalDeviceVariablePointerFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceVariablePointerFeatures
p
          = Ptr VkPhysicalDeviceVariablePointerFeatures
-> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceVariablePointerFeatures
p (Int
20)
{-# LINE 19956 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceVariablePointerFeatures where
        showsPrec :: Int -> VkPhysicalDeviceVariablePointerFeatures -> ShowS
showsPrec Int
d VkPhysicalDeviceVariablePointerFeatures
x
          = String -> ShowS
showString String
"VkPhysicalDeviceVariablePointerFeatures {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceVariablePointerFeatures
-> FieldType "sType" VkPhysicalDeviceVariablePointerFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceVariablePointerFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceVariablePointerFeatures
-> FieldType "pNext" VkPhysicalDeviceVariablePointerFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceVariablePointerFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"variablePointersStorageBuffer = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceVariablePointerFeatures
-> FieldType
     "variablePointersStorageBuffer"
     VkPhysicalDeviceVariablePointerFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"variablePointersStorageBuffer" VkPhysicalDeviceVariablePointerFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"variablePointers = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceVariablePointerFeatures
-> FieldType
     "variablePointers" VkPhysicalDeviceVariablePointerFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"variablePointers" VkPhysicalDeviceVariablePointerFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | 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# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> Bool
==
          x :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x@(VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# Addr#
a ByteArray#
_)
          compare :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> Ordering
`compare`
          x :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x@(VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        sizeOf :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> Int
sizeOf ~VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
_
          = (Int
24)
{-# LINE 20008 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> Int
alignment ~VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
_
          = Int
8
{-# LINE 20012 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> IO VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
peek = Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> IO VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> IO ()
poke = Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        unsafeAddr :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> Addr#
unsafeAddr
          (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> ByteArray#
unsafeByteArray
          (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int#
-> ByteArray#
-> VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr#
-> ByteArray#
-> VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "sType"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
getField VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x) (Int
0))
{-# LINE 20087 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> IO
     (FieldType
        "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT)
readField Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p
          = Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p (Int
0)
{-# LINE 20091 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p
          = Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "pNext"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
getField VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x) (Int
8))
{-# LINE 20133 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> IO
     (FieldType
        "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT)
readField Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p
          = Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p (Int
8)
{-# LINE 20137 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p
          = Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p (Int
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 :: Bool
fieldOptional = Bool
False

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

instance {-# OVERLAPPING #-}
         CanReadField "maxVertexAttribDivisor"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# NOINLINE getField #-}
        getField :: VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> FieldType
     "maxVertexAttribDivisor"
     VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
getField VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x) (Int
16))
{-# LINE 20179 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> IO
     (FieldType
        "maxVertexAttribDivisor"
        VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT)
readField Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p
          = Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p (Int
16)
{-# LINE 20183 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxVertexAttribDivisor"
           VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> FieldType
     "maxVertexAttribDivisor"
     VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> IO ()
writeField Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p
          = Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
p (Int
16)
{-# LINE 20191 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDevice.hsc" #-}

instance Show VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
         where
        showsPrec :: Int -> VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT -> ShowS
showsPrec Int
d VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x
          = String -> ShowS
showString
              String
"VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT {"
              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> FieldType
     "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> FieldType
     "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"maxVertexAttribDivisor = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
-> FieldType
     "maxVertexAttribDivisor"
     VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"maxVertexAttribDivisor" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'