{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_EXT_subgroup_size_control"
module Vulkan.Core13.Promoted_From_VK_EXT_subgroup_size_control  ( PhysicalDeviceSubgroupSizeControlFeatures(..)
                                                                 , PhysicalDeviceSubgroupSizeControlProperties(..)
                                                                 , PipelineShaderStageRequiredSubgroupSizeCreateInfo(..)
                                                                 , StructureType(..)
                                                                 , PipelineShaderStageCreateFlagBits(..)
                                                                 , PipelineShaderStageCreateFlags
                                                                 ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBGROUP_SIZE_CONTROL_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBGROUP_SIZE_CONTROL_PROPERTIES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_REQUIRED_SUBGROUP_SIZE_CREATE_INFO))
import Vulkan.Core10.Enums.PipelineShaderStageCreateFlagBits (PipelineShaderStageCreateFlagBits(..))
import Vulkan.Core10.Enums.PipelineShaderStageCreateFlagBits (PipelineShaderStageCreateFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDeviceSubgroupSizeControlFeatures - Structure describing the
-- subgroup size control features that can be supported by an
-- implementation
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceSubgroupSizeControlFeatures' structure is included
-- in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceSubgroupSizeControlFeatures' /can/ also be
-- used in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- Note
--
-- The
-- 'Vulkan.Extensions.VK_EXT_subgroup_size_control.PhysicalDeviceSubgroupSizeControlFeaturesEXT'
-- structure was added in version 2 of the @VK_EXT_subgroup_size_control@
-- extension. Version 1 implementations of this extension will not fill out
-- the features structure but applications may assume that both
-- @subgroupSizeControl@ and @computeFullSubgroups@ are supported if the
-- extension is supported. (See also the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-requirements Feature Requirements>
-- section.) Applications are advised to add a
-- 'Vulkan.Extensions.VK_EXT_subgroup_size_control.PhysicalDeviceSubgroupSizeControlFeaturesEXT'
-- structure to the @pNext@ chain of
-- 'Vulkan.Core10.Device.DeviceCreateInfo' to enable the features
-- regardless of the version of the extension supported by the
-- implementation. If the implementation only supports version 1, it will
-- safely ignore the
-- 'Vulkan.Extensions.VK_EXT_subgroup_size_control.PhysicalDeviceSubgroupSizeControlFeaturesEXT'
-- structure.
--
-- Vulkan 1.3 implementations always support the features structure.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_subgroup_size_control VK_EXT_subgroup_size_control>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceSubgroupSizeControlFeatures = PhysicalDeviceSubgroupSizeControlFeatures
  { -- | #extension-features-subgroupSizeControl# @subgroupSizeControl@ indicates
    -- whether the implementation supports controlling shader subgroup sizes
    -- via the
    -- 'Vulkan.Core10.Enums.PipelineShaderStageCreateFlagBits.PIPELINE_SHADER_STAGE_CREATE_ALLOW_VARYING_SUBGROUP_SIZE_BIT'
    -- flag and the 'PipelineShaderStageRequiredSubgroupSizeCreateInfo'
    -- structure.
    PhysicalDeviceSubgroupSizeControlFeatures -> Bool
subgroupSizeControl :: Bool
  , -- | #extension-features-computeFullSubgroups# @computeFullSubgroups@
    -- indicates whether the implementation supports requiring full subgroups
    -- in compute , mesh, or task shaders via the
    -- 'Vulkan.Core10.Enums.PipelineShaderStageCreateFlagBits.PIPELINE_SHADER_STAGE_CREATE_REQUIRE_FULL_SUBGROUPS_BIT'
    -- flag.
    PhysicalDeviceSubgroupSizeControlFeatures -> Bool
computeFullSubgroups :: Bool
  }
  deriving (Typeable, PhysicalDeviceSubgroupSizeControlFeatures
-> PhysicalDeviceSubgroupSizeControlFeatures -> Bool
(PhysicalDeviceSubgroupSizeControlFeatures
 -> PhysicalDeviceSubgroupSizeControlFeatures -> Bool)
-> (PhysicalDeviceSubgroupSizeControlFeatures
    -> PhysicalDeviceSubgroupSizeControlFeatures -> Bool)
-> Eq PhysicalDeviceSubgroupSizeControlFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceSubgroupSizeControlFeatures
-> PhysicalDeviceSubgroupSizeControlFeatures -> Bool
$c/= :: PhysicalDeviceSubgroupSizeControlFeatures
-> PhysicalDeviceSubgroupSizeControlFeatures -> Bool
== :: PhysicalDeviceSubgroupSizeControlFeatures
-> PhysicalDeviceSubgroupSizeControlFeatures -> Bool
$c== :: PhysicalDeviceSubgroupSizeControlFeatures
-> PhysicalDeviceSubgroupSizeControlFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSubgroupSizeControlFeatures)
#endif
deriving instance Show PhysicalDeviceSubgroupSizeControlFeatures

instance ToCStruct PhysicalDeviceSubgroupSizeControlFeatures where
  withCStruct :: forall b.
PhysicalDeviceSubgroupSizeControlFeatures
-> (Ptr PhysicalDeviceSubgroupSizeControlFeatures -> IO b) -> IO b
withCStruct PhysicalDeviceSubgroupSizeControlFeatures
x Ptr PhysicalDeviceSubgroupSizeControlFeatures -> IO b
f = Int
-> (Ptr PhysicalDeviceSubgroupSizeControlFeatures -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceSubgroupSizeControlFeatures -> IO b) -> IO b)
-> (Ptr PhysicalDeviceSubgroupSizeControlFeatures -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceSubgroupSizeControlFeatures
p -> Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> PhysicalDeviceSubgroupSizeControlFeatures -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSubgroupSizeControlFeatures
p PhysicalDeviceSubgroupSizeControlFeatures
x (Ptr PhysicalDeviceSubgroupSizeControlFeatures -> IO b
f Ptr PhysicalDeviceSubgroupSizeControlFeatures
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> PhysicalDeviceSubgroupSizeControlFeatures -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSubgroupSizeControlFeatures
p PhysicalDeviceSubgroupSizeControlFeatures{Bool
computeFullSubgroups :: Bool
subgroupSizeControl :: Bool
$sel:computeFullSubgroups:PhysicalDeviceSubgroupSizeControlFeatures :: PhysicalDeviceSubgroupSizeControlFeatures -> Bool
$sel:subgroupSizeControl:PhysicalDeviceSubgroupSizeControlFeatures :: PhysicalDeviceSubgroupSizeControlFeatures -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBGROUP_SIZE_CONTROL_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
subgroupSizeControl))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
computeFullSubgroups))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceSubgroupSizeControlFeatures -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceSubgroupSizeControlFeatures
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBGROUP_SIZE_CONTROL_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceSubgroupSizeControlFeatures where
  peekCStruct :: Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> IO PhysicalDeviceSubgroupSizeControlFeatures
