diff --git a/cabal.project b/cabal.project index 8033969..ce88621 100644 --- a/cabal.project +++ b/cabal.project @@ -14,6 +14,12 @@ packages: ./ghengin-core/ ./ghengin-core-indep/ ./linear-utils/ +------------------------------- +-- DEBUG PATCHES +------------------------------- + -- ~/Developer/vector/vector + -- ~/Developer/vector/vector-stream/ + -- ~/Developer/linear-base-fork/ package dear-imgui flags: +glfw +vulkan -sdl -opengl3 diff --git a/cabal.project.local b/cabal.project.local index c845ab0..84b9bae 100644 --- a/cabal.project.local +++ b/cabal.project.local @@ -124,7 +124,7 @@ constraints: true-name ==0.1.0.3, typelits-printf ==0.2.0.0, unordered-containers ==0.2.19.1, - vector ==0.13.0.0, + vector ==0.13.1.0, vector-builder ==0.3.8.4, vector-circular ==0.1.4, vector-space ==0.16, diff --git a/ghengin-core-indep/ghengin-core-indep/Ghengin/Core/Prelude.hs b/ghengin-core-indep/ghengin-core-indep/Ghengin/Core/Prelude.hs index 289792d..4f275de 100644 --- a/ghengin-core-indep/ghengin-core-indep/Ghengin/Core/Prelude.hs +++ b/ghengin-core-indep/ghengin-core-indep/Ghengin/Core/Prelude.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE CPP #-} module Ghengin.Core.Prelude ( -- * Re-exports @@ -38,6 +39,8 @@ module Ghengin.Core.Prelude , GHList(..), (=<<), (<=<), (>=>), v2vec, l2vec, vec2l , vzipWith + + , assertM ) where @@ -186,6 +189,14 @@ l2vec = Unsafe.toLinear V.fromList vec2l :: V.Vector a ⊸ [a] vec2l = Unsafe.toLinear V.toList +assertM :: Monad m => String -> Bool -> m () +{-# INLINE assertM #-} +#ifdef DEBUG +assertM s b = if b then pure () else error ("Failed assertion: " ++ s) +#else +assertM _ _ = pure () +#endif + --- More orphans instance MonadIO m => MonadIO (StateT s m) where diff --git a/ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/DescriptorSet.hs b/ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/DescriptorSet.hs index 5dd1d93..cd85fae 100644 --- a/ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/DescriptorSet.hs +++ b/ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/DescriptorSet.hs @@ -131,6 +131,9 @@ instance Show SomeDefs where -- less simple alternative should be added... createDescriptorSetBindingsMap :: ShaderPipeline info -> DescriptorSetMap createDescriptorSetBindingsMap ppstages = makeDescriptorSetMap (go Prelude.mempty ppstages) + -- If any of the descriptor sets is + -- unused, we default to an empty bindings map + <> IM.fromList [(0, mempty), (1, mempty), (2, mempty)] where go :: Map FIR.Shader [(SPIRV.PointerTy,SomeDefs,SPIRV.Decorations)] -> ShaderPipeline info @@ -328,7 +331,8 @@ allocateEmptyDescriptorSet ix = extract <=< allocateEmptyDescriptorSets (VL.make -- | Like 'allocateEmptyDescriptorSet' but allocate multiple sets at once -- INVARIANT: The Int vector does not have duplicate Ints -allocateEmptyDescriptorSets :: ∀ n. V n Int -- ^ The sets to allocate by Ix +allocateEmptyDescriptorSets :: ∀ n. KnownNat n + => V n Int -- ^ The sets to allocate by Ix -> DescriptorPool -- ^ The descriptor pool associated with a shader pipeline in which the descriptor sets will be used ⊸ Renderer (V n DescriptorSet, DescriptorPool) allocateEmptyDescriptorSets ixs DescriptorPool{..} = enterD "allocateEmptyDescriptorSets" $ Linear.do @@ -338,6 +342,11 @@ allocateEmptyDescriptorSets ixs DescriptorPool{..} = enterD "allocateEmptyDescri -- Extract the layouts info needed for allocation out of the dpool map (to_alloc, the_rest) <- pure $ IML.partitionByKeys ixs set_bindings + + (Ur to_alloc_size, to_alloc) <- pure $ IML.size to_alloc + assertM "allocateEmptyDescriptorSets" (to_alloc_size == VL.theLength @n) + + -- Extract the infos from the sets by ix to allocate (keys, to_alloc_tups) <- pure $ unzip $ IML.toList $ to_alloc (layouts, bindingsxs) <- pure $ unzip $ to_alloc_tups @@ -347,7 +356,7 @@ allocateEmptyDescriptorSets ixs DescriptorPool{..} = enterD "allocateEmptyDescri -- Reconstruct things (to_alloc_tups, Nothing) <- pure $ zip' (vec2l layouts) bindingsxs - (to_alloc,Nothing) <- pure $ zip' keys to_alloc_tups + (to_alloc, Nothing) <- pure $ zip' keys to_alloc_tups set_bindings <- pure $ IML.unionWith (Unsafe.toLinear2 \_ _ -> error "impossible") (IML.fromList to_alloc) the_rest pure (vzipWith DescriptorSet ixs dsets, DescriptorPool dpool set_bindings) diff --git a/linear-utils/linear-utils/Data/IntMap/Linear.hs b/linear-utils/linear-utils/Data/IntMap/Linear.hs index 002558e..6ad3942 100644 --- a/linear-utils/linear-utils/Data/IntMap/Linear.hs +++ b/linear-utils/linear-utils/Data/IntMap/Linear.hs @@ -83,6 +83,8 @@ traverseWithKey f = toLinear go | otherwise = liftA2 (Bin p m) (go l) (go r) {-# INLINE traverseWithKey #-} +size :: IntMap a ⊸ (Ur Int, IntMap a) +size = toLinear \im -> (Ur $ IM.size im, im) instance {-# OVERLAPPABLE #-} Consumable a => Consumable (IntMap a) where consume = \case