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

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

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
module Graphics.Vulkan.Types.Struct.Bind
       (VkBindBufferMemoryDeviceGroupInfo(..),
        VkBindBufferMemoryDeviceGroupInfoKHR, VkBindBufferMemoryInfo(..),
        VkBindBufferMemoryInfoKHR, VkBindImageMemoryDeviceGroupInfo(..),
        VkBindImageMemoryDeviceGroupInfoKHR, VkBindImageMemoryInfo(..),
        VkBindImageMemoryInfoKHR, VkBindImageMemorySwapchainInfoKHR(..),
        VkBindImagePlaneMemoryInfo(..), VkBindImagePlaneMemoryInfoKHR,
        VkBindSparseInfo(..))
       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          (VkDeviceSize)
import           Graphics.Vulkan.Types.Enum.Image         (VkImageAspectFlagBits)
import           Graphics.Vulkan.Types.Enum.StructureType (VkStructureType)
import           Graphics.Vulkan.Types.Handles            (VkBuffer,
                                                           VkDeviceMemory,
                                                           VkImage, VkSemaphore,
                                                           VkSwapchainKHR)
import           Graphics.Vulkan.Types.Struct.Rect        (VkRect2D)
import           Graphics.Vulkan.Types.Struct.Sparse      (VkSparseBufferMemoryBindInfo,
                                                           VkSparseImageMemoryBindInfo,
                                                           VkSparseImageOpaqueMemoryBindInfo)