peekCStruct Ptr PhysicalDeviceSubgroupSizeControlFeatures
p = do
    Bool32
subgroupSizeControl <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    Bool32
computeFullSubgroups <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSubgroupSizeControlFeatures
p Ptr PhysicalDeviceSubgroupSizeControlFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
    PhysicalDeviceSubgroupSizeControlFeatures
-> IO PhysicalDeviceSubgroupSizeControlFeatures
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceSubgroupSizeControlFeatures
 -> IO PhysicalDeviceSubgroupSizeControlFeatures)
-> PhysicalDeviceSubgroupSizeControlFeatures
-> IO PhysicalDeviceSubgroupSizeControlFeatures
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> PhysicalDeviceSubgroupSizeControlFeatures
PhysicalDeviceSubgroupSizeControlFeatures
             (Bool32 -> Bool
bool32ToBool Bool32
subgroupSizeControl)
             (Bool32 -> Bool
bool32ToBool Bool32
computeFullSubgroups)

instance Storable PhysicalDeviceSubgroupSizeControlFeatures where
  sizeOf :: PhysicalDeviceSubgroupSizeControlFeatures -> Int
sizeOf ~PhysicalDeviceSubgroupSizeControlFeatures
_ = Int
24
  alignment :: PhysicalDeviceSubgroupSizeControlFeatures -> Int
