gpu-vulkan 0.1.0.142 → 0.1.0.153

raw patch · 24 files changed

+529/−34 lines, 24 filesdep ~gpu-vulkan-middlePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: gpu-vulkan-middle

API changes (from Hackage documentation)

Files

• README.md +5/−0
• debug/Debug.hs +6/−0
• gpu-vulkan.cabal +10/−3
• src/Gpu/Vulkan/Buffer.hs +4/−0
• src/Gpu/Vulkan/Buffer/Internal.hs +5/−1
• src/Gpu/Vulkan/Buffer/Type.hs +3/−0
• src/Gpu/Vulkan/Device/Internal.hs +1/−1
• src/Gpu/Vulkan/Image.hs +4/−0
• src/Gpu/Vulkan/Image/Internal.hs +5/−1
• src/Gpu/Vulkan/Image/Type.hs +3/−0
• src/Gpu/Vulkan/Memory.hs +14/−6
• src/Gpu/Vulkan/Memory/Bind.hs +27/−4
• src/Gpu/Vulkan/Memory/ImageBuffer.hs +67/−17
• src/Gpu/Vulkan/Memory/Type.hs +18/−1
• src/Gpu/Vulkan/Object.hs +4/−0
• src/Gpu/Vulkan/Queue.hs +98/−0
• src/Gpu/Vulkan/Queue.hs-boot +6/−0
• src/Gpu/Vulkan/Sparse.hs +3/−0
• src/Gpu/Vulkan/Sparse/Buffer.hs +5/−0
• src/Gpu/Vulkan/Sparse/Buffer/Internal.hs +55/−0
• src/Gpu/Vulkan/Sparse/Enum.hs +5/−0
• src/Gpu/Vulkan/Sparse/Image.hs +6/−0
• src/Gpu/Vulkan/Sparse/Image/Internal.hs +120/−0
• src/Gpu/Vulkan/Sparse/Internal.hs +55/−0

@@ -1,1 +1,6 @@ # gpu-vulkan++This package is still experimental. But examples are++* https://github.com/YoshikuniJujo/test_haskell/tree/master/tribial/zenn/vulkan_blit/zenn-vulkan-blit-v1+* https://github.com/YoshikuniJujo/test_haskell/tree/master/themes/gui/vulkan/try_using

@@ -1,3 +1,9 @@+{-# LANGUAGE TemplateHaskell #-}+ module Debug where++import Language.Haskell.TH++runIO $ putStrLn "gpu-vulkan Debug: ************* DEBUG DEBUG DEBUG **************" >> pure []  debug = True

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           gpu-vulkan-version:        0.1.0.142+version:        0.1.0.153 synopsis:       Vulkan library description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/gpu-vulkan#readme> category:       GPU@@ -98,6 +98,9 @@       Gpu.Vulkan.Subpass       Gpu.Vulkan.TypeEnum       Gpu.Vulkan.VertexInput+      Gpu.Vulkan.Sparse+      Gpu.Vulkan.Sparse.Buffer+      Gpu.Vulkan.Sparse.Image   other-modules:       Gpu.Vulkan.AllocationCallbacks.Type       Gpu.Vulkan.Attachment.Enum@@ -172,6 +175,10 @@       Gpu.Vulkan.Sampler.Type       Gpu.Vulkan.Semaphore.Type       Gpu.Vulkan.ShaderModule.Internal+      Gpu.Vulkan.Sparse.Buffer.Internal+      Gpu.Vulkan.Sparse.Enum+      Gpu.Vulkan.Sparse.Image.Internal+      Gpu.Vulkan.Sparse.Internal       Gpu.Vulkan.Subpass.Enum       Gpu.Vulkan.TypeEnum.Th       Gpu.Vulkan.TypeEnum.TypeValues@@ -185,7 +192,7 @@     , bytestring <1     , containers <1     , data-default <1-    , gpu-vulkan-middle <1+    , gpu-vulkan-middle >=0.1.0.60 && <1     , hetero-parameter-list <1     , hetero-parameter-list-with-typelevel-tools <1     , language-spir-v <1@@ -225,7 +232,7 @@     , containers <1     , data-default <1     , gpu-vulkan-    , gpu-vulkan-middle <1+    , gpu-vulkan-middle >=0.1.0.60 && <1     , hetero-parameter-list <1     , hetero-parameter-list-with-typelevel-tools <1     , language-spir-v <1

@@ -33,6 +33,10 @@  	MemoryBarrier(..), MemoryBarrierListToMiddle, +	-- * UNSAFE++	unsafeToBinded,+ 	-- * ENUM  	module Gpu.Vulkan.Buffer.Enum

@@ -36,7 +36,11 @@  	-- * MEMORY BARRIER -	MemoryBarrier(..), MemoryBarrierListToMiddle(..)+	MemoryBarrier(..), MemoryBarrierListToMiddle(..),++	-- * UNSAFE++	unsafeToBinded 	 	) where 

