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


{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
module Graphics.Vulkan.Types.Struct.PhysicalDeviceFeatures
       (VkPhysicalDeviceFeatures(..)) where
import           Foreign.Storable                 (Storable (..))
import           GHC.Base                         (Addr#, ByteArray#,
                                                   byteArrayContents#,
                                                   plusAddr#)
import           Graphics.Vulkan.Marshal
import           Graphics.Vulkan.Marshal.Internal
import           Graphics.Vulkan.Types.BaseTypes  (VkBool32)
import           System.IO.Unsafe                 (unsafeDupablePerformIO)

-- | > typedef struct VkPhysicalDeviceFeatures {
--   >     VkBool32               robustBufferAccess;
--   >     VkBool32               fullDrawIndexUint32;
--   >     VkBool32               imageCubeArray;
--   >     VkBool32               independentBlend;
--   >     VkBool32               geometryShader;
--   >     VkBool32               tessellationShader;
--   >     VkBool32               sampleRateShading;
--   >     VkBool32               dualSrcBlend;
--   >     VkBool32               logicOp;
--   >     VkBool32               multiDrawIndirect;
--   >     VkBool32               drawIndirectFirstInstance;
--   >     VkBool32               depthClamp;
--   >     VkBool32               depthBiasClamp;
--   >     VkBool32               fillModeNonSolid;
--   >     VkBool32               depthBounds;
--   >     VkBool32               wideLines;
--   >     VkBool32               largePoints;
--   >     VkBool32               alphaToOne;
--   >     VkBool32               multiViewport;
--   >     VkBool32               samplerAnisotropy;
--   >     VkBool32               textureCompressionETC2;
--   >     VkBool32               textureCompressionASTC_LDR;
--   >     VkBool32               textureCompressionBC;
--   >     VkBool32               occlusionQueryPrecise;
--   >     VkBool32               pipelineStatisticsQuery;
--   >     VkBool32               vertexPipelineStoresAndAtomics;
--   >     VkBool32               fragmentStoresAndAtomics;
--   >     VkBool32               shaderTessellationAndGeometryPointSize;
--   >     VkBool32               shaderImageGatherExtended;
--   >     VkBool32               shaderStorageImageExtendedFormats;
--   >     VkBool32               shaderStorageImageMultisample;
--   >     VkBool32               shaderStorageImageReadWithoutFormat;
--   >     VkBool32               shaderStorageImageWriteWithoutFormat;
--   >     VkBool32               shaderUniformBufferArrayDynamicIndexing;
--   >     VkBool32               shaderSampledImageArrayDynamicIndexing;
--   >     VkBool32               shaderStorageBufferArrayDynamicIndexing;
--   >     VkBool32               shaderStorageImageArrayDynamicIndexing;
--   >     VkBool32               shaderClipDistance;
--   >     VkBool32               shaderCullDistance;
--   >     VkBool32               shaderFloat64;
--   >     VkBool32               shaderInt64;
--   >     VkBool32               shaderInt16;
--   >     VkBool32               shaderResourceResidency;
--   >     VkBool32               shaderResourceMinLod;
--   >     VkBool32               sparseBinding;
--   >     VkBool32               sparseResidencyBuffer;
--   >     VkBool32               sparseResidencyImage2D;
--   >     VkBool32               sparseResidencyImage3D;
--   >     VkBool32               sparseResidency2Samples;
--   >     VkBool32               sparseResidency4Samples;
--   >     VkBool32               sparseResidency8Samples;
--   >     VkBool32               sparseResidency16Samples;
--   >     VkBool32               sparseResidencyAliased;
--   >     VkBool32               variableMultisampleRate;
--   >     VkBool32               inheritedQueries;
--   > } VkPhysicalDeviceFeatures;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkPhysicalDeviceFeatures VkPhysicalDeviceFeatures registry at www.khronos.org>
data VkPhysicalDeviceFeatures = VkPhysicalDeviceFeatures# Addr#
                                                          ByteArray#

instance Eq VkPhysicalDeviceFeatures where
        (VkPhysicalDeviceFeatures# Addr#
a ByteArray#
_) == :: VkPhysicalDeviceFeatures -> VkPhysicalDeviceFeatures -> Bool
==
          x :: VkPhysicalDeviceFeatures
x@(VkPhysicalDeviceFeatures# Addr#
b ByteArray#
_) = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkPhysicalDeviceFeatures -> Int
forall a. Storable a => a -> Int
sizeOf VkPhysicalDeviceFeatures
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

instance Storable VkPhysicalDeviceFeatures where
        sizeOf :: VkPhysicalDeviceFeatures -> Int
sizeOf ~VkPhysicalDeviceFeatures
_ = (Int
220)
{-# LINE 97 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkPhysicalDeviceFeatures -> Int
alignment ~VkPhysicalDeviceFeatures
_ = Int
4
{-# LINE 100 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

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

        {-# INLINE poke #-}

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

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

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkPhysicalDeviceFeatures
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkPhysicalDeviceFeatures
VkPhysicalDeviceFeatures# (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkPhysicalDeviceFeatures where
        type StructFields VkPhysicalDeviceFeatures =
             '["robustBufferAccess", "fullDrawIndexUint32", "imageCubeArray", -- ' closing tick for hsc2hs
               "independentBlend", "geometryShader", "tessellationShader",
               "sampleRateShading", "dualSrcBlend", "logicOp",
               "multiDrawIndirect", "drawIndirectFirstInstance", "depthClamp",
               "depthBiasClamp", "fillModeNonSolid", "depthBounds", "wideLines",
               "largePoints", "alphaToOne", "multiViewport", "samplerAnisotropy",
               "textureCompressionETC2", "textureCompressionASTC_LDR",
               "textureCompressionBC", "occlusionQueryPrecise",
               "pipelineStatisticsQuery", "vertexPipelineStoresAndAtomics",
               "fragmentStoresAndAtomics",
               "shaderTessellationAndGeometryPointSize",
               "shaderImageGatherExtended", "shaderStorageImageExtendedFormats",
               "shaderStorageImageMultisample",
               "shaderStorageImageReadWithoutFormat",
               "shaderStorageImageWriteWithoutFormat",
               "shaderUniformBufferArrayDynamicIndexing",
               "shaderSampledImageArrayDynamicIndexing",
               "shaderStorageBufferArrayDynamicIndexing",
               "shaderStorageImageArrayDynamicIndexing", "shaderClipDistance",
               "shaderCullDistance", "shaderFloat64", "shaderInt64",
               "shaderInt16", "shaderResourceResidency", "shaderResourceMinLod",
               "sparseBinding", "sparseResidencyBuffer", "sparseResidencyImage2D",
               "sparseResidencyImage3D", "sparseResidency2Samples",
               "sparseResidency4Samples", "sparseResidency8Samples",
               "sparseResidency16Samples", "sparseResidencyAliased",
               "variableMultisampleRate", "inheritedQueries"]
        type CUnionType VkPhysicalDeviceFeatures = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkPhysicalDeviceFeatures = 'False -- ' closing tick for hsc2hs
        type StructExtends VkPhysicalDeviceFeatures = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "robustBufferAccess" VkPhysicalDeviceFeatures where
        type FieldType "robustBufferAccess" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "robustBufferAccess" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "robustBufferAccess" VkPhysicalDeviceFeatures =
             (0)
{-# LINE 162 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "robustBufferAccess" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "robustBufferAccess" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
0)
{-# LINE 182 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "robustBufferAccess" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "robustBufferAccess" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
0)
{-# LINE 188 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "fullDrawIndexUint32" VkPhysicalDeviceFeatures where
        type FieldType "fullDrawIndexUint32" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "fullDrawIndexUint32" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "fullDrawIndexUint32" VkPhysicalDeviceFeatures =
             (4)
{-# LINE 197 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "fullDrawIndexUint32" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "fullDrawIndexUint32" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
4)
{-# LINE 217 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "fullDrawIndexUint32" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "fullDrawIndexUint32" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
4)
{-# LINE 223 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "imageCubeArray" VkPhysicalDeviceFeatures where
        type FieldType "imageCubeArray" VkPhysicalDeviceFeatures = VkBool32
        type FieldOptional "imageCubeArray" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "imageCubeArray" VkPhysicalDeviceFeatures =
             (8)
{-# LINE 231 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "imageCubeArray" VkPhysicalDeviceFeatures =
             '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/PhysicalDeviceFeatures.hsc" #-}

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "imageCubeArray" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "imageCubeArray" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
8)
{-# LINE 257 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "independentBlend" VkPhysicalDeviceFeatures where
        type FieldType "independentBlend" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "independentBlend" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "independentBlend" VkPhysicalDeviceFeatures =
             (12)
{-# LINE 266 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "independentBlend" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "independentBlend" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
12)
{-# LINE 286 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "independentBlend" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "independentBlend" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
12)
{-# LINE 292 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "tessellationShader" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "tessellationShader" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
20)
{-# LINE 361 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sampleRateShading" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sampleRateShading" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
24)
{-# LINE 396 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "logicOp" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "logicOp" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
32)
{-# LINE 460 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "drawIndirectFirstInstance" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "drawIndirectFirstInstance" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
40)
{-# LINE 536 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "depthClamp" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "depthClamp" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
44)
{-# LINE 568 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "fillModeNonSolid" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "fillModeNonSolid" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
52)
{-# LINE 637 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "depthBounds" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "depthBounds" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
56)
{-# LINE 669 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "largePoints" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "largePoints" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
64)
{-# LINE 733 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "alphaToOne" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "alphaToOne" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
68)
{-# LINE 765 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "multiViewport" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "multiViewport" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
72)
{-# LINE 798 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "samplerAnisotropy" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "samplerAnisotropy" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
76)
{-# LINE 833 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "textureCompressionETC2" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "textureCompressionETC2" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
80)
{-# LINE 872 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "textureCompressionASTC_LDR" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "textureCompressionASTC_LDR" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
84)
{-# LINE 915 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "textureCompressionBC" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "textureCompressionBC" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
88)
{-# LINE 950 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "pipelineStatisticsQuery" VkPhysicalDeviceFeatures where
        type FieldType "pipelineStatisticsQuery" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "pipelineStatisticsQuery"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pipelineStatisticsQuery" VkPhysicalDeviceFeatures
             =
             (96)
{-# LINE 997 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "pipelineStatisticsQuery"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType "pipelineStatisticsQuery" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
96)
{-# LINE 1019 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pipelineStatisticsQuery" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "pipelineStatisticsQuery" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
96)
{-# LINE 1026 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "vertexPipelineStoresAndAtomics" VkPhysicalDeviceFeatures
         where
        type FieldType "vertexPipelineStoresAndAtomics"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "vertexPipelineStoresAndAtomics"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "vertexPipelineStoresAndAtomics"
               VkPhysicalDeviceFeatures
             =
             (100)
{-# LINE 1040 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "vertexPipelineStoresAndAtomics"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "vertexPipelineStoresAndAtomics" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
100)
{-# LINE 1063 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "vertexPipelineStoresAndAtomics"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "vertexPipelineStoresAndAtomics" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
100)
{-# LINE 1071 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "fragmentStoresAndAtomics" VkPhysicalDeviceFeatures where
        type FieldType "fragmentStoresAndAtomics" VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "fragmentStoresAndAtomics"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "fragmentStoresAndAtomics"
               VkPhysicalDeviceFeatures
             =
             (104)
{-# LINE 1083 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "fragmentStoresAndAtomics"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType "fragmentStoresAndAtomics" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
104)
{-# LINE 1105 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "fragmentStoresAndAtomics" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "fragmentStoresAndAtomics" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
104)
{-# LINE 1112 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderTessellationAndGeometryPointSize"
           VkPhysicalDeviceFeatures
         where
        type FieldType "shaderTessellationAndGeometryPointSize"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderTessellationAndGeometryPointSize"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderTessellationAndGeometryPointSize"
               VkPhysicalDeviceFeatures
             =
             (108)
{-# LINE 1127 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderTessellationAndGeometryPointSize"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "shaderTessellationAndGeometryPointSize" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
108)
{-# LINE 1150 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderTessellationAndGeometryPointSize"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "shaderTessellationAndGeometryPointSize" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
108)
{-# LINE 1158 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderImageGatherExtended" VkPhysicalDeviceFeatures where
        type FieldType "shaderImageGatherExtended" VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderImageGatherExtended"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderImageGatherExtended"
               VkPhysicalDeviceFeatures
             =
             (112)
{-# LINE 1170 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderImageGatherExtended"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType "shaderImageGatherExtended" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
112)
{-# LINE 1192 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderImageGatherExtended" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "shaderImageGatherExtended" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
112)
{-# LINE 1199 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageImageExtendedFormats"
           VkPhysicalDeviceFeatures
         where
        type FieldType "shaderStorageImageExtendedFormats"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderStorageImageExtendedFormats"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageImageExtendedFormats"
               VkPhysicalDeviceFeatures
             =
             (116)
{-# LINE 1214 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderStorageImageExtendedFormats"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "shaderStorageImageExtendedFormats" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
116)
{-# LINE 1237 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageImageExtendedFormats"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageExtendedFormats" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
116)
{-# LINE 1245 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageImageMultisample" VkPhysicalDeviceFeatures
         where
        type FieldType "shaderStorageImageMultisample"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderStorageImageMultisample"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageImageMultisample"
               VkPhysicalDeviceFeatures
             =
             (120)
{-# LINE 1259 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderStorageImageMultisample"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "shaderStorageImageMultisample" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
120)
{-# LINE 1282 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageImageMultisample"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageMultisample" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
120)
{-# LINE 1290 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageImageReadWithoutFormat"
           VkPhysicalDeviceFeatures
         where
        type FieldType "shaderStorageImageReadWithoutFormat"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderStorageImageReadWithoutFormat"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageImageReadWithoutFormat"
               VkPhysicalDeviceFeatures
             =
             (124)
{-# LINE 1305 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderStorageImageReadWithoutFormat"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "shaderStorageImageReadWithoutFormat" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
124)
{-# LINE 1328 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageImageReadWithoutFormat"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageReadWithoutFormat" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
124)
{-# LINE 1336 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageImageWriteWithoutFormat"
           VkPhysicalDeviceFeatures
         where
        type FieldType "shaderStorageImageWriteWithoutFormat"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderStorageImageWriteWithoutFormat"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageImageWriteWithoutFormat"
               VkPhysicalDeviceFeatures
             =
             (128)
{-# LINE 1351 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderStorageImageWriteWithoutFormat"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "shaderStorageImageWriteWithoutFormat" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
128)
{-# LINE 1374 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageImageWriteWithoutFormat"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageWriteWithoutFormat" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
128)
{-# LINE 1382 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderUniformBufferArrayDynamicIndexing"
           VkPhysicalDeviceFeatures
         where
        type FieldType "shaderUniformBufferArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderUniformBufferArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderUniformBufferArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             =
             (132)
{-# LINE 1397 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderUniformBufferArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "shaderUniformBufferArrayDynamicIndexing" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
132)
{-# LINE 1420 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderUniformBufferArrayDynamicIndexing"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "shaderUniformBufferArrayDynamicIndexing" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
132)
{-# LINE 1428 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderSampledImageArrayDynamicIndexing"
           VkPhysicalDeviceFeatures
         where
        type FieldType "shaderSampledImageArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderSampledImageArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderSampledImageArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             =
             (136)
{-# LINE 1443 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderSampledImageArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "shaderSampledImageArrayDynamicIndexing" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
136)
{-# LINE 1466 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderSampledImageArrayDynamicIndexing"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "shaderSampledImageArrayDynamicIndexing" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
136)
{-# LINE 1474 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageBufferArrayDynamicIndexing"
           VkPhysicalDeviceFeatures
         where
        type FieldType "shaderStorageBufferArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderStorageBufferArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageBufferArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             =
             (140)
{-# LINE 1489 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderStorageBufferArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "shaderStorageBufferArrayDynamicIndexing" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
140)
{-# LINE 1512 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageBufferArrayDynamicIndexing"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageBufferArrayDynamicIndexing" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
140)
{-# LINE 1520 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderStorageImageArrayDynamicIndexing"
           VkPhysicalDeviceFeatures
         where
        type FieldType "shaderStorageImageArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "shaderStorageImageArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderStorageImageArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             =
             (144)
{-# LINE 1535 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderStorageImageArrayDynamicIndexing"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType
        "shaderStorageImageArrayDynamicIndexing" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
144)
{-# LINE 1558 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderStorageImageArrayDynamicIndexing"
           VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageArrayDynamicIndexing" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
144)
{-# LINE 1566 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderClipDistance" VkPhysicalDeviceFeatures where
        type FieldType "shaderClipDistance" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "shaderClipDistance" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderClipDistance" VkPhysicalDeviceFeatures =
             (148)
{-# LINE 1575 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderClipDistance" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "shaderClipDistance" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
148)
{-# LINE 1595 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderClipDistance" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "shaderClipDistance" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
148)
{-# LINE 1601 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderCullDistance" VkPhysicalDeviceFeatures where
        type FieldType "shaderCullDistance" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "shaderCullDistance" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderCullDistance" VkPhysicalDeviceFeatures =
             (152)
{-# LINE 1610 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderCullDistance" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "shaderCullDistance" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
152)
{-# LINE 1630 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderCullDistance" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "shaderCullDistance" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
152)
{-# LINE 1636 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderFloat64" VkPhysicalDeviceFeatures where
        type FieldType "shaderFloat64" VkPhysicalDeviceFeatures = VkBool32
        type FieldOptional "shaderFloat64" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderFloat64" VkPhysicalDeviceFeatures =
             (156)
{-# LINE 1644 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderFloat64" VkPhysicalDeviceFeatures = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "shaderFloat64" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
156)
{-# LINE 1663 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderFloat64" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "shaderFloat64" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
156)
{-# LINE 1669 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderInt64" VkPhysicalDeviceFeatures where
        type FieldType "shaderInt64" VkPhysicalDeviceFeatures = VkBool32
        type FieldOptional "shaderInt64" VkPhysicalDeviceFeatures = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderInt64" VkPhysicalDeviceFeatures =
             (160)
{-# LINE 1676 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderInt64" VkPhysicalDeviceFeatures = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "shaderInt64" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
160)
{-# LINE 1695 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderInt64" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "shaderInt64" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
160)
{-# LINE 1701 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderInt16" VkPhysicalDeviceFeatures where
        type FieldType "shaderInt16" VkPhysicalDeviceFeatures = VkBool32
        type FieldOptional "shaderInt16" VkPhysicalDeviceFeatures = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderInt16" VkPhysicalDeviceFeatures =
             (164)
{-# LINE 1708 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderInt16" VkPhysicalDeviceFeatures = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "shaderInt16" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
164)
{-# LINE 1727 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderInt16" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "shaderInt16" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
164)
{-# LINE 1733 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderResourceResidency" VkPhysicalDeviceFeatures where
        type FieldType "shaderResourceResidency" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "shaderResourceResidency"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderResourceResidency" VkPhysicalDeviceFeatures
             =
             (168)
{-# LINE 1744 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderResourceResidency"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType "shaderResourceResidency" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
168)
{-# LINE 1766 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderResourceResidency" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "shaderResourceResidency" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
168)
{-# LINE 1773 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "shaderResourceMinLod" VkPhysicalDeviceFeatures where
        type FieldType "shaderResourceMinLod" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "shaderResourceMinLod" VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "shaderResourceMinLod" VkPhysicalDeviceFeatures =
             (172)
{-# LINE 1782 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "shaderResourceMinLod" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "shaderResourceMinLod" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
172)
{-# LINE 1802 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "shaderResourceMinLod" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "shaderResourceMinLod" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
172)
{-# LINE 1808 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseBinding" VkPhysicalDeviceFeatures where
        type FieldType "sparseBinding" VkPhysicalDeviceFeatures = VkBool32
        type FieldOptional "sparseBinding" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseBinding" VkPhysicalDeviceFeatures =
             (176)
{-# LINE 1816 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "sparseBinding" VkPhysicalDeviceFeatures = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "sparseBinding" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
176)
{-# LINE 1835 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseBinding" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sparseBinding" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
176)
{-# LINE 1841 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseResidencyBuffer" VkPhysicalDeviceFeatures where
        type FieldType "sparseResidencyBuffer" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "sparseResidencyBuffer" VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseResidencyBuffer" VkPhysicalDeviceFeatures =
             (180)
{-# LINE 1850 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "sparseResidencyBuffer" VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
180)
{-# LINE 1859 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "sparseResidencyBuffer" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
180)
{-# LINE 1870 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseResidencyBuffer" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sparseResidencyBuffer" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
180)
{-# LINE 1877 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseResidencyImage2D" VkPhysicalDeviceFeatures where
        type FieldType "sparseResidencyImage2D" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "sparseResidencyImage2D"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseResidencyImage2D" VkPhysicalDeviceFeatures
             =
             (184)
{-# LINE 1888 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "sparseResidencyImage2D" VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
184)
{-# LINE 1897 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "sparseResidencyImage2D" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
184)
{-# LINE 1909 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseResidencyImage2D" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sparseResidencyImage2D" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
184)
{-# LINE 1916 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseResidencyImage3D" VkPhysicalDeviceFeatures where
        type FieldType "sparseResidencyImage3D" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "sparseResidencyImage3D"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseResidencyImage3D" VkPhysicalDeviceFeatures
             =
             (188)
{-# LINE 1927 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "sparseResidencyImage3D" VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
188)
{-# LINE 1936 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "sparseResidencyImage3D" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
188)
{-# LINE 1948 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseResidencyImage3D" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sparseResidencyImage3D" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
188)
{-# LINE 1955 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseResidency2Samples" VkPhysicalDeviceFeatures where
        type FieldType "sparseResidency2Samples" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "sparseResidency2Samples"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseResidency2Samples" VkPhysicalDeviceFeatures
             =
             (192)
{-# LINE 1966 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "sparseResidency2Samples"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
192)
{-# LINE 1976 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType "sparseResidency2Samples" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
192)
{-# LINE 1988 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseResidency2Samples" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sparseResidency2Samples" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
192)
{-# LINE 1995 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseResidency4Samples" VkPhysicalDeviceFeatures where
        type FieldType "sparseResidency4Samples" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "sparseResidency4Samples"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseResidency4Samples" VkPhysicalDeviceFeatures
             =
             (196)
{-# LINE 2006 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "sparseResidency4Samples"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
196)
{-# LINE 2016 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType "sparseResidency4Samples" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
196)
{-# LINE 2028 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseResidency4Samples" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sparseResidency4Samples" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
196)
{-# LINE 2035 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseResidency8Samples" VkPhysicalDeviceFeatures where
        type FieldType "sparseResidency8Samples" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "sparseResidency8Samples"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseResidency8Samples" VkPhysicalDeviceFeatures
             =
             (200)
{-# LINE 2046 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "sparseResidency8Samples"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
200)
{-# LINE 2056 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType "sparseResidency8Samples" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
200)
{-# LINE 2068 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseResidency8Samples" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sparseResidency8Samples" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
200)
{-# LINE 2075 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseResidency16Samples" VkPhysicalDeviceFeatures where
        type FieldType "sparseResidency16Samples" VkPhysicalDeviceFeatures
             = VkBool32
        type FieldOptional "sparseResidency16Samples"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseResidency16Samples"
               VkPhysicalDeviceFeatures
             =
             (204)
{-# LINE 2087 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "sparseResidency16Samples"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
204)
{-# LINE 2097 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType "sparseResidency16Samples" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
204)
{-# LINE 2109 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseResidency16Samples" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sparseResidency16Samples" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
204)
{-# LINE 2116 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "sparseResidencyAliased" VkPhysicalDeviceFeatures where
        type FieldType "sparseResidencyAliased" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "sparseResidencyAliased"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "sparseResidencyAliased" VkPhysicalDeviceFeatures
             =
             (208)
{-# LINE 2127 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "sparseResidencyAliased" VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
208)
{-# LINE 2136 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "sparseResidencyAliased" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
208)
{-# LINE 2148 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sparseResidencyAliased" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "sparseResidencyAliased" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
208)
{-# LINE 2155 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "variableMultisampleRate" VkPhysicalDeviceFeatures where
        type FieldType "variableMultisampleRate" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "variableMultisampleRate"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "variableMultisampleRate" VkPhysicalDeviceFeatures
             =
             (212)
{-# LINE 2166 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "variableMultisampleRate"
               VkPhysicalDeviceFeatures
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
212)
{-# LINE 2176 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO
     (FieldType "variableMultisampleRate" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
212)
{-# LINE 2188 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "variableMultisampleRate" VkPhysicalDeviceFeatures
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "variableMultisampleRate" VkPhysicalDeviceFeatures
-> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
212)
{-# LINE 2195 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "inheritedQueries" VkPhysicalDeviceFeatures where
        type FieldType "inheritedQueries" VkPhysicalDeviceFeatures =
             VkBool32
        type FieldOptional "inheritedQueries" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "inheritedQueries" VkPhysicalDeviceFeatures =
             (216)
{-# LINE 2204 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}
        type FieldIsArray "inheritedQueries" VkPhysicalDeviceFeatures =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
216)
{-# LINE 2213 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

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

        {-# INLINE readField #-}
        readField :: Ptr VkPhysicalDeviceFeatures
-> IO (FieldType "inheritedQueries" VkPhysicalDeviceFeatures)
readField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkPhysicalDeviceFeatures
p (Int
216)
{-# LINE 2224 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "inheritedQueries" VkPhysicalDeviceFeatures where
        {-# INLINE writeField #-}
        writeField :: Ptr VkPhysicalDeviceFeatures
-> FieldType "inheritedQueries" VkPhysicalDeviceFeatures -> IO ()
writeField Ptr VkPhysicalDeviceFeatures
p
          = Ptr VkPhysicalDeviceFeatures -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkPhysicalDeviceFeatures
p (Int
216)
{-# LINE 2230 "src-gen/Graphics/Vulkan/Types/Struct/PhysicalDeviceFeatures.hsc" #-}

instance Show VkPhysicalDeviceFeatures where
        showsPrec :: Int -> VkPhysicalDeviceFeatures -> ShowS
showsPrec Int
d VkPhysicalDeviceFeatures
x
          = String -> ShowS
showString String
"VkPhysicalDeviceFeatures {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"robustBufferAccess = " 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 (VkPhysicalDeviceFeatures
-> FieldType "robustBufferAccess" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"robustBufferAccess" VkPhysicalDeviceFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"fullDrawIndexUint32 = " 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 (VkPhysicalDeviceFeatures
-> FieldType "fullDrawIndexUint32" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"fullDrawIndexUint32" VkPhysicalDeviceFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"imageCubeArray = " 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 (VkPhysicalDeviceFeatures
-> FieldType "imageCubeArray" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"imageCubeArray" VkPhysicalDeviceFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"independentBlend = " 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 (VkPhysicalDeviceFeatures
-> FieldType "independentBlend" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"independentBlend" VkPhysicalDeviceFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"geometryShader = " 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 (VkPhysicalDeviceFeatures
-> FieldType "geometryShader" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"geometryShader" VkPhysicalDeviceFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"tessellationShader = " 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 (VkPhysicalDeviceFeatures
-> FieldType "tessellationShader" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tessellationShader" VkPhysicalDeviceFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
"sampleRateShading = " 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 (VkPhysicalDeviceFeatures
-> FieldType "sampleRateShading" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sampleRateShading" VkPhysicalDeviceFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                        String -> ShowS
showString String
"dualSrcBlend = " 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 (VkPhysicalDeviceFeatures
-> FieldType "dualSrcBlend" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"dualSrcBlend" VkPhysicalDeviceFeatures
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                            String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                              String -> ShowS
showString String
"logicOp = " 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 (VkPhysicalDeviceFeatures
-> FieldType "logicOp" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"logicOp" VkPhysicalDeviceFeatures
x)
                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                    String -> ShowS
showString
                                                                      String
"multiDrawIndirect = "
                                                                      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
                                                                        (VkPhysicalDeviceFeatures
-> FieldType "multiDrawIndirect" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                           @"multiDrawIndirect"
                                                                           VkPhysicalDeviceFeatures
x)
                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                          String -> ShowS
showString
                                                                            String
"drawIndirectFirstInstance = "
                                                                            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
                                                                              (VkPhysicalDeviceFeatures
-> FieldType "drawIndirectFirstInstance" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                 @"drawIndirectFirstInstance"
                                                                                 VkPhysicalDeviceFeatures
x)
                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                String -> ShowS
showString
                                                                                  String
"depthClamp = "
                                                                                  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
                                                                                    (VkPhysicalDeviceFeatures
-> FieldType "depthClamp" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                       @"depthClamp"
                                                                                       VkPhysicalDeviceFeatures
x)
                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                    String -> ShowS
showString String
", "
                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                      String -> ShowS
showString
                                                                                        String
"depthBiasClamp = "
                                                                                        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
                                                                                          (VkPhysicalDeviceFeatures
-> FieldType "depthBiasClamp" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                             @"depthBiasClamp"
                                                                                             VkPhysicalDeviceFeatures
x)
                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                          String -> ShowS
showString
                                                                                            String
", "
                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                            String -> ShowS
showString
                                                                                              String
"fillModeNonSolid = "
                                                                                              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
                                                                                                (VkPhysicalDeviceFeatures
-> FieldType "fillModeNonSolid" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                   @"fillModeNonSolid"
                                                                                                   VkPhysicalDeviceFeatures
x)
                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                String -> ShowS
showString
                                                                                                  String
", "
                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                  String -> ShowS
showString
                                                                                                    String
"depthBounds = "
                                                                                                    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
                                                                                                      (VkPhysicalDeviceFeatures
-> FieldType "depthBounds" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                         @"depthBounds"
                                                                                                         VkPhysicalDeviceFeatures
x)
                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                      String -> ShowS
showString
                                                                                                        String
", "
                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                        String -> ShowS
showString
                                                                                                          String
"wideLines = "
                                                                                                          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
                                                                                                            (VkPhysicalDeviceFeatures
-> FieldType "wideLines" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                               @"wideLines"
                                                                                                               VkPhysicalDeviceFeatures
x)
                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                            String -> ShowS
showString
                                                                                                              String
", "
                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                              String -> ShowS
showString
                                                                                                                String
"largePoints = "
                                                                                                                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
                                                                                                                  (VkPhysicalDeviceFeatures
-> FieldType "largePoints" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                     @"largePoints"
                                                                                                                     VkPhysicalDeviceFeatures
x)
                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                  String -> ShowS
showString
                                                                                                                    String
", "
                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                    String -> ShowS
showString
                                                                                                                      String
"alphaToOne = "
                                                                                                                      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
                                                                                                                        (VkPhysicalDeviceFeatures
-> FieldType "alphaToOne" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                           @"alphaToOne"
                                                                                                                           VkPhysicalDeviceFeatures
x)
                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                        String -> ShowS
showString
                                                                                                                          String
", "
                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                          String -> ShowS
showString
                                                                                                                            String
"multiViewport = "
                                                                                                                            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
                                                                                                                              (VkPhysicalDeviceFeatures
-> FieldType "multiViewport" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                 @"multiViewport"
                                                                                                                                 VkPhysicalDeviceFeatures
x)
                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                              String -> ShowS
showString
                                                                                                                                String
", "
                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                String -> ShowS
showString
                                                                                                                                  String
"samplerAnisotropy = "
                                                                                                                                  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
                                                                                                                                    (VkPhysicalDeviceFeatures
-> FieldType "samplerAnisotropy" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                       @"samplerAnisotropy"
                                                                                                                                       VkPhysicalDeviceFeatures
x)
                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                    String -> ShowS
showString
                                                                                                                                      String
", "
                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                      String -> ShowS
showString
                                                                                                                                        String
"textureCompressionETC2 = "
                                                                                                                                        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
                                                                                                                                          (VkPhysicalDeviceFeatures
-> FieldType "textureCompressionETC2" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                             @"textureCompressionETC2"
                                                                                                                                             VkPhysicalDeviceFeatures
x)
                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                          String -> ShowS
showString
                                                                                                                                            String
", "
                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                            String -> ShowS
showString
                                                                                                                                              String
"textureCompressionASTC_LDR = "
                                                                                                                                              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
                                                                                                                                                (VkPhysicalDeviceFeatures
-> FieldType "textureCompressionASTC_LDR" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                   @"textureCompressionASTC_LDR"
                                                                                                                                                   VkPhysicalDeviceFeatures
x)
                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                String -> ShowS
showString
                                                                                                                                                  String
", "
                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                    String
"textureCompressionBC = "
                                                                                                                                                    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
                                                                                                                                                      (VkPhysicalDeviceFeatures
-> FieldType "textureCompressionBC" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                         @"textureCompressionBC"
                                                                                                                                                         VkPhysicalDeviceFeatures
x)
                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                        String
", "
                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                          String
"occlusionQueryPrecise = "
                                                                                                                                                          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
                                                                                                                                                            (VkPhysicalDeviceFeatures
-> FieldType "occlusionQueryPrecise" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                               @"occlusionQueryPrecise"
                                                                                                                                                               VkPhysicalDeviceFeatures
x)
                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                              String
", "
                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                String
"pipelineStatisticsQuery = "
                                                                                                                                                                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
                                                                                                                                                                  (VkPhysicalDeviceFeatures
-> FieldType "pipelineStatisticsQuery" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                     @"pipelineStatisticsQuery"
                                                                                                                                                                     VkPhysicalDeviceFeatures
x)
                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                    String
", "
                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                      String
"vertexPipelineStoresAndAtomics = "
                                                                                                                                                                      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
                                                                                                                                                                        (VkPhysicalDeviceFeatures
-> FieldType
     "vertexPipelineStoresAndAtomics" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                           @"vertexPipelineStoresAndAtomics"
                                                                                                                                                                           VkPhysicalDeviceFeatures
x)
                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                          String
", "
                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                            String
"fragmentStoresAndAtomics = "
                                                                                                                                                                            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
                                                                                                                                                                              (VkPhysicalDeviceFeatures
-> FieldType "fragmentStoresAndAtomics" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                 @"fragmentStoresAndAtomics"
                                                                                                                                                                                 VkPhysicalDeviceFeatures
x)
                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                String
", "
                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                  String
"shaderTessellationAndGeometryPointSize = "
                                                                                                                                                                                  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
                                                                                                                                                                                    (VkPhysicalDeviceFeatures
-> FieldType
     "shaderTessellationAndGeometryPointSize" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                       @"shaderTessellationAndGeometryPointSize"
                                                                                                                                                                                       VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                      String
", "
                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                        String
"shaderImageGatherExtended = "
                                                                                                                                                                                        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
                                                                                                                                                                                          (VkPhysicalDeviceFeatures
-> FieldType "shaderImageGatherExtended" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                             @"shaderImageGatherExtended"
                                                                                                                                                                                             VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                            String
", "
                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                              String
"shaderStorageImageExtendedFormats = "
                                                                                                                                                                                              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
                                                                                                                                                                                                (VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageExtendedFormats" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                   @"shaderStorageImageExtendedFormats"
                                                                                                                                                                                                   VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                    String
"shaderStorageImageMultisample = "
                                                                                                                                                                                                    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
                                                                                                                                                                                                      (VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageMultisample" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                         @"shaderStorageImageMultisample"
                                                                                                                                                                                                         VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                          String
"shaderStorageImageReadWithoutFormat = "
                                                                                                                                                                                                          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
                                                                                                                                                                                                            (VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageReadWithoutFormat" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                               @"shaderStorageImageReadWithoutFormat"
                                                                                                                                                                                                               VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                String
"shaderStorageImageWriteWithoutFormat = "
                                                                                                                                                                                                                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
                                                                                                                                                                                                                  (VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageWriteWithoutFormat" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                     @"shaderStorageImageWriteWithoutFormat"
                                                                                                                                                                                                                     VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                      String
"shaderUniformBufferArrayDynamicIndexing = "
                                                                                                                                                                                                                      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
                                                                                                                                                                                                                        (VkPhysicalDeviceFeatures
-> FieldType
     "shaderUniformBufferArrayDynamicIndexing" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                           @"shaderUniformBufferArrayDynamicIndexing"
                                                                                                                                                                                                                           VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                            String
"shaderSampledImageArrayDynamicIndexing = "
                                                                                                                                                                                                                            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
                                                                                                                                                                                                                              (VkPhysicalDeviceFeatures
-> FieldType
     "shaderSampledImageArrayDynamicIndexing" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                 @"shaderSampledImageArrayDynamicIndexing"
                                                                                                                                                                                                                                 VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                  String
"shaderStorageBufferArrayDynamicIndexing = "
                                                                                                                                                                                                                                  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
                                                                                                                                                                                                                                    (VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageBufferArrayDynamicIndexing" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                       @"shaderStorageBufferArrayDynamicIndexing"
                                                                                                                                                                                                                                       VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                        String
"shaderStorageImageArrayDynamicIndexing = "
                                                                                                                                                                                                                                        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
                                                                                                                                                                                                                                          (VkPhysicalDeviceFeatures
-> FieldType
     "shaderStorageImageArrayDynamicIndexing" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                             @"shaderStorageImageArrayDynamicIndexing"
                                                                                                                                                                                                                                             VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                              String
"shaderClipDistance = "
                                                                                                                                                                                                                                              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
                                                                                                                                                                                                                                                (VkPhysicalDeviceFeatures
-> FieldType "shaderClipDistance" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                   @"shaderClipDistance"
                                                                                                                                                                                                                                                   VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                    String
"shaderCullDistance = "
                                                                                                                                                                                                                                                    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
                                                                                                                                                                                                                                                      (VkPhysicalDeviceFeatures
-> FieldType "shaderCullDistance" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                         @"shaderCullDistance"
                                                                                                                                                                                                                                                         VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                          String
"shaderFloat64 = "
                                                                                                                                                                                                                                                          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
                                                                                                                                                                                                                                                            (VkPhysicalDeviceFeatures
-> FieldType "shaderFloat64" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                               @"shaderFloat64"
                                                                                                                                                                                                                                                               VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                String
"shaderInt64 = "
                                                                                                                                                                                                                                                                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
                                                                                                                                                                                                                                                                  (VkPhysicalDeviceFeatures
-> FieldType "shaderInt64" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                     @"shaderInt64"
                                                                                                                                                                                                                                                                     VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                      String
"shaderInt16 = "
                                                                                                                                                                                                                                                                      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
                                                                                                                                                                                                                                                                        (VkPhysicalDeviceFeatures
-> FieldType "shaderInt16" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                           @"shaderInt16"
                                                                                                                                                                                                                                                                           VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                            String
"shaderResourceResidency = "
                                                                                                                                                                                                                                                                            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
                                                                                                                                                                                                                                                                              (VkPhysicalDeviceFeatures
-> FieldType "shaderResourceResidency" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                 @"shaderResourceResidency"
                                                                                                                                                                                                                                                                                 VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                  String
"shaderResourceMinLod = "
                                                                                                                                                                                                                                                                                  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
                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceFeatures
-> FieldType "shaderResourceMinLod" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                       @"shaderResourceMinLod"
                                                                                                                                                                                                                                                                                       VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                        String
"sparseBinding = "
                                                                                                                                                                                                                                                                                        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
                                                                                                                                                                                                                                                                                          (VkPhysicalDeviceFeatures
-> FieldType "sparseBinding" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                             @"sparseBinding"
                                                                                                                                                                                                                                                                                             VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                              String
"sparseResidencyBuffer = "
                                                                                                                                                                                                                                                                                              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
                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceFeatures
-> FieldType "sparseResidencyBuffer" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                   @"sparseResidencyBuffer"
                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                    String
"sparseResidencyImage2D = "
                                                                                                                                                                                                                                                                                                    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
                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceFeatures
-> FieldType "sparseResidencyImage2D" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                         @"sparseResidencyImage2D"
                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                        String
", "
                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                          String
"sparseResidencyImage3D = "
                                                                                                                                                                                                                                                                                                          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
                                                                                                                                                                                                                                                                                                            (VkPhysicalDeviceFeatures
-> FieldType "sparseResidencyImage3D" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                               @"sparseResidencyImage3D"
                                                                                                                                                                                                                                                                                                               VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                              String
", "
                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                String
"sparseResidency2Samples = "
                                                                                                                                                                                                                                                                                                                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
                                                                                                                                                                                                                                                                                                                  (VkPhysicalDeviceFeatures
-> FieldType "sparseResidency2Samples" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                     @"sparseResidency2Samples"
                                                                                                                                                                                                                                                                                                                     VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                    String
", "
                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                      String
"sparseResidency4Samples = "
                                                                                                                                                                                                                                                                                                                      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
                                                                                                                                                                                                                                                                                                                        (VkPhysicalDeviceFeatures
-> FieldType "sparseResidency4Samples" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                           @"sparseResidency4Samples"
                                                                                                                                                                                                                                                                                                                           VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                        String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                          String
", "
                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                            String
"sparseResidency8Samples = "
                                                                                                                                                                                                                                                                                                                            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
                                                                                                                                                                                                                                                                                                                              (VkPhysicalDeviceFeatures
-> FieldType "sparseResidency8Samples" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                 @"sparseResidency8Samples"
                                                                                                                                                                                                                                                                                                                                 VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                              String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                String
", "
                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                  String
"sparseResidency16Samples = "
                                                                                                                                                                                                                                                                                                                                  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
                                                                                                                                                                                                                                                                                                                                    (VkPhysicalDeviceFeatures
-> FieldType "sparseResidency16Samples" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                       @"sparseResidency16Samples"
                                                                                                                                                                                                                                                                                                                                       VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                    String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                      String
", "
                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                      String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                        String
"sparseResidencyAliased = "
                                                                                                                                                                                                                                                                                                                                        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
                                                                                                                                                                                                                                                                                                                                          (VkPhysicalDeviceFeatures
-> FieldType "sparseResidencyAliased" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                             @"sparseResidencyAliased"
                                                                                                                                                                                                                                                                                                                                             VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                          String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                            String
", "
                                                                                                                                                                                                                                                                                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                            String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                              String
"variableMultisampleRate = "
                                                                                                                                                                                                                                                                                                                                              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
                                                                                                                                                                                                                                                                                                                                                (VkPhysicalDeviceFeatures
-> FieldType "variableMultisampleRate" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                   @"variableMultisampleRate"
                                                                                                                                                                                                                                                                                                                                                   VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                  String
", "
                                                                                                                                                                                                                                                                                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                  String -> ShowS
showString
                                                                                                                                                                                                                                                                                                                                                    String
"inheritedQueries = "
                                                                                                                                                                                                                                                                                                                                                    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
                                                                                                                                                                                                                                                                                                                                                      (VkPhysicalDeviceFeatures
-> FieldType "inheritedQueries" VkPhysicalDeviceFeatures
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                                                                                                                                                                                                                                                         @"inheritedQueries"
                                                                                                                                                                                                                                                                                                                                                         VkPhysicalDeviceFeatures
x)
                                                                                                                                                                                                                                                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                                                                                                                                                                                                                                                      Char -> ShowS
showChar
                                                                                                                                                                                                                                                                                                                                                        Char
'}'