alignment ~PhysicalDeviceSubgroupSizeControlFeatures
_ = Int
8
  peek :: Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> IO PhysicalDeviceSubgroupSizeControlFeatures
peek = Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> IO PhysicalDeviceSubgroupSizeControlFeatures
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> PhysicalDeviceSubgroupSizeControlFeatures -> IO ()
poke Ptr PhysicalDeviceSubgroupSizeControlFeatures
ptr PhysicalDeviceSubgroupSizeControlFeatures
poked = Ptr PhysicalDeviceSubgroupSizeControlFeatures
-> PhysicalDeviceSubgroupSizeControlFeatures -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSubgroupSizeControlFeatures
ptr PhysicalDeviceSubgroupSizeControlFeatures
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceSubgroupSizeControlFeatures where
  zero :: PhysicalDeviceSubgroupSizeControlFeatures
zero = Bool -> Bool -> PhysicalDeviceSubgroupSizeControlFeatures
PhysicalDeviceSubgroupSizeControlFeatures
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | VkPhysicalDeviceSubgroupSizeControlProperties - Structure describing the
-- control subgroup size properties of an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceSubgroupSizeControlProperties' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2',
-- it is filled in with each corresponding implementation-dependent
-- property.
--
-- If
-- 'Vulkan.Core11.Originally_Based_On_VK_KHR_subgroup.PhysicalDeviceSubgroupProperties'::@supportedOperations@
-- includes
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-subgroup-quad >,
-- @minSubgroupSize@ /must/ be greater than or equal to 4.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_subgroup_size_control VK_EXT_subgroup_size_control>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Enums.ShaderStageFlagBits.ShaderStageFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceSubgroupSizeControlProperties = PhysicalDeviceSubgroupSizeControlProperties
  { -- | #extension-limits-minSubgroupSize# @minSubgroupSize@ is the minimum
    -- subgroup size supported by this device. @minSubgroupSize@ is at least
    -- one if any of the physical device’s queues support
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_GRAPHICS_BIT' or
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_COMPUTE_BIT'. @minSubgroupSize@
    -- is a power-of-two. @minSubgroupSize@ is less than or equal to
    -- @maxSubgroupSize@. @minSubgroupSize@ is less than or equal to
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-subgroup-size subgroupSize>.
    PhysicalDeviceSubgroupSizeControlProperties -> Word32
minSubgroupSize :: Word32
  , -- | #extension-limits-maxSubgroupSize# @maxSubgroupSize@ is the maximum
    -- subgroup size supported by this device. @maxSubgroupSize@ is at least
    -- one if any of the physical device’s queues support
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_GRAPHICS_BIT' or
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_COMPUTE_BIT'. @maxSubgroupSize@
    -- is a power-of-two. @maxSubgroupSize@ is greater than or equal to
    -- @minSubgroupSize@. @maxSubgroupSize@ is greater than or equal to
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-subgroup-size subgroupSize>.
    PhysicalDeviceSubgroupSizeControlProperties -> Word32
maxSubgroupSize :: Word32
  , -- | #extension-limits-maxComputeWorkgroupSubgroups#
    -- @maxComputeWorkgroupSubgroups@ is the maximum number of subgroups
    -- supported by the implementation within a workgroup.
    PhysicalDeviceSubgroupSizeControlProperties -> Word32
maxComputeWorkgroupSubgroups :: Word32
  , -- | #extension-limits-requiredSubgroupSizeStages#
    -- @requiredSubgroupSizeStages@ is a bitfield of what shader stages support
    -- having a required subgroup size specified.
    PhysicalDeviceSubgroupSizeControlProperties -> ShaderStageFlags
requiredSubgroupSizeStages :: ShaderStageFlags
  }
  deriving (Typeable, PhysicalDeviceSubgroupSizeControlProperties
-> PhysicalDeviceSubgroupSizeControlProperties -> Bool
(PhysicalDeviceSubgroupSizeControlProperties
 -> PhysicalDeviceSubgroupSizeControlProperties -> Bool)
-> (PhysicalDeviceSubgroupSizeControlProperties
    -> PhysicalDeviceSubgroupSizeControlProperties -> Bool)
-> Eq PhysicalDeviceSubgroupSizeControlProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceSubgroupSizeControlProperties
-> PhysicalDeviceSubgroupSizeControlProperties -> Bool
$c/= :: PhysicalDeviceSubgroupSizeControlProperties
-> PhysicalDeviceSubgroupSizeControlProperties -> Bool
== :: PhysicalDeviceSubgroupSizeControlProperties
-> PhysicalDeviceSubgroupSizeControlProperties -> Bool
$c== :: PhysicalDeviceSubgroupSizeControlProperties
-> PhysicalDeviceSubgroupSizeControlProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSubgroupSizeControlProperties)
#endif
deriving instance Show PhysicalDeviceSubgroupSizeControlProperties