@@ -34,3 +34,6 @@  deriving instance Eq (HeteroParList.PL VObj.Length objs) => 	Eq (Binded sm sb nm objs)++unsafeToBinded :: B sb nm objs -> Binded sm sb nm objs+unsafeToBinded (B l b) = (Binded l b)

@@ -46,7 +46,7 @@ import qualified Gpu.Vulkan.PhysicalDevice as PhysicalDevice import qualified Gpu.Vulkan.Device.Middle as M import qualified Gpu.Vulkan.QueueFamily.Middle as QueueFamily-import qualified Gpu.Vulkan.Queue as Queue+import {-# SOURCE #-} qualified Gpu.Vulkan.Queue as Queue  import Data.HeteroParList qualified as HeteroParList 

@@ -31,6 +31,10 @@  	Blit(..), SubresourceLayers(..), +	-- * OTHERS++	Subresource(..), unsafeToBinded,+ 	-- * ENUM  	module Gpu.Vulkan.Image.Enum

@@ -31,7 +31,11 @@  	-- * BLIT -	M.Blit(..), M.SubresourceLayers(..)+	M.Blit(..), M.SubresourceLayers(..),++	-- * OTHERS++	M.Subresource(..), unsafeToBinded  	) where 

@@ -12,3 +12,6 @@ newtype I s (nm :: Symbol) (fmt :: T.Format) = I M.I  newtype Binded sm si (nm :: Symbol) (fmt :: T.Format) = Binded M.I++unsafeToBinded :: I si nm fmt -> Binded sm si hm fmt+unsafeToBinded (I i) = (Binded i)

@@ -46,9 +46,13 @@  	M.Barrier(..), +	-- * OTHERS++	RawOffset(..),+ 	-- * ENUM -	module Gpu.Vulkan.Memory.Enum+	module Gpu.Vulkan.Memory.Enum,  	) where @@ -242,16 +246,20 @@ 		M.allocateInfoMemoryTypeIndex = mti }  memoryRequirementsListToSize ::-	Device.M.Size -> [Maybe Device.M.Size] -> [M.Requirements] -> Device.M.Size+	Device.M.Size -> [Maybe Device.M.Size] -> [Either AlgnSize M.Requirements] -> Device.M.Size memoryRequirementsListToSize sz0 _ [] = sz0 memoryRequirementsListToSize sz0 [] _ = sz0-memoryRequirementsListToSize sz0 (malgn : malgns) (reqs : reqss) =+memoryRequirementsListToSize sz0 (malgn : malgns) (ereqs : reqss) = 	memoryRequirementsListToSize 		(((sz0 - 1) `div` algn + 1) * algn + sz) malgns reqss 	where-	sz = M.requirementsSize reqs-	algn = (fromMaybe 1 malgn) `lcm`-		M.requirementsAlignment reqs+	sz = case ereqs of+		Left (_, s) -> s+		Right reqs -> M.requirementsSize reqs+	algn = case ereqs of+		Left (a, _) -> a+		Right reqs ->+			(fromMaybe 1 malgn) `lcm` M.requirementsAlignment reqs  -- READ AND WRITE 

@@ -16,6 +16,8 @@  	) where +import Control.Monad+ import Data.TypeLevel.Tuple.Uncurry import Data.HeteroParList qualified as HeteroParList import Data.HeteroParList (pattern (:**))@@ -32,6 +34,10 @@  import Gpu.Vulkan.Memory.Type +import Gpu.Vulkan.Object qualified as VObj++import Debug+ class (BindAll ibargs ibargs, Alignments ibargs) => Bindable ibargs instance (BindAll ibargs ibargs , Alignments ibargs) => Bindable ibargs @@ -47,20 +53,31 @@ 	bindAll dv@(Device.D mdv) (U2 ii@(Image (Image.I i)) :** ibs) m ost = do 		(_, mm) <- readM m 		(ost', sz) <- adjustOffsetSize dv ii ost+		when debug . putStrLn $ "Gpu.Vulkan.Memory.Bind.BindAll (ImageArg): (ost', sz) = " ++ show (ost', sz) 		Image.M.bindMemory mdv i mm ost' 		(U2 (ImageBinded $ Image.Binded i) :**) 			<$> bindAll dv ibs m (ost' + sz) -instance BindAll ibargs mibargs =>-	BindAll ('(sb, ('BufferArg nm objs)) ': ibargs) mibargs where+instance (VObj.SizeAlignment obj, BindAll ibargs mibargs) =>+	BindAll ('(sb, ('BufferArg nm (obj ': objs))) ': ibargs) mibargs where 	bindAll dv@(Device.D mdv) 		(U2 bb@(Buffer (Buffer.B lns b)) :** ibs) m ost  = do 		(_, mm) <- readM m 		(ost', sz) <- adjustOffsetSize dv bb ost-		Buffer.M.bindMemory mdv b mm ost'+		let	ost'' = adjust (VObj.alignment @obj) ost'+		when debug . putStrLn $ "Gpu.Vulkan.Memory.Bind.BindAll (BufferArg): " ++ show (ost', sz)+		when debug . putStrLn $ "Gpu.Vulkan.Memory.Bind.BindAll (BufferArg): ost'' = " ++ show ost''+		Buffer.M.bindMemory mdv b mm ost'' 		(U2 (BufferBinded $ Buffer.Binded lns b) :**)-			<$> bindAll dv ibs m (ost' + sz)+			<$> bindAll dv ibs m (ost'' + sz) +instance BindAll ibargs mibargs =>+	BindAll ('(sb, 'RawArg) ': ibargs) mibargs where+	bindAll dv (U2 bb@(Raw a s) :** ibs) m ost  = do+		(ost', sz) <- adjustOffsetSize dv bb ost+		when debug . putStrLn $ "Gpu.Vulkan.Memory.Bind.BindAll (RawArg): " ++ show (ost', sz)+		(U2 (RawBinded a s) :**) <$> bindAll dv ibs m (ost' + sz)+ class (RebindAll ibargs ibargs, Alignments ibargs) => Rebindable ibargs instance (RebindAll ibargs ibargs, Alignments ibargs) => Rebindable ibargs @@ -87,4 +104,10 @@ 		(_, mm) <- readM m 		(ost', sz) <- adjustOffsetSizeBinded dv bb ost 		Buffer.M.bindMemory mdv b mm ost'+		rebindAll dv ibs m $ ost' + sz++instance RebindAll ibargs mibargs =>+	RebindAll ('(sb, 'RawArg) ': ibargs) mibargs where+	rebindAll dv (U2 bb :** ibs) m ost = do+		(ost', sz) <- adjustOffsetSizeBinded dv bb ost 		rebindAll dv ibs m $ ost' + sz