import           System.IO.Unsafe                         (unsafeDupablePerformIO)

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkBindBufferMemoryDeviceGroupInfo where
        type StructFields VkBindBufferMemoryDeviceGroupInfo =
             '["sType", "pNext", "deviceIndexCount", "pDeviceIndices"] -- ' closing tick for hsc2hs
        type CUnionType VkBindBufferMemoryDeviceGroupInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkBindBufferMemoryDeviceGroupInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkBindBufferMemoryDeviceGroupInfo =
             '[VkBindBufferMemoryInfo] -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "deviceIndexCount" VkBindBufferMemoryDeviceGroupInfo where
        type FieldType "deviceIndexCount" VkBindBufferMemoryDeviceGroupInfo
             = Word32
        type FieldOptional "deviceIndexCount"
               VkBindBufferMemoryDeviceGroupInfo
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "deviceIndexCount"
               VkBindBufferMemoryDeviceGroupInfo
             =
             (16)
{-# LINE 180 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "deviceIndexCount"
               VkBindBufferMemoryDeviceGroupInfo
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

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

instance {-# OVERLAPPING #-}
         CanReadField "deviceIndexCount" VkBindBufferMemoryDeviceGroupInfo
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 198 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "deviceIndexCount" VkBindBufferMemoryDeviceGroupInfo
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 209 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pDeviceIndices" VkBindBufferMemoryDeviceGroupInfo where
        type FieldType "pDeviceIndices" VkBindBufferMemoryDeviceGroupInfo =
             Ptr Word32
        type FieldOptional "pDeviceIndices"
               VkBindBufferMemoryDeviceGroupInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pDeviceIndices" VkBindBufferMemoryDeviceGroupInfo
             =
             (24)
{-# LINE 220 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "pDeviceIndices"
               VkBindBufferMemoryDeviceGroupInfo
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "pDeviceIndices" VkBindBufferMemoryDeviceGroupInfo
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 238 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "pDeviceIndices" VkBindBufferMemoryDeviceGroupInfo
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 249 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

-- | Alias for `VkBindBufferMemoryDeviceGroupInfo`
type VkBindBufferMemoryDeviceGroupInfoKHR =
     VkBindBufferMemoryDeviceGroupInfo

-- | > typedef struct VkBindBufferMemoryInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkBuffer                         buffer;
--   >     VkDeviceMemory                   memory;
--   >     VkDeviceSize                     memoryOffset;
--   > } VkBindBufferMemoryInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkBindBufferMemoryInfo VkBindBufferMemoryInfo registry at www.khronos.org>
data VkBindBufferMemoryInfo = VkBindBufferMemoryInfo# Addr#
                                                      ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkBindBufferMemoryInfo where
        type StructFields VkBindBufferMemoryInfo =
             '["sType", "pNext", "buffer", "memory", "memoryOffset"] -- ' closing tick for hsc2hs
        type CUnionType VkBindBufferMemoryInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkBindBufferMemoryInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkBindBufferMemoryInfo = '[] -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "buffer" VkBindBufferMemoryInfo where
        type FieldType "buffer" VkBindBufferMemoryInfo = VkBuffer
        type FieldOptional "buffer" VkBindBufferMemoryInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "buffer" VkBindBufferMemoryInfo =
             (16)
{-# LINE 394 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "buffer" VkBindBufferMemoryInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "buffer" VkBindBufferMemoryInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 408 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "buffer" VkBindBufferMemoryInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 418 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "memory" VkBindBufferMemoryInfo where
        type FieldType "memory" VkBindBufferMemoryInfo = VkDeviceMemory
        type FieldOptional "memory" VkBindBufferMemoryInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "memory" VkBindBufferMemoryInfo =
             (24)
{-# LINE 425 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "memory" VkBindBufferMemoryInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "memory" VkBindBufferMemoryInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 439 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "memory" VkBindBufferMemoryInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 449 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "memoryOffset" VkBindBufferMemoryInfo where
        type FieldType "memoryOffset" VkBindBufferMemoryInfo = VkDeviceSize
        type FieldOptional "memoryOffset" VkBindBufferMemoryInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "memoryOffset" VkBindBufferMemoryInfo =
             (32)
{-# LINE 456 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "memoryOffset" VkBindBufferMemoryInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "memoryOffset" VkBindBufferMemoryInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 471 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "memoryOffset" VkBindBufferMemoryInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 481 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance Show VkBindBufferMemoryInfo where
        showsPrec d x
          = showString "VkBindBufferMemoryInfo {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "buffer = " .
                            showsPrec d (getField @"buffer" x) .
                              showString ", " .
                                showString "memory = " .
                                  showsPrec d (getField @"memory" x) .
                                    showString ", " .
                                      showString "memoryOffset = " .
                                        showsPrec d (getField @"memoryOffset" x) . showChar '}'

-- | Alias for `VkBindBufferMemoryInfo`
type VkBindBufferMemoryInfoKHR = VkBindBufferMemoryInfo

-- | > typedef struct VkBindImageMemoryDeviceGroupInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     uint32_t         deviceIndexCount;
--   >     const uint32_t*  pDeviceIndices;
--   >     uint32_t         splitInstanceBindRegionCount;
--   >     const VkRect2D*  pSplitInstanceBindRegions;
--   > } VkBindImageMemoryDeviceGroupInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkBindImageMemoryDeviceGroupInfo VkBindImageMemoryDeviceGroupInfo registry at www.khronos.org>
data VkBindImageMemoryDeviceGroupInfo = VkBindImageMemoryDeviceGroupInfo# Addr#
                                                                          ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

instance Storable VkBindImageMemoryDeviceGroupInfo where
        sizeOf ~_ = (48)
{-# LINE 532 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkBindImageMemoryDeviceGroupInfo where
        type StructFields VkBindImageMemoryDeviceGroupInfo =
             '["sType", "pNext", "deviceIndexCount", "pDeviceIndices", -- ' closing tick for hsc2hs
               "splitInstanceBindRegionCount", "pSplitInstanceBindRegions"]
        type CUnionType VkBindImageMemoryDeviceGroupInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkBindImageMemoryDeviceGroupInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkBindImageMemoryDeviceGroupInfo =
             '[VkBindImageMemoryInfo] -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "deviceIndexCount" VkBindImageMemoryDeviceGroupInfo where
        type FieldType "deviceIndexCount" VkBindImageMemoryDeviceGroupInfo
             = Word32
        type FieldOptional "deviceIndexCount"
               VkBindImageMemoryDeviceGroupInfo
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "deviceIndexCount"
               VkBindImageMemoryDeviceGroupInfo
             =
             (16)
{-# LINE 646 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "deviceIndexCount"
               VkBindImageMemoryDeviceGroupInfo
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "deviceIndexCount" VkBindImageMemoryDeviceGroupInfo
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 675 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pDeviceIndices" VkBindImageMemoryDeviceGroupInfo where
        type FieldType "pDeviceIndices" VkBindImageMemoryDeviceGroupInfo =
             Ptr Word32
        type FieldOptional "pDeviceIndices"
               VkBindImageMemoryDeviceGroupInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pDeviceIndices" VkBindImageMemoryDeviceGroupInfo
             =
             (24)
{-# LINE 686 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "pDeviceIndices" VkBindImageMemoryDeviceGroupInfo
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "pDeviceIndices" VkBindImageMemoryDeviceGroupInfo
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 703 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "pDeviceIndices" VkBindImageMemoryDeviceGroupInfo
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 714 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "splitInstanceBindRegionCount"
           VkBindImageMemoryDeviceGroupInfo
         where
        type FieldType "splitInstanceBindRegionCount"
               VkBindImageMemoryDeviceGroupInfo
             = Word32
        type FieldOptional "splitInstanceBindRegionCount"
               VkBindImageMemoryDeviceGroupInfo
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "splitInstanceBindRegionCount"
               VkBindImageMemoryDeviceGroupInfo
             =
             (32)
{-# LINE 729 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "splitInstanceBindRegionCount"
               VkBindImageMemoryDeviceGroupInfo
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

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

instance {-# OVERLAPPING #-}
         CanReadField "splitInstanceBindRegionCount"
           VkBindImageMemoryDeviceGroupInfo
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 748 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "splitInstanceBindRegionCount"
           VkBindImageMemoryDeviceGroupInfo
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 760 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pSplitInstanceBindRegions"
           VkBindImageMemoryDeviceGroupInfo
         where
        type FieldType "pSplitInstanceBindRegions"
               VkBindImageMemoryDeviceGroupInfo
             = Ptr VkRect2D
        type FieldOptional "pSplitInstanceBindRegions"
               VkBindImageMemoryDeviceGroupInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pSplitInstanceBindRegions"
               VkBindImageMemoryDeviceGroupInfo
             =
             (40)
{-# LINE 775 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "pSplitInstanceBindRegions"
               VkBindImageMemoryDeviceGroupInfo
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "pSplitInstanceBindRegions"
           VkBindImageMemoryDeviceGroupInfo
         where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (40))
{-# LINE 794 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "pSplitInstanceBindRegions"
           VkBindImageMemoryDeviceGroupInfo
         where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (40)
{-# LINE 806 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance Show VkBindImageMemoryDeviceGroupInfo where
        showsPrec d x
          = showString "VkBindImageMemoryDeviceGroupInfo {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "deviceIndexCount = " .
                            showsPrec d (getField @"deviceIndexCount" x) .
                              showString ", " .
                                showString "pDeviceIndices = " .
                                  showsPrec d (getField @"pDeviceIndices" x) .
                                    showString ", " .
                                      showString "splitInstanceBindRegionCount = " .
                                        showsPrec d (getField @"splitInstanceBindRegionCount" x) .
                                          showString ", " .
                                            showString "pSplitInstanceBindRegions = " .
                                              showsPrec d (getField @"pSplitInstanceBindRegions" x)
                                                . showChar '}'

-- | Alias for `VkBindImageMemoryDeviceGroupInfo`
type VkBindImageMemoryDeviceGroupInfoKHR =
     VkBindImageMemoryDeviceGroupInfo

-- | > typedef struct VkBindImageMemoryInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkImage                          image;
--   >     VkDeviceMemory                   memory;
--   >     VkDeviceSize                     memoryOffset;
--   > } VkBindImageMemoryInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkBindImageMemoryInfo VkBindImageMemoryInfo registry at www.khronos.org>
data VkBindImageMemoryInfo = VkBindImageMemoryInfo# Addr#
                                                    ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkBindImageMemoryInfo where
        type StructFields VkBindImageMemoryInfo =
             '["sType", "pNext", "image", "memory", "memoryOffset"] -- ' closing tick for hsc2hs
        type CUnionType VkBindImageMemoryInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkBindImageMemoryInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkBindImageMemoryInfo = '[] -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

instance {-# OVERLAPPING #-} HasField "image" VkBindImageMemoryInfo
         where
        type FieldType "image" VkBindImageMemoryInfo = VkImage
        type FieldOptional "image" VkBindImageMemoryInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "image" VkBindImageMemoryInfo =
             (16)
{-# LINE 958 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "image" VkBindImageMemoryInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "image" VkBindImageMemoryInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 972 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "image" VkBindImageMemoryInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 982 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "memory" VkBindImageMemoryInfo where
        type FieldType "memory" VkBindImageMemoryInfo = VkDeviceMemory
        type FieldOptional "memory" VkBindImageMemoryInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "memory" VkBindImageMemoryInfo =
             (24)
{-# LINE 989 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "memory" VkBindImageMemoryInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "memory" VkBindImageMemoryInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 1003 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "memory" VkBindImageMemoryInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 1013 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "memoryOffset" VkBindImageMemoryInfo where
        type FieldType "memoryOffset" VkBindImageMemoryInfo = VkDeviceSize
        type FieldOptional "memoryOffset" VkBindImageMemoryInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "memoryOffset" VkBindImageMemoryInfo =
             (32)
{-# LINE 1020 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "memoryOffset" VkBindImageMemoryInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "memoryOffset" VkBindImageMemoryInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 1035 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "memoryOffset" VkBindImageMemoryInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 1045 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance Show VkBindImageMemoryInfo where
        showsPrec d x
          = showString "VkBindImageMemoryInfo {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "image = " .
                            showsPrec d (getField @"image" x) .
                              showString ", " .
                                showString "memory = " .
                                  showsPrec d (getField @"memory" x) .
                                    showString ", " .
                                      showString "memoryOffset = " .
                                        showsPrec d (getField @"memoryOffset" x) . showChar '}'

-- | Alias for `VkBindImageMemoryInfo`
type VkBindImageMemoryInfoKHR = VkBindImageMemoryInfo

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkBindImageMemorySwapchainInfoKHR where
        type StructFields VkBindImageMemorySwapchainInfoKHR =
             '["sType", "pNext", "swapchain", "imageIndex"] -- ' closing tick for hsc2hs
        type CUnionType VkBindImageMemorySwapchainInfoKHR = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkBindImageMemorySwapchainInfoKHR = 'False -- ' closing tick for hsc2hs
        type StructExtends VkBindImageMemorySwapchainInfoKHR =
             '[VkBindImageMemoryInfo] -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "swapchain" VkBindImageMemorySwapchainInfoKHR where
        type FieldType "swapchain" VkBindImageMemorySwapchainInfoKHR =
             VkSwapchainKHR
        type FieldOptional "swapchain" VkBindImageMemorySwapchainInfoKHR =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "swapchain" VkBindImageMemorySwapchainInfoKHR =
             (16)
{-# LINE 1206 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "swapchain" VkBindImageMemorySwapchainInfoKHR =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "swapchain" VkBindImageMemorySwapchainInfoKHR where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 1222 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "swapchain" VkBindImageMemorySwapchainInfoKHR where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 1232 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "imageIndex" VkBindImageMemorySwapchainInfoKHR where
        type FieldType "imageIndex" VkBindImageMemorySwapchainInfoKHR =
             Word32
        type FieldOptional "imageIndex" VkBindImageMemorySwapchainInfoKHR =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "imageIndex" VkBindImageMemorySwapchainInfoKHR =
             (24)
{-# LINE 1241 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "imageIndex" VkBindImageMemorySwapchainInfoKHR =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "imageIndex" VkBindImageMemorySwapchainInfoKHR where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 1257 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "imageIndex" VkBindImageMemorySwapchainInfoKHR where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 1267 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "planeAspect" VkBindImagePlaneMemoryInfo where
        type FieldType "planeAspect" VkBindImagePlaneMemoryInfo =
             VkImageAspectFlagBits
        type FieldOptional "planeAspect" VkBindImagePlaneMemoryInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "planeAspect" VkBindImagePlaneMemoryInfo =
             (16)
{-# LINE 1414 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "planeAspect" VkBindImagePlaneMemoryInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "planeAspect" VkBindImagePlaneMemoryInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 1429 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "planeAspect" VkBindImagePlaneMemoryInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 1439 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

-- | Alias for `VkBindImagePlaneMemoryInfo`
type VkBindImagePlaneMemoryInfoKHR = VkBindImagePlaneMemoryInfo

-- | > typedef struct VkBindSparseInfo {
--   >     VkStructureType sType;
--   >     const void*            pNext;
--   >     uint32_t               waitSemaphoreCount;
--   >     const VkSemaphore*     pWaitSemaphores;
--   >     uint32_t               bufferBindCount;
--   >     const VkSparseBufferMemoryBindInfo* pBufferBinds;
--   >     uint32_t               imageOpaqueBindCount;
--   >     const VkSparseImageOpaqueMemoryBindInfo* pImageOpaqueBinds;
--   >     uint32_t               imageBindCount;
--   >     const VkSparseImageMemoryBindInfo* pImageBinds;
--   >     uint32_t               signalSemaphoreCount;
--   >     const VkSemaphore*     pSignalSemaphores;
--   > } VkBindSparseInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkBindSparseInfo VkBindSparseInfo registry at www.khronos.org>
data VkBindSparseInfo = VkBindSparseInfo# Addr# ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkBindSparseInfo where
        type StructFields VkBindSparseInfo =
             '["sType", "pNext", "waitSemaphoreCount", "pWaitSemaphores", -- ' closing tick for hsc2hs
               "bufferBindCount", "pBufferBinds", "imageOpaqueBindCount",
               "pImageOpaqueBinds", "imageBindCount", "pImageBinds",
               "signalSemaphoreCount", "pSignalSemaphores"]
        type CUnionType VkBindSparseInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkBindSparseInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkBindSparseInfo = '[] -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

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

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "waitSemaphoreCount" VkBindSparseInfo where
        type FieldType "waitSemaphoreCount" VkBindSparseInfo = Word32
        type FieldOptional "waitSemaphoreCount" VkBindSparseInfo = 'True -- ' closing tick for hsc2hs
        type FieldOffset "waitSemaphoreCount" VkBindSparseInfo =
             (16)
{-# LINE 1589 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "waitSemaphoreCount" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

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

instance {-# OVERLAPPING #-}
         CanReadField "waitSemaphoreCount" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (16))
{-# LINE 1604 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "waitSemaphoreCount" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (16)
{-# LINE 1614 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pWaitSemaphores" VkBindSparseInfo where
        type FieldType "pWaitSemaphores" VkBindSparseInfo = Ptr VkSemaphore
        type FieldOptional "pWaitSemaphores" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pWaitSemaphores" VkBindSparseInfo =
             (24)
{-# LINE 1621 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "pWaitSemaphores" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "pWaitSemaphores" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (24))
{-# LINE 1636 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "pWaitSemaphores" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (24)
{-# LINE 1646 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "bufferBindCount" VkBindSparseInfo where
        type FieldType "bufferBindCount" VkBindSparseInfo = Word32
        type FieldOptional "bufferBindCount" VkBindSparseInfo = 'True -- ' closing tick for hsc2hs
        type FieldOffset "bufferBindCount" VkBindSparseInfo =
             (32)
{-# LINE 1653 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "bufferBindCount" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

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

instance {-# OVERLAPPING #-}
         CanReadField "bufferBindCount" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (32))
{-# LINE 1668 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "bufferBindCount" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (32)
{-# LINE 1678 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pBufferBinds" VkBindSparseInfo where
        type FieldType "pBufferBinds" VkBindSparseInfo =
             Ptr VkSparseBufferMemoryBindInfo
        type FieldOptional "pBufferBinds" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pBufferBinds" VkBindSparseInfo =
             (40)
{-# LINE 1686 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "pBufferBinds" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "pBufferBinds" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (40))
{-# LINE 1700 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "pBufferBinds" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (40)
{-# LINE 1710 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "imageOpaqueBindCount" VkBindSparseInfo where
        type FieldType "imageOpaqueBindCount" VkBindSparseInfo = Word32
        type FieldOptional "imageOpaqueBindCount" VkBindSparseInfo = 'True -- ' closing tick for hsc2hs
        type FieldOffset "imageOpaqueBindCount" VkBindSparseInfo =
             (48)
{-# LINE 1717 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "imageOpaqueBindCount" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

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

instance {-# OVERLAPPING #-}
         CanReadField "imageOpaqueBindCount" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (48))
{-# LINE 1732 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "imageOpaqueBindCount" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (48)
{-# LINE 1742 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pImageOpaqueBinds" VkBindSparseInfo where
        type FieldType "pImageOpaqueBinds" VkBindSparseInfo =
             Ptr VkSparseImageOpaqueMemoryBindInfo
        type FieldOptional "pImageOpaqueBinds" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pImageOpaqueBinds" VkBindSparseInfo =
             (56)
{-# LINE 1750 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "pImageOpaqueBinds" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "pImageOpaqueBinds" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (56))
{-# LINE 1765 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "pImageOpaqueBinds" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (56)
{-# LINE 1775 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "imageBindCount" VkBindSparseInfo where
        type FieldType "imageBindCount" VkBindSparseInfo = Word32
        type FieldOptional "imageBindCount" VkBindSparseInfo = 'True -- ' closing tick for hsc2hs
        type FieldOffset "imageBindCount" VkBindSparseInfo =
             (64)
{-# LINE 1782 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "imageBindCount" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

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

instance {-# OVERLAPPING #-}
         CanReadField "imageBindCount" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (64))
{-# LINE 1797 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "imageBindCount" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (64)
{-# LINE 1807 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pImageBinds" VkBindSparseInfo where
        type FieldType "pImageBinds" VkBindSparseInfo =
             Ptr VkSparseImageMemoryBindInfo
        type FieldOptional "pImageBinds" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pImageBinds" VkBindSparseInfo =
             (72)
{-# LINE 1815 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "pImageBinds" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "pImageBinds" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (72))
{-# LINE 1829 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "pImageBinds" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (72)
{-# LINE 1839 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "signalSemaphoreCount" VkBindSparseInfo where
        type FieldType "signalSemaphoreCount" VkBindSparseInfo = Word32
        type FieldOptional "signalSemaphoreCount" VkBindSparseInfo = 'True -- ' closing tick for hsc2hs
        type FieldOffset "signalSemaphoreCount" VkBindSparseInfo =
             (80)
{-# LINE 1846 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "signalSemaphoreCount" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = True

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

instance {-# OVERLAPPING #-}
         CanReadField "signalSemaphoreCount" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (80))
{-# LINE 1861 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "signalSemaphoreCount" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (80)
{-# LINE 1871 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pSignalSemaphores" VkBindSparseInfo where
        type FieldType "pSignalSemaphores" VkBindSparseInfo =
             Ptr VkSemaphore
        type FieldOptional "pSignalSemaphores" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pSignalSemaphores" VkBindSparseInfo =
             (88)
{-# LINE 1879 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}
        type FieldIsArray "pSignalSemaphores" VkBindSparseInfo = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional = False

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

instance {-# OVERLAPPING #-}
         CanReadField "pSignalSemaphores" VkBindSparseInfo where
        {-# NOINLINE getField #-}
        getField x
          = unsafeDupablePerformIO
              (peekByteOff (unsafePtr x) (88))
{-# LINE 1894 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

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

instance {-# OVERLAPPING #-}
         CanWriteField "pSignalSemaphores" VkBindSparseInfo where
        {-# INLINE writeField #-}
        writeField p
          = pokeByteOff p (88)
{-# LINE 1904 "src-gen/Graphics/Vulkan/Types/Struct/Bind.hsc" #-}

instance Show VkBindSparseInfo where
        showsPrec d x
          = showString "VkBindSparseInfo {" .
              showString "sType = " .
                showsPrec d (getField @"sType" x) .
                  showString ", " .
                    showString "pNext = " .
                      showsPrec d (getField @"pNext" x) .
                        showString ", " .
                          showString "waitSemaphoreCount = " .
                            showsPrec d (getField @"waitSemaphoreCount" x) .
                              showString ", " .
                                showString "pWaitSemaphores = " .
                                  showsPrec d (getField @"pWaitSemaphores" x) .
                                    showString ", " .
                                      showString "bufferBindCount = " .
                                        showsPrec d (getField @"bufferBindCount" x) .
                                          showString ", " .
                                            showString "pBufferBinds = " .
                                              showsPrec d (getField @"pBufferBinds" x) .
                                                showString ", " .
                                                  showString "imageOpaqueBindCount = " .
                                                    showsPrec d (getField @"imageOpaqueBindCount" x)
                                                      .
                                                      showString ", " .
                                                        showString "pImageOpaqueBinds = " .
                                                          showsPrec d
                                                            (getField @"pImageOpaqueBinds" x)
                                                            .
                                                            showString ", " .
                                                              showString "imageBindCount = " .
                                                                showsPrec d
                                                                  (getField @"imageBindCount" x)
                                                                  .
                                                                  showString ", " .
                                                                    showString "pImageBinds = " .
                                                                      showsPrec d
                                                                        (getField @"pImageBinds" x)
                                                                        .
                                                                        showString ", " .
                                                                          showString
                                                                            "signalSemaphoreCount = "
                                                                            .
                                                                            showsPrec d
                                                                              (getField
                                                                                 @"signalSemaphoreCount"
                                                                                 x)
                                                                              .
                                                                              showString ", " .
                                                                                showString
                                                                                  "pSignalSemaphores = "
                                                                                  .
                                                                                  showsPrec d
                                                                                    (getField
                                                                                       @"pSignalSemaphores"
                                                                                       x)
                                                                                    . showChar '}'