instance ToCStruct PhysicalDeviceSubgroupSizeControlProperties where
  withCStruct :: forall b.
PhysicalDeviceSubgroupSizeControlProperties
-> (Ptr PhysicalDeviceSubgroupSizeControlProperties -> IO b)
-> IO b
withCStruct PhysicalDeviceSubgroupSizeControlProperties
x Ptr PhysicalDeviceSubgroupSizeControlProperties -> IO b
f = Int
-> (Ptr PhysicalDeviceSubgroupSizeControlProperties -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr PhysicalDeviceSubgroupSizeControlProperties -> IO b) -> IO b)
-> (Ptr PhysicalDeviceSubgroupSizeControlProperties -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceSubgroupSizeControlProperties
p -> Ptr PhysicalDeviceSubgroupSizeControlProperties
-> PhysicalDeviceSubgroupSizeControlProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSubgroupSizeControlProperties
p PhysicalDeviceSubgroupSizeControlProperties
x (Ptr PhysicalDeviceSubgroupSizeControlProperties -> IO b
f Ptr PhysicalDeviceSubgroupSizeControlProperties
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceSubgroupSizeControlProperties
-> PhysicalDeviceSubgroupSizeControlProperties -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSubgroupSizeControlProperties
p PhysicalDeviceSubgroupSizeControlProperties{Word32
ShaderStageFlags
requiredSubgroupSizeStages :: ShaderStageFlags
maxComputeWorkgroupSubgroups :: Word32
maxSubgroupSize :: Word32
minSubgroupSize :: Word32
$sel:requiredSubgroupSizeStages:PhysicalDeviceSubgroupSizeControlProperties :: PhysicalDeviceSubgroupSizeControlProperties -> ShaderStageFlags
$sel:maxComputeWorkgroupSubgroups:PhysicalDeviceSubgroupSizeControlProperties :: PhysicalDeviceSubgroupSizeControlProperties -> Word32
$sel:maxSubgroupSize:PhysicalDeviceSubgroupSizeControlProperties :: PhysicalDeviceSubgroupSizeControlProperties -> Word32
$sel:minSubgroupSize:PhysicalDeviceSubgroupSizeControlProperties :: PhysicalDeviceSubgroupSizeControlProperties -> Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBGROUP_SIZE_CONTROL_PROPERTIES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
minSubgroupSize)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
maxSubgroupSize)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
maxComputeWorkgroupSubgroups)
    Ptr ShaderStageFlags -> ShaderStageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr ShaderStageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ShaderStageFlags)) (ShaderStageFlags
requiredSubgroupSizeStages)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceSubgroupSizeControlProperties -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceSubgroupSizeControlProperties
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBGROUP_SIZE_CONTROL_PROPERTIES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr ShaderStageFlags -> ShaderStageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr ShaderStageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ShaderStageFlags)) (ShaderStageFlags
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PhysicalDeviceSubgroupSizeControlProperties where
  peekCStruct :: Ptr PhysicalDeviceSubgroupSizeControlProperties
-> IO PhysicalDeviceSubgroupSizeControlProperties
peekCStruct Ptr PhysicalDeviceSubgroupSizeControlProperties
p = do
    Word32
minSubgroupSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Word32
maxSubgroupSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    Word32
maxComputeWorkgroupSubgroups <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    ShaderStageFlags
requiredSubgroupSizeStages <- forall a. Storable a => Ptr a -> IO a
peek @ShaderStageFlags ((Ptr PhysicalDeviceSubgroupSizeControlProperties
p Ptr PhysicalDeviceSubgroupSizeControlProperties
-> Int -> Ptr ShaderStageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ShaderStageFlags))
    PhysicalDeviceSubgroupSizeControlProperties
-> IO PhysicalDeviceSubgroupSizeControlProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceSubgroupSizeControlProperties
 -> IO PhysicalDeviceSubgroupSizeControlProperties)