@@ -7,7 +7,7 @@ {-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-} {-# LANGUAGE PatternSynonyms, ViewPatterns #-}-{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-}  module Gpu.Vulkan.Memory.ImageBuffer (@@ -30,8 +30,16 @@  	-- * FOR READ AND WRITE -	ObjectLength(..)+	ObjectLength(..), +	-- * OTHERS++	AlgnSize, adjust,++	-- * RAW OFFSET++	RawOffset(..), RawOffsetToOffset(..)+ 	) where  import Prelude hiding (map, read)@@ -47,6 +55,7 @@  import qualified Gpu.Vulkan.TypeEnum as T +import qualified Gpu.Vulkan.Device as Device import qualified Gpu.Vulkan.Device.Type as Device import qualified Gpu.Vulkan.Device.Middle as Device.M @@ -54,11 +63,14 @@ import qualified Gpu.Vulkan.Buffer.Middle as Buffer.M import qualified Gpu.Vulkan.Memory.Middle as Memory.M +import qualified Data.HeteroParList as HPList+ -- IMAGE BUFFER  data ImageBuffer s (ibarg :: ImageBufferArg) where 	Image :: Image.I si nm fmt -> ImageBuffer si ('ImageArg nm fmt) 	Buffer :: Buffer.B sb nm objs -> ImageBuffer sb ('BufferArg nm objs)+	Raw :: Device.M.Size -> Device.M.Size -> ImageBuffer s RawArg  deriving instance Show (HeteroParList.PL VObj.Length objs) => 	Show (ImageBuffer sib ('BufferArg nm objs))@@ -68,51 +80,62 @@ 		ImageBufferBinded sm si ('ImageArg nm fmt) 	BufferBinded :: Buffer.Binded sm sb nm objs -> 		ImageBufferBinded sm sb ('BufferArg nm objs)+	RawBinded :: Device.M.Size -> Device.M.Size ->+		ImageBufferBinded sm sb RawArg  deriving instance Show (HeteroParList.PL VObj.Length objs) => 	Show (ImageBufferBinded sm sib ('BufferArg nm objs)) -data ImageBufferArg = ImageArg Symbol T.Format | BufferArg Symbol [VObj.O]+data ImageBufferArg =+	ImageArg Symbol T.Format | BufferArg Symbol [VObj.O] | RawArg  -- GET REQUIREMENTS LIST -getRequirementsList :: Device.D sd ->-	HeteroParList.PL (U2 ImageBuffer) ibargs -> IO [Memory.M.Requirements]+type AlgnSize = (Device.M.Size, Device.M.Size)++getRequirementsList ::+	Device.D sd -> HeteroParList.PL (U2 ImageBuffer) ibargs ->+	IO [Either AlgnSize Memory.M.Requirements] getRequirementsList dv = 	HeteroParList.toListM \(U2 bi) -> getMemoryRequirements dv bi  getRequirementsListBinded :: 	Device.D sd -> HeteroParList.PL (U2 (ImageBufferBinded sm)) ibargs ->-	IO [Memory.M.Requirements]+	IO [Either AlgnSize Memory.M.Requirements] getRequirementsListBinded dv = 	HeteroParList.toListM \(U2 bi) -> getMemoryRequirementsBinded dv bi  getMemoryRequirements ::-	Device.D sd -> ImageBuffer sib fos -> IO Memory.M.Requirements+	Device.D sd -> ImageBuffer sib fos -> IO (Either AlgnSize Memory.M.Requirements) getMemoryRequirements (Device.D dv) = \case-	Buffer (Buffer.B _ b) -> Buffer.M.getMemoryRequirements dv b-	Image (Image.I i) -> Image.M.getMemoryRequirements dv i+	Buffer (Buffer.B _ b) -> Right <$> Buffer.M.getMemoryRequirements dv b+	Image (Image.I i) -> Right <$> Image.M.getMemoryRequirements dv i+	Raw algn sz -> pure $ Left (algn, sz)  getMemoryRequirementsBinded ::-	Device.D sd -> ImageBufferBinded sm sib fos -> IO Memory.M.Requirements+	Device.D sd -> ImageBufferBinded sm sib fos -> IO (Either AlgnSize Memory.M.Requirements) getMemoryRequirementsBinded (Device.D dv) = \case-	BufferBinded (Buffer.Binded _ b) -> Buffer.M.getMemoryRequirements dv b-	ImageBinded (Image.Binded i) -> Image.M.getMemoryRequirements dv i+	BufferBinded (Buffer.Binded _ b) -> Right <$> Buffer.M.getMemoryRequirements dv b+	ImageBinded (Image.Binded i) -> Right <$> Image.M.getMemoryRequirements dv i+	RawBinded algn sz -> pure $ Left (algn, sz)  -- ADJUST OFFSET AND GET SIZE  adjustOffsetSize :: Device.D sd -> ImageBuffer sib ibarg -> Device.M.Size -> 	IO (Device.M.Size, Device.M.Size)-adjustOffsetSize dv ib ost = (<$> getMemoryRequirements dv ib) \rs -> (-	adjust (Memory.M.requirementsAlignment rs) ost,-	Memory.M.requirementsSize rs )+adjustOffsetSize dv ib ost = (<$> getMemoryRequirements dv ib) \case+	Right rs -> (+		adjust (Memory.M.requirementsAlignment rs) ost,+		Memory.M.requirementsSize rs )+	Left (algn, sz) -> (adjust algn ost, sz)  adjustOffsetSizeBinded :: Device.D sd -> ImageBufferBinded sm sib ibarg -> 	Device.M.Size -> IO (Device.M.Size, Device.M.Size)-adjustOffsetSizeBinded dv ib ost =-	(<$> getMemoryRequirementsBinded dv ib) \rs -> (+adjustOffsetSizeBinded dv ib ost = (<$> getMemoryRequirementsBinded dv ib) \case+	Right rs -> ( 		adjust (Memory.M.requirementsAlignment rs) ost, 		Memory.M.requirementsSize rs )+	Left (algn, sz) -> (adjust algn ost, sz)  adjust :: Device.M.Size -> Device.M.Size -> Device.M.Size adjust algn ost = ((ost - 1) `div` algn + 1) * algn@@ -131,6 +154,9 @@ 	Alignments ('(_s, 'BufferArg _nm objs) ': ibs) where 	alignments = Just (VObj.wholeAlign @objs) : alignments @ibs +instance Alignments ibs => Alignments ('(_s, 'RawArg) ': ibs) where+	alignments = Nothing : alignments @ibs+ -- OBJECT LENGTH  class ObjectLength (nm :: Symbol) (obj :: VObj.O) ibargs where@@ -145,3 +171,27 @@ instance {-# OVERLAPPABLE #-} ObjectLength nm obj ibargs => 	ObjectLength nm obj (ibarg ': ibargs) where 	objectLength' (_ :** lns) = objectLength' @nm @obj lns++-- RAW OFFSET++class RawOffsetToOffset ibargs (n :: Nat) where+	rawOffsetToOffset :: Device.Size -> Device.D sd ->+		HPList.PL (U2 ImageBuffer) ibargs -> RawOffset n ->+		IO Device.Size++instance RawOffsetToOffset ('(sr, RawArg) ': ibargs) 0 where+	rawOffsetToOffset ost0 _ _ (RawOffset o) = pure $ ost0 + o++instance {-# OVERLAPPABLE #-} RawOffsetToOffset ibargs (n - 1) =>+	RawOffsetToOffset ('(sr, RawArg) ': ibargs) n where+	rawOffsetToOffset ost0 dv (U2 ib :** ibs) (RawOffset o) = do+		(ost', sz) <- adjustOffsetSize dv ib ost0+		rawOffsetToOffset (ost' + sz) dv ibs (RawOffset @(n - 1) o)++instance {-# OVERLAPPABLE #-} RawOffsetToOffset ibargs n =>+	RawOffsetToOffset (ibarg ': ibargs) n where+	rawOffsetToOffset ost0 dv (U2 ib :** ibs) ro = do+		(ost', sz) <- adjustOffsetSize dv ib ost0+		rawOffsetToOffset (ost' + sz) dv ibs ro++newtype RawOffset (n :: Nat) = RawOffset Device.Size deriving (Show, Num)

@@ -7,6 +7,7 @@ {-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-}  module Gpu.Vulkan.Memory.Type (@@ -23,8 +24,12 @@  	-- * OBJECT LENGTH -	objectLength+	objectLength, +	-- * RAW OFFSET++	RawOffset, rawOffset, RawOffsetToOffset+ 	) where  import Data.Kind@@ -39,6 +44,8 @@ import Gpu.Vulkan.Memory.ImageBuffer import Gpu.Vulkan.Memory.Middle qualified as M +import Gpu.Vulkan.Device.Internal qualified as Device+ -- MEMORY  data M s (ibargs :: [(Type, ImageBufferArg)]) =@@ -55,6 +62,7 @@ 	toBinded :: U2 ImageBuffer ibarg -> U2 (ImageBufferBinded sm) ibarg 	toBinded (U2 (Image (I.I i))) = U2 . ImageBinded $ I.Binded i 	toBinded (U2 (Buffer (B.B x b))) = U2 . BufferBinded $ B.Binded x b+	toBinded (U2 (Raw algn sz)) = U2 $ RawBinded algn sz  readM :: M s ibargs -> IO (HeteroParList.PL (U2 ImageBuffer) ibargs, M.M) readM (M ib m) = (, m) <$> readIORef ib@@ -67,9 +75,18 @@ 	fromBinded :: U2 (ImageBufferBinded sm) ibarg -> U2 ImageBuffer ibarg 	fromBinded (U2 (ImageBinded (I.Binded i))) = U2 . Image $ I.I i 	fromBinded (U2 (BufferBinded (B.Binded x b))) = U2 . Buffer $ B.B x b+	fromBinded (U2 (RawBinded algn sz)) = U2 $ Raw algn sz  -- OBJECT LENGTH  objectLength :: forall nm obj ibargs sm . ObjectLength nm obj ibargs => 	M sm ibargs -> IO (VObj.Length obj) objectLength m = (<$> readM m) \(ibs, _m) -> objectLength' @nm @obj @ibargs ibs++-- RAW OFFSET++rawOffset :: RawOffsetToOffset ibargs n =>+	Device.D sd -> M sm ibargs -> RawOffset n -> IO Device.Size+rawOffset dv (M ribs _) ro = do+	ibs <- readIORef ribs+	rawOffsetToOffset 0 dv ibs ro

@@ -82,6 +82,10 @@  	SizeAlignmentList(..), SizeAlignment(..), +	-- ** Others++	alignment+ 	) where  import Prelude hiding (length)

