{-# language CPP #-}
module Vulkan.Extensions.VK_KHR_pipeline_executable_properties ( getPipelineExecutablePropertiesKHR
, getPipelineExecutableStatisticsKHR
, getPipelineExecutableInternalRepresentationsKHR
, PhysicalDevicePipelineExecutablePropertiesFeaturesKHR(..)
, PipelineInfoKHR(..)
, PipelineExecutablePropertiesKHR(..)
, PipelineExecutableInfoKHR(..)
, PipelineExecutableStatisticKHR(..)
, PipelineExecutableInternalRepresentationKHR(..)
, PipelineExecutableStatisticValueKHR(..)
, peekPipelineExecutableStatisticValueKHR
, PipelineExecutableStatisticFormatKHR( PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR
, PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR
, PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR
, PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR
, ..
)
, KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION
, pattern KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION
, KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME
, pattern KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME
) where
import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showsPrec)
import Data.ByteString (packCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Control.Monad.Trans.Cont (runContT)
import Data.Vector (generateM)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CDouble)
import Foreign.C.Types (CDouble(..))
import Foreign.C.Types (CDouble(CDouble))
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.C.Types (CSize(CSize))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Data.Int (Int64)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.Word (Word64)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineExecutableInternalRepresentationsKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineExecutablePropertiesKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineExecutableStatisticsKHR))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.APIConstants (MAX_DESCRIPTION_SIZE)
import Vulkan.Core10.Handles (Pipeline)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PIPELINE_EXECUTABLE_PROPERTIES_FEATURES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INTERNAL_REPRESENTATION_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_EXECUTABLE_PROPERTIES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_EXECUTABLE_STATISTIC_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_INFO_KHR))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPipelineExecutablePropertiesKHR
:: FunPtr (Ptr Device_T -> Ptr PipelineInfoKHR -> Ptr Word32 -> Ptr PipelineExecutablePropertiesKHR -> IO Result) -> Ptr Device_T -> Ptr PipelineInfoKHR -> Ptr Word32 -> Ptr PipelineExecutablePropertiesKHR -> IO Result
getPipelineExecutablePropertiesKHR :: forall io
. (MonadIO io)
=>
Device
->
PipelineInfoKHR
-> io (Result, ("properties" ::: Vector PipelineExecutablePropertiesKHR))
getPipelineExecutablePropertiesKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineInfoKHR
-> io
(Result, "properties" ::: Vector PipelineExecutablePropertiesKHR)
getPipelineExecutablePropertiesKHR Device
device PipelineInfoKHR
pipelineInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPipelineExecutablePropertiesKHRPtr :: FunPtr
(Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result)
vkGetPipelineExecutablePropertiesKHRPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result)
pVkGetPipelineExecutablePropertiesKHR (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result)
vkGetPipelineExecutablePropertiesKHRPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPipelineExecutablePropertiesKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPipelineExecutablePropertiesKHR' :: Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result
vkGetPipelineExecutablePropertiesKHR' = FunPtr
(Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result)
-> Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result
mkVkGetPipelineExecutablePropertiesKHR FunPtr
(Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result)
vkGetPipelineExecutablePropertiesKHRPtr
let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
"pPipelineInfo" ::: Ptr PipelineInfoKHR
pPipelineInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (PipelineInfoKHR
pipelineInfo)
"pExecutableCount" ::: Ptr Word32
pPExecutableCount <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPipelineExecutablePropertiesKHR" (Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result
vkGetPipelineExecutablePropertiesKHR'
Ptr Device_T
device'
"pPipelineInfo" ::: Ptr PipelineInfoKHR
pPipelineInfo
("pExecutableCount" ::: Ptr Word32
pPExecutableCount)
(forall a. Ptr a
nullPtr))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Word32
pExecutableCount <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pExecutableCount" ::: Ptr Word32
pPExecutableCount
"pProperties" ::: Ptr PipelineExecutablePropertiesKHR
pPProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @PipelineExecutablePropertiesKHR ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pExecutableCount)) forall a. Num a => a -> a -> a
* Int
536)) forall a. Ptr a -> IO ()
free
[()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
pPProperties forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
536) :: Ptr PipelineExecutablePropertiesKHR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pExecutableCount)) forall a. Num a => a -> a -> a
- Int
1]
Result
r' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPipelineExecutablePropertiesKHR" (Ptr Device_T
-> ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO Result
vkGetPipelineExecutablePropertiesKHR'
Ptr Device_T
device'
"pPipelineInfo" ::: Ptr PipelineInfoKHR
pPipelineInfo
("pExecutableCount" ::: Ptr Word32
pPExecutableCount)
(("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
pPProperties)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
Word32
pExecutableCount' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pExecutableCount" ::: Ptr Word32
pPExecutableCount
"properties" ::: Vector PipelineExecutablePropertiesKHR
pProperties' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pExecutableCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PipelineExecutablePropertiesKHR ((("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
pPProperties) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
536 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PipelineExecutablePropertiesKHR)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "properties" ::: Vector PipelineExecutablePropertiesKHR
pProperties')
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPipelineExecutableStatisticsKHR
:: FunPtr (Ptr Device_T -> Ptr PipelineExecutableInfoKHR -> Ptr Word32 -> Ptr PipelineExecutableStatisticKHR -> IO Result) -> Ptr Device_T -> Ptr PipelineExecutableInfoKHR -> Ptr Word32 -> Ptr PipelineExecutableStatisticKHR -> IO Result
getPipelineExecutableStatisticsKHR :: forall io
. (MonadIO io)
=>
Device
->
PipelineExecutableInfoKHR
-> io (Result, ("statistics" ::: Vector PipelineExecutableStatisticKHR))
getPipelineExecutableStatisticsKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineExecutableInfoKHR
-> io
(Result, "statistics" ::: Vector PipelineExecutableStatisticKHR)
getPipelineExecutableStatisticsKHR Device
device
PipelineExecutableInfoKHR
executableInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPipelineExecutableStatisticsKHRPtr :: FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result)
vkGetPipelineExecutableStatisticsKHRPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result)
pVkGetPipelineExecutableStatisticsKHR (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result)
vkGetPipelineExecutableStatisticsKHRPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPipelineExecutableStatisticsKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPipelineExecutableStatisticsKHR' :: Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result
vkGetPipelineExecutableStatisticsKHR' = FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result)
-> Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result
mkVkGetPipelineExecutableStatisticsKHR FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result)
vkGetPipelineExecutableStatisticsKHRPtr
let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
"pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (PipelineExecutableInfoKHR
executableInfo)
"pExecutableCount" ::: Ptr Word32
pPStatisticCount <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPipelineExecutableStatisticsKHR" (Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result
vkGetPipelineExecutableStatisticsKHR'
Ptr Device_T
device'
"pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo
("pExecutableCount" ::: Ptr Word32
pPStatisticCount)
(forall a. Ptr a
nullPtr))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Word32
pStatisticCount <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pExecutableCount" ::: Ptr Word32
pPStatisticCount
"pStatistics" ::: Ptr PipelineExecutableStatisticKHR
pPStatistics <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @PipelineExecutableStatisticKHR ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pStatisticCount)) forall a. Num a => a -> a -> a
* Int
544)) forall a. Ptr a -> IO ()
free
[()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
pPStatistics forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
544) :: Ptr PipelineExecutableStatisticKHR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pStatisticCount)) forall a. Num a => a -> a -> a
- Int
1]
Result
r' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPipelineExecutableStatisticsKHR" (Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO Result
vkGetPipelineExecutableStatisticsKHR'
Ptr Device_T
device'
"pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo
("pExecutableCount" ::: Ptr Word32
pPStatisticCount)
(("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
pPStatistics)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
Word32
pStatisticCount' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pExecutableCount" ::: Ptr Word32
pPStatisticCount
"statistics" ::: Vector PipelineExecutableStatisticKHR
pStatistics' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pStatisticCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PipelineExecutableStatisticKHR ((("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
pPStatistics) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
544 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PipelineExecutableStatisticKHR)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "statistics" ::: Vector PipelineExecutableStatisticKHR
pStatistics')
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPipelineExecutableInternalRepresentationsKHR
:: FunPtr (Ptr Device_T -> Ptr PipelineExecutableInfoKHR -> Ptr Word32 -> Ptr PipelineExecutableInternalRepresentationKHR -> IO Result) -> Ptr Device_T -> Ptr PipelineExecutableInfoKHR -> Ptr Word32 -> Ptr PipelineExecutableInternalRepresentationKHR -> IO Result
getPipelineExecutableInternalRepresentationsKHR :: forall io
. (MonadIO io)
=>
Device
->
PipelineExecutableInfoKHR
-> io (Result, ("internalRepresentations" ::: Vector PipelineExecutableInternalRepresentationKHR))
getPipelineExecutableInternalRepresentationsKHR :: forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineExecutableInfoKHR
-> io
(Result,
"internalRepresentations"
::: Vector PipelineExecutableInternalRepresentationKHR)
getPipelineExecutableInternalRepresentationsKHR Device
device
PipelineExecutableInfoKHR
executableInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPipelineExecutableInternalRepresentationsKHRPtr :: FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result)
vkGetPipelineExecutableInternalRepresentationsKHRPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result)
pVkGetPipelineExecutableInternalRepresentationsKHR (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result)
vkGetPipelineExecutableInternalRepresentationsKHRPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPipelineExecutableInternalRepresentationsKHR is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPipelineExecutableInternalRepresentationsKHR' :: Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result
vkGetPipelineExecutableInternalRepresentationsKHR' = FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result)
-> Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result
mkVkGetPipelineExecutableInternalRepresentationsKHR FunPtr
(Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result)
vkGetPipelineExecutableInternalRepresentationsKHRPtr
let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
"pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (PipelineExecutableInfoKHR
executableInfo)
"pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPipelineExecutableInternalRepresentationsKHR" (Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result
vkGetPipelineExecutableInternalRepresentationsKHR'
Ptr Device_T
device'
"pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo
("pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount)
(forall a. Ptr a
nullPtr))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Word32
pInternalRepresentationCount <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount
"pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
pPInternalRepresentations <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @PipelineExecutableInternalRepresentationKHR ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pInternalRepresentationCount)) forall a. Num a => a -> a -> a
* Int
552)) forall a. Ptr a -> IO ()
free
[()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
pPInternalRepresentations forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
552) :: Ptr PipelineExecutableInternalRepresentationKHR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pInternalRepresentationCount)) forall a. Num a => a -> a -> a
- Int
1]
Result
r' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPipelineExecutableInternalRepresentationsKHR" (Ptr Device_T
-> ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> ("pExecutableCount" ::: Ptr Word32)
-> ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO Result
vkGetPipelineExecutableInternalRepresentationsKHR'
Ptr Device_T
device'
"pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
pExecutableInfo
("pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount)
(("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
pPInternalRepresentations)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
Word32
pInternalRepresentationCount' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pExecutableCount" ::: Ptr Word32
pPInternalRepresentationCount
"internalRepresentations"
::: Vector PipelineExecutableInternalRepresentationKHR
pInternalRepresentations' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pInternalRepresentationCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PipelineExecutableInternalRepresentationKHR ((("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
pPInternalRepresentations) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
552 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PipelineExecutableInternalRepresentationKHR)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "internalRepresentations"
::: Vector PipelineExecutableInternalRepresentationKHR
pInternalRepresentations')
data PhysicalDevicePipelineExecutablePropertiesFeaturesKHR = PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
{
PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
pipelineExecutableInfo :: Bool }
deriving (Typeable, PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
$c/= :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
== :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
$c== :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePipelineExecutablePropertiesFeaturesKHR)
#endif
deriving instance Show PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
instance ToCStruct PhysicalDevicePipelineExecutablePropertiesFeaturesKHR where
withCStruct :: forall b.
PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> (Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> IO b)
-> IO b
withCStruct PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
x Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
x (Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> IO b
f Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p)
pokeCStruct :: forall b.
Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> IO b
-> IO b
pokeCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p PhysicalDevicePipelineExecutablePropertiesFeaturesKHR{Bool
pipelineExecutableInfo :: Bool
$sel:pipelineExecutableInfo:PhysicalDevicePipelineExecutablePropertiesFeaturesKHR :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PIPELINE_EXECUTABLE_PROPERTIES_FEATURES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
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 PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
pipelineExecutableInfo))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PIPELINE_EXECUTABLE_PROPERTIES_FEATURES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
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 PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDevicePipelineExecutablePropertiesFeaturesKHR where
peekCStruct :: Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> IO PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
peekCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p = do
Bool32
pipelineExecutableInfo <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
(Bool32 -> Bool
bool32ToBool Bool32
pipelineExecutableInfo)
instance Storable PhysicalDevicePipelineExecutablePropertiesFeaturesKHR where
sizeOf :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Int
sizeOf ~PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
_ = Int
24
alignment :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> Int
alignment ~PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
_ = Int
8
peek :: Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> IO PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
-> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR -> IO ()
poke Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
ptr PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDevicePipelineExecutablePropertiesFeaturesKHR where
zero :: PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
zero = Bool -> PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
PhysicalDevicePipelineExecutablePropertiesFeaturesKHR
forall a. Zero a => a
zero
data PipelineInfoKHR = PipelineInfoKHR
{
PipelineInfoKHR -> Pipeline
pipeline :: Pipeline }
deriving (Typeable, PipelineInfoKHR -> PipelineInfoKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineInfoKHR -> PipelineInfoKHR -> Bool
$c/= :: PipelineInfoKHR -> PipelineInfoKHR -> Bool
== :: PipelineInfoKHR -> PipelineInfoKHR -> Bool
$c== :: PipelineInfoKHR -> PipelineInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineInfoKHR)
#endif
deriving instance Show PipelineInfoKHR
instance ToCStruct PipelineInfoKHR where
withCStruct :: forall b.
PipelineInfoKHR
-> (("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO b) -> IO b
withCStruct PipelineInfoKHR
x ("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pPipelineInfo" ::: Ptr PipelineInfoKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
p PipelineInfoKHR
x (("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO b
f "pPipelineInfo" ::: Ptr PipelineInfoKHR
p)
pokeCStruct :: forall b.
("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> PipelineInfoKHR -> IO b -> IO b
pokeCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
p PipelineInfoKHR{Pipeline
pipeline :: Pipeline
$sel:pipeline:PipelineInfoKHR :: PipelineInfoKHR -> Pipeline
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INFO_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
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 (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline)) (Pipeline
pipeline)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. ("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO b -> IO b
pokeZeroCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INFO_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPipelineInfo" ::: Ptr PipelineInfoKHR
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 (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PipelineInfoKHR where
peekCStruct :: ("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO PipelineInfoKHR
peekCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
p = do
Pipeline
pipeline <- forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pPipelineInfo" ::: Ptr PipelineInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Pipeline -> PipelineInfoKHR
PipelineInfoKHR
Pipeline
pipeline
instance Storable PipelineInfoKHR where
sizeOf :: PipelineInfoKHR -> Int
sizeOf ~PipelineInfoKHR
_ = Int
24
alignment :: PipelineInfoKHR -> Int
alignment ~PipelineInfoKHR
_ = Int
8
peek :: ("pPipelineInfo" ::: Ptr PipelineInfoKHR) -> IO PipelineInfoKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pPipelineInfo" ::: Ptr PipelineInfoKHR)
-> PipelineInfoKHR -> IO ()
poke "pPipelineInfo" ::: Ptr PipelineInfoKHR
ptr PipelineInfoKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pPipelineInfo" ::: Ptr PipelineInfoKHR
ptr PipelineInfoKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PipelineInfoKHR where
zero :: PipelineInfoKHR
zero = Pipeline -> PipelineInfoKHR
PipelineInfoKHR
forall a. Zero a => a
zero
data PipelineExecutablePropertiesKHR = PipelineExecutablePropertiesKHR
{
PipelineExecutablePropertiesKHR -> ShaderStageFlags
stages :: ShaderStageFlags
,
PipelineExecutablePropertiesKHR -> ByteString
name :: ByteString
,
PipelineExecutablePropertiesKHR -> ByteString
description :: ByteString
,
PipelineExecutablePropertiesKHR -> Word32
subgroupSize :: Word32
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineExecutablePropertiesKHR)
#endif
deriving instance Show PipelineExecutablePropertiesKHR
instance ToCStruct PipelineExecutablePropertiesKHR where
withCStruct :: forall b.
PipelineExecutablePropertiesKHR
-> (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO b)
-> IO b
withCStruct PipelineExecutablePropertiesKHR
x ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
536 forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p PipelineExecutablePropertiesKHR
x (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR) -> IO b
f "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p)
pokeCStruct :: forall b.
("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> PipelineExecutablePropertiesKHR -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p PipelineExecutablePropertiesKHR{Word32
ByteString
ShaderStageFlags
subgroupSize :: Word32
description :: ByteString
name :: ByteString
stages :: ShaderStageFlags
$sel:subgroupSize:PipelineExecutablePropertiesKHR :: PipelineExecutablePropertiesKHR -> Word32
$sel:description:PipelineExecutablePropertiesKHR :: PipelineExecutablePropertiesKHR -> ByteString
$sel:name:PipelineExecutablePropertiesKHR :: PipelineExecutablePropertiesKHR -> ByteString
$sel:stages:PipelineExecutablePropertiesKHR :: PipelineExecutablePropertiesKHR -> ShaderStageFlags
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_PROPERTIES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
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 (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags)) (ShaderStageFlags
stages)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
name)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr Word32)) (Word32
subgroupSize)
IO b
f
cStructSize :: Int
cStructSize = Int
536
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_PROPERTIES_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
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 (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags)) (forall a. Zero a => a
zero)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PipelineExecutablePropertiesKHR where
peekCStruct :: ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO PipelineExecutablePropertiesKHR
peekCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p = do
ShaderStageFlags
stages <- forall a. Storable a => Ptr a -> IO a
peek @ShaderStageFlags (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderStageFlags))
ByteString
name <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
Word32
subgroupSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PipelineExecutablePropertiesKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ShaderStageFlags
-> ByteString
-> ByteString
-> Word32
-> PipelineExecutablePropertiesKHR
PipelineExecutablePropertiesKHR
ShaderStageFlags
stages ByteString
name ByteString
description Word32
subgroupSize
instance Storable PipelineExecutablePropertiesKHR where
sizeOf :: PipelineExecutablePropertiesKHR -> Int
sizeOf ~PipelineExecutablePropertiesKHR
_ = Int
536
alignment :: PipelineExecutablePropertiesKHR -> Int
alignment ~PipelineExecutablePropertiesKHR
_ = Int
8
peek :: ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> IO PipelineExecutablePropertiesKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pProperties" ::: Ptr PipelineExecutablePropertiesKHR)
-> PipelineExecutablePropertiesKHR -> IO ()
poke "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
ptr PipelineExecutablePropertiesKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PipelineExecutablePropertiesKHR
ptr PipelineExecutablePropertiesKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PipelineExecutablePropertiesKHR where
zero :: PipelineExecutablePropertiesKHR
zero = ShaderStageFlags
-> ByteString
-> ByteString
-> Word32
-> PipelineExecutablePropertiesKHR
PipelineExecutablePropertiesKHR
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
forall a. Zero a => a
zero
data PipelineExecutableInfoKHR = PipelineExecutableInfoKHR
{
PipelineExecutableInfoKHR -> Pipeline
pipeline :: Pipeline
,
PipelineExecutableInfoKHR -> Word32
executableIndex :: Word32
}
deriving (Typeable, PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
$c/= :: PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
== :: PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
$c== :: PipelineExecutableInfoKHR -> PipelineExecutableInfoKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineExecutableInfoKHR)
#endif
deriving instance Show PipelineExecutableInfoKHR
instance ToCStruct PipelineExecutableInfoKHR where
withCStruct :: forall b.
PipelineExecutableInfoKHR
-> (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR) -> IO b)
-> IO b
withCStruct PipelineExecutableInfoKHR
x ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p PipelineExecutableInfoKHR
x (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR) -> IO b
f "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p)
pokeCStruct :: forall b.
("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> PipelineExecutableInfoKHR -> IO b -> IO b
pokeCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p PipelineExecutableInfoKHR{Word32
Pipeline
executableIndex :: Word32
pipeline :: Pipeline
$sel:executableIndex:PipelineExecutableInfoKHR :: PipelineExecutableInfoKHR -> Word32
$sel:pipeline:PipelineExecutableInfoKHR :: PipelineExecutableInfoKHR -> Pipeline
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INFO_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
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 (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline)) (Pipeline
pipeline)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
executableIndex)
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> IO b -> IO b
pokeZeroCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INFO_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
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 (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PipelineExecutableInfoKHR where
peekCStruct :: ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> IO PipelineExecutableInfoKHR
peekCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p = do
Pipeline
pipeline <- forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Pipeline))
Word32
executableIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Pipeline -> Word32 -> PipelineExecutableInfoKHR
PipelineExecutableInfoKHR
Pipeline
pipeline Word32
executableIndex
instance Storable PipelineExecutableInfoKHR where
sizeOf :: PipelineExecutableInfoKHR -> Int
sizeOf ~PipelineExecutableInfoKHR
_ = Int
32
alignment :: PipelineExecutableInfoKHR -> Int
alignment ~PipelineExecutableInfoKHR
_ = Int
8
peek :: ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> IO PipelineExecutableInfoKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR)
-> PipelineExecutableInfoKHR -> IO ()
poke "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
ptr PipelineExecutableInfoKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pExecutableInfo" ::: Ptr PipelineExecutableInfoKHR
ptr PipelineExecutableInfoKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PipelineExecutableInfoKHR where
zero :: PipelineExecutableInfoKHR
zero = Pipeline -> Word32 -> PipelineExecutableInfoKHR
PipelineExecutableInfoKHR
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PipelineExecutableStatisticKHR = PipelineExecutableStatisticKHR
{
PipelineExecutableStatisticKHR -> ByteString
name :: ByteString
,
PipelineExecutableStatisticKHR -> ByteString
description :: ByteString
,
PipelineExecutableStatisticKHR
-> PipelineExecutableStatisticFormatKHR
format :: PipelineExecutableStatisticFormatKHR
,
PipelineExecutableStatisticKHR
-> PipelineExecutableStatisticValueKHR
value :: PipelineExecutableStatisticValueKHR
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineExecutableStatisticKHR)
#endif
deriving instance Show PipelineExecutableStatisticKHR
instance ToCStruct PipelineExecutableStatisticKHR where
withCStruct :: forall b.
PipelineExecutableStatisticKHR
-> (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR) -> IO b)
-> IO b
withCStruct PipelineExecutableStatisticKHR
x ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
544 forall a b. (a -> b) -> a -> b
$ \"pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p PipelineExecutableStatisticKHR
x (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR) -> IO b
f "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p)
pokeCStruct :: forall b.
("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> PipelineExecutableStatisticKHR -> IO b -> IO b
pokeCStruct "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p PipelineExecutableStatisticKHR{ByteString
PipelineExecutableStatisticFormatKHR
PipelineExecutableStatisticValueKHR
value :: PipelineExecutableStatisticValueKHR
format :: PipelineExecutableStatisticFormatKHR
description :: ByteString
name :: ByteString
$sel:value:PipelineExecutableStatisticKHR :: PipelineExecutableStatisticKHR
-> PipelineExecutableStatisticValueKHR
$sel:format:PipelineExecutableStatisticKHR :: PipelineExecutableStatisticKHR
-> PipelineExecutableStatisticFormatKHR
$sel:description:PipelineExecutableStatisticKHR :: PipelineExecutableStatisticKHR -> ByteString
$sel:name:PipelineExecutableStatisticKHR :: PipelineExecutableStatisticKHR -> ByteString
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_STATISTIC_KHR)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
name)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr PipelineExecutableStatisticFormatKHR)) (PipelineExecutableStatisticFormatKHR
format)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr PipelineExecutableStatisticValueKHR)) (PipelineExecutableStatisticValueKHR
value) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
544
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO b -> IO b
pokeZeroCStruct "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_STATISTIC_KHR)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr PipelineExecutableStatisticFormatKHR)) (forall a. Zero a => a
zero)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr PipelineExecutableStatisticValueKHR)) (forall a. Zero a => a
zero) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct PipelineExecutableStatisticKHR where
peekCStruct :: ("pStatistics" ::: Ptr PipelineExecutableStatisticKHR)
-> IO PipelineExecutableStatisticKHR
peekCStruct "pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p = do
ByteString
name <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
PipelineExecutableStatisticFormatKHR
format <- forall a. Storable a => Ptr a -> IO a
peek @PipelineExecutableStatisticFormatKHR (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr PipelineExecutableStatisticFormatKHR))
PipelineExecutableStatisticValueKHR
value <- PipelineExecutableStatisticFormatKHR
-> Ptr PipelineExecutableStatisticValueKHR
-> IO PipelineExecutableStatisticValueKHR
peekPipelineExecutableStatisticValueKHR PipelineExecutableStatisticFormatKHR
format (("pStatistics" ::: Ptr PipelineExecutableStatisticKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr PipelineExecutableStatisticValueKHR))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticValueKHR
-> PipelineExecutableStatisticKHR
PipelineExecutableStatisticKHR
ByteString
name ByteString
description PipelineExecutableStatisticFormatKHR
format PipelineExecutableStatisticValueKHR
value
instance Zero PipelineExecutableStatisticKHR where
zero :: PipelineExecutableStatisticKHR
zero = ByteString
-> ByteString
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticValueKHR
-> PipelineExecutableStatisticKHR
PipelineExecutableStatisticKHR
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PipelineExecutableInternalRepresentationKHR = PipelineExecutableInternalRepresentationKHR
{
PipelineExecutableInternalRepresentationKHR -> ByteString
name :: ByteString
,
PipelineExecutableInternalRepresentationKHR -> ByteString
description :: ByteString
,
PipelineExecutableInternalRepresentationKHR -> Bool
isText :: Bool
,
PipelineExecutableInternalRepresentationKHR -> Word64
dataSize :: Word64
,
PipelineExecutableInternalRepresentationKHR -> Ptr ()
data' :: Ptr ()
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineExecutableInternalRepresentationKHR)
#endif
deriving instance Show PipelineExecutableInternalRepresentationKHR
instance ToCStruct PipelineExecutableInternalRepresentationKHR where
withCStruct :: forall b.
PipelineExecutableInternalRepresentationKHR
-> (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO b)
-> IO b
withCStruct PipelineExecutableInternalRepresentationKHR
x ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
552 forall a b. (a -> b) -> a -> b
$ \"pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p PipelineExecutableInternalRepresentationKHR
x (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO b
f "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p)
pokeCStruct :: forall b.
("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> PipelineExecutableInternalRepresentationKHR -> IO b -> IO b
pokeCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p PipelineExecutableInternalRepresentationKHR{Bool
Word64
Ptr ()
ByteString
data' :: Ptr ()
dataSize :: Word64
isText :: Bool
description :: ByteString
name :: ByteString
$sel:data':PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> Ptr ()
$sel:dataSize:PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> Word64
$sel:isText:PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> Bool
$sel:description:PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> ByteString
$sel:name:PipelineExecutableInternalRepresentationKHR :: PipelineExecutableInternalRepresentationKHR -> ByteString
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INTERNAL_REPRESENTATION_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
name)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (ByteString
description)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
isText))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
dataSize))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
544 :: Ptr (Ptr ()))) (Ptr ()
data')
IO b
f
cStructSize :: Int
cStructSize = Int
552
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO b -> IO b
pokeZeroCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_EXECUTABLE_INTERNAL_REPRESENTATION_KHR)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (forall a. Monoid a => a
mempty)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr CSize)) (Word64 -> CSize
CSize (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PipelineExecutableInternalRepresentationKHR where
peekCStruct :: ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO PipelineExecutableInternalRepresentationKHR
peekCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p = do
ByteString
name <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
ByteString
description <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
Bool32
isText <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
528 :: Ptr Bool32))
CSize
dataSize <- forall a. Storable a => Ptr a -> IO a
peek @CSize (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
536 :: Ptr CSize))
Ptr ()
pData <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) (("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
544 :: Ptr (Ptr ())))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> Bool
-> Word64
-> Ptr ()
-> PipelineExecutableInternalRepresentationKHR
PipelineExecutableInternalRepresentationKHR
ByteString
name
ByteString
description
(Bool32 -> Bool
bool32ToBool Bool32
isText)
(coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
dataSize)
Ptr ()
pData
instance Storable PipelineExecutableInternalRepresentationKHR where
sizeOf :: PipelineExecutableInternalRepresentationKHR -> Int
sizeOf ~PipelineExecutableInternalRepresentationKHR
_ = Int
552
alignment :: PipelineExecutableInternalRepresentationKHR -> Int
alignment ~PipelineExecutableInternalRepresentationKHR
_ = Int
8
peek :: ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> IO PipelineExecutableInternalRepresentationKHR
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR)
-> PipelineExecutableInternalRepresentationKHR -> IO ()
poke "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
ptr PipelineExecutableInternalRepresentationKHR
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pInternalRepresentations"
::: Ptr PipelineExecutableInternalRepresentationKHR
ptr PipelineExecutableInternalRepresentationKHR
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PipelineExecutableInternalRepresentationKHR where
zero :: PipelineExecutableInternalRepresentationKHR
zero = ByteString
-> ByteString
-> Bool
-> Word64
-> Ptr ()
-> PipelineExecutableInternalRepresentationKHR
PipelineExecutableInternalRepresentationKHR
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PipelineExecutableStatisticValueKHR
= B32 Bool
| I64 Int64
| U64 Word64
| F64 Double
deriving (Int -> PipelineExecutableStatisticValueKHR -> ShowS
[PipelineExecutableStatisticValueKHR] -> ShowS
PipelineExecutableStatisticValueKHR -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PipelineExecutableStatisticValueKHR] -> ShowS
$cshowList :: [PipelineExecutableStatisticValueKHR] -> ShowS
show :: PipelineExecutableStatisticValueKHR -> String
$cshow :: PipelineExecutableStatisticValueKHR -> String
showsPrec :: Int -> PipelineExecutableStatisticValueKHR -> ShowS
$cshowsPrec :: Int -> PipelineExecutableStatisticValueKHR -> ShowS
Show)
instance ToCStruct PipelineExecutableStatisticValueKHR where
withCStruct :: forall b.
PipelineExecutableStatisticValueKHR
-> (Ptr PipelineExecutableStatisticValueKHR -> IO b) -> IO b
withCStruct PipelineExecutableStatisticValueKHR
x Ptr PipelineExecutableStatisticValueKHR -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr PipelineExecutableStatisticValueKHR
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineExecutableStatisticValueKHR
p PipelineExecutableStatisticValueKHR
x (Ptr PipelineExecutableStatisticValueKHR -> IO b
f Ptr PipelineExecutableStatisticValueKHR
p)
pokeCStruct :: Ptr PipelineExecutableStatisticValueKHR -> PipelineExecutableStatisticValueKHR -> IO a -> IO a
pokeCStruct :: forall b.
Ptr PipelineExecutableStatisticValueKHR
-> PipelineExecutableStatisticValueKHR -> IO b -> IO b
pokeCStruct Ptr PipelineExecutableStatisticValueKHR
p = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
B32 Bool
v -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr @_ @Bool32 Ptr PipelineExecutableStatisticValueKHR
p) (Bool -> Bool32
boolToBool32 (Bool
v))
I64 Int64
v -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr @_ @Int64 Ptr PipelineExecutableStatisticValueKHR
p) (Int64
v)
U64 Word64
v -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr @_ @Word64 Ptr PipelineExecutableStatisticValueKHR
p) (Word64
v)
F64 Double
v -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr @_ @CDouble Ptr PipelineExecutableStatisticValueKHR
p) (Double -> CDouble
CDouble (Double
v))
pokeZeroCStruct :: Ptr PipelineExecutableStatisticValueKHR -> IO b -> IO b
pokeZeroCStruct :: forall b. Ptr PipelineExecutableStatisticValueKHR -> IO b -> IO b
pokeZeroCStruct Ptr PipelineExecutableStatisticValueKHR
_ IO b
f = IO b
f
cStructSize :: Int
cStructSize = Int
8
cStructAlignment :: Int
cStructAlignment = Int
8
instance Zero PipelineExecutableStatisticValueKHR where
zero :: PipelineExecutableStatisticValueKHR
zero = Int64 -> PipelineExecutableStatisticValueKHR
I64 forall a. Zero a => a
zero
peekPipelineExecutableStatisticValueKHR :: PipelineExecutableStatisticFormatKHR -> Ptr PipelineExecutableStatisticValueKHR -> IO PipelineExecutableStatisticValueKHR
peekPipelineExecutableStatisticValueKHR :: PipelineExecutableStatisticFormatKHR
-> Ptr PipelineExecutableStatisticValueKHR
-> IO PipelineExecutableStatisticValueKHR
peekPipelineExecutableStatisticValueKHR PipelineExecutableStatisticFormatKHR
tag Ptr PipelineExecutableStatisticValueKHR
p = case PipelineExecutableStatisticFormatKHR
tag of
PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR -> Bool -> PipelineExecutableStatisticValueKHR
B32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
Bool32
b32 <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (forall a b. Ptr a -> Ptr b
castPtr @_ @Bool32 Ptr PipelineExecutableStatisticValueKHR
p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool32 -> Bool
bool32ToBool Bool32
b32)
PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR -> Int64 -> PipelineExecutableStatisticValueKHR
I64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek @Int64 (forall a b. Ptr a -> Ptr b
castPtr @_ @Int64 Ptr PipelineExecutableStatisticValueKHR
p))
PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR -> Word64 -> PipelineExecutableStatisticValueKHR
U64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Storable a => Ptr a -> IO a
peek @Word64 (forall a b. Ptr a -> Ptr b
castPtr @_ @Word64 Ptr PipelineExecutableStatisticValueKHR
p))
PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR -> Double -> PipelineExecutableStatisticValueKHR
F64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
CDouble
f64 <- forall a. Storable a => Ptr a -> IO a
peek @CDouble (forall a b. Ptr a -> Ptr b
castPtr @_ @CDouble Ptr PipelineExecutableStatisticValueKHR
p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce @CDouble @Double CDouble
f64)
newtype PipelineExecutableStatisticFormatKHR = PipelineExecutableStatisticFormatKHR Int32
deriving newtype (PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c/= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
== :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c== :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
Eq, Eq PipelineExecutableStatisticFormatKHR
PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Ordering
PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
$cmin :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
max :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
$cmax :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR
>= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c>= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
> :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c> :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
<= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c<= :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
< :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
$c< :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Bool
compare :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Ordering
$ccompare :: PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> Ordering
Ord, Ptr PipelineExecutableStatisticFormatKHR
-> IO PipelineExecutableStatisticFormatKHR
Ptr PipelineExecutableStatisticFormatKHR
-> Int -> IO PipelineExecutableStatisticFormatKHR
Ptr PipelineExecutableStatisticFormatKHR
-> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
Ptr PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> IO ()
PipelineExecutableStatisticFormatKHR -> Int
forall b. Ptr b -> Int -> IO PipelineExecutableStatisticFormatKHR
forall b.
Ptr b -> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> IO ()
$cpoke :: Ptr PipelineExecutableStatisticFormatKHR
-> PipelineExecutableStatisticFormatKHR -> IO ()
peek :: Ptr PipelineExecutableStatisticFormatKHR
-> IO PipelineExecutableStatisticFormatKHR
$cpeek :: Ptr PipelineExecutableStatisticFormatKHR
-> IO PipelineExecutableStatisticFormatKHR
pokeByteOff :: forall b.
Ptr b -> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
$cpokeByteOff :: forall b.
Ptr b -> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO PipelineExecutableStatisticFormatKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO PipelineExecutableStatisticFormatKHR
pokeElemOff :: Ptr PipelineExecutableStatisticFormatKHR
-> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
$cpokeElemOff :: Ptr PipelineExecutableStatisticFormatKHR
-> Int -> PipelineExecutableStatisticFormatKHR -> IO ()
peekElemOff :: Ptr PipelineExecutableStatisticFormatKHR
-> Int -> IO PipelineExecutableStatisticFormatKHR
$cpeekElemOff :: Ptr PipelineExecutableStatisticFormatKHR
-> Int -> IO PipelineExecutableStatisticFormatKHR
alignment :: PipelineExecutableStatisticFormatKHR -> Int
$calignment :: PipelineExecutableStatisticFormatKHR -> Int
sizeOf :: PipelineExecutableStatisticFormatKHR -> Int
$csizeOf :: PipelineExecutableStatisticFormatKHR -> Int
Storable, PipelineExecutableStatisticFormatKHR
forall a. a -> Zero a
zero :: PipelineExecutableStatisticFormatKHR
$czero :: PipelineExecutableStatisticFormatKHR
Zero)
pattern $bPIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR :: PipelineExecutableStatisticFormatKHR
$mPIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR :: forall {r}.
PipelineExecutableStatisticFormatKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR = PipelineExecutableStatisticFormatKHR 0
pattern $bPIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR :: PipelineExecutableStatisticFormatKHR
$mPIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR :: forall {r}.
PipelineExecutableStatisticFormatKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR = PipelineExecutableStatisticFormatKHR 1
pattern $bPIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR :: PipelineExecutableStatisticFormatKHR
$mPIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR :: forall {r}.
PipelineExecutableStatisticFormatKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR = PipelineExecutableStatisticFormatKHR 2
pattern $bPIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR :: PipelineExecutableStatisticFormatKHR
$mPIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR :: forall {r}.
PipelineExecutableStatisticFormatKHR
-> ((# #) -> r) -> ((# #) -> r) -> r
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR = PipelineExecutableStatisticFormatKHR 3
{-# COMPLETE
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR
, PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR
, PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR
, PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR ::
PipelineExecutableStatisticFormatKHR
#-}
conNamePipelineExecutableStatisticFormatKHR :: String
conNamePipelineExecutableStatisticFormatKHR :: String
conNamePipelineExecutableStatisticFormatKHR = String
"PipelineExecutableStatisticFormatKHR"
enumPrefixPipelineExecutableStatisticFormatKHR :: String
enumPrefixPipelineExecutableStatisticFormatKHR :: String
enumPrefixPipelineExecutableStatisticFormatKHR = String
"PIPELINE_EXECUTABLE_STATISTIC_FORMAT_"
showTablePipelineExecutableStatisticFormatKHR :: [(PipelineExecutableStatisticFormatKHR, String)]
showTablePipelineExecutableStatisticFormatKHR :: [(PipelineExecutableStatisticFormatKHR, String)]
showTablePipelineExecutableStatisticFormatKHR =
[
( PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_BOOL32_KHR
, String
"BOOL32_KHR"
)
,
( PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_INT64_KHR
, String
"INT64_KHR"
)
,
( PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_UINT64_KHR
, String
"UINT64_KHR"
)
,
( PipelineExecutableStatisticFormatKHR
PIPELINE_EXECUTABLE_STATISTIC_FORMAT_FLOAT64_KHR
, String
"FLOAT64_KHR"
)
]
instance Show PipelineExecutableStatisticFormatKHR where
showsPrec :: Int -> PipelineExecutableStatisticFormatKHR -> ShowS
showsPrec =
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
String
enumPrefixPipelineExecutableStatisticFormatKHR
[(PipelineExecutableStatisticFormatKHR, String)]
showTablePipelineExecutableStatisticFormatKHR
String
conNamePipelineExecutableStatisticFormatKHR
(\(PipelineExecutableStatisticFormatKHR Int32
x) -> Int32
x)
(forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)
instance Read PipelineExecutableStatisticFormatKHR where
readPrec :: ReadPrec PipelineExecutableStatisticFormatKHR
readPrec =
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
String
enumPrefixPipelineExecutableStatisticFormatKHR
[(PipelineExecutableStatisticFormatKHR, String)]
showTablePipelineExecutableStatisticFormatKHR
String
conNamePipelineExecutableStatisticFormatKHR
Int32 -> PipelineExecutableStatisticFormatKHR
PipelineExecutableStatisticFormatKHR
type KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION = 1
pattern KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION :: forall a. Integral a => a
$mKHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_PIPELINE_EXECUTABLE_PROPERTIES_SPEC_VERSION = 1
type KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME = "VK_KHR_pipeline_executable_properties"
pattern KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mKHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
KHR_PIPELINE_EXECUTABLE_PROPERTIES_EXTENSION_NAME = "VK_KHR_pipeline_executable_properties"