{-# language CPP #-}
-- No documentation found for Chapter "Originally_Based_On_VK_KHR_subgroup"
module Vulkan.Core11.Originally_Based_On_VK_KHR_subgroup  ( PhysicalDeviceSubgroupProperties(..)
                                                          , StructureType(..)
                                                          , SubgroupFeatureFlagBits(..)
                                                          , SubgroupFeatureFlags
                                                          ) 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.Core11.Enums.SubgroupFeatureFlagBits (SubgroupFeatureFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBGROUP_PROPERTIES))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
import Vulkan.Core11.Enums.SubgroupFeatureFlagBits (SubgroupFeatureFlagBits(..))
import Vulkan.Core11.Enums.SubgroupFeatureFlagBits (SubgroupFeatureFlags)
-- | VkPhysicalDeviceSubgroupProperties - Structure describing subgroup
-- support for an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceSubgroupProperties' 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 @supportedOperations@ includes
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-subgroup-quad >,
-- or
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-shaderSubgroupUniformControlFlow shaderSubgroupUniformControlFlow>
-- is enabled, @subgroupSize@ /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_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.ShaderStageFlagBits.ShaderStageFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Core11.Enums.SubgroupFeatureFlagBits.SubgroupFeatureFlags'
data PhysicalDeviceSubgroupProperties = PhysicalDeviceSubgroupProperties
  { -- | #extension-limits-subgroup-size# @subgroupSize@ is the default number of
    -- invocations in each subgroup. @subgroupSize@ is at least 1 if any of the
    -- physical device’s queues support
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_GRAPHICS_BIT' or
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_COMPUTE_BIT'. @subgroupSize@ is
    -- a power-of-two.
    PhysicalDeviceSubgroupProperties -> Word32
subgroupSize :: Word32
  , -- | #limits-subgroup-supportedStages# @supportedStages@ is a bitfield of
    -- 'Vulkan.Core10.Enums.ShaderStageFlagBits.ShaderStageFlagBits' describing
    -- the shader stages that
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#shaders-group-operations group operations>
    -- with
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#shaders-scope-subgroup subgroup scope>
    -- are supported in. @supportedStages@ will have the
    -- 'Vulkan.Core10.Enums.ShaderStageFlagBits.SHADER_STAGE_COMPUTE_BIT' bit
    -- set if any of the physical device’s queues support
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_COMPUTE_BIT'.
    PhysicalDeviceSubgroupProperties -> ShaderStageFlags
supportedStages :: ShaderStageFlags
  , -- | #limits-subgroupSupportedOperations# @supportedOperations@ is a bitmask
    -- of 'Vulkan.Core11.Enums.SubgroupFeatureFlagBits.SubgroupFeatureFlagBits'
    -- specifying the sets of
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#shaders-group-operations group operations>
    -- with
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#shaders-scope-subgroup subgroup scope>
    -- supported on this device. @supportedOperations@ will have the
    -- 'Vulkan.Core11.Enums.SubgroupFeatureFlagBits.SUBGROUP_FEATURE_BASIC_BIT'
    -- bit set if any of the physical device’s queues support
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_GRAPHICS_BIT' or
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_COMPUTE_BIT'.
    PhysicalDeviceSubgroupProperties -> SubgroupFeatureFlags
supportedOperations :: SubgroupFeatureFlags
  , -- | #limits-subgroup-quadOperationsInAllStages# @quadOperationsInAllStages@
    -- is a boolean specifying whether
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#shaders-quad-operations quad group operations>
    -- are available in all stages, or are restricted to fragment and compute
    -- stages.
    PhysicalDeviceSubgroupProperties -> Bool
quadOperationsInAllStages :: Bool
  }
  deriving (Typeable, PhysicalDeviceSubgroupProperties
-> PhysicalDeviceSubgroupProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceSubgroupProperties
-> PhysicalDeviceSubgroupProperties -> Bool
$c/= :: PhysicalDeviceSubgroupProperties
-> PhysicalDeviceSubgroupProperties -> Bool
== :: PhysicalDeviceSubgroupProperties
-> PhysicalDeviceSubgroupProperties -> Bool
$c== :: PhysicalDeviceSubgroupProperties
-> PhysicalDeviceSubgroupProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSubgroupProperties)
#endif
deriving instance Show PhysicalDeviceSubgroupProperties

instance ToCStruct PhysicalDeviceSubgroupProperties where
  withCStruct :: forall b.
PhysicalDeviceSubgroupProperties
-> (Ptr PhysicalDeviceSubgroupProperties -> IO b) -> IO b
withCStruct PhysicalDeviceSubgroupProperties
x Ptr PhysicalDeviceSubgroupProperties -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceSubgroupProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSubgroupProperties
p PhysicalDeviceSubgroupProperties
x (Ptr PhysicalDeviceSubgroupProperties -> IO b
f Ptr PhysicalDeviceSubgroupProperties
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceSubgroupProperties
-> PhysicalDeviceSubgroupProperties -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSubgroupProperties
p PhysicalDeviceSubgroupProperties{Bool
Word32
ShaderStageFlags
SubgroupFeatureFlags
quadOperationsInAllStages :: Bool
supportedOperations :: SubgroupFeatureFlags
supportedStages :: ShaderStageFlags
subgroupSize :: Word32
$sel:quadOperationsInAllStages:PhysicalDeviceSubgroupProperties :: PhysicalDeviceSubgroupProperties -> Bool
$sel:supportedOperations:PhysicalDeviceSubgroupProperties :: PhysicalDeviceSubgroupProperties -> SubgroupFeatureFlags
$sel:supportedStages:PhysicalDeviceSubgroupProperties :: PhysicalDeviceSubgroupProperties -> ShaderStageFlags
$sel:subgroupSize:PhysicalDeviceSubgroupProperties :: PhysicalDeviceSubgroupProperties -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBGROUP_PROPERTIES)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
subgroupSize)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ShaderStageFlags)) (ShaderStageFlags
supportedStages)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SubgroupFeatureFlags)) (SubgroupFeatureFlags
supportedOperations)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
quadOperationsInAllStages))
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr PhysicalDeviceSubgroupProperties -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceSubgroupProperties
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBGROUP_PROPERTIES)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ShaderStageFlags)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SubgroupFeatureFlags)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceSubgroupProperties where
  peekCStruct :: Ptr PhysicalDeviceSubgroupProperties
-> IO PhysicalDeviceSubgroupProperties
peekCStruct Ptr PhysicalDeviceSubgroupProperties
p = do
    Word32
subgroupSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    ShaderStageFlags
supportedStages <- forall a. Storable a => Ptr a -> IO a
peek @ShaderStageFlags ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ShaderStageFlags))
    SubgroupFeatureFlags
supportedOperations <- forall a. Storable a => Ptr a -> IO a
peek @SubgroupFeatureFlags ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SubgroupFeatureFlags))
    Bool32
quadOperationsInAllStages <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSubgroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> ShaderStageFlags
-> SubgroupFeatureFlags
-> Bool
-> PhysicalDeviceSubgroupProperties
PhysicalDeviceSubgroupProperties
             Word32
subgroupSize
             ShaderStageFlags
supportedStages
             SubgroupFeatureFlags
supportedOperations
             (Bool32 -> Bool
bool32ToBool Bool32
quadOperationsInAllStages)

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

instance Zero PhysicalDeviceSubgroupProperties where
  zero :: PhysicalDeviceSubgroupProperties
zero = Word32
-> ShaderStageFlags
-> SubgroupFeatureFlags
-> Bool
-> PhysicalDeviceSubgroupProperties
PhysicalDeviceSubgroupProperties
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero