{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_device_memory_report ( PhysicalDeviceDeviceMemoryReportFeaturesEXT(..)
, DeviceDeviceMemoryReportCreateInfoEXT(..)
, DeviceMemoryReportCallbackDataEXT(..)
, DeviceMemoryReportFlagsEXT(..)
, DeviceMemoryReportEventTypeEXT( DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT
, DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT
, DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT
, DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT
, DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT
, ..
)
, PFN_vkDeviceMemoryReportCallbackEXT
, FN_vkDeviceMemoryReportCallbackEXT
, EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION
, pattern EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION
, EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME
, pattern EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME
) where
import Data.Bits (Bits)
import Data.Bits (FiniteBits)
import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Numeric (showHex)
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 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 Data.Int (Int32)
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.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Core10.Enums.ObjectType (ObjectType)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_DEVICE_MEMORY_REPORT_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_MEMORY_REPORT_CALLBACK_DATA_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_MEMORY_REPORT_FEATURES_EXT))
data PhysicalDeviceDeviceMemoryReportFeaturesEXT = PhysicalDeviceDeviceMemoryReportFeaturesEXT
{
PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
deviceMemoryReport :: Bool }
deriving (Typeable, PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
$c/= :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
== :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
$c== :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDeviceMemoryReportFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceDeviceMemoryReportFeaturesEXT
instance ToCStruct PhysicalDeviceDeviceMemoryReportFeaturesEXT where
withCStruct :: forall b.
PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> (Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b)
-> IO b
withCStruct PhysicalDeviceDeviceMemoryReportFeaturesEXT
x Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p PhysicalDeviceDeviceMemoryReportFeaturesEXT
x (Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b
f Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p PhysicalDeviceDeviceMemoryReportFeaturesEXT{Bool
deviceMemoryReport :: Bool
$sel:deviceMemoryReport:PhysicalDeviceDeviceMemoryReportFeaturesEXT :: PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_MEMORY_REPORT_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
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 PhysicalDeviceDeviceMemoryReportFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
deviceMemoryReport))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_MEMORY_REPORT_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
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 PhysicalDeviceDeviceMemoryReportFeaturesEXT
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 PhysicalDeviceDeviceMemoryReportFeaturesEXT where
peekCStruct :: Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> IO PhysicalDeviceDeviceMemoryReportFeaturesEXT
peekCStruct Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
p = do
Bool32
deviceMemoryReport <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
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 -> PhysicalDeviceDeviceMemoryReportFeaturesEXT
PhysicalDeviceDeviceMemoryReportFeaturesEXT
(Bool32 -> Bool
bool32ToBool Bool32
deviceMemoryReport)
instance Storable PhysicalDeviceDeviceMemoryReportFeaturesEXT where
sizeOf :: PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Int
sizeOf ~PhysicalDeviceDeviceMemoryReportFeaturesEXT
_ = Int
24
alignment :: PhysicalDeviceDeviceMemoryReportFeaturesEXT -> Int
alignment ~PhysicalDeviceDeviceMemoryReportFeaturesEXT
_ = Int
8
peek :: Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> IO PhysicalDeviceDeviceMemoryReportFeaturesEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
-> PhysicalDeviceDeviceMemoryReportFeaturesEXT -> IO ()
poke Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
ptr PhysicalDeviceDeviceMemoryReportFeaturesEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceDeviceMemoryReportFeaturesEXT where
zero :: PhysicalDeviceDeviceMemoryReportFeaturesEXT
zero = Bool -> PhysicalDeviceDeviceMemoryReportFeaturesEXT
PhysicalDeviceDeviceMemoryReportFeaturesEXT
forall a. Zero a => a
zero
data DeviceDeviceMemoryReportCreateInfoEXT = DeviceDeviceMemoryReportCreateInfoEXT
{
DeviceDeviceMemoryReportCreateInfoEXT -> DeviceMemoryReportFlagsEXT
flags :: DeviceMemoryReportFlagsEXT
,
DeviceDeviceMemoryReportCreateInfoEXT
-> PFN_vkDeviceMemoryReportCallbackEXT
pfnUserCallback :: PFN_vkDeviceMemoryReportCallbackEXT
,
DeviceDeviceMemoryReportCreateInfoEXT -> Ptr ()
userData :: Ptr ()
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceDeviceMemoryReportCreateInfoEXT)
#endif
deriving instance Show DeviceDeviceMemoryReportCreateInfoEXT
instance ToCStruct DeviceDeviceMemoryReportCreateInfoEXT where
withCStruct :: forall b.
DeviceDeviceMemoryReportCreateInfoEXT
-> (Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b) -> IO b
withCStruct DeviceDeviceMemoryReportCreateInfoEXT
x Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \Ptr DeviceDeviceMemoryReportCreateInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceDeviceMemoryReportCreateInfoEXT
p DeviceDeviceMemoryReportCreateInfoEXT
x (Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b
f Ptr DeviceDeviceMemoryReportCreateInfoEXT
p)
pokeCStruct :: forall b.
Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> DeviceDeviceMemoryReportCreateInfoEXT -> IO b -> IO b
pokeCStruct Ptr DeviceDeviceMemoryReportCreateInfoEXT
p DeviceDeviceMemoryReportCreateInfoEXT{Ptr ()
PFN_vkDeviceMemoryReportCallbackEXT
DeviceMemoryReportFlagsEXT
userData :: Ptr ()
pfnUserCallback :: PFN_vkDeviceMemoryReportCallbackEXT
flags :: DeviceMemoryReportFlagsEXT
$sel:userData:DeviceDeviceMemoryReportCreateInfoEXT :: DeviceDeviceMemoryReportCreateInfoEXT -> Ptr ()
$sel:pfnUserCallback:DeviceDeviceMemoryReportCreateInfoEXT :: DeviceDeviceMemoryReportCreateInfoEXT
-> PFN_vkDeviceMemoryReportCallbackEXT
$sel:flags:DeviceDeviceMemoryReportCreateInfoEXT :: DeviceDeviceMemoryReportCreateInfoEXT -> DeviceMemoryReportFlagsEXT
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_DEVICE_MEMORY_REPORT_CREATE_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
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 DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemoryReportFlagsEXT)) (DeviceMemoryReportFlagsEXT
flags)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PFN_vkDeviceMemoryReportCallbackEXT)) (PFN_vkDeviceMemoryReportCallbackEXT
pfnUserCallback)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr ()))) (Ptr ()
userData)
IO b
f
cStructSize :: Int
cStructSize = Int
40
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr DeviceDeviceMemoryReportCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr DeviceDeviceMemoryReportCreateInfoEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_DEVICE_MEMORY_REPORT_CREATE_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
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 DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemoryReportFlagsEXT)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PFN_vkDeviceMemoryReportCallbackEXT)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr ()))) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct DeviceDeviceMemoryReportCreateInfoEXT where
peekCStruct :: Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> IO DeviceDeviceMemoryReportCreateInfoEXT
peekCStruct Ptr DeviceDeviceMemoryReportCreateInfoEXT
p = do
DeviceMemoryReportFlagsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @DeviceMemoryReportFlagsEXT ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemoryReportFlagsEXT))
PFN_vkDeviceMemoryReportCallbackEXT
pfnUserCallback <- forall a. Storable a => Ptr a -> IO a
peek @PFN_vkDeviceMemoryReportCallbackEXT ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PFN_vkDeviceMemoryReportCallbackEXT))
Ptr ()
pUserData <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr DeviceDeviceMemoryReportCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr ())))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceMemoryReportFlagsEXT
-> PFN_vkDeviceMemoryReportCallbackEXT
-> Ptr ()
-> DeviceDeviceMemoryReportCreateInfoEXT
DeviceDeviceMemoryReportCreateInfoEXT
DeviceMemoryReportFlagsEXT
flags PFN_vkDeviceMemoryReportCallbackEXT
pfnUserCallback Ptr ()
pUserData
instance Storable DeviceDeviceMemoryReportCreateInfoEXT where
sizeOf :: DeviceDeviceMemoryReportCreateInfoEXT -> Int
sizeOf ~DeviceDeviceMemoryReportCreateInfoEXT
_ = Int
40
alignment :: DeviceDeviceMemoryReportCreateInfoEXT -> Int
alignment ~DeviceDeviceMemoryReportCreateInfoEXT
_ = Int
8
peek :: Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> IO DeviceDeviceMemoryReportCreateInfoEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr DeviceDeviceMemoryReportCreateInfoEXT
-> DeviceDeviceMemoryReportCreateInfoEXT -> IO ()
poke Ptr DeviceDeviceMemoryReportCreateInfoEXT
ptr DeviceDeviceMemoryReportCreateInfoEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceDeviceMemoryReportCreateInfoEXT
ptr DeviceDeviceMemoryReportCreateInfoEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero DeviceDeviceMemoryReportCreateInfoEXT where
zero :: DeviceDeviceMemoryReportCreateInfoEXT
zero = DeviceMemoryReportFlagsEXT
-> PFN_vkDeviceMemoryReportCallbackEXT
-> Ptr ()
-> DeviceDeviceMemoryReportCreateInfoEXT
DeviceDeviceMemoryReportCreateInfoEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data DeviceMemoryReportCallbackDataEXT = DeviceMemoryReportCallbackDataEXT
{
DeviceMemoryReportCallbackDataEXT -> DeviceMemoryReportFlagsEXT
flags :: DeviceMemoryReportFlagsEXT
,
DeviceMemoryReportCallbackDataEXT -> DeviceMemoryReportEventTypeEXT
type' :: DeviceMemoryReportEventTypeEXT
,
DeviceMemoryReportCallbackDataEXT -> Word64
memoryObjectId :: Word64
,
DeviceMemoryReportCallbackDataEXT -> Word64
size :: DeviceSize
,
DeviceMemoryReportCallbackDataEXT -> ObjectType
objectType :: ObjectType
,
DeviceMemoryReportCallbackDataEXT -> Word64
objectHandle :: Word64
,
DeviceMemoryReportCallbackDataEXT -> Word32
heapIndex :: Word32
}
deriving (Typeable, DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
$c/= :: DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
== :: DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
$c== :: DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceMemoryReportCallbackDataEXT)
#endif
deriving instance Show DeviceMemoryReportCallbackDataEXT
instance ToCStruct DeviceMemoryReportCallbackDataEXT where
withCStruct :: forall b.
DeviceMemoryReportCallbackDataEXT
-> (Ptr DeviceMemoryReportCallbackDataEXT -> IO b) -> IO b
withCStruct DeviceMemoryReportCallbackDataEXT
x Ptr DeviceMemoryReportCallbackDataEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 forall a b. (a -> b) -> a -> b
$ \Ptr DeviceMemoryReportCallbackDataEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceMemoryReportCallbackDataEXT
p DeviceMemoryReportCallbackDataEXT
x (Ptr DeviceMemoryReportCallbackDataEXT -> IO b
f Ptr DeviceMemoryReportCallbackDataEXT
p)
pokeCStruct :: forall b.
Ptr DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> IO b -> IO b
pokeCStruct Ptr DeviceMemoryReportCallbackDataEXT
p DeviceMemoryReportCallbackDataEXT{Word32
Word64
ObjectType
DeviceMemoryReportEventTypeEXT
DeviceMemoryReportFlagsEXT
heapIndex :: Word32
objectHandle :: Word64
objectType :: ObjectType
size :: Word64
memoryObjectId :: Word64
type' :: DeviceMemoryReportEventTypeEXT
flags :: DeviceMemoryReportFlagsEXT
$sel:heapIndex:DeviceMemoryReportCallbackDataEXT :: DeviceMemoryReportCallbackDataEXT -> Word32
$sel:objectHandle:DeviceMemoryReportCallbackDataEXT :: DeviceMemoryReportCallbackDataEXT -> Word64
$sel:objectType:DeviceMemoryReportCallbackDataEXT :: DeviceMemoryReportCallbackDataEXT -> ObjectType
$sel:size:DeviceMemoryReportCallbackDataEXT :: DeviceMemoryReportCallbackDataEXT -> Word64
$sel:memoryObjectId:DeviceMemoryReportCallbackDataEXT :: DeviceMemoryReportCallbackDataEXT -> Word64
$sel:type':DeviceMemoryReportCallbackDataEXT :: DeviceMemoryReportCallbackDataEXT -> DeviceMemoryReportEventTypeEXT
$sel:flags:DeviceMemoryReportCallbackDataEXT :: DeviceMemoryReportCallbackDataEXT -> DeviceMemoryReportFlagsEXT
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_MEMORY_REPORT_CALLBACK_DATA_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
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 DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemoryReportFlagsEXT)) (DeviceMemoryReportFlagsEXT
flags)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr DeviceMemoryReportEventTypeEXT)) (DeviceMemoryReportEventTypeEXT
type')
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (Word64
memoryObjectId)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceSize)) (Word64
size)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ObjectType)) (ObjectType
objectType)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word64)) (Word64
objectHandle)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Word32)) (Word32
heapIndex)
IO b
f
cStructSize :: Int
cStructSize = Int
64
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr DeviceMemoryReportCallbackDataEXT -> IO b -> IO b
pokeZeroCStruct Ptr DeviceMemoryReportCallbackDataEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_MEMORY_REPORT_CALLBACK_DATA_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
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 DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemoryReportFlagsEXT)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr DeviceMemoryReportEventTypeEXT)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ObjectType)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word64)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct DeviceMemoryReportCallbackDataEXT where
peekCStruct :: Ptr DeviceMemoryReportCallbackDataEXT
-> IO DeviceMemoryReportCallbackDataEXT
peekCStruct Ptr DeviceMemoryReportCallbackDataEXT
p = do
DeviceMemoryReportFlagsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @DeviceMemoryReportFlagsEXT ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemoryReportFlagsEXT))
DeviceMemoryReportEventTypeEXT
type' <- forall a. Storable a => Ptr a -> IO a
peek @DeviceMemoryReportEventTypeEXT ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr DeviceMemoryReportEventTypeEXT))
Word64
memoryObjectId <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word64))
Word64
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceSize))
ObjectType
objectType <- forall a. Storable a => Ptr a -> IO a
peek @ObjectType ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ObjectType))
Word64
objectHandle <- forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word64))
Word32
heapIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceMemoryReportCallbackDataEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportEventTypeEXT
-> Word64
-> Word64
-> ObjectType
-> Word64
-> Word32
-> DeviceMemoryReportCallbackDataEXT
DeviceMemoryReportCallbackDataEXT
DeviceMemoryReportFlagsEXT
flags DeviceMemoryReportEventTypeEXT
type' Word64
memoryObjectId Word64
size ObjectType
objectType Word64
objectHandle Word32
heapIndex
instance Storable DeviceMemoryReportCallbackDataEXT where
sizeOf :: DeviceMemoryReportCallbackDataEXT -> Int
sizeOf ~DeviceMemoryReportCallbackDataEXT
_ = Int
64
alignment :: DeviceMemoryReportCallbackDataEXT -> Int
alignment ~DeviceMemoryReportCallbackDataEXT
_ = Int
8
peek :: Ptr DeviceMemoryReportCallbackDataEXT
-> IO DeviceMemoryReportCallbackDataEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr DeviceMemoryReportCallbackDataEXT
-> DeviceMemoryReportCallbackDataEXT -> IO ()
poke Ptr DeviceMemoryReportCallbackDataEXT
ptr DeviceMemoryReportCallbackDataEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceMemoryReportCallbackDataEXT
ptr DeviceMemoryReportCallbackDataEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero DeviceMemoryReportCallbackDataEXT where
zero :: DeviceMemoryReportCallbackDataEXT
zero = DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportEventTypeEXT
-> Word64
-> Word64
-> ObjectType
-> Word64
-> Word32
-> DeviceMemoryReportCallbackDataEXT
DeviceMemoryReportCallbackDataEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
newtype DeviceMemoryReportFlagsEXT = DeviceMemoryReportFlagsEXT Flags
deriving newtype (DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c/= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
== :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c== :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
Eq, Eq DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> Ordering
DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
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 :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$cmin :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
max :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$cmax :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
>= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c>= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
> :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c> :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
<= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c<= :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
< :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
$c< :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT -> Bool
compare :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> Ordering
$ccompare :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> Ordering
Ord, Ptr DeviceMemoryReportFlagsEXT -> IO DeviceMemoryReportFlagsEXT
Ptr DeviceMemoryReportFlagsEXT
-> Int -> IO DeviceMemoryReportFlagsEXT
Ptr DeviceMemoryReportFlagsEXT
-> Int -> DeviceMemoryReportFlagsEXT -> IO ()
Ptr DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
DeviceMemoryReportFlagsEXT -> Int
forall b. Ptr b -> Int -> IO DeviceMemoryReportFlagsEXT
forall b. Ptr b -> Int -> DeviceMemoryReportFlagsEXT -> 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 DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
$cpoke :: Ptr DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> IO ()
peek :: Ptr DeviceMemoryReportFlagsEXT -> IO DeviceMemoryReportFlagsEXT
$cpeek :: Ptr DeviceMemoryReportFlagsEXT -> IO DeviceMemoryReportFlagsEXT
pokeByteOff :: forall b. Ptr b -> Int -> DeviceMemoryReportFlagsEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DeviceMemoryReportFlagsEXT -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO DeviceMemoryReportFlagsEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DeviceMemoryReportFlagsEXT
pokeElemOff :: Ptr DeviceMemoryReportFlagsEXT
-> Int -> DeviceMemoryReportFlagsEXT -> IO ()
$cpokeElemOff :: Ptr DeviceMemoryReportFlagsEXT
-> Int -> DeviceMemoryReportFlagsEXT -> IO ()
peekElemOff :: Ptr DeviceMemoryReportFlagsEXT
-> Int -> IO DeviceMemoryReportFlagsEXT
$cpeekElemOff :: Ptr DeviceMemoryReportFlagsEXT
-> Int -> IO DeviceMemoryReportFlagsEXT
alignment :: DeviceMemoryReportFlagsEXT -> Int
$calignment :: DeviceMemoryReportFlagsEXT -> Int
sizeOf :: DeviceMemoryReportFlagsEXT -> Int
$csizeOf :: DeviceMemoryReportFlagsEXT -> Int
Storable, DeviceMemoryReportFlagsEXT
forall a. a -> Zero a
zero :: DeviceMemoryReportFlagsEXT
$czero :: DeviceMemoryReportFlagsEXT
Zero, Eq DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT
Int -> DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT -> Bool
DeviceMemoryReportFlagsEXT -> Int
DeviceMemoryReportFlagsEXT -> Maybe Int
DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT -> Int -> Bool
DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: DeviceMemoryReportFlagsEXT -> Int
$cpopCount :: DeviceMemoryReportFlagsEXT -> Int
rotateR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$crotateR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
rotateL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$crotateL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
unsafeShiftR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cunsafeShiftR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
shiftR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cshiftR :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
unsafeShiftL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cunsafeShiftL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
shiftL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cshiftL :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
isSigned :: DeviceMemoryReportFlagsEXT -> Bool
$cisSigned :: DeviceMemoryReportFlagsEXT -> Bool
bitSize :: DeviceMemoryReportFlagsEXT -> Int
$cbitSize :: DeviceMemoryReportFlagsEXT -> Int
bitSizeMaybe :: DeviceMemoryReportFlagsEXT -> Maybe Int
$cbitSizeMaybe :: DeviceMemoryReportFlagsEXT -> Maybe Int
testBit :: DeviceMemoryReportFlagsEXT -> Int -> Bool
$ctestBit :: DeviceMemoryReportFlagsEXT -> Int -> Bool
complementBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$ccomplementBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
clearBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cclearBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
setBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$csetBit :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
bit :: Int -> DeviceMemoryReportFlagsEXT
$cbit :: Int -> DeviceMemoryReportFlagsEXT
zeroBits :: DeviceMemoryReportFlagsEXT
$czeroBits :: DeviceMemoryReportFlagsEXT
rotate :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$crotate :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
shift :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
$cshift :: DeviceMemoryReportFlagsEXT -> Int -> DeviceMemoryReportFlagsEXT
complement :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$ccomplement :: DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
xor :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$cxor :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
.|. :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$c.|. :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
.&. :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
$c.&. :: DeviceMemoryReportFlagsEXT
-> DeviceMemoryReportFlagsEXT -> DeviceMemoryReportFlagsEXT
Bits, Bits DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: DeviceMemoryReportFlagsEXT -> Int
$ccountTrailingZeros :: DeviceMemoryReportFlagsEXT -> Int
countLeadingZeros :: DeviceMemoryReportFlagsEXT -> Int
$ccountLeadingZeros :: DeviceMemoryReportFlagsEXT -> Int
finiteBitSize :: DeviceMemoryReportFlagsEXT -> Int
$cfiniteBitSize :: DeviceMemoryReportFlagsEXT -> Int
FiniteBits)
conNameDeviceMemoryReportFlagsEXT :: String
conNameDeviceMemoryReportFlagsEXT :: String
conNameDeviceMemoryReportFlagsEXT = String
"DeviceMemoryReportFlagsEXT"
enumPrefixDeviceMemoryReportFlagsEXT :: String
enumPrefixDeviceMemoryReportFlagsEXT :: String
enumPrefixDeviceMemoryReportFlagsEXT = String
""
showTableDeviceMemoryReportFlagsEXT :: [(DeviceMemoryReportFlagsEXT, String)]
showTableDeviceMemoryReportFlagsEXT :: [(DeviceMemoryReportFlagsEXT, String)]
showTableDeviceMemoryReportFlagsEXT = []
instance Show DeviceMemoryReportFlagsEXT where
showsPrec :: Int -> DeviceMemoryReportFlagsEXT -> ShowS
showsPrec =
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
String
enumPrefixDeviceMemoryReportFlagsEXT
[(DeviceMemoryReportFlagsEXT, String)]
showTableDeviceMemoryReportFlagsEXT
String
conNameDeviceMemoryReportFlagsEXT
(\(DeviceMemoryReportFlagsEXT Word32
x) -> Word32
x)
(\Word32
x -> String -> ShowS
showString String
"0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
x)
instance Read DeviceMemoryReportFlagsEXT where
readPrec :: ReadPrec DeviceMemoryReportFlagsEXT
readPrec =
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
String
enumPrefixDeviceMemoryReportFlagsEXT
[(DeviceMemoryReportFlagsEXT, String)]
showTableDeviceMemoryReportFlagsEXT
String
conNameDeviceMemoryReportFlagsEXT
Word32 -> DeviceMemoryReportFlagsEXT
DeviceMemoryReportFlagsEXT
newtype DeviceMemoryReportEventTypeEXT = DeviceMemoryReportEventTypeEXT Int32
deriving newtype (DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c/= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
== :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c== :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
Eq, Eq DeviceMemoryReportEventTypeEXT
DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Ordering
DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
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 :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
$cmin :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
max :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
$cmax :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> DeviceMemoryReportEventTypeEXT
>= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c>= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
> :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c> :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
<= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c<= :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
< :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
$c< :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Bool
compare :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Ordering
$ccompare :: DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> Ordering
Ord, Ptr DeviceMemoryReportEventTypeEXT
-> IO DeviceMemoryReportEventTypeEXT
Ptr DeviceMemoryReportEventTypeEXT
-> Int -> IO DeviceMemoryReportEventTypeEXT
Ptr DeviceMemoryReportEventTypeEXT
-> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
Ptr DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> IO ()
DeviceMemoryReportEventTypeEXT -> Int
forall b. Ptr b -> Int -> IO DeviceMemoryReportEventTypeEXT
forall b. Ptr b -> Int -> DeviceMemoryReportEventTypeEXT -> 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 DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> IO ()
$cpoke :: Ptr DeviceMemoryReportEventTypeEXT
-> DeviceMemoryReportEventTypeEXT -> IO ()
peek :: Ptr DeviceMemoryReportEventTypeEXT
-> IO DeviceMemoryReportEventTypeEXT
$cpeek :: Ptr DeviceMemoryReportEventTypeEXT
-> IO DeviceMemoryReportEventTypeEXT
pokeByteOff :: forall b. Ptr b -> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO DeviceMemoryReportEventTypeEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DeviceMemoryReportEventTypeEXT
pokeElemOff :: Ptr DeviceMemoryReportEventTypeEXT
-> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
$cpokeElemOff :: Ptr DeviceMemoryReportEventTypeEXT
-> Int -> DeviceMemoryReportEventTypeEXT -> IO ()
peekElemOff :: Ptr DeviceMemoryReportEventTypeEXT
-> Int -> IO DeviceMemoryReportEventTypeEXT
$cpeekElemOff :: Ptr DeviceMemoryReportEventTypeEXT
-> Int -> IO DeviceMemoryReportEventTypeEXT
alignment :: DeviceMemoryReportEventTypeEXT -> Int
$calignment :: DeviceMemoryReportEventTypeEXT -> Int
sizeOf :: DeviceMemoryReportEventTypeEXT -> Int
$csizeOf :: DeviceMemoryReportEventTypeEXT -> Int
Storable, DeviceMemoryReportEventTypeEXT
forall a. a -> Zero a
zero :: DeviceMemoryReportEventTypeEXT
$czero :: DeviceMemoryReportEventTypeEXT
Zero)
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT :: forall {r}.
DeviceMemoryReportEventTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT = DeviceMemoryReportEventTypeEXT 0
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT :: forall {r}.
DeviceMemoryReportEventTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT = DeviceMemoryReportEventTypeEXT 1
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT :: forall {r}.
DeviceMemoryReportEventTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT = DeviceMemoryReportEventTypeEXT 2
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT :: forall {r}.
DeviceMemoryReportEventTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT = DeviceMemoryReportEventTypeEXT 3
pattern $bDEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT :: DeviceMemoryReportEventTypeEXT
$mDEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT :: forall {r}.
DeviceMemoryReportEventTypeEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT = DeviceMemoryReportEventTypeEXT 4
{-# COMPLETE
DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT
, DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT
, DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT
, DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT
, DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT ::
DeviceMemoryReportEventTypeEXT
#-}
conNameDeviceMemoryReportEventTypeEXT :: String
conNameDeviceMemoryReportEventTypeEXT :: String
conNameDeviceMemoryReportEventTypeEXT = String
"DeviceMemoryReportEventTypeEXT"
enumPrefixDeviceMemoryReportEventTypeEXT :: String
enumPrefixDeviceMemoryReportEventTypeEXT :: String
enumPrefixDeviceMemoryReportEventTypeEXT = String
"DEVICE_MEMORY_REPORT_EVENT_TYPE_"
showTableDeviceMemoryReportEventTypeEXT :: [(DeviceMemoryReportEventTypeEXT, String)]
showTableDeviceMemoryReportEventTypeEXT :: [(DeviceMemoryReportEventTypeEXT, String)]
showTableDeviceMemoryReportEventTypeEXT =
[
( DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATE_EXT
, String
"ALLOCATE_EXT"
)
,
( DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_FREE_EXT
, String
"FREE_EXT"
)
,
( DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_IMPORT_EXT
, String
"IMPORT_EXT"
)
,
( DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_UNIMPORT_EXT
, String
"UNIMPORT_EXT"
)
,
( DeviceMemoryReportEventTypeEXT
DEVICE_MEMORY_REPORT_EVENT_TYPE_ALLOCATION_FAILED_EXT
, String
"ALLOCATION_FAILED_EXT"
)
]
instance Show DeviceMemoryReportEventTypeEXT where
showsPrec :: Int -> DeviceMemoryReportEventTypeEXT -> ShowS
showsPrec =
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
String
enumPrefixDeviceMemoryReportEventTypeEXT
[(DeviceMemoryReportEventTypeEXT, String)]
showTableDeviceMemoryReportEventTypeEXT
String
conNameDeviceMemoryReportEventTypeEXT
(\(DeviceMemoryReportEventTypeEXT Int32
x) -> Int32
x)
(forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)
instance Read DeviceMemoryReportEventTypeEXT where
readPrec :: ReadPrec DeviceMemoryReportEventTypeEXT
readPrec =
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
String
enumPrefixDeviceMemoryReportEventTypeEXT
[(DeviceMemoryReportEventTypeEXT, String)]
showTableDeviceMemoryReportEventTypeEXT
String
conNameDeviceMemoryReportEventTypeEXT
Int32 -> DeviceMemoryReportEventTypeEXT
DeviceMemoryReportEventTypeEXT
type FN_vkDeviceMemoryReportCallbackEXT = ("pCallbackData" ::: Ptr DeviceMemoryReportCallbackDataEXT) -> ("pUserData" ::: Ptr ()) -> IO ()
type PFN_vkDeviceMemoryReportCallbackEXT = FunPtr FN_vkDeviceMemoryReportCallbackEXT
type EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION = 2
pattern EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_DEVICE_MEMORY_REPORT_SPEC_VERSION :: forall a. Integral a => a
$mEXT_DEVICE_MEMORY_REPORT_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_DEVICE_MEMORY_REPORT_SPEC_VERSION = 2
type EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME = "VK_EXT_device_memory_report"
pattern EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_DEVICE_MEMORY_REPORT_EXTENSION_NAME = "VK_EXT_device_memory_report"