@@ -1,4 +1,9 @@ {-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-}  module Gpu.Vulkan.Queue (@@ -11,6 +16,10 @@  	Index, +	-- * SPARSE RESOURCES++	bindSparse, BindSparseInfo(..), BindSparseInfosToMiddle,+ 	-- * ENUM  	module Gpu.Vulkan.Queue.Enum@@ -18,6 +27,7 @@ 	) where  import Data.TypeLevel.Tuple.Uncurry+import Data.TypeLevel.Tuple.MapIndex import Data.HeteroParList qualified as HeteroParList import Data.Word @@ -28,9 +38,97 @@ import Gpu.Vulkan.Queue.Middle qualified as M import Gpu.Vulkan.Queue.Enum +import Data.TypeLevel.Maybe qualified as TMaybe+import Data.HeteroParList (pattern (:**))+import Data.HeteroParList qualified as HPList++import Foreign.Storable.PeekPoke+import Gpu.Vulkan.Device qualified as Device+import Gpu.Vulkan.Semaphore.Internal qualified as Semaphore+import Gpu.Vulkan.Sparse.Buffer.Internal qualified as Sparse.Buffer+import Gpu.Vulkan.Sparse.Image.Internal qualified as Sparse.Image++import Control.Monad+import Debug+ submit :: SubmitInfoListToMiddle sias => M.Q -> 	HeteroParList.PL (U4 SubmitInfo) sias -> Maybe (Fence.F sf) -> IO () submit q sis mf = 	M.submit q (submitInfoListToMiddle sis) $ (\(Fence.F f) -> f) <$> mf  type Index = Word32++bindSparse :: (+	BindSparseInfosToMiddle ias,+	HPList.ToListWithCCpsM' WithPoked TMaybe.M (M0_6 ias) ) =>+	Device.D sd -> M.Q ->+	HPList.PL (U6 BindSparseInfo) ias -> Maybe (Fence.F sf) -> IO ()+bindSparse dv q is mf = do+	let	mmf = case mf of+			Just (Fence.F f) -> Just f+			Nothing -> Nothing+	when debug $ putStrLn+		"Gpu.Vulkan.Queue.bindSparse: before bindSparseInfoToMiddle"+	mis <- bindSparseInfosToMiddle dv is+	when debug $ putStrLn+		"Gpu.Vulkan.Queue.bindSparse: before M.bindSparse"+	M.bindSparse q mis mmf++data BindSparseInfo mn swss bbs iobs ibs ssss = BindSparseInfo {+	bindSparseInfoNext :: TMaybe.M mn,+	bindSparseInfoWaitSemaphores :: HPList.PL Semaphore.S swss,+	bindSparseInfoBufferBinds ::+		HPList.PL (U4 Sparse.Buffer.MemoryBindInfo) bbs,+	bindSparseInfoImageOpaqueBinds ::+		HPList.PL (U4 Sparse.Image.OpaqueMemoryBindInfo) iobs,+	bindSparseInfoImageBinds ::+		HPList.PL (U4 Sparse.Image.MemoryBindInfo) ibs,+	bindSparseInfoSignalSemaphores :: HPList.PL Semaphore.S ssss }++bindSparseInfoToMiddle :: (+	Sparse.Buffer.MemoryBindInfosToMiddle bbs,+	Sparse.Image.OpaqueMemoryBindInfosToMiddle iobs,+	Sparse.Image.MemoryBindInfosToMiddle ibs ) =>+	Device.D sd ->+	BindSparseInfo mn swss bbs iobs ibs ssss -> IO (M.BindSparseInfo mn)+bindSparseInfoToMiddle dv BindSparseInfo {+	bindSparseInfoNext = mn,+	bindSparseInfoWaitSemaphores =+		HPList.toList (\(Semaphore.S s) -> s) -> wss,+	bindSparseInfoBufferBinds = bbs,+	bindSparseInfoImageOpaqueBinds = iobs,+	bindSparseInfoImageBinds = ibs,+	bindSparseInfoSignalSemaphores =+		HPList.toList (\(Semaphore.S s) -> s) -> sss+	} = do+	mbbs <- Sparse.Buffer.memoryBindInfosToMiddle dv bbs+	miobs <- Sparse.Image.opaqueMemoryBindInfosToMiddle dv iobs+	mibs <- Sparse.Image.memoryBindInfosToMiddle dv ibs+	pure M.BindSparseInfo {+		M.bindSparseInfoNext = mn,+		M.bindSparseInfoWaitSemaphores = wss,+		M.bindSparseInfoBufferBinds = mbbs,+		M.bindSparseInfoImageOpaqueBinds = miobs,+		M.bindSparseInfoImageBinds = mibs,+		M.bindSparseInfoSignalSemaphores = sss }++class BindSparseInfosToMiddle bsias where+	bindSparseInfosToMiddle :: Device.D sd ->+		HPList.PL (U6 BindSparseInfo) bsias ->+		IO (HPList.PL M.BindSparseInfo (M0_6 bsias))++instance BindSparseInfosToMiddle '[] where+	bindSparseInfosToMiddle _ HPList.Nil = pure HPList.Nil++instance (+	Sparse.Buffer.MemoryBindInfosToMiddle bbs,+	Sparse.Image.OpaqueMemoryBindInfosToMiddle iobs,+	Sparse.Image.MemoryBindInfosToMiddle ibs,+	BindSparseInfosToMiddle bsias ) =>+	BindSparseInfosToMiddle+		('(mn, swss, bbs, iobs, ibs, ssss) ': bsias) where+	bindSparseInfosToMiddle dv (U6 i :** is) = (:**)+		<$> bindSparseInfoToMiddle dv i+		<*> bindSparseInfosToMiddle dv is++-- instance BindSparse

@@ -0,0 +1,6 @@+module Gpu.Vulkan.Queue (Q, Index) where++import Data.Word+import Gpu.Vulkan.Queue.Middle++type Index = Word32

@@ -0,0 +1,3 @@+module Gpu.Vulkan.Sparse (MemoryBind(..)) where++import Gpu.Vulkan.Sparse.Internal

@@ -0,0 +1,5 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Sparse.Buffer (MemoryBindInfo(..)) where++import Gpu.Vulkan.Sparse.Buffer.Internal

@@ -0,0 +1,55 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGe PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Sparse.Buffer.Internal where++import Data.TypeLevel.Tuple.Uncurry+import Data.HeteroParList (pattern (:**))+import Data.HeteroParList qualified as HPList++import Gpu.Vulkan.Device qualified as Device+import Gpu.Vulkan.Buffer.Type qualified as Buffer+import Gpu.Vulkan.Sparse.Internal++import Gpu.Vulkan.Sparse.Buffer.Middle qualified as M++data MemoryBindInfo sb bnm objs sais = MemoryBindInfo {+	memoryBindInfoBuffer :: Buffer.B sb bnm objs,+	memoryBindInfoBinds :: HPList.PL (U3 MemoryBind) sais }++memoryBindInfoToMiddle :: MemoryBindsToMiddle sais =>+	Device.D sd -> MemoryBindInfo sb bnm objs sais -> IO M.MemoryBindInfo+memoryBindInfoToMiddle dv MemoryBindInfo {+	memoryBindInfoBuffer = Buffer.B _ b,+	memoryBindInfoBinds = bs+	} = do+	mbs <- memoryBindsToMiddle dv bs+	pure M.MemoryBindInfo {+		M.memoryBindInfoBuffer = b,+		M.memoryBindInfoBinds = mbs }++class MemoryBindInfosToMiddle mbias where+	memoryBindInfosToMiddle ::+		Device.D sd ->+		HPList.PL (U4 MemoryBindInfo) mbias -> IO [M.MemoryBindInfo]++instance MemoryBindInfosToMiddle '[] where+	memoryBindInfosToMiddle _ HPList.Nil = pure []++instance (MemoryBindsToMiddle sais, MemoryBindInfosToMiddle mbias) =>+	MemoryBindInfosToMiddle ('(sb, bnm, objs, sais) ': mbias) where+	memoryBindInfosToMiddle dv (U4 mbi :** mbis) = (:)+		<$> memoryBindInfoToMiddle dv mbi+		<*> memoryBindInfosToMiddle dv mbis++{-+memoryBindInfosToMiddle ::+	HPList.ToListWithCM' MemoryBindsToMiddle I3_4 mbias =>+	Device.D sd -> HPList.PL (U4 MemoryBindInfo) mbias -> IO [M.MemoryBindInfo]+memoryBindInfosToMiddle dv = toListWithCM' (\U4 mbi -> memoryBindInfoToMiddle dv mbi)+-}

@@ -0,0 +1,5 @@+{-# LANGUAGE PackageImports #-}++module Gpu.Vulkan.Sparse.Enum (module Gpu.Vulkan.Sparse.Enum) where++import "gpu-vulkan-middle" Gpu.Vulkan.Sparse.Enum

@@ -0,0 +1,6 @@+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Sparse.Image (+	OpaqueMemoryBindInfo(..), MemoryBindInfo(..), MemoryBind(..) ) where++import Gpu.Vulkan.Sparse.Image.Internal

@@ -0,0 +1,120 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Sparse.Image.Internal where++import Data.TypeLevel.Tuple.Uncurry+import Data.HeteroParList (pattern (:**))+import Data.HeteroParList qualified as HPList++import Gpu.Vulkan.Internal+import Gpu.Vulkan.Device.Internal qualified as Device+import Gpu.Vulkan.Memory.Type qualified as Memory+import Gpu.Vulkan.Image.Internal qualified as Image+import Gpu.Vulkan.Sparse.Internal qualified as S++import Gpu.Vulkan.Sparse.Enum qualified as S+import Gpu.Vulkan.Sparse.Image.Middle qualified as M++data OpaqueMemoryBindInfo si inm fmt sais = OpaqueMemoryBindInfo {+	opaqueMemoryBindInfoImage :: Image.I si inm fmt,+	opaqueMemoryBindInfoBinds :: HPList.PL (U3 S.MemoryBind) sais }++opaqueMemoryBindInfoToMiddle :: S.MemoryBindsToMiddle sais =>+	Device.D sd -> OpaqueMemoryBindInfo si inm fmt sais ->+	IO M.OpaqueMemoryBindInfo+opaqueMemoryBindInfoToMiddle dv OpaqueMemoryBindInfo {+	opaqueMemoryBindInfoImage = Image.I i,+	opaqueMemoryBindInfoBinds = bs } = do+	mbs <- S.memoryBindsToMiddle dv bs+	pure M.OpaqueMemoryBindInfo {+		M.opaqueMemoryBindInfoImage = i,+		M.opaqueMemoryBindInfoBinds = mbs }++class OpaqueMemoryBindInfosToMiddle ombias where+	opaqueMemoryBindInfosToMiddle ::+		Device.D sd -> HPList.PL (U4 OpaqueMemoryBindInfo) ombias ->+		IO [M.OpaqueMemoryBindInfo]++instance OpaqueMemoryBindInfosToMiddle '[] where+	opaqueMemoryBindInfosToMiddle _ HPList.Nil = pure []++instance (S.MemoryBindsToMiddle sais, OpaqueMemoryBindInfosToMiddle ombias) =>+	OpaqueMemoryBindInfosToMiddle ('(si, inm, fmt, sais) ': ombias) where+	opaqueMemoryBindInfosToMiddle dv (U4 ombi :** ombis) = (:)+		<$> opaqueMemoryBindInfoToMiddle dv ombi+		<*> opaqueMemoryBindInfosToMiddle dv ombis++data MemoryBindInfo si inm fmt sais = MemoryBindInfo {+	memoryBindInfoImage :: Image.I si inm fmt,+	memoryBindInfoBinds :: HPList.PL (U3 MemoryBind) sais }++memoryBindInfoToMiddle :: MemoryBindsToMiddle sais =>+	Device.D sd -> MemoryBindInfo si inm fmt sais -> IO M.MemoryBindInfo+memoryBindInfoToMiddle dv MemoryBindInfo {+	memoryBindInfoImage = Image.I mi,+	memoryBindInfoBinds = bs+	} = do+	mbs <- memoryBindsToMiddle dv bs+	pure M.MemoryBindInfo {+		M.memoryBindInfoImage = mi,+		M.memoryBindInfoBinds = mbs }++class MemoryBindInfosToMiddle mbias where+	memoryBindInfosToMiddle ::+		Device.D sd ->+		HPList.PL (U4 MemoryBindInfo) mbias -> IO [M.MemoryBindInfo]++instance MemoryBindInfosToMiddle '[] where+	memoryBindInfosToMiddle _ HPList.Nil = pure []++instance (MemoryBindsToMiddle sais, MemoryBindInfosToMiddle mbias) =>+	MemoryBindInfosToMiddle ('(si, inm, fmt, sais) ': mbias) where+	memoryBindInfosToMiddle dv (U4 mbi :** mbis) = (:)+		<$> memoryBindInfoToMiddle dv mbi+		<*> memoryBindInfosToMiddle dv mbis++data MemoryBind sm ibargs i = MemoryBind {+	memoryBindSubresource :: Image.Subresource,+	memoryBindOffset :: Offset3d,+	memoryBindExtent :: Extent3d,+	memoryBindMemory :: Memory.M sm ibargs,+	memoryBindMemoryOffset :: Memory.RawOffset i,+	memoryBindFlags :: S.MemoryBindFlags }++memoryBindToMiddle :: Memory.RawOffsetToOffset ibargs i =>+	Device.D sd -> MemoryBind sm ibargs i -> IO M.MemoryBind+memoryBindToMiddle dv MemoryBind {+	memoryBindSubresource = sr,+	memoryBindOffset = ost,+	memoryBindExtent = ex,+	memoryBindMemory = m@(Memory.M _ mm),+	memoryBindMemoryOffset = most,+	memoryBindFlags = fs+	} = do+	mmo <- Memory.rawOffset dv m most+	pure M.MemoryBind {+		M.memoryBindSubresource = sr,+		M.memoryBindOffset = ost,+		M.memoryBindExtent = ex,+		M.memoryBindMemory = mm,+		M.memoryBindMemoryOffset = mmo,+		M.memoryBindFlags = fs }++class MemoryBindsToMiddle sais where+	memoryBindsToMiddle ::+		Device.D sd -> HPList.PL (U3 MemoryBind) sais -> IO [M.MemoryBind]++instance MemoryBindsToMiddle '[] where+	memoryBindsToMiddle _ HPList.Nil = pure []++instance (Memory.RawOffsetToOffset ibargs i, MemoryBindsToMiddle sais) =>+	MemoryBindsToMiddle ('(sm, ibargs, i) ': sais) where+	memoryBindsToMiddle dv (U3 mb :** mbs) = (:)+		<$> memoryBindToMiddle dv mb+		<*> memoryBindsToMiddle dv mbs

@@ -0,0 +1,55 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Gpu.Vulkan.Sparse.Internal where++import Data.TypeLevel.Tuple.Uncurry+import Data.HeteroParList (pattern (:**))+import Data.HeteroParList qualified as HPList++import Gpu.Vulkan.Device qualified as Device+import Gpu.Vulkan.Memory.Type qualified as Memory+import Gpu.Vulkan.Sparse.Enum++import Gpu.Vulkan.Sparse.Middle qualified as M++data MemoryBind sm ibargs i = MemoryBind {+	memoryBindResourceOffset :: Device.Size,+	memoryBindSize :: Device.Size,+	memoryBindMemory :: Memory.M sm ibargs,+	memoryBindMemoryOffset :: Memory.RawOffset i,+	memoryBindFlags :: MemoryBindFlags }++memoryBindToMiddle :: Memory.RawOffsetToOffset ibargs i =>+	Device.D sd -> MemoryBind sm ibargs i -> IO M.MemoryBind+memoryBindToMiddle dv MemoryBind {+	memoryBindResourceOffset = rsco,+	memoryBindSize = sz,+	memoryBindMemory = m@(Memory.M _ mm),+	memoryBindMemoryOffset = rwo,+	memoryBindFlags = fs } = do+	mo <- Memory.rawOffset dv m rwo+	pure M.MemoryBind {+		M.memoryBindResourceOffset = rsco,+		M.memoryBindSize = sz,+		M.memoryBindMemory = mm,+		M.memoryBindMemoryOffset = mo,+		M.memoryBindFlags = fs }++class MemoryBindsToMiddle sais where+	memoryBindsToMiddle ::+		Device.D sd -> HPList.PL (U3 MemoryBind) sais -> IO [M.MemoryBind]++instance MemoryBindsToMiddle '[] where+	memoryBindsToMiddle _ HPList.Nil = pure []++instance (Memory.RawOffsetToOffset ibargs i, MemoryBindsToMiddle sais) =>+	MemoryBindsToMiddle ('(sm, ibargs, i) ': sais) where+	memoryBindsToMiddle dv (U3 mb :** mbs) = (:)+		<$> memoryBindToMiddle dv mb+		<*> memoryBindsToMiddle dv mbs