{-# language CPP #-}
-- | = Name
--
-- VK_NV_shader_sm_builtins - device extension
--
-- == VK_NV_shader_sm_builtins
--
-- [__Name String__]
--     @VK_NV_shader_sm_builtins@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     155
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.1
--
-- [__Contact__]
--
--     -   Daniel Koch
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_shader_sm_builtins] @dgkoch%0A<<Here describe the issue or question you have about the VK_NV_shader_sm_builtins extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2019-05-28
--
-- [__Interactions and External Dependencies__]
--
--     -   This extension requires
--         <https://htmlpreview.github.io/?https://github.com/KhronosGroup/SPIRV-Registry/blob/master/extensions/NV/SPV_NV_shader_sm_builtins.html SPV_NV_shader_sm_builtins>.
--
--     -   This extension enables
--         <https://github.com/KhronosGroup/GLSL/blob/master/extensions/nv/GLSL_NV_shader_sm_builtins.txt GL_NV_shader_sm_builtins>
--         for GLSL source languages.
--
-- [__Contributors__]
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Eric Werness, NVIDIA
--
-- == Description
--
-- This extension provides the ability to determine device-specific
-- properties on NVIDIA GPUs. It provides the number of streaming
-- multiprocessors (SMs), the maximum number of warps (subgroups) that can
-- run on an SM, and shader builtins to enable invocations to identify
-- which SM and warp a shader invocation is executing on.
--
-- This extension enables support for the SPIR-V @ShaderSMBuiltinsNV@
-- capability.
--
-- These properties and built-ins /should/ typically only be used for
-- debugging purposes.
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceShaderSMBuiltinsFeaturesNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceShaderSMBuiltinsPropertiesNV'
--
-- == New Enum Constants
--
-- -   'NV_SHADER_SM_BUILTINS_EXTENSION_NAME'
--
-- -   'NV_SHADER_SM_BUILTINS_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_SM_BUILTINS_FEATURES_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_SM_BUILTINS_PROPERTIES_NV'
--
-- == New or Modified Built-In Variables
--
-- -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#interfaces-builtin-variables-warpspersmnv WarpsPerSMNV>
--
-- -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#interfaces-builtin-variables-smcountnv SMCountNV>
--
-- -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#interfaces-builtin-variables-warpidnv WarpIDNV>
--
-- -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#interfaces-builtin-variables-smidnv SMIDNV>
--
-- == New SPIR-V Capabilities
--
-- -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#spirvenv-capabilities-table-ShaderSMBuiltinsNV ShaderSMBuiltinsNV>
--
-- == Issues
--
-- 1.  What should we call this extension?
--
--     __RESOLVED__: @NV_shader_sm_builtins@. Other options considered
--     included:
--
--     -   @NV_shader_smid@ - but SMID is really easy to typo\/confuse as
--         SIMD.
--
--     -   @NV_shader_sm_info@ - but __Info__ is typically reserved for
--         input structures
--
-- == Version History
--
-- -   Revision 1, 2019-05-28 (Daniel Koch)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'PhysicalDeviceShaderSMBuiltinsFeaturesNV',
-- 'PhysicalDeviceShaderSMBuiltinsPropertiesNV'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_shader_sm_builtins Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_NV_shader_sm_builtins  ( PhysicalDeviceShaderSMBuiltinsPropertiesNV(..)
                                                   , PhysicalDeviceShaderSMBuiltinsFeaturesNV(..)
                                                   , NV_SHADER_SM_BUILTINS_SPEC_VERSION
                                                   , pattern NV_SHADER_SM_BUILTINS_SPEC_VERSION
                                                   , NV_SHADER_SM_BUILTINS_EXTENSION_NAME
                                                   , pattern NV_SHADER_SM_BUILTINS_EXTENSION_NAME
                                                   ) 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.String (IsString)
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.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_SM_BUILTINS_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_SM_BUILTINS_PROPERTIES_NV))
-- | VkPhysicalDeviceShaderSMBuiltinsPropertiesNV - Structure describing
-- shader SM Builtins properties supported by an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceShaderSMBuiltinsPropertiesNV' 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.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_shader_sm_builtins VK_NV_shader_sm_builtins>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceShaderSMBuiltinsPropertiesNV = PhysicalDeviceShaderSMBuiltinsPropertiesNV
  { -- | #limits-shaderSMCount# @shaderSMCount@ is the number of SMs on the
    -- device.
    PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Word32
shaderSMCount :: Word32
  , -- | #limits-shaderWarpsPerSM# @shaderWarpsPerSM@ is the maximum number of
    -- simultaneously executing warps on an SM.
    PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Word32
shaderWarpsPerSM :: Word32
  }
  deriving (Typeable, PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Bool
(PhysicalDeviceShaderSMBuiltinsPropertiesNV
 -> PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Bool)
-> (PhysicalDeviceShaderSMBuiltinsPropertiesNV
    -> PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Bool)
-> Eq PhysicalDeviceShaderSMBuiltinsPropertiesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Bool
$c/= :: PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Bool
== :: PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Bool
$c== :: PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceShaderSMBuiltinsPropertiesNV)
#endif
deriving instance Show PhysicalDeviceShaderSMBuiltinsPropertiesNV

instance ToCStruct PhysicalDeviceShaderSMBuiltinsPropertiesNV where
  withCStruct :: PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> (Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> IO b) -> IO b
withCStruct PhysicalDeviceShaderSMBuiltinsPropertiesNV
x Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> IO b
f = Int
-> (Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> IO b) -> IO b)
-> (Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p -> Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> PhysicalDeviceShaderSMBuiltinsPropertiesNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p PhysicalDeviceShaderSMBuiltinsPropertiesNV
x (Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> IO b
f Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p)
  pokeCStruct :: Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> PhysicalDeviceShaderSMBuiltinsPropertiesNV -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p PhysicalDeviceShaderSMBuiltinsPropertiesNV{Word32
shaderWarpsPerSM :: Word32
shaderSMCount :: Word32
$sel:shaderWarpsPerSM:PhysicalDeviceShaderSMBuiltinsPropertiesNV :: PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Word32
$sel:shaderSMCount:PhysicalDeviceShaderSMBuiltinsPropertiesNV :: PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_SM_BUILTINS_PROPERTIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> 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 PhysicalDeviceShaderSMBuiltinsPropertiesNV
p Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
shaderSMCount)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
shaderWarpsPerSM)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_SM_BUILTINS_PROPERTIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
p Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV
-> 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 PhysicalDeviceShaderSMBuiltinsPropertiesNV
p Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> 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 PhysicalDeviceShaderSMBuiltinsPropertiesNV
p Ptr PhysicalDeviceShaderSMBuiltinsPropertiesNV -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

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

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

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


-- | VkPhysicalDeviceShaderSMBuiltinsFeaturesNV - Structure describing the
-- shader SM Builtins features that can be supported by an implementation
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceShaderSMBuiltinsFeaturesNV' 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. 'PhysicalDeviceShaderSMBuiltinsFeaturesNV' /can/ also be used
-- in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_shader_sm_builtins VK_NV_shader_sm_builtins>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceShaderSMBuiltinsFeaturesNV = PhysicalDeviceShaderSMBuiltinsFeaturesNV
  { -- | #features-shaderSMBuiltins# @shaderSMBuiltins@ indicates whether the
    -- implementation supports the SPIR-V @ShaderSMBuiltinsNV@ capability.
    PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Bool
shaderSMBuiltins :: Bool }
  deriving (Typeable, PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Bool
(PhysicalDeviceShaderSMBuiltinsFeaturesNV
 -> PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Bool)
-> (PhysicalDeviceShaderSMBuiltinsFeaturesNV
    -> PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Bool)
-> Eq PhysicalDeviceShaderSMBuiltinsFeaturesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Bool
$c/= :: PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Bool
== :: PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Bool
$c== :: PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceShaderSMBuiltinsFeaturesNV)
#endif
deriving instance Show PhysicalDeviceShaderSMBuiltinsFeaturesNV

instance ToCStruct PhysicalDeviceShaderSMBuiltinsFeaturesNV where
  withCStruct :: PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> (Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> IO b) -> IO b
withCStruct PhysicalDeviceShaderSMBuiltinsFeaturesNV
x Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> IO b
f = Int
-> (Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> IO b) -> IO b)
-> (Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
p -> Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> PhysicalDeviceShaderSMBuiltinsFeaturesNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
p PhysicalDeviceShaderSMBuiltinsFeaturesNV
x (Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> IO b
f Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
p)
  pokeCStruct :: Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> PhysicalDeviceShaderSMBuiltinsFeaturesNV -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
p PhysicalDeviceShaderSMBuiltinsFeaturesNV{Bool
shaderSMBuiltins :: Bool
$sel:shaderSMBuiltins:PhysicalDeviceShaderSMBuiltinsFeaturesNV :: PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
p Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_SM_BUILTINS_FEATURES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
p Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> 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 PhysicalDeviceShaderSMBuiltinsFeaturesNV
p Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderSMBuiltins))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
p Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_SM_BUILTINS_FEATURES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV
p Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> 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 PhysicalDeviceShaderSMBuiltinsFeaturesNV
p Ptr PhysicalDeviceShaderSMBuiltinsFeaturesNV -> 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))
    IO b
f

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

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

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


type NV_SHADER_SM_BUILTINS_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_NV_SHADER_SM_BUILTINS_SPEC_VERSION"
pattern NV_SHADER_SM_BUILTINS_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_SHADER_SM_BUILTINS_SPEC_VERSION :: a
$mNV_SHADER_SM_BUILTINS_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
NV_SHADER_SM_BUILTINS_SPEC_VERSION = 1


type NV_SHADER_SM_BUILTINS_EXTENSION_NAME = "VK_NV_shader_sm_builtins"

-- No documentation found for TopLevel "VK_NV_SHADER_SM_BUILTINS_EXTENSION_NAME"
pattern NV_SHADER_SM_BUILTINS_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_SHADER_SM_BUILTINS_EXTENSION_NAME :: a
$mNV_SHADER_SM_BUILTINS_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
NV_SHADER_SM_BUILTINS_EXTENSION_NAME = "VK_NV_shader_sm_builtins"