-> PhysicalDeviceSubgroupSizeControlProperties
-> IO PhysicalDeviceSubgroupSizeControlProperties
forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Word32
-> ShaderStageFlags
-> PhysicalDeviceSubgroupSizeControlProperties
PhysicalDeviceSubgroupSizeControlProperties
             Word32
minSubgroupSize
             Word32
maxSubgroupSize
             Word32
maxComputeWorkgroupSubgroups
             ShaderStageFlags
requiredSubgroupSizeStages

instance Storable PhysicalDeviceSubgroupSizeControlProperties where
  sizeOf :: PhysicalDeviceSubgroupSizeControlProperties -> Int
sizeOf ~PhysicalDeviceSubgroupSizeControlProperties
_ = Int
32
  alignment :: PhysicalDeviceSubgroupSizeControlProperties -> Int
alignment ~PhysicalDeviceSubgroupSizeControlProperties
_ = Int
8
  peek :: Ptr PhysicalDeviceSubgroupSizeControlProperties
-> IO PhysicalDeviceSubgroupSizeControlProperties
peek = Ptr PhysicalDeviceSubgroupSizeControlProperties
-> IO PhysicalDeviceSubgroupSizeControlProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceSubgroupSizeControlProperties
-> PhysicalDeviceSubgroupSizeControlProperties -> IO ()
poke Ptr PhysicalDeviceSubgroupSizeControlProperties
ptr PhysicalDeviceSubgroupSizeControlProperties
poked = Ptr PhysicalDeviceSubgroupSizeControlProperties
-> PhysicalDeviceSubgroupSizeControlProperties -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSubgroupSizeControlProperties
ptr PhysicalDeviceSubgroupSizeControlProperties
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceSubgroupSizeControlProperties where
  zero :: PhysicalDeviceSubgroupSizeControlProperties
zero = Word32
-> Word32
-> Word32
-> ShaderStageFlags
-> PhysicalDeviceSubgroupSizeControlProperties
PhysicalDeviceSubgroupSizeControlProperties
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           ShaderStageFlags
forall a. Zero a => a
zero


-- | VkPipelineShaderStageRequiredSubgroupSizeCreateInfo - Structure
-- specifying the required subgroup size of a newly created pipeline shader
-- stage
--
-- = Description
--
-- If a 'PipelineShaderStageRequiredSubgroupSizeCreateInfo' structure is
-- included in the @pNext@ chain of
-- 'Vulkan.Core10.Pipeline.PipelineShaderStageCreateInfo', it specifies
-- that the pipeline shader stage being compiled has a required subgroup
-- size.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_subgroup_size_control VK_EXT_subgroup_size_control>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PipelineShaderStageRequiredSubgroupSizeCreateInfo = PipelineShaderStageRequiredSubgroupSizeCreateInfo
  { -- | #pipelines-required-subgroup-size# @requiredSubgroupSize@ is an unsigned
    -- integer value specifying the required subgroup size for the newly
    -- created pipeline shader stage.
    --
    -- #VUID-VkPipelineShaderStageRequiredSubgroupSizeCreateInfo-requiredSubgroupSize-02760#
    -- @requiredSubgroupSize@ /must/ be a power-of-two integer
    --
    -- #VUID-VkPipelineShaderStageRequiredSubgroupSizeCreateInfo-requiredSubgroupSize-02761#
    -- @requiredSubgroupSize@ /must/ be greater or equal to
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-minSubgroupSize minSubgroupSize>
    --
    -- #VUID-VkPipelineShaderStageRequiredSubgroupSizeCreateInfo-requiredSubgroupSize-02762#
    -- @requiredSubgroupSize@ /must/ be less than or equal to
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-maxSubgroupSize maxSubgroupSize>
    PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Word32
requiredSubgroupSize :: Word32 }
  deriving (Typeable, PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Bool
(PipelineShaderStageRequiredSubgroupSizeCreateInfo
 -> PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Bool)
-> (PipelineShaderStageRequiredSubgroupSizeCreateInfo
    -> PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Bool)
-> Eq PipelineShaderStageRequiredSubgroupSizeCreateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Bool
$c/= :: PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Bool
== :: PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Bool
$c== :: PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineShaderStageRequiredSubgroupSizeCreateInfo)
#endif
deriving instance Show PipelineShaderStageRequiredSubgroupSizeCreateInfo

