{-# language CPP #-}
module Vulkan.Core11.Promoted_From_VK_KHR_device_group_creation ( enumeratePhysicalDeviceGroups
, PhysicalDeviceGroupProperties(..)
, DeviceGroupDeviceCreateInfo(..)
, StructureType(..)
, MemoryHeapFlagBits(..)
, MemoryHeapFlags
, MAX_DEVICE_GROUP_SIZE
, pattern MAX_DEVICE_GROUP_SIZE
) where
import Vulkan.CStruct.Utils (FixedArray)
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 (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
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 GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
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.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Instance)
import Vulkan.Core10.Handles (Instance(..))
import Vulkan.Core10.Handles (Instance(Instance))
import Vulkan.Dynamic (InstanceCmds(pVkEnumeratePhysicalDeviceGroups))
import Vulkan.Core10.Handles (Instance_T)
import Vulkan.Core10.APIConstants (MAX_DEVICE_GROUP_SIZE)
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.APIConstants (pattern MAX_DEVICE_GROUP_SIZE)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEVICE_GROUP_DEVICE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_GROUP_PROPERTIES))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.APIConstants (MAX_DEVICE_GROUP_SIZE)
import Vulkan.Core10.Enums.MemoryHeapFlagBits (MemoryHeapFlagBits(..))
import Vulkan.Core10.Enums.MemoryHeapFlagBits (MemoryHeapFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
import Vulkan.Core10.APIConstants (pattern MAX_DEVICE_GROUP_SIZE)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkEnumeratePhysicalDeviceGroups
:: FunPtr (Ptr Instance_T -> Ptr Word32 -> Ptr PhysicalDeviceGroupProperties -> IO Result) -> Ptr Instance_T -> Ptr Word32 -> Ptr PhysicalDeviceGroupProperties -> IO Result
enumeratePhysicalDeviceGroups :: forall io
. (MonadIO io)
=>
Instance
-> io (Result, ("physicalDeviceGroupProperties" ::: Vector PhysicalDeviceGroupProperties))
enumeratePhysicalDeviceGroups :: forall (io :: * -> *).
MonadIO io =>
Instance
-> io
(Result,
"physicalDeviceGroupProperties"
::: Vector PhysicalDeviceGroupProperties)
enumeratePhysicalDeviceGroups Instance
instance' = 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 vkEnumeratePhysicalDeviceGroupsPtr :: FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceGroupCount" ::: Ptr Word32)
-> ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO Result)
vkEnumeratePhysicalDeviceGroupsPtr = InstanceCmds
-> FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceGroupCount" ::: Ptr Word32)
-> ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO Result)
pVkEnumeratePhysicalDeviceGroups (case Instance
instance' of Instance{InstanceCmds
$sel:instanceCmds:Instance :: Instance -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
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 Instance_T
-> ("pPhysicalDeviceGroupCount" ::: Ptr Word32)
-> ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO Result)
vkEnumeratePhysicalDeviceGroupsPtr 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 vkEnumeratePhysicalDeviceGroups is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkEnumeratePhysicalDeviceGroups' :: Ptr Instance_T
-> ("pPhysicalDeviceGroupCount" ::: Ptr Word32)
-> ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO Result
vkEnumeratePhysicalDeviceGroups' = FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceGroupCount" ::: Ptr Word32)
-> ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO Result)
-> Ptr Instance_T
-> ("pPhysicalDeviceGroupCount" ::: Ptr Word32)
-> ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO Result
mkVkEnumeratePhysicalDeviceGroups FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceGroupCount" ::: Ptr Word32)
-> ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO Result)
vkEnumeratePhysicalDeviceGroupsPtr
let instance'' :: Ptr Instance_T
instance'' = Instance -> Ptr Instance_T
instanceHandle (Instance
instance')
"pPhysicalDeviceGroupCount" ::: Ptr Word32
pPPhysicalDeviceGroupCount <- 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
"vkEnumeratePhysicalDeviceGroups" (Ptr Instance_T
-> ("pPhysicalDeviceGroupCount" ::: Ptr Word32)
-> ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO Result
vkEnumeratePhysicalDeviceGroups'
Ptr Instance_T
instance''
("pPhysicalDeviceGroupCount" ::: Ptr Word32
pPPhysicalDeviceGroupCount)
(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
pPhysicalDeviceGroupCount <- 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 "pPhysicalDeviceGroupCount" ::: Ptr Word32
pPPhysicalDeviceGroupCount
"pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
pPPhysicalDeviceGroupProperties <- 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 @PhysicalDeviceGroupProperties ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPhysicalDeviceGroupCount)) forall a. Num a => a -> a -> a
* Int
288)) 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 ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
pPPhysicalDeviceGroupProperties forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
288) :: Ptr PhysicalDeviceGroupProperties) 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
pPhysicalDeviceGroupCount)) 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
"vkEnumeratePhysicalDeviceGroups" (Ptr Instance_T
-> ("pPhysicalDeviceGroupCount" ::: Ptr Word32)
-> ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO Result
vkEnumeratePhysicalDeviceGroups'
Ptr Instance_T
instance''
("pPhysicalDeviceGroupCount" ::: Ptr Word32
pPPhysicalDeviceGroupCount)
(("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
pPPhysicalDeviceGroupProperties)))
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
pPhysicalDeviceGroupCount' <- 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 "pPhysicalDeviceGroupCount" ::: Ptr Word32
pPPhysicalDeviceGroupCount
"physicalDeviceGroupProperties"
::: Vector PhysicalDeviceGroupProperties
pPhysicalDeviceGroupProperties' <- 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
pPhysicalDeviceGroupCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceGroupProperties ((("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
pPPhysicalDeviceGroupProperties) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
288 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr PhysicalDeviceGroupProperties)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "physicalDeviceGroupProperties"
::: Vector PhysicalDeviceGroupProperties
pPhysicalDeviceGroupProperties')
data PhysicalDeviceGroupProperties = PhysicalDeviceGroupProperties
{
PhysicalDeviceGroupProperties -> Word32
physicalDeviceCount :: Word32
,
PhysicalDeviceGroupProperties -> Vector (Ptr PhysicalDevice_T)
physicalDevices :: Vector (Ptr PhysicalDevice_T)
,
PhysicalDeviceGroupProperties -> Bool
subsetAllocation :: Bool
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceGroupProperties)
#endif
deriving instance Show PhysicalDeviceGroupProperties
instance ToCStruct PhysicalDeviceGroupProperties where
withCStruct :: forall b.
PhysicalDeviceGroupProperties
-> (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO b)
-> IO b
withCStruct PhysicalDeviceGroupProperties
x ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
288 forall a b. (a -> b) -> a -> b
$ \"pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p PhysicalDeviceGroupProperties
x (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO b
f "pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p)
pokeCStruct :: forall b.
("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> PhysicalDeviceGroupProperties -> IO b -> IO b
pokeCStruct "pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p PhysicalDeviceGroupProperties{Bool
Word32
Vector (Ptr PhysicalDevice_T)
subsetAllocation :: Bool
physicalDevices :: Vector (Ptr PhysicalDevice_T)
physicalDeviceCount :: Word32
$sel:subsetAllocation:PhysicalDeviceGroupProperties :: PhysicalDeviceGroupProperties -> Bool
$sel:physicalDevices:PhysicalDeviceGroupProperties :: PhysicalDeviceGroupProperties -> Vector (Ptr PhysicalDevice_T)
$sel:physicalDeviceCount:PhysicalDeviceGroupProperties :: PhysicalDeviceGroupProperties -> Word32
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_GROUP_PROPERTIES)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
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 (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
physicalDeviceCount)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector (Ptr PhysicalDevice_T)
physicalDevices)) forall a. Ord a => a -> a -> Bool
<= forall a. Integral a => a
MAX_DEVICE_GROUP_SIZE) 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
"physicalDevices is too long, a maximum of MAX_DEVICE_GROUP_SIZE elements are allowed" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Ptr PhysicalDevice_T
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ((forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (FixedArray MAX_DEVICE_GROUP_SIZE (Ptr PhysicalDevice_T))))) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr PhysicalDevice_T)) (Ptr PhysicalDevice_T
e)) (Vector (Ptr PhysicalDevice_T)
physicalDevices)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
280 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
subsetAllocation))
IO b
f
cStructSize :: Int
cStructSize = Int
288
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO b -> IO b
pokeZeroCStruct "pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_GROUP_PROPERTIES)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
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 (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
280 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceGroupProperties where
peekCStruct :: ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO PhysicalDeviceGroupProperties
peekCStruct "pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p = do
Word32
physicalDeviceCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
Vector (Ptr PhysicalDevice_T)
physicalDevices <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a. Integral a => a
MAX_DEVICE_GROUP_SIZE) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @(Ptr PhysicalDevice_T) (((forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @(Ptr PhysicalDevice_T) (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (FixedArray MAX_DEVICE_GROUP_SIZE (Ptr PhysicalDevice_T))))) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr PhysicalDevice_T))))
Bool32
subsetAllocation <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
280 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> Vector (Ptr PhysicalDevice_T)
-> Bool
-> PhysicalDeviceGroupProperties
PhysicalDeviceGroupProperties
Word32
physicalDeviceCount Vector (Ptr PhysicalDevice_T)
physicalDevices (Bool32 -> Bool
bool32ToBool Bool32
subsetAllocation)
instance Storable PhysicalDeviceGroupProperties where
sizeOf :: PhysicalDeviceGroupProperties -> Int
sizeOf ~PhysicalDeviceGroupProperties
_ = Int
288
alignment :: PhysicalDeviceGroupProperties -> Int
alignment ~PhysicalDeviceGroupProperties
_ = Int
8
peek :: ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> IO PhysicalDeviceGroupProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties)
-> PhysicalDeviceGroupProperties -> IO ()
poke "pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
ptr PhysicalDeviceGroupProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pPhysicalDeviceGroupProperties"
::: Ptr PhysicalDeviceGroupProperties
ptr PhysicalDeviceGroupProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceGroupProperties where
zero :: PhysicalDeviceGroupProperties
zero = Word32
-> Vector (Ptr PhysicalDevice_T)
-> Bool
-> PhysicalDeviceGroupProperties
PhysicalDeviceGroupProperties
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
forall a. Zero a => a
zero
data DeviceGroupDeviceCreateInfo = DeviceGroupDeviceCreateInfo
{
DeviceGroupDeviceCreateInfo -> Vector (Ptr PhysicalDevice_T)
physicalDevices :: Vector (Ptr PhysicalDevice_T) }
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceGroupDeviceCreateInfo)
#endif
deriving instance Show DeviceGroupDeviceCreateInfo
instance ToCStruct DeviceGroupDeviceCreateInfo where
withCStruct :: forall b.
DeviceGroupDeviceCreateInfo
-> (Ptr DeviceGroupDeviceCreateInfo -> IO b) -> IO b
withCStruct DeviceGroupDeviceCreateInfo
x Ptr DeviceGroupDeviceCreateInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr DeviceGroupDeviceCreateInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DeviceGroupDeviceCreateInfo
p DeviceGroupDeviceCreateInfo
x (Ptr DeviceGroupDeviceCreateInfo -> IO b
f Ptr DeviceGroupDeviceCreateInfo
p)
pokeCStruct :: forall b.
Ptr DeviceGroupDeviceCreateInfo
-> DeviceGroupDeviceCreateInfo -> IO b -> IO b
pokeCStruct Ptr DeviceGroupDeviceCreateInfo
p DeviceGroupDeviceCreateInfo{Vector (Ptr PhysicalDevice_T)
physicalDevices :: Vector (Ptr PhysicalDevice_T)
$sel:physicalDevices:DeviceGroupDeviceCreateInfo :: DeviceGroupDeviceCreateInfo -> Vector (Ptr PhysicalDevice_T)
..} 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 ((Ptr DeviceGroupDeviceCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_GROUP_DEVICE_CREATE_INFO)
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 ((Ptr DeviceGroupDeviceCreateInfo
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 a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceGroupDeviceCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector (Ptr PhysicalDevice_T)
physicalDevices)) :: Word32))
Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices' <- 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. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(Ptr PhysicalDevice_T) ((forall a. Vector a -> Int
Data.Vector.length (Vector (Ptr PhysicalDevice_T)
physicalDevices)) forall a. Num a => a -> a -> a
* Int
8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Ptr PhysicalDevice_T
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr PhysicalDevice_T)) (Ptr PhysicalDevice_T
e)) (Vector (Ptr PhysicalDevice_T)
physicalDevices)
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 ((Ptr DeviceGroupDeviceCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr (Ptr PhysicalDevice_T)))) (Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices')
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
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr DeviceGroupDeviceCreateInfo -> IO b -> IO b
pokeZeroCStruct Ptr DeviceGroupDeviceCreateInfo
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceGroupDeviceCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_GROUP_DEVICE_CREATE_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DeviceGroupDeviceCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
IO b
f
instance FromCStruct DeviceGroupDeviceCreateInfo where
peekCStruct :: Ptr DeviceGroupDeviceCreateInfo -> IO DeviceGroupDeviceCreateInfo
peekCStruct Ptr DeviceGroupDeviceCreateInfo
p = do
Word32
physicalDeviceCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DeviceGroupDeviceCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
Ptr (Ptr PhysicalDevice_T)
pPhysicalDevices <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr PhysicalDevice_T)) ((Ptr DeviceGroupDeviceCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr (Ptr PhysicalDevice_T))))
Vector (Ptr PhysicalDevice_T)
pPhysicalDevices' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
physicalDeviceCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @(Ptr PhysicalDevice_T) ((Ptr (Ptr PhysicalDevice_T)
pPhysicalDevices forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr PhysicalDevice_T))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector (Ptr PhysicalDevice_T) -> DeviceGroupDeviceCreateInfo
DeviceGroupDeviceCreateInfo
Vector (Ptr PhysicalDevice_T)
pPhysicalDevices'
instance Zero DeviceGroupDeviceCreateInfo where
zero :: DeviceGroupDeviceCreateInfo
zero = Vector (Ptr PhysicalDevice_T) -> DeviceGroupDeviceCreateInfo
DeviceGroupDeviceCreateInfo
forall a. Monoid a => a
mempty