{-# LINE 1 "src/Gpu/Vulkan/QueryPool/Middle/Internal.hsc" #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE BlockArguments, LambdaCase #-} {-# LANGUAGE ScopedTypeVariables, TypeApplications #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-} module Gpu.Vulkan.QueryPool.Middle.Internal where import Foreign.Ptr import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Storable import Foreign.Storable.PeekPoke import Foreign.C.Enum import Data.TypeLevel.Maybe qualified as TMaybe import Data.TypeLevel.ParMaybe qualified as TPMaybe import Data.Bits import Data.Bool import Data.Word import Gpu.Vulkan.Exception.Middle.Internal import Gpu.Vulkan.Exception.Enum import Gpu.Vulkan.AllocationCallbacks.Middle.Internal qualified as AllocationCallbacks import Gpu.Vulkan.Device.Middle.Internal qualified as Device import Gpu.Vulkan.Query.Enum import Gpu.Vulkan.QueryPool.Core qualified as C enum "CreateFlagBits" ''Word32 {-# LINE 39 "src/Gpu/Vulkan/QueryPool/Middle/Internal.hsc" #-} [''Show, ''Eq, ''Storable, ''Bits] [] type CreateFlags = CreateFlagBits data CreateInfo mn = CreateInfo { forall (mn :: Maybe (*)). CreateInfo mn -> M mn createInfoNext :: TMaybe.M mn, forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlagBits createInfoFlags :: CreateFlags, forall (mn :: Maybe (*)). CreateInfo mn -> Type createInfoQueryType :: Type, forall (mn :: Maybe (*)). CreateInfo mn -> Word32 createInfoQueryCount :: Word32, forall (mn :: Maybe (*)). CreateInfo mn -> PipelineStatisticFlags createInfoPipelineStatistics :: PipelineStatisticFlags } deriving instance Show (TMaybe.M mn) => Show (CreateInfo mn) createInfoToCore :: WithPoked (TMaybe.M mn) => CreateInfo mn -> (Ptr C.CreateInfo -> IO a) -> IO () createInfoToCore :: forall (mn :: Maybe (*)) a. WithPoked (M mn) => CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO () createInfoToCore CreateInfo { createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn createInfoNext = M mn mnxt, createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlagBits createInfoFlags = CreateFlagBits Word32 flgs, createInfoQueryType :: forall (mn :: Maybe (*)). CreateInfo mn -> Type createInfoQueryType = Type Word32 tp, createInfoQueryCount :: forall (mn :: Maybe (*)). CreateInfo mn -> Word32 createInfoQueryCount = Word32 cnt, createInfoPipelineStatistics :: forall (mn :: Maybe (*)). CreateInfo mn -> PipelineStatisticFlags createInfoPipelineStatistics = PipelineStatisticFlagBits Word32 ps } Ptr CreateInfo -> IO a f = M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO () forall a b. WithPoked a => a -> (forall s. PtrS s a -> IO b) -> IO b forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b withPoked' M mn mnxt \PtrS s (M mn) pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO () forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO () withPtrS PtrS s (M mn) pnxt \(Ptr (M mn) -> Ptr () forall a b. Ptr a -> Ptr b castPtr -> Ptr () pnxt') -> CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b withPoked C.CreateInfo { createInfoSType :: () C.createInfoSType = (), createInfoPNext :: Ptr () C.createInfoPNext = Ptr () pnxt', createInfoFlags :: Word32 C.createInfoFlags = Word32 flgs, createInfoQueryType :: Word32 C.createInfoQueryType = Word32 tp, createInfoQueryCount :: Word32 C.createInfoQueryCount = Word32 cnt, createInfoPipelineStatistics :: Word32 C.createInfoPipelineStatistics = Word32 ps } Ptr CreateInfo -> IO a f newtype Q = Q C.Q deriving Int -> Q -> ShowS [Q] -> ShowS Q -> String (Int -> Q -> ShowS) -> (Q -> String) -> ([Q] -> ShowS) -> Show Q forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Q -> ShowS showsPrec :: Int -> Q -> ShowS $cshow :: Q -> String show :: Q -> String $cshowList :: [Q] -> ShowS showList :: [Q] -> ShowS Show create :: WithPoked (TMaybe.M mn) => Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO Q create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)). WithPoked (M mn) => D -> CreateInfo mn -> M A mc -> IO Q create (Device.D D dv) CreateInfo mn ci M A mc mac = Q -> Q Q (Q -> Q) -> IO Q -> IO Q forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Ptr Q -> IO Q) -> IO Q forall a b. Storable a => (Ptr a -> IO b) -> IO b alloca \Ptr Q pq -> do CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO () forall (mn :: Maybe (*)) a. WithPoked (M mn) => CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO () createInfoToCore CreateInfo mn ci \Ptr CreateInfo pci -> M A mc -> (Ptr A -> IO ()) -> IO () forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO () AllocationCallbacks.mToCore M A mc mac \Ptr A pac -> do r <- D -> Ptr CreateInfo -> Ptr A -> Ptr Q -> IO Int32 C.create D dv Ptr CreateInfo pci Ptr A pac Ptr Q pq throwUnlessSuccess $ Result r Ptr Q -> IO Q forall a. Storable a => Ptr a -> IO a peek Ptr Q pq destroy :: Device.D -> Q -> TPMaybe.M AllocationCallbacks.A md -> IO () destroy :: forall (md :: Maybe (*)). D -> Q -> M A md -> IO () destroy (Device.D D dv) (Q Q q) M A md mad = M A md -> (Ptr A -> IO ()) -> IO () forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO () AllocationCallbacks.mToCore M A md mad \Ptr A pad -> D -> Q -> Ptr A -> IO () C.destroy D dv Q q Ptr A pad reset :: Device.D -> Q -> Word32 -> Word32 -> IO () reset :: D -> Q -> Word32 -> Word32 -> IO () reset (Device.D D dv) (Q Q q) Word32 fq Word32 qc = D -> Q -> Word32 -> Word32 -> IO () C.reset D dv Q q Word32 fq Word32 qc getResultsRaw :: Device.D -> Q -> Word32 -> Word32 -> ResultFlags -> IO [Word32] getResultsRaw :: D -> Q -> Word32 -> Word32 -> ResultFlags -> IO [Word32] getResultsRaw (Device.D D dv) (Q Q q) Word32 fq Word32 qc (ResultFlagBits Word32 flgs) = Int -> (Ptr () -> IO [Word32]) -> IO [Word32] forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray (Int forall n. Integral n => n qc' Int -> Int -> Int forall a. Num a => a -> a -> a * Int 16) \Ptr () pd -> do r <- D -> Q -> Word32 -> Word32 -> Word64 -> Ptr () -> Word64 -> Word32 -> IO Int32 C.getResults D dv Q q Word32 fq Word32 qc (Word64 forall n. Integral n => n qc' Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * Word64 16) Ptr () pd Word64 16 Word32 flgs throwUnlessSuccess $ Result r peekArray (qc' * 4) $ castPtr pd where qc' :: Integral n => n qc' :: forall n. Integral n => n qc' = Word32 -> n forall a b. (Integral a, Num b) => a -> b fromIntegral Word32 qc data W32W64 (w64 :: Bool) where W32 :: Word32 -> W32W64 'False W64 :: Word64 -> W32W64 'True deriving instance Show (W32W64 w64) deriving instance Eq (W32W64 w64) instance Storable (W32W64 'False) where sizeOf :: W32W64 'False -> Int sizeOf W32W64 'False _ = forall a. Storable a => a -> Int sizeOf @Word32 Word32 forall a. HasCallStack => a undefined alignment :: W32W64 'False -> Int alignment W32W64 'False _ = forall a. Storable a => a -> Int alignment @Word32 Word32 forall a. HasCallStack => a undefined peek :: Ptr (W32W64 'False) -> IO (W32W64 'False) peek Ptr (W32W64 'False) p = Word32 -> W32W64 'False W32 (Word32 -> W32W64 'False) -> IO Word32 -> IO (W32W64 'False) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Ptr Word32 -> IO Word32 forall a. Storable a => Ptr a -> IO a peek (Ptr (W32W64 'False) -> Ptr Word32 forall a b. Ptr a -> Ptr b castPtr Ptr (W32W64 'False) p) poke :: Ptr (W32W64 'False) -> W32W64 'False -> IO () poke Ptr (W32W64 'False) p (W32 Word32 w) = Ptr Word32 -> Word32 -> IO () forall a. Storable a => Ptr a -> a -> IO () poke (Ptr (W32W64 'False) -> Ptr Word32 forall a b. Ptr a -> Ptr b castPtr Ptr (W32W64 'False) p) Word32 w instance Storable (W32W64 'True) where sizeOf :: W32W64 'True -> Int sizeOf W32W64 'True _ = forall a. Storable a => a -> Int sizeOf @Word64 Word64 forall a. HasCallStack => a undefined alignment :: W32W64 'True -> Int alignment W32W64 'True _ = forall a. Storable a => a -> Int alignment @Word64 Word64 forall a. HasCallStack => a undefined peek :: Ptr (W32W64 'True) -> IO (W32W64 'True) peek Ptr (W32W64 'True) p = Word64 -> W32W64 'True W64 (Word64 -> W32W64 'True) -> IO Word64 -> IO (W32W64 'True) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Ptr Word64 -> IO Word64 forall a. Storable a => Ptr a -> IO a peek (Ptr (W32W64 'True) -> Ptr Word64 forall a b. Ptr a -> Ptr b castPtr Ptr (W32W64 'True) p) poke :: Ptr (W32W64 'True) -> W32W64 'True -> IO () poke Ptr (W32W64 'True) p (W64 Word64 w) = Ptr Word64 -> Word64 -> IO () forall a. Storable a => Ptr a -> a -> IO () poke (Ptr (W32W64 'True) -> Ptr Word64 forall a b. Ptr a -> Ptr b castPtr Ptr (W32W64 'True) p) Word64 w instance Num (W32W64 'False) where W32 Word32 m + :: W32W64 'False -> W32W64 'False -> W32W64 'False + W32 Word32 n = Word32 -> W32W64 'False W32 (Word32 -> W32W64 'False) -> Word32 -> W32W64 'False forall a b. (a -> b) -> a -> b $ Word32 m Word32 -> Word32 -> Word32 forall a. Num a => a -> a -> a + Word32 n W32 Word32 m * :: W32W64 'False -> W32W64 'False -> W32W64 'False * W32 Word32 n = Word32 -> W32W64 'False W32 (Word32 -> W32W64 'False) -> Word32 -> W32W64 'False forall a b. (a -> b) -> a -> b $ Word32 m Word32 -> Word32 -> Word32 forall a. Num a => a -> a -> a * Word32 n abs :: W32W64 'False -> W32W64 'False abs (W32 Word32 n) = Word32 -> W32W64 'False W32 (Word32 -> W32W64 'False) -> Word32 -> W32W64 'False forall a b. (a -> b) -> a -> b $ Word32 -> Word32 forall a. Num a => a -> a abs Word32 n signum :: W32W64 'False -> W32W64 'False signum (W32 Word32 n) = Word32 -> W32W64 'False W32 (Word32 -> W32W64 'False) -> Word32 -> W32W64 'False forall a b. (a -> b) -> a -> b $ Word32 -> Word32 forall a. Num a => a -> a signum Word32 n fromInteger :: Integer -> W32W64 'False fromInteger = Word32 -> W32W64 'False W32 (Word32 -> W32W64 'False) -> (Integer -> Word32) -> Integer -> W32W64 'False forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Word32 forall a. Num a => Integer -> a fromInteger negate :: W32W64 'False -> W32W64 'False negate (W32 Word32 n) = Word32 -> W32W64 'False W32 (Word32 -> W32W64 'False) -> Word32 -> W32W64 'False forall a b. (a -> b) -> a -> b $ Word32 -> Word32 forall a. Num a => a -> a negate Word32 n instance Num (W32W64 'True) where W64 Word64 m + :: W32W64 'True -> W32W64 'True -> W32W64 'True + W64 Word64 n = Word64 -> W32W64 'True W64 (Word64 -> W32W64 'True) -> Word64 -> W32W64 'True forall a b. (a -> b) -> a -> b $ Word64 m Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 n W64 Word64 m * :: W32W64 'True -> W32W64 'True -> W32W64 'True * W64 Word64 n = Word64 -> W32W64 'True W64 (Word64 -> W32W64 'True) -> Word64 -> W32W64 'True forall a b. (a -> b) -> a -> b $ Word64 m Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * Word64 n abs :: W32W64 'True -> W32W64 'True abs (W64 Word64 n) = Word64 -> W32W64 'True W64 (Word64 -> W32W64 'True) -> Word64 -> W32W64 'True forall a b. (a -> b) -> a -> b $ Word64 -> Word64 forall a. Num a => a -> a abs Word64 n signum :: W32W64 'True -> W32W64 'True signum (W64 Word64 n) = Word64 -> W32W64 'True W64 (Word64 -> W32W64 'True) -> Word64 -> W32W64 'True forall a b. (a -> b) -> a -> b $ Word64 -> Word64 forall a. Num a => a -> a signum Word64 n fromInteger :: Integer -> W32W64 'True fromInteger = Word64 -> W32W64 'True W64 (Word64 -> W32W64 'True) -> (Integer -> Word64) -> Integer -> W32W64 'True forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Word64 forall a. Num a => Integer -> a fromInteger negate :: W32W64 'True -> W32W64 'True negate (W64 Word64 n) = Word64 -> W32W64 'True W64 (Word64 -> W32W64 'True) -> Word64 -> W32W64 'True forall a b. (a -> b) -> a -> b $ Word64 -> Word64 forall a. Num a => a -> a negate Word64 n class W32W64Tools (w64 :: Bool) where bytesOf :: Integral n => n result64Bit :: ResultFlags -> ResultFlags instance W32W64Tools False where bytesOf :: forall n. Integral n => n bytesOf = n 4 result64Bit :: ResultFlags -> ResultFlags result64Bit = (ResultFlags -> ResultFlags -> ResultFlags forall a. Bits a => a -> a -> a .&. ResultFlags -> ResultFlags forall a. Bits a => a -> a complement ResultFlags Result64Bit) instance W32W64Tools True where bytesOf :: forall n. Integral n => n bytesOf = n 8 result64Bit :: ResultFlags -> ResultFlags result64Bit = (ResultFlags -> ResultFlags -> ResultFlags forall a. Bits a => a -> a -> a .|. ResultFlags Result64Bit) getResultsW32W64 :: forall w64 . (Storable (W32W64 w64), W32W64Tools w64) => Device.D -> Q -> Word32 -> Word32 -> ResultFlags -> IO [W32W64 w64] getResultsW32W64 :: forall (w64 :: Bool). (Storable (W32W64 w64), W32W64Tools w64) => D -> Q -> Word32 -> Word32 -> ResultFlags -> IO [W32W64 w64] getResultsW32W64 (Device.D D dv) (Q Q q) Word32 fq Word32 qc (forall (w64 :: Bool). W32W64Tools w64 => ResultFlags -> ResultFlags result64Bit @w64 -> ResultFlagBits Word32 flgs) = Int -> (Ptr () -> IO [W32W64 w64]) -> IO [W32W64 w64] forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray (Int forall n. Integral n => n qc' Int -> Int -> Int forall a. Num a => a -> a -> a * Int 2) \Ptr () pd -> do r <- D -> Q -> Word32 -> Word32 -> Word64 -> Ptr () -> Word64 -> Word32 -> IO Int32 C.getResults D dv Q q Word32 fq Word32 qc (Word64 forall n. Integral n => n qc' Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * Word64 2 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * forall (w64 :: Bool) n. (W32W64Tools w64, Integral n) => n bytesOf @w64) Ptr () pd (Word64 2 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * forall (w64 :: Bool) n. (W32W64Tools w64, Integral n) => n bytesOf @w64) Word32 flgs throwUnlessSuccess $ Result r peekArray (qc' * 2) $ castPtr pd where qc' :: Integral n => n qc' :: forall n. Integral n => n qc' = Word32 -> n forall a b. (Integral a, Num b) => a -> b fromIntegral Word32 qc data Availability (av :: Bool) a where NonAvailability :: a -> Availability 'False a Availability :: Maybe a -> Availability 'True a deriving instance Show a => Show (Availability av a) instance Functor (Availability av) where fmap :: forall a b. (a -> b) -> Availability av a -> Availability av b fmap a -> b f = \case NonAvailability a x -> b -> Availability 'False b forall a. a -> Availability 'False a NonAvailability (b -> Availability 'False b) -> b -> Availability 'False b forall a b. (a -> b) -> a -> b $ a -> b f a x Availability Maybe a mx -> Maybe b -> Availability 'True b forall a. Maybe a -> Availability 'True a Availability (Maybe b -> Availability 'True b) -> Maybe b -> Availability 'True b forall a b. (a -> b) -> a -> b $ a -> b f (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe a mx class AvailabilityTools (av :: Bool) a where numOfWords :: Integral n => n resultWithAvailBit :: ResultFlags -> ResultFlags mkAvailability :: [a] -> [Availability av a] instance AvailabilityTools 'False a where numOfWords :: forall n. Integral n => n numOfWords = n 1 resultWithAvailBit :: ResultFlags -> ResultFlags resultWithAvailBit = (ResultFlags -> ResultFlags -> ResultFlags forall a. Bits a => a -> a -> a .&. ResultFlags -> ResultFlags forall a. Bits a => a -> a complement ResultFlags ResultWithAvailabilityBit) mkAvailability :: [a] -> [Availability 'False a] mkAvailability = (a -> Availability 'False a forall a. a -> Availability 'False a NonAvailability (a -> Availability 'False a) -> [a] -> [Availability 'False a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) instance (Eq n, Num n) => AvailabilityTools 'True n where numOfWords :: forall n. Integral n => n numOfWords = n 2 resultWithAvailBit :: ResultFlags -> ResultFlags resultWithAvailBit = (ResultFlags -> ResultFlags -> ResultFlags forall a. Bits a => a -> a -> a .|. ResultFlags ResultWithAvailabilityBit) mkAvailability :: [n] -> [Availability 'True n] mkAvailability = \case [] -> [] [n _] -> String -> [Availability 'True n] forall a. HasCallStack => String -> a error String "never occur" n x : n a : [n] xas -> Maybe n -> Availability 'True n forall a. Maybe a -> Availability 'True a Availability (Maybe n -> Maybe n -> Bool -> Maybe n forall a. a -> a -> Bool -> a bool Maybe n forall a. Maybe a Nothing (n -> Maybe n forall a. a -> Maybe a Just n x) (n a n -> n -> Bool forall a. Eq a => a -> a -> Bool /= n 0)) Availability 'True n -> [Availability 'True n] -> [Availability 'True n] forall a. a -> [a] -> [a] : [n] -> [Availability 'True n] forall (av :: Bool) a. AvailabilityTools av a => [a] -> [Availability av a] mkAvailability [n] xas getResults :: forall av w64 . ( Storable (W32W64 w64), W32W64Tools w64, AvailabilityTools av (W32W64 w64) ) => Device.D -> Q -> Word32 -> Word32 -> ResultFlags -> IO [Availability av (W32W64 w64)] getResults :: forall (av :: Bool) (w64 :: Bool). (Storable (W32W64 w64), W32W64Tools w64, AvailabilityTools av (W32W64 w64)) => D -> Q -> Word32 -> Word32 -> ResultFlags -> IO [Availability av (W32W64 w64)] getResults (Device.D D dv) (Q Q q) Word32 fq Word32 qc (forall (av :: Bool) a. AvailabilityTools av a => ResultFlags -> ResultFlags resultWithAvailBit @av @(W32W64 w64) (ResultFlags -> ResultFlags) -> (ResultFlags -> ResultFlags) -> ResultFlags -> ResultFlags forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (w64 :: Bool). W32W64Tools w64 => ResultFlags -> ResultFlags result64Bit @w64 -> ResultFlagBits Word32 flgs) = Int -> (Ptr () -> IO [Availability av (W32W64 w64)]) -> IO [Availability av (W32W64 w64)] forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray (Int forall n. Integral n => n qc' Int -> Int -> Int forall a. Num a => a -> a -> a * Int forall n. Integral n => n nw) \Ptr () pd -> do r <- D -> Q -> Word32 -> Word32 -> Word64 -> Ptr () -> Word64 -> Word32 -> IO Int32 C.getResults D dv Q q Word32 fq Word32 qc (Word64 forall n. Integral n => n qc' Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * Word64 forall n. Integral n => n nw Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * forall (w64 :: Bool) n. (W32W64Tools w64, Integral n) => n bytesOf @w64) Ptr () pd (Word64 forall n. Integral n => n nw Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a * forall (w64 :: Bool) n. (W32W64Tools w64, Integral n) => n bytesOf @w64) Word32 flgs throwUnlessSuccess $ Result r mkAvailability <$> peekArray (qc' * nw) (castPtr pd) where qc' :: Integral n => n qc' :: forall n. Integral n => n qc' = Word32 -> n forall a b. (Integral a, Num b) => a -> b fromIntegral Word32 qc nw :: Integral n => n nw :: forall n. Integral n => n nw = forall (av :: Bool) a n. (AvailabilityTools av a, Integral n) => n numOfWords @av @(W32W64 w64)