Handle empty descriptor sets with empty bindings map

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

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,

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

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)

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