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


{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
module Graphics.Vulkan.Types.Struct.Device
       (VkDeviceCreateInfo(..), VkDeviceEventInfoEXT(..),
        VkDeviceGeneratedCommandsFeaturesNVX(..),
        VkDeviceGeneratedCommandsLimitsNVX(..),
        VkDeviceGroupBindSparseInfo(..), VkDeviceGroupBindSparseInfoKHR,
        VkDeviceGroupCommandBufferBeginInfo(..),
        VkDeviceGroupCommandBufferBeginInfoKHR,
        VkDeviceGroupDeviceCreateInfo(..),
        VkDeviceGroupDeviceCreateInfoKHR,
        VkDeviceGroupPresentCapabilitiesKHR(..),
        VkDeviceGroupPresentInfoKHR(..),
        VkDeviceGroupRenderPassBeginInfo(..),
        VkDeviceGroupRenderPassBeginInfoKHR, VkDeviceGroupSubmitInfo(..),
        VkDeviceGroupSubmitInfoKHR,
        VkDeviceGroupSwapchainCreateInfoKHR(..),
        VkDeviceQueueCreateInfo(..),
        VkDeviceQueueGlobalPriorityCreateInfoEXT(..),
        VkDeviceQueueInfo2(..))
       where
import           Foreign.Storable                                    (Storable (..))
import           GHC.Base                                            (Addr#,
                                                                      ByteArray#,
                                                                      Proxy#,
                                                                      byteArrayContents#,
                                                                      plusAddr#,
                                                                      proxy#)
import           GHC.TypeLits                                        (KnownNat,
                                                                      natVal') -- ' closing tick for hsc2hs
import           Graphics.Vulkan.Constants                           (VK_MAX_DEVICE_GROUP_SIZE,
                                                                      pattern VK_MAX_DEVICE_GROUP_SIZE)
import           Graphics.Vulkan.Marshal
import           Graphics.Vulkan.Marshal.Internal
import           Graphics.Vulkan.Types.BaseTypes                     (VkBool32)
import           Graphics.Vulkan.Types.Bitmasks                      (VkDeviceCreateFlags)
import           Graphics.Vulkan.Types.Enum.Device                   (VkDeviceEventTypeEXT,
                                                                      VkDeviceGroupPresentModeFlagBitsKHR,
                                                                      VkDeviceGroupPresentModeFlagsKHR,
                                                                      VkDeviceQueueCreateFlags)
import           Graphics.Vulkan.Types.Enum.Queue                    (VkQueueGlobalPriorityEXT)
import           Graphics.Vulkan.Types.Enum.StructureType            (VkStructureType)
import           Graphics.Vulkan.Types.Handles                       (VkPhysicalDevice)
import           Graphics.Vulkan.Types.Struct.Bind                   (VkBindSparseInfo)
import           Graphics.Vulkan.Types.Struct.Command                (VkCommandBufferBeginInfo)
import           Graphics.Vulkan.Types.Struct.PhysicalDeviceFeatures (VkPhysicalDeviceFeatures)
import           Graphics.Vulkan.Types.Struct.Present                (VkPresentInfoKHR)
import           Graphics.Vulkan.Types.Struct.Rect                   (VkRect2D)
import           Graphics.Vulkan.Types.Struct.RenderPass             (VkRenderPassBeginInfo)
import           Graphics.Vulkan.Types.Struct.SubmitInfo             (VkSubmitInfo)
import           Graphics.Vulkan.Types.Struct.SwapchainC             (VkSwapchainCreateInfoKHR)
import           System.IO.Unsafe                                    (unsafeDupablePerformIO)

-- | > typedef struct VkDeviceCreateInfo {
--   >     VkStructureType sType;
--   >     const void*     pNext;
--   >     VkDeviceCreateFlags    flags;
--   >     uint32_t        queueCreateInfoCount;
--   >     const VkDeviceQueueCreateInfo* pQueueCreateInfos;
--   >     uint32_t               enabledLayerCount;
--   >     const char* const*      ppEnabledLayerNames;
--   >     uint32_t               enabledExtensionCount;
--   >     const char* const*      ppEnabledExtensionNames;
--   >     const VkPhysicalDeviceFeatures* pEnabledFeatures;
--   > } VkDeviceCreateInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkDeviceCreateInfo VkDeviceCreateInfo registry at www.khronos.org>
data VkDeviceCreateInfo = VkDeviceCreateInfo# Addr# ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

instance Storable VkDeviceCreateInfo where
        sizeOf :: VkDeviceCreateInfo -> Int
sizeOf ~VkDeviceCreateInfo
_ = (Int
72)
{-# LINE 95 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDeviceCreateInfo where
        type StructFields VkDeviceCreateInfo =
             '["sType", "pNext", "flags", "queueCreateInfoCount", -- ' closing tick for hsc2hs
               "pQueueCreateInfos", "enabledLayerCount", "ppEnabledLayerNames",
               "enabledExtensionCount", "ppEnabledExtensionNames",
               "pEnabledFeatures"]
        type CUnionType VkDeviceCreateInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDeviceCreateInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDeviceCreateInfo = '[] -- ' closing tick for hsc2hs

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceCreateInfo
-> FieldType "sType" VkDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceCreateInfo
p (Int
0)
{-# LINE 159 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceCreateInfo
-> FieldType "pNext" VkDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceCreateInfo
p (Int
8)
{-# LINE 190 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceCreateInfo
-> FieldType "flags" VkDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> VkDeviceCreateFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceCreateInfo
p (Int
16)
{-# LINE 221 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "queueCreateInfoCount" VkDeviceCreateInfo where
        type FieldType "queueCreateInfoCount" VkDeviceCreateInfo = Word32
        type FieldOptional "queueCreateInfoCount" VkDeviceCreateInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "queueCreateInfoCount" VkDeviceCreateInfo =
             (20)
{-# LINE 229 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "queueCreateInfoCount" VkDeviceCreateInfo =
             'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "queueCreateInfoCount" VkDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceCreateInfo
-> FieldType "queueCreateInfoCount" VkDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceCreateInfo
p (Int
20)
{-# LINE 255 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pQueueCreateInfos" VkDeviceCreateInfo where
        type FieldType "pQueueCreateInfos" VkDeviceCreateInfo =
             Ptr VkDeviceQueueCreateInfo
        type FieldOptional "pQueueCreateInfos" VkDeviceCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pQueueCreateInfos" VkDeviceCreateInfo =
             (24)
{-# LINE 263 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "pQueueCreateInfos" VkDeviceCreateInfo = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceCreateInfo
-> IO (FieldType "pQueueCreateInfos" VkDeviceCreateInfo)
readField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> IO (Ptr VkDeviceQueueCreateInfo)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceCreateInfo
p (Int
24)
{-# LINE 282 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pQueueCreateInfos" VkDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceCreateInfo
-> FieldType "pQueueCreateInfos" VkDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo
-> Int -> Ptr VkDeviceQueueCreateInfo -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceCreateInfo
p (Int
24)
{-# LINE 288 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "enabledLayerCount" VkDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceCreateInfo
-> FieldType "enabledLayerCount" VkDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceCreateInfo
p (Int
32)
{-# LINE 320 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "ppEnabledLayerNames" VkDeviceCreateInfo where
        type FieldType "ppEnabledLayerNames" VkDeviceCreateInfo =
             Ptr CString
        type FieldOptional "ppEnabledLayerNames" VkDeviceCreateInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "ppEnabledLayerNames" VkDeviceCreateInfo =
             (40)
{-# LINE 329 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "ppEnabledLayerNames" VkDeviceCreateInfo = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceCreateInfo
-> IO (FieldType "ppEnabledLayerNames" VkDeviceCreateInfo)
readField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> IO (Ptr CString)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceCreateInfo
p (Int
40)
{-# LINE 348 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "ppEnabledLayerNames" VkDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceCreateInfo
-> FieldType "ppEnabledLayerNames" VkDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> Ptr CString -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceCreateInfo
p (Int
40)
{-# LINE 354 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "enabledExtensionCount" VkDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceCreateInfo
-> FieldType "enabledExtensionCount" VkDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceCreateInfo
p (Int
48)
{-# LINE 388 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "ppEnabledExtensionNames" VkDeviceCreateInfo where
        type FieldType "ppEnabledExtensionNames" VkDeviceCreateInfo =
             Ptr CString
        type FieldOptional "ppEnabledExtensionNames" VkDeviceCreateInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "ppEnabledExtensionNames" VkDeviceCreateInfo =
             (56)
{-# LINE 397 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "ppEnabledExtensionNames" VkDeviceCreateInfo =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceCreateInfo
-> IO (FieldType "ppEnabledExtensionNames" VkDeviceCreateInfo)
readField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> IO (Ptr CString)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceCreateInfo
p (Int
56)
{-# LINE 417 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "ppEnabledExtensionNames" VkDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceCreateInfo
-> FieldType "ppEnabledExtensionNames" VkDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceCreateInfo
p
          = Ptr VkDeviceCreateInfo -> Int -> Ptr CString -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceCreateInfo
p (Int
56)
{-# LINE 423 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pEnabledFeatures" VkDeviceCreateInfo where
        type FieldType "pEnabledFeatures" VkDeviceCreateInfo =
             Ptr VkPhysicalDeviceFeatures
        type FieldOptional "pEnabledFeatures" VkDeviceCreateInfo = 'True -- ' closing tick for hsc2hs
        type FieldOffset "pEnabledFeatures" VkDeviceCreateInfo =
             (64)
{-# LINE 431 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "pEnabledFeatures" VkDeviceCreateInfo = 'False -- ' closing tick for hsc2hs

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

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

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

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

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

instance Show VkDeviceCreateInfo where
        showsPrec :: Int -> VkDeviceCreateInfo -> ShowS
showsPrec Int
d VkDeviceCreateInfo
x
          = String -> ShowS
showString String
"VkDeviceCreateInfo {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDeviceCreateInfo -> FieldType "sType" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkDeviceCreateInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDeviceCreateInfo -> FieldType "pNext" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkDeviceCreateInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"flags = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkDeviceCreateFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDeviceCreateInfo -> FieldType "flags" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"flags" VkDeviceCreateInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"queueCreateInfoCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDeviceCreateInfo
-> FieldType "queueCreateInfoCount" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"queueCreateInfoCount" VkDeviceCreateInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"pQueueCreateInfos = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Ptr VkDeviceQueueCreateInfo -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDeviceCreateInfo
-> FieldType "pQueueCreateInfos" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pQueueCreateInfos" VkDeviceCreateInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"enabledLayerCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDeviceCreateInfo
-> FieldType "enabledLayerCount" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"enabledLayerCount" VkDeviceCreateInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                  String -> ShowS
showString String
"ppEnabledLayerNames = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> Ptr CString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDeviceCreateInfo
-> FieldType "ppEnabledLayerNames" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"ppEnabledLayerNames" VkDeviceCreateInfo
x)
                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                      String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                        String -> ShowS
showString String
"enabledExtensionCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                            (VkDeviceCreateInfo
-> FieldType "enabledExtensionCount" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"enabledExtensionCount" VkDeviceCreateInfo
x)
                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                            String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                              String -> ShowS
showString
                                                                String
"ppEnabledExtensionNames = "
                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                Int -> Ptr CString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                  (VkDeviceCreateInfo
-> FieldType "ppEnabledExtensionNames" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                     @"ppEnabledExtensionNames"
                                                                     VkDeviceCreateInfo
x)
                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                    String -> ShowS
showString String
"pEnabledFeatures = "
                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                      Int -> Ptr VkPhysicalDeviceFeatures -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                        (VkDeviceCreateInfo
-> FieldType "pEnabledFeatures" VkDeviceCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                           @"pEnabledFeatures"
                                                                           VkDeviceCreateInfo
x)
                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceEventInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceEventInfoEXT
-> FieldType "sType" VkDeviceEventInfoEXT -> IO ()
writeField Ptr VkDeviceEventInfoEXT
p
          = Ptr VkDeviceEventInfoEXT -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceEventInfoEXT
p (Int
0)
{-# LINE 588 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceEventInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceEventInfoEXT
-> FieldType "pNext" VkDeviceEventInfoEXT -> IO ()
writeField Ptr VkDeviceEventInfoEXT
p
          = Ptr VkDeviceEventInfoEXT -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceEventInfoEXT
p (Int
8)
{-# LINE 619 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "deviceEvent" VkDeviceEventInfoEXT where
        type FieldType "deviceEvent" VkDeviceEventInfoEXT =
             VkDeviceEventTypeEXT
        type FieldOptional "deviceEvent" VkDeviceEventInfoEXT = 'False -- ' closing tick for hsc2hs
        type FieldOffset "deviceEvent" VkDeviceEventInfoEXT =
             (16)
{-# LINE 627 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "deviceEvent" VkDeviceEventInfoEXT = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceEventInfoEXT
-> IO (FieldType "deviceEvent" VkDeviceEventInfoEXT)
readField Ptr VkDeviceEventInfoEXT
p
          = Ptr VkDeviceEventInfoEXT -> Int -> IO VkDeviceEventTypeEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceEventInfoEXT
p (Int
16)
{-# LINE 646 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "deviceEvent" VkDeviceEventInfoEXT where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceEventInfoEXT
-> FieldType "deviceEvent" VkDeviceEventInfoEXT -> IO ()
writeField Ptr VkDeviceEventInfoEXT
p
          = Ptr VkDeviceEventInfoEXT -> Int -> VkDeviceEventTypeEXT -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceEventInfoEXT
p (Int
16)
{-# LINE 652 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGeneratedCommandsFeaturesNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGeneratedCommandsFeaturesNVX
-> FieldType "sType" VkDeviceGeneratedCommandsFeaturesNVX -> IO ()
writeField Ptr VkDeviceGeneratedCommandsFeaturesNVX
p
          = Ptr VkDeviceGeneratedCommandsFeaturesNVX
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGeneratedCommandsFeaturesNVX
p (Int
0)
{-# LINE 761 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGeneratedCommandsFeaturesNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGeneratedCommandsFeaturesNVX
-> FieldType "pNext" VkDeviceGeneratedCommandsFeaturesNVX -> IO ()
writeField Ptr VkDeviceGeneratedCommandsFeaturesNVX
p
          = Ptr VkDeviceGeneratedCommandsFeaturesNVX
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGeneratedCommandsFeaturesNVX
p (Int
8)
{-# LINE 796 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

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

instance Show VkDeviceGeneratedCommandsFeaturesNVX where
        showsPrec :: Int -> VkDeviceGeneratedCommandsFeaturesNVX -> ShowS
showsPrec Int
d VkDeviceGeneratedCommandsFeaturesNVX
x
          = String -> ShowS
showString String
"VkDeviceGeneratedCommandsFeaturesNVX {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDeviceGeneratedCommandsFeaturesNVX
-> FieldType "sType" VkDeviceGeneratedCommandsFeaturesNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkDeviceGeneratedCommandsFeaturesNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkDeviceGeneratedCommandsFeaturesNVX
-> FieldType "pNext" VkDeviceGeneratedCommandsFeaturesNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkDeviceGeneratedCommandsFeaturesNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"computeBindingPointSupport = " 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 (VkDeviceGeneratedCommandsFeaturesNVX
-> FieldType
     "computeBindingPointSupport" VkDeviceGeneratedCommandsFeaturesNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"computeBindingPointSupport" VkDeviceGeneratedCommandsFeaturesNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              Char -> ShowS
showChar Char
'}'

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDeviceGeneratedCommandsLimitsNVX where
        type StructFields VkDeviceGeneratedCommandsLimitsNVX =
             '["sType", "pNext", "maxIndirectCommandsLayoutTokenCount", -- ' closing tick for hsc2hs
               "maxObjectEntryCounts", "minSequenceCountBufferOffsetAlignment",
               "minSequenceIndexBufferOffsetAlignment",
               "minCommandsTokenBufferOffsetAlignment"]
        type CUnionType VkDeviceGeneratedCommandsLimitsNVX = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDeviceGeneratedCommandsLimitsNVX = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDeviceGeneratedCommandsLimitsNVX = '[] -- ' closing tick for hsc2hs

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGeneratedCommandsLimitsNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGeneratedCommandsLimitsNVX
-> FieldType "sType" VkDeviceGeneratedCommandsLimitsNVX -> IO ()
writeField Ptr VkDeviceGeneratedCommandsLimitsNVX
p
          = Ptr VkDeviceGeneratedCommandsLimitsNVX
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGeneratedCommandsLimitsNVX
p (Int
0)
{-# LINE 957 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGeneratedCommandsLimitsNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGeneratedCommandsLimitsNVX
-> FieldType "pNext" VkDeviceGeneratedCommandsLimitsNVX -> IO ()
writeField Ptr VkDeviceGeneratedCommandsLimitsNVX
p
          = Ptr VkDeviceGeneratedCommandsLimitsNVX -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGeneratedCommandsLimitsNVX
p (Int
8)
{-# LINE 992 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "maxObjectEntryCounts" VkDeviceGeneratedCommandsLimitsNVX
         where
        type FieldType "maxObjectEntryCounts"
               VkDeviceGeneratedCommandsLimitsNVX
             = Word32
        type FieldOptional "maxObjectEntryCounts"
               VkDeviceGeneratedCommandsLimitsNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxObjectEntryCounts"
               VkDeviceGeneratedCommandsLimitsNVX
             =
             (20)
{-# LINE 1052 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "maxObjectEntryCounts"
               VkDeviceGeneratedCommandsLimitsNVX
             = 'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "maxObjectEntryCounts"
           VkDeviceGeneratedCommandsLimitsNVX
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGeneratedCommandsLimitsNVX
-> FieldType
     "maxObjectEntryCounts" VkDeviceGeneratedCommandsLimitsNVX
-> IO ()
writeField Ptr VkDeviceGeneratedCommandsLimitsNVX
p
          = Ptr VkDeviceGeneratedCommandsLimitsNVX -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGeneratedCommandsLimitsNVX
p (Int
20)
{-# LINE 1083 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "minSequenceCountBufferOffsetAlignment"
           VkDeviceGeneratedCommandsLimitsNVX
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGeneratedCommandsLimitsNVX
-> FieldType
     "minSequenceCountBufferOffsetAlignment"
     VkDeviceGeneratedCommandsLimitsNVX
-> IO ()
writeField Ptr VkDeviceGeneratedCommandsLimitsNVX
p
          = Ptr VkDeviceGeneratedCommandsLimitsNVX -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGeneratedCommandsLimitsNVX
p (Int
24)
{-# LINE 1129 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minSequenceIndexBufferOffsetAlignment"
           VkDeviceGeneratedCommandsLimitsNVX
         where
        type FieldType "minSequenceIndexBufferOffsetAlignment"
               VkDeviceGeneratedCommandsLimitsNVX
             = Word32
        type FieldOptional "minSequenceIndexBufferOffsetAlignment"
               VkDeviceGeneratedCommandsLimitsNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minSequenceIndexBufferOffsetAlignment"
               VkDeviceGeneratedCommandsLimitsNVX
             =
             (28)
{-# LINE 1144 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "minSequenceIndexBufferOffsetAlignment"
               VkDeviceGeneratedCommandsLimitsNVX
             = 'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "minSequenceIndexBufferOffsetAlignment"
           VkDeviceGeneratedCommandsLimitsNVX
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGeneratedCommandsLimitsNVX
-> FieldType
     "minSequenceIndexBufferOffsetAlignment"
     VkDeviceGeneratedCommandsLimitsNVX
-> IO ()
writeField Ptr VkDeviceGeneratedCommandsLimitsNVX
p
          = Ptr VkDeviceGeneratedCommandsLimitsNVX -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGeneratedCommandsLimitsNVX
p (Int
28)
{-# LINE 1175 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minCommandsTokenBufferOffsetAlignment"
           VkDeviceGeneratedCommandsLimitsNVX
         where
        type FieldType "minCommandsTokenBufferOffsetAlignment"
               VkDeviceGeneratedCommandsLimitsNVX
             = Word32
        type FieldOptional "minCommandsTokenBufferOffsetAlignment"
               VkDeviceGeneratedCommandsLimitsNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minCommandsTokenBufferOffsetAlignment"
               VkDeviceGeneratedCommandsLimitsNVX
             =
             (32)
{-# LINE 1190 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "minCommandsTokenBufferOffsetAlignment"
               VkDeviceGeneratedCommandsLimitsNVX
             = 'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "minCommandsTokenBufferOffsetAlignment"
           VkDeviceGeneratedCommandsLimitsNVX
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGeneratedCommandsLimitsNVX
-> FieldType
     "minCommandsTokenBufferOffsetAlignment"
     VkDeviceGeneratedCommandsLimitsNVX
-> IO ()
writeField Ptr VkDeviceGeneratedCommandsLimitsNVX
p
          = Ptr VkDeviceGeneratedCommandsLimitsNVX -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGeneratedCommandsLimitsNVX
p (Int
32)
{-# LINE 1221 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDeviceGroupBindSparseInfo where
        type StructFields VkDeviceGroupBindSparseInfo =
             '["sType", "pNext", "resourceDeviceIndex", "memoryDeviceIndex"] -- ' closing tick for hsc2hs
        type CUnionType VkDeviceGroupBindSparseInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDeviceGroupBindSparseInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDeviceGroupBindSparseInfo =
             '[VkBindSparseInfo] -- ' closing tick for hsc2hs

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGroupBindSparseInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupBindSparseInfo
-> FieldType "sType" VkDeviceGroupBindSparseInfo -> IO ()
writeField Ptr VkDeviceGroupBindSparseInfo
p
          = Ptr VkDeviceGroupBindSparseInfo -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupBindSparseInfo
p (Int
0)
{-# LINE 1349 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGroupBindSparseInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupBindSparseInfo
-> FieldType "pNext" VkDeviceGroupBindSparseInfo -> IO ()
writeField Ptr VkDeviceGroupBindSparseInfo
p
          = Ptr VkDeviceGroupBindSparseInfo -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupBindSparseInfo
p (Int
8)
{-# LINE 1381 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "memoryDeviceIndex" VkDeviceGroupBindSparseInfo where
        type FieldType "memoryDeviceIndex" VkDeviceGroupBindSparseInfo =
             Word32
        type FieldOptional "memoryDeviceIndex" VkDeviceGroupBindSparseInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "memoryDeviceIndex" VkDeviceGroupBindSparseInfo =
             (20)
{-# LINE 1429 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "memoryDeviceIndex" VkDeviceGroupBindSparseInfo =
             'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "memoryDeviceIndex" VkDeviceGroupBindSparseInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupBindSparseInfo
-> FieldType "memoryDeviceIndex" VkDeviceGroupBindSparseInfo
-> IO ()
writeField Ptr VkDeviceGroupBindSparseInfo
p
          = Ptr VkDeviceGroupBindSparseInfo -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupBindSparseInfo
p (Int
20)
{-# LINE 1455 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

-- | Alias for `VkDeviceGroupBindSparseInfo`
type VkDeviceGroupBindSparseInfoKHR = VkDeviceGroupBindSparseInfo

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGroupCommandBufferBeginInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupCommandBufferBeginInfo
-> FieldType "sType" VkDeviceGroupCommandBufferBeginInfo -> IO ()
writeField Ptr VkDeviceGroupCommandBufferBeginInfo
p
          = Ptr VkDeviceGroupCommandBufferBeginInfo
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupCommandBufferBeginInfo
p (Int
0)
{-# LINE 1570 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGroupCommandBufferBeginInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupCommandBufferBeginInfo
-> FieldType "pNext" VkDeviceGroupCommandBufferBeginInfo -> IO ()
writeField Ptr VkDeviceGroupCommandBufferBeginInfo
p
          = Ptr VkDeviceGroupCommandBufferBeginInfo -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupCommandBufferBeginInfo
p (Int
8)
{-# LINE 1605 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

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

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

-- | Alias for `VkDeviceGroupCommandBufferBeginInfo`
type VkDeviceGroupCommandBufferBeginInfoKHR =
     VkDeviceGroupCommandBufferBeginInfo

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGroupDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupDeviceCreateInfo
-> FieldType "sType" VkDeviceGroupDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceGroupDeviceCreateInfo
p
          = Ptr VkDeviceGroupDeviceCreateInfo
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupDeviceCreateInfo
p (Int
0)
{-# LINE 1751 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGroupDeviceCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupDeviceCreateInfo
-> FieldType "pNext" VkDeviceGroupDeviceCreateInfo -> IO ()
writeField Ptr VkDeviceGroupDeviceCreateInfo
p
          = Ptr VkDeviceGroupDeviceCreateInfo -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupDeviceCreateInfo
p (Int
8)
{-# LINE 1783 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "pPhysicalDevices" VkDeviceGroupDeviceCreateInfo where
        type FieldType "pPhysicalDevices" VkDeviceGroupDeviceCreateInfo =
             Ptr VkPhysicalDevice
        type FieldOptional "pPhysicalDevices" VkDeviceGroupDeviceCreateInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pPhysicalDevices" VkDeviceGroupDeviceCreateInfo =
             (24)
{-# LINE 1833 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "pPhysicalDevices" VkDeviceGroupDeviceCreateInfo
             = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceGroupDeviceCreateInfo
-> IO (FieldType "pPhysicalDevices" VkDeviceGroupDeviceCreateInfo)
readField Ptr VkDeviceGroupDeviceCreateInfo
p
          = Ptr VkDeviceGroupDeviceCreateInfo
-> Int -> IO (Ptr VkPhysicalDevice)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceGroupDeviceCreateInfo
p (Int
24)
{-# LINE 1853 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pPhysicalDevices" VkDeviceGroupDeviceCreateInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupDeviceCreateInfo
-> FieldType "pPhysicalDevices" VkDeviceGroupDeviceCreateInfo
-> IO ()
writeField Ptr VkDeviceGroupDeviceCreateInfo
p
          = Ptr VkDeviceGroupDeviceCreateInfo
-> Int -> Ptr VkPhysicalDevice -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupDeviceCreateInfo
p (Int
24)
{-# LINE 1860 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

-- | Alias for `VkDeviceGroupDeviceCreateInfo`
type VkDeviceGroupDeviceCreateInfoKHR =
     VkDeviceGroupDeviceCreateInfo

-- | > typedef struct VkDeviceGroupPresentCapabilitiesKHR {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     uint32_t                         presentMask[VK_MAX_DEVICE_GROUP_SIZE];
--   >     VkDeviceGroupPresentModeFlagsKHR modes;
--   > } VkDeviceGroupPresentCapabilitiesKHR;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkDeviceGroupPresentCapabilitiesKHR VkDeviceGroupPresentCapabilitiesKHR registry at www.khronos.org>
data VkDeviceGroupPresentCapabilitiesKHR = VkDeviceGroupPresentCapabilitiesKHR# Addr#
                                                                                ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

instance Storable VkDeviceGroupPresentCapabilitiesKHR where
        sizeOf :: VkDeviceGroupPresentCapabilitiesKHR -> Int
sizeOf ~VkDeviceGroupPresentCapabilitiesKHR
_ = (Int
152)
{-# LINE 1907 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDeviceGroupPresentCapabilitiesKHR where
        type StructFields VkDeviceGroupPresentCapabilitiesKHR =
             '["sType", "pNext", "presentMask", "modes"] -- ' closing tick for hsc2hs
        type CUnionType VkDeviceGroupPresentCapabilitiesKHR = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDeviceGroupPresentCapabilitiesKHR = 'True -- ' closing tick for hsc2hs
        type StructExtends VkDeviceGroupPresentCapabilitiesKHR = '[] -- ' closing tick for hsc2hs

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGroupPresentCapabilitiesKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupPresentCapabilitiesKHR
-> FieldType "sType" VkDeviceGroupPresentCapabilitiesKHR -> IO ()
writeField Ptr VkDeviceGroupPresentCapabilitiesKHR
p
          = Ptr VkDeviceGroupPresentCapabilitiesKHR
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupPresentCapabilitiesKHR
p (Int
0)
{-# LINE 1976 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGroupPresentCapabilitiesKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupPresentCapabilitiesKHR
-> FieldType "pNext" VkDeviceGroupPresentCapabilitiesKHR -> IO ()
writeField Ptr VkDeviceGroupPresentCapabilitiesKHR
p
          = Ptr VkDeviceGroupPresentCapabilitiesKHR -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupPresentCapabilitiesKHR
p (Int
8)
{-# LINE 2011 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

        {-# SPECIALISE instance
                       CanReadFieldArray "presentMask" 1
                         VkDeviceGroupPresentCapabilitiesKHR
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "presentMask" 2
                         VkDeviceGroupPresentCapabilitiesKHR
                       #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "presentMask" 3
                         VkDeviceGroupPresentCapabilitiesKHR
                       #-}
        type FieldArrayLength "presentMask"
               VkDeviceGroupPresentCapabilitiesKHR
             = VK_MAX_DEVICE_GROUP_SIZE

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength :: Int
fieldArrayLength = Int
forall a. (Num a, Eq a) => a
VK_MAX_DEVICE_GROUP_SIZE

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

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkDeviceGroupPresentCapabilitiesKHR
-> IO (FieldType "presentMask" VkDeviceGroupPresentCapabilitiesKHR)
readFieldArray Ptr VkDeviceGroupPresentCapabilitiesKHR
p
          = Ptr VkDeviceGroupPresentCapabilitiesKHR -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceGroupPresentCapabilitiesKHR
p
              ((Int
16)
{-# LINE 2079 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

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

        {-# SPECIALISE instance
                       CanWriteFieldArray "presentMask" 1
                         VkDeviceGroupPresentCapabilitiesKHR
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "presentMask" 2
                         VkDeviceGroupPresentCapabilitiesKHR
                       #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "presentMask" 3
                         VkDeviceGroupPresentCapabilitiesKHR
                       #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray :: Ptr VkDeviceGroupPresentCapabilitiesKHR
-> FieldType "presentMask" VkDeviceGroupPresentCapabilitiesKHR
-> IO ()
writeFieldArray Ptr VkDeviceGroupPresentCapabilitiesKHR
p
          = Ptr VkDeviceGroupPresentCapabilitiesKHR -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupPresentCapabilitiesKHR
p
              ((Int
16)
{-# LINE 2114 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
                 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "modes" VkDeviceGroupPresentCapabilitiesKHR where
        type FieldType "modes" VkDeviceGroupPresentCapabilitiesKHR =
             VkDeviceGroupPresentModeFlagsKHR
        type FieldOptional "modes" VkDeviceGroupPresentCapabilitiesKHR =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "modes" VkDeviceGroupPresentCapabilitiesKHR =
             (144)
{-# LINE 2126 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "modes" VkDeviceGroupPresentCapabilitiesKHR =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceGroupPresentCapabilitiesKHR
-> IO (FieldType "modes" VkDeviceGroupPresentCapabilitiesKHR)
readField Ptr VkDeviceGroupPresentCapabilitiesKHR
p
          = Ptr VkDeviceGroupPresentCapabilitiesKHR
-> Int -> IO VkDeviceGroupPresentModeFlagsKHR
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceGroupPresentCapabilitiesKHR
p (Int
144)
{-# LINE 2146 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "modes" VkDeviceGroupPresentCapabilitiesKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupPresentCapabilitiesKHR
-> FieldType "modes" VkDeviceGroupPresentCapabilitiesKHR -> IO ()
writeField Ptr VkDeviceGroupPresentCapabilitiesKHR
p
          = Ptr VkDeviceGroupPresentCapabilitiesKHR
-> Int -> VkDeviceGroupPresentModeFlagsKHR -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupPresentCapabilitiesKHR
p (Int
144)
{-# LINE 2152 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDeviceGroupPresentInfoKHR where
        type StructFields VkDeviceGroupPresentInfoKHR =
             '["sType", "pNext", "swapchainCount", "pDeviceMasks", "mode"] -- ' closing tick for hsc2hs
        type CUnionType VkDeviceGroupPresentInfoKHR = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDeviceGroupPresentInfoKHR = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDeviceGroupPresentInfoKHR =
             '[VkPresentInfoKHR] -- ' closing tick for hsc2hs

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGroupPresentInfoKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupPresentInfoKHR
-> FieldType "sType" VkDeviceGroupPresentInfoKHR -> IO ()
writeField Ptr VkDeviceGroupPresentInfoKHR
p
          = Ptr VkDeviceGroupPresentInfoKHR -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupPresentInfoKHR
p (Int
0)
{-# LINE 2277 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGroupPresentInfoKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupPresentInfoKHR
-> FieldType "pNext" VkDeviceGroupPresentInfoKHR -> IO ()
writeField Ptr VkDeviceGroupPresentInfoKHR
p
          = Ptr VkDeviceGroupPresentInfoKHR -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupPresentInfoKHR
p (Int
8)
{-# LINE 2309 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pDeviceMasks" VkDeviceGroupPresentInfoKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupPresentInfoKHR
-> FieldType "pDeviceMasks" VkDeviceGroupPresentInfoKHR -> IO ()
writeField Ptr VkDeviceGroupPresentInfoKHR
p
          = Ptr VkDeviceGroupPresentInfoKHR -> Int -> Ptr Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupPresentInfoKHR
p (Int
24)
{-# LINE 2379 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "mode" VkDeviceGroupPresentInfoKHR where
        type FieldType "mode" VkDeviceGroupPresentInfoKHR =
             VkDeviceGroupPresentModeFlagBitsKHR
        type FieldOptional "mode" VkDeviceGroupPresentInfoKHR = 'False -- ' closing tick for hsc2hs
        type FieldOffset "mode" VkDeviceGroupPresentInfoKHR =
             (32)
{-# LINE 2387 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "mode" VkDeviceGroupPresentInfoKHR = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceGroupPresentInfoKHR
-> IO (FieldType "mode" VkDeviceGroupPresentInfoKHR)
readField Ptr VkDeviceGroupPresentInfoKHR
p
          = Ptr VkDeviceGroupPresentInfoKHR
-> Int -> IO VkDeviceGroupPresentModeFlagBitsKHR
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceGroupPresentInfoKHR
p (Int
32)
{-# LINE 2406 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "mode" VkDeviceGroupPresentInfoKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupPresentInfoKHR
-> FieldType "mode" VkDeviceGroupPresentInfoKHR -> IO ()
writeField Ptr VkDeviceGroupPresentInfoKHR
p
          = Ptr VkDeviceGroupPresentInfoKHR
-> Int -> VkDeviceGroupPresentModeFlagBitsKHR -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupPresentInfoKHR
p (Int
32)
{-# LINE 2412 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDeviceGroupRenderPassBeginInfo where
        type StructFields VkDeviceGroupRenderPassBeginInfo =
             '["sType", "pNext", "deviceMask", "deviceRenderAreaCount", -- ' closing tick for hsc2hs
               "pDeviceRenderAreas"]
        type CUnionType VkDeviceGroupRenderPassBeginInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDeviceGroupRenderPassBeginInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDeviceGroupRenderPassBeginInfo =
             '[VkRenderPassBeginInfo] -- ' closing tick for hsc2hs

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGroupRenderPassBeginInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupRenderPassBeginInfo
-> FieldType "sType" VkDeviceGroupRenderPassBeginInfo -> IO ()
writeField Ptr VkDeviceGroupRenderPassBeginInfo
p
          = Ptr VkDeviceGroupRenderPassBeginInfo
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupRenderPassBeginInfo
p (Int
0)
{-# LINE 2528 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGroupRenderPassBeginInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupRenderPassBeginInfo
-> FieldType "pNext" VkDeviceGroupRenderPassBeginInfo -> IO ()
writeField Ptr VkDeviceGroupRenderPassBeginInfo
p
          = Ptr VkDeviceGroupRenderPassBeginInfo -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupRenderPassBeginInfo
p (Int
8)
{-# LINE 2561 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "deviceRenderAreaCount" VkDeviceGroupRenderPassBeginInfo
         where
        type FieldType "deviceRenderAreaCount"
               VkDeviceGroupRenderPassBeginInfo
             = Word32
        type FieldOptional "deviceRenderAreaCount"
               VkDeviceGroupRenderPassBeginInfo
             = 'True -- ' closing tick for hsc2hs
        type FieldOffset "deviceRenderAreaCount"
               VkDeviceGroupRenderPassBeginInfo
             =
             (20)
{-# LINE 2610 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "deviceRenderAreaCount"
               VkDeviceGroupRenderPassBeginInfo
             = 'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "deviceRenderAreaCount"
           VkDeviceGroupRenderPassBeginInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupRenderPassBeginInfo
-> FieldType
     "deviceRenderAreaCount" VkDeviceGroupRenderPassBeginInfo
-> IO ()
writeField Ptr VkDeviceGroupRenderPassBeginInfo
p
          = Ptr VkDeviceGroupRenderPassBeginInfo -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupRenderPassBeginInfo
p (Int
20)
{-# LINE 2641 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pDeviceRenderAreas" VkDeviceGroupRenderPassBeginInfo
         where
        type FieldType "pDeviceRenderAreas"
               VkDeviceGroupRenderPassBeginInfo
             = Ptr VkRect2D
        type FieldOptional "pDeviceRenderAreas"
               VkDeviceGroupRenderPassBeginInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pDeviceRenderAreas"
               VkDeviceGroupRenderPassBeginInfo
             =
             (24)
{-# LINE 2655 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "pDeviceRenderAreas"
               VkDeviceGroupRenderPassBeginInfo
             = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceGroupRenderPassBeginInfo
-> IO
     (FieldType "pDeviceRenderAreas" VkDeviceGroupRenderPassBeginInfo)
readField Ptr VkDeviceGroupRenderPassBeginInfo
p
          = Ptr VkDeviceGroupRenderPassBeginInfo -> Int -> IO (Ptr VkRect2D)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceGroupRenderPassBeginInfo
p (Int
24)
{-# LINE 2677 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pDeviceRenderAreas" VkDeviceGroupRenderPassBeginInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupRenderPassBeginInfo
-> FieldType "pDeviceRenderAreas" VkDeviceGroupRenderPassBeginInfo
-> IO ()
writeField Ptr VkDeviceGroupRenderPassBeginInfo
p
          = Ptr VkDeviceGroupRenderPassBeginInfo
-> Int -> Ptr VkRect2D -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupRenderPassBeginInfo
p (Int
24)
{-# LINE 2684 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

-- | Alias for `VkDeviceGroupRenderPassBeginInfo`
type VkDeviceGroupRenderPassBeginInfoKHR =
     VkDeviceGroupRenderPassBeginInfo

-- | > typedef struct VkDeviceGroupSubmitInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     uint32_t         waitSemaphoreCount;
--   >     const uint32_t*    pWaitSemaphoreDeviceIndices;
--   >     uint32_t         commandBufferCount;
--   >     const uint32_t*    pCommandBufferDeviceMasks;
--   >     uint32_t         signalSemaphoreCount;
--   >     const uint32_t*  pSignalSemaphoreDeviceIndices;
--   > } VkDeviceGroupSubmitInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkDeviceGroupSubmitInfo VkDeviceGroupSubmitInfo registry at www.khronos.org>
data VkDeviceGroupSubmitInfo = VkDeviceGroupSubmitInfo# Addr#
                                                        ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDeviceGroupSubmitInfo where
        type StructFields VkDeviceGroupSubmitInfo =
             '["sType", "pNext", "waitSemaphoreCount", -- ' closing tick for hsc2hs
               "pWaitSemaphoreDeviceIndices", "commandBufferCount",
               "pCommandBufferDeviceMasks", "signalSemaphoreCount",
               "pSignalSemaphoreDeviceIndices"]
        type CUnionType VkDeviceGroupSubmitInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDeviceGroupSubmitInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDeviceGroupSubmitInfo = '[VkSubmitInfo] -- ' closing tick for hsc2hs

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGroupSubmitInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSubmitInfo
-> FieldType "sType" VkDeviceGroupSubmitInfo -> IO ()
writeField Ptr VkDeviceGroupSubmitInfo
p
          = Ptr VkDeviceGroupSubmitInfo -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSubmitInfo
p (Int
0)
{-# LINE 2801 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGroupSubmitInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSubmitInfo
-> FieldType "pNext" VkDeviceGroupSubmitInfo -> IO ()
writeField Ptr VkDeviceGroupSubmitInfo
p
          = Ptr VkDeviceGroupSubmitInfo -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSubmitInfo
p (Int
8)
{-# LINE 2832 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pWaitSemaphoreDeviceIndices" VkDeviceGroupSubmitInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSubmitInfo
-> FieldType "pWaitSemaphoreDeviceIndices" VkDeviceGroupSubmitInfo
-> IO ()
writeField Ptr VkDeviceGroupSubmitInfo
p
          = Ptr VkDeviceGroupSubmitInfo -> Int -> Ptr Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSubmitInfo
p (Int
24)
{-# LINE 2910 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "commandBufferCount" VkDeviceGroupSubmitInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSubmitInfo
-> FieldType "commandBufferCount" VkDeviceGroupSubmitInfo -> IO ()
writeField Ptr VkDeviceGroupSubmitInfo
p
          = Ptr VkDeviceGroupSubmitInfo -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSubmitInfo
p (Int
32)
{-# LINE 2945 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pCommandBufferDeviceMasks" VkDeviceGroupSubmitInfo where
        type FieldType "pCommandBufferDeviceMasks" VkDeviceGroupSubmitInfo
             = Ptr Word32
        type FieldOptional "pCommandBufferDeviceMasks"
               VkDeviceGroupSubmitInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pCommandBufferDeviceMasks"
               VkDeviceGroupSubmitInfo
             =
             (40)
{-# LINE 2957 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "pCommandBufferDeviceMasks"
               VkDeviceGroupSubmitInfo
             = 'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pCommandBufferDeviceMasks" VkDeviceGroupSubmitInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSubmitInfo
-> FieldType "pCommandBufferDeviceMasks" VkDeviceGroupSubmitInfo
-> IO ()
writeField Ptr VkDeviceGroupSubmitInfo
p
          = Ptr VkDeviceGroupSubmitInfo -> Int -> Ptr Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSubmitInfo
p (Int
40)
{-# LINE 2986 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "signalSemaphoreCount" VkDeviceGroupSubmitInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSubmitInfo
-> FieldType "signalSemaphoreCount" VkDeviceGroupSubmitInfo
-> IO ()
writeField Ptr VkDeviceGroupSubmitInfo
p
          = Ptr VkDeviceGroupSubmitInfo -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSubmitInfo
p (Int
48)
{-# LINE 3021 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pSignalSemaphoreDeviceIndices" VkDeviceGroupSubmitInfo
         where
        type FieldType "pSignalSemaphoreDeviceIndices"
               VkDeviceGroupSubmitInfo
             = Ptr Word32
        type FieldOptional "pSignalSemaphoreDeviceIndices"
               VkDeviceGroupSubmitInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pSignalSemaphoreDeviceIndices"
               VkDeviceGroupSubmitInfo
             =
             (56)
{-# LINE 3035 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "pSignalSemaphoreDeviceIndices"
               VkDeviceGroupSubmitInfo
             = 'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pSignalSemaphoreDeviceIndices"
           VkDeviceGroupSubmitInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSubmitInfo
-> FieldType
     "pSignalSemaphoreDeviceIndices" VkDeviceGroupSubmitInfo
-> IO ()
writeField Ptr VkDeviceGroupSubmitInfo
p
          = Ptr VkDeviceGroupSubmitInfo -> Int -> Ptr Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSubmitInfo
p (Int
56)
{-# LINE 3066 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

-- | Alias for `VkDeviceGroupSubmitInfo`
type VkDeviceGroupSubmitInfoKHR = VkDeviceGroupSubmitInfo

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceGroupSwapchainCreateInfoKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSwapchainCreateInfoKHR
-> FieldType "sType" VkDeviceGroupSwapchainCreateInfoKHR -> IO ()
writeField Ptr VkDeviceGroupSwapchainCreateInfoKHR
p
          = Ptr VkDeviceGroupSwapchainCreateInfoKHR
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSwapchainCreateInfoKHR
p (Int
0)
{-# LINE 3201 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceGroupSwapchainCreateInfoKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSwapchainCreateInfoKHR
-> FieldType "pNext" VkDeviceGroupSwapchainCreateInfoKHR -> IO ()
writeField Ptr VkDeviceGroupSwapchainCreateInfoKHR
p
          = Ptr VkDeviceGroupSwapchainCreateInfoKHR -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSwapchainCreateInfoKHR
p (Int
8)
{-# LINE 3236 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "modes" VkDeviceGroupSwapchainCreateInfoKHR where
        type FieldType "modes" VkDeviceGroupSwapchainCreateInfoKHR =
             VkDeviceGroupPresentModeFlagsKHR
        type FieldOptional "modes" VkDeviceGroupSwapchainCreateInfoKHR =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "modes" VkDeviceGroupSwapchainCreateInfoKHR =
             (16)
{-# LINE 3245 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "modes" VkDeviceGroupSwapchainCreateInfoKHR =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceGroupSwapchainCreateInfoKHR
-> IO (FieldType "modes" VkDeviceGroupSwapchainCreateInfoKHR)
readField Ptr VkDeviceGroupSwapchainCreateInfoKHR
p
          = Ptr VkDeviceGroupSwapchainCreateInfoKHR
-> Int -> IO VkDeviceGroupPresentModeFlagsKHR
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceGroupSwapchainCreateInfoKHR
p (Int
16)
{-# LINE 3265 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "modes" VkDeviceGroupSwapchainCreateInfoKHR where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceGroupSwapchainCreateInfoKHR
-> FieldType "modes" VkDeviceGroupSwapchainCreateInfoKHR -> IO ()
writeField Ptr VkDeviceGroupSwapchainCreateInfoKHR
p
          = Ptr VkDeviceGroupSwapchainCreateInfoKHR
-> Int -> VkDeviceGroupPresentModeFlagsKHR -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceGroupSwapchainCreateInfoKHR
p (Int
16)
{-# LINE 3271 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

-- | > typedef struct VkDeviceQueueCreateInfo {
--   >     VkStructureType sType;
--   >     const void*     pNext;
--   >     VkDeviceQueueCreateFlags    flags;
--   >     uint32_t        queueFamilyIndex;
--   >     uint32_t        queueCount;
--   >     const float*    pQueuePriorities;
--   > } VkDeviceQueueCreateInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkDeviceQueueCreateInfo VkDeviceQueueCreateInfo registry at www.khronos.org>
data VkDeviceQueueCreateInfo = VkDeviceQueueCreateInfo# Addr#
                                                        ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDeviceQueueCreateInfo where
        type StructFields VkDeviceQueueCreateInfo =
             '["sType", "pNext", "flags", "queueFamilyIndex", "queueCount", -- ' closing tick for hsc2hs
               "pQueuePriorities"]
        type CUnionType VkDeviceQueueCreateInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDeviceQueueCreateInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDeviceQueueCreateInfo = '[] -- ' closing tick for hsc2hs

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceQueueCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueCreateInfo
-> FieldType "sType" VkDeviceQueueCreateInfo -> IO ()
writeField Ptr VkDeviceQueueCreateInfo
p
          = Ptr VkDeviceQueueCreateInfo -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueCreateInfo
p (Int
0)
{-# LINE 3373 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceQueueCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueCreateInfo
-> FieldType "pNext" VkDeviceQueueCreateInfo -> IO ()
writeField Ptr VkDeviceQueueCreateInfo
p
          = Ptr VkDeviceQueueCreateInfo -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueCreateInfo
p (Int
8)
{-# LINE 3404 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkDeviceQueueCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueCreateInfo
-> FieldType "flags" VkDeviceQueueCreateInfo -> IO ()
writeField Ptr VkDeviceQueueCreateInfo
p
          = Ptr VkDeviceQueueCreateInfo
-> Int -> VkDeviceQueueCreateFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueCreateInfo
p (Int
16)
{-# LINE 3436 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "queueFamilyIndex" VkDeviceQueueCreateInfo where
        type FieldType "queueFamilyIndex" VkDeviceQueueCreateInfo = Word32
        type FieldOptional "queueFamilyIndex" VkDeviceQueueCreateInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "queueFamilyIndex" VkDeviceQueueCreateInfo =
             (20)
{-# LINE 3444 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "queueFamilyIndex" VkDeviceQueueCreateInfo =
             'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "queueFamilyIndex" VkDeviceQueueCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueCreateInfo
-> FieldType "queueFamilyIndex" VkDeviceQueueCreateInfo -> IO ()
writeField Ptr VkDeviceQueueCreateInfo
p
          = Ptr VkDeviceQueueCreateInfo -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueCreateInfo
p (Int
20)
{-# LINE 3470 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "queueCount" VkDeviceQueueCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueCreateInfo
-> FieldType "queueCount" VkDeviceQueueCreateInfo -> IO ()
writeField Ptr VkDeviceQueueCreateInfo
p
          = Ptr VkDeviceQueueCreateInfo -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueCreateInfo
p (Int
24)
{-# LINE 3502 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pQueuePriorities" VkDeviceQueueCreateInfo where
        type FieldType "pQueuePriorities" VkDeviceQueueCreateInfo =
             Ptr Float
{-# LINE 3507 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldOptional "pQueuePriorities" VkDeviceQueueCreateInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pQueuePriorities" VkDeviceQueueCreateInfo =
             (32)
{-# LINE 3511 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "pQueuePriorities" VkDeviceQueueCreateInfo =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceQueueCreateInfo
-> IO (FieldType "pQueuePriorities" VkDeviceQueueCreateInfo)
readField Ptr VkDeviceQueueCreateInfo
p
          = Ptr VkDeviceQueueCreateInfo -> Int -> IO (Ptr Float)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceQueueCreateInfo
p (Int
32)
{-# LINE 3531 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pQueuePriorities" VkDeviceQueueCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueCreateInfo
-> FieldType "pQueuePriorities" VkDeviceQueueCreateInfo -> IO ()
writeField Ptr VkDeviceQueueCreateInfo
p
          = Ptr VkDeviceQueueCreateInfo -> Int -> Ptr Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueCreateInfo
p (Int
32)
{-# LINE 3537 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceQueueGlobalPriorityCreateInfoEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
-> FieldType "sType" VkDeviceQueueGlobalPriorityCreateInfoEXT
-> IO ()
writeField Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
p
          = Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
p (Int
0)
{-# LINE 3659 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceQueueGlobalPriorityCreateInfoEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
-> FieldType "pNext" VkDeviceQueueGlobalPriorityCreateInfoEXT
-> IO ()
writeField Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
p
          = Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
p (Int
8)
{-# LINE 3695 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "globalPriority" VkDeviceQueueGlobalPriorityCreateInfoEXT
         where
        type FieldType "globalPriority"
               VkDeviceQueueGlobalPriorityCreateInfoEXT
             = VkQueueGlobalPriorityEXT
        type FieldOptional "globalPriority"
               VkDeviceQueueGlobalPriorityCreateInfoEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "globalPriority"
               VkDeviceQueueGlobalPriorityCreateInfoEXT
             =
             (16)
{-# LINE 3709 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "globalPriority"
               VkDeviceQueueGlobalPriorityCreateInfoEXT
             = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
-> IO
     (FieldType
        "globalPriority" VkDeviceQueueGlobalPriorityCreateInfoEXT)
readField Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
p
          = Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
-> Int -> IO VkQueueGlobalPriorityEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
p (Int
16)
{-# LINE 3732 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "globalPriority"
           VkDeviceQueueGlobalPriorityCreateInfoEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
-> FieldType
     "globalPriority" VkDeviceQueueGlobalPriorityCreateInfoEXT
-> IO ()
writeField Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
p
          = Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
-> Int -> VkQueueGlobalPriorityEXT -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueGlobalPriorityCreateInfoEXT
p (Int
16)
{-# LINE 3740 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkDeviceQueueInfo2 where
        type StructFields VkDeviceQueueInfo2 =
             '["sType", "pNext", "flags", "queueFamilyIndex", "queueIndex"] -- ' closing tick for hsc2hs
        type CUnionType VkDeviceQueueInfo2 = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkDeviceQueueInfo2 = 'False -- ' closing tick for hsc2hs
        type StructExtends VkDeviceQueueInfo2 = '[] -- ' closing tick for hsc2hs

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkDeviceQueueInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueInfo2
-> FieldType "sType" VkDeviceQueueInfo2 -> IO ()
writeField Ptr VkDeviceQueueInfo2
p
          = Ptr VkDeviceQueueInfo2 -> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueInfo2
p (Int
0)
{-# LINE 3839 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkDeviceQueueInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueInfo2
-> FieldType "pNext" VkDeviceQueueInfo2 -> IO ()
writeField Ptr VkDeviceQueueInfo2
p
          = Ptr VkDeviceQueueInfo2 -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueInfo2
p (Int
8)
{-# LINE 3870 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-} HasField "flags" VkDeviceQueueInfo2
         where
        type FieldType "flags" VkDeviceQueueInfo2 =
             VkDeviceQueueCreateFlags
        type FieldOptional "flags" VkDeviceQueueInfo2 = 'False -- ' closing tick for hsc2hs
        type FieldOffset "flags" VkDeviceQueueInfo2 =
             (16)
{-# LINE 3878 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "flags" VkDeviceQueueInfo2 = 'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkDeviceQueueInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueInfo2
-> FieldType "flags" VkDeviceQueueInfo2 -> IO ()
writeField Ptr VkDeviceQueueInfo2
p
          = Ptr VkDeviceQueueInfo2 -> Int -> VkDeviceQueueCreateFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueInfo2
p (Int
16)
{-# LINE 3902 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "queueFamilyIndex" VkDeviceQueueInfo2 where
        type FieldType "queueFamilyIndex" VkDeviceQueueInfo2 = Word32
        type FieldOptional "queueFamilyIndex" VkDeviceQueueInfo2 = 'False -- ' closing tick for hsc2hs
        type FieldOffset "queueFamilyIndex" VkDeviceQueueInfo2 =
             (20)
{-# LINE 3909 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}
        type FieldIsArray "queueFamilyIndex" VkDeviceQueueInfo2 = 'False -- ' closing tick for hsc2hs

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "queueFamilyIndex" VkDeviceQueueInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueInfo2
-> FieldType "queueFamilyIndex" VkDeviceQueueInfo2 -> IO ()
writeField Ptr VkDeviceQueueInfo2
p
          = Ptr VkDeviceQueueInfo2 -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueInfo2
p (Int
20)
{-# LINE 3934 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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

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

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

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

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

instance {-# OVERLAPPING #-}
         CanWriteField "queueIndex" VkDeviceQueueInfo2 where
        {-# INLINE writeField #-}
        writeField :: Ptr VkDeviceQueueInfo2
-> FieldType "queueIndex" VkDeviceQueueInfo2 -> IO ()
writeField Ptr VkDeviceQueueInfo2
p
          = Ptr VkDeviceQueueInfo2 -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkDeviceQueueInfo2
p (Int
24)
{-# LINE 3965 "src-gen/Graphics/Vulkan/Types/Struct/Device.hsc" #-}

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