instance ToCStruct PipelineShaderStageRequiredSubgroupSizeCreateInfo where
  withCStruct :: forall b.
PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> (Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo -> IO b)
-> IO b
withCStruct PipelineShaderStageRequiredSubgroupSizeCreateInfo
x Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo -> IO b
f = Int
-> (Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo -> IO b)
 -> IO b)
-> (Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p -> Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> IO b
-> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p PipelineShaderStageRequiredSubgroupSizeCreateInfo
x (Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo -> IO b
f Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p)
  pokeCStruct :: forall b.
Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> IO b
-> IO b
pokeCStruct Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p PipelineShaderStageRequiredSubgroupSizeCreateInfo{Word32
requiredSubgroupSize :: Word32
$sel:requiredSubgroupSize:PipelineShaderStageRequiredSubgroupSizeCreateInfo :: PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_REQUIRED_SUBGROUP_SIZE_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
requiredSubgroupSize)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> IO b -> IO b
pokeZeroCStruct Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_REQUIRED_SUBGROUP_SIZE_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PipelineShaderStageRequiredSubgroupSizeCreateInfo where
  peekCStruct :: Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> IO PipelineShaderStageRequiredSubgroupSizeCreateInfo
peekCStruct Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p = do
    Word32
requiredSubgroupSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
p Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> IO PipelineShaderStageRequiredSubgroupSizeCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineShaderStageRequiredSubgroupSizeCreateInfo
 -> IO PipelineShaderStageRequiredSubgroupSizeCreateInfo)
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> IO PipelineShaderStageRequiredSubgroupSizeCreateInfo
forall a b. (a -> b) -> a -> b
$ Word32 -> PipelineShaderStageRequiredSubgroupSizeCreateInfo
PipelineShaderStageRequiredSubgroupSizeCreateInfo
             Word32
requiredSubgroupSize

instance Storable PipelineShaderStageRequiredSubgroupSizeCreateInfo where
  sizeOf :: PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Int
sizeOf ~PipelineShaderStageRequiredSubgroupSizeCreateInfo
_ = Int
24
  alignment :: PipelineShaderStageRequiredSubgroupSizeCreateInfo -> Int
alignment ~PipelineShaderStageRequiredSubgroupSizeCreateInfo
_ = Int
8
  peek :: Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> IO PipelineShaderStageRequiredSubgroupSizeCreateInfo
peek = Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> IO PipelineShaderStageRequiredSubgroupSizeCreateInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo -> IO ()
poke Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
poked = Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> PipelineShaderStageRequiredSubgroupSizeCreateInfo
-> IO ()
-> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
ptr PipelineShaderStageRequiredSubgroupSizeCreateInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PipelineShaderStageRequiredSubgroupSizeCreateInfo where
  zero :: PipelineShaderStageRequiredSubgroupSizeCreateInfo
zero = Word32 -> PipelineShaderStageRequiredSubgroupSizeCreateInfo
PipelineShaderStageRequiredSubgroupSizeCreateInfo
           Word32
forall a. Zero a => a
zero