Introduce SeqConstraintUnit to reduce possible overhead

The definition of `Extendss` that involves pairs:

  type Extendss p xs where
    Extendss p '[] = ()
    Extendss p (x : xs) = (Extends p x, Extendss p xs)

Would produce a constraint that looks like this: `((), ((), ((), ...)))`
That may result in a runtime overhead if GHC would be incapable to
perform cross-module inlining here (it would be)

The new `SeqConstraintUnit` type family ensures that `Extends p x` reduces
to the constraint unit and drops it after that entirely. Hence, produced
constraint would be just `()`. Much better!

Author: s-and-witch

generate-new/src/Render/Spec/Extends.hs

@@ -187,9 +187,18 @@ classes Spec {..} = do
       class PeekChain (xs :: [Type])
       class PokeChain (xs :: [Type])
       type family Extends (p :: [Type] -> Type) (x :: Type) :: Constraint where ..
+
+      -- | We don't really need constraint units produced by `Extends`, so this type
+      -- family will ensure that it would reduce and drop the result
+      --
+      -- That will result in less overhead because `Extendss` reduces into a single
+      -- contraint unit `()` instead of cons-list `((), ((), ()))` produced by `(,)`
+      type family SeqConstraintUnit (a :: Constraint) (b :: Constraint) :: Constraint where
+        SeqConstraintUnit () b = b
+      
       type family Extendss (p :: [Type] -> Type) (xs :: [Type]) :: Constraint where
         Extendss p '[]      = ()
-        Extendss p (x : xs) = (Extends p x, Extendss p xs)
+        Extendss p (x : xs) = Extends p x `SeqConstraintUnit` Extendss p xs
       type family Chain (xs :: [a]) = (r :: a) | r -> xs where
         Chain '[]    = ()
         Chain (x:xs) = (x, Chain xs)
@@ -362,9 +371,17 @@ classes Spec {..} = do
     infixr 7 :&
     \{-# complete (:&) #-}
 
+    -- | We don't really need constraint units produced by `Extends`, so this type
+    -- family will ensure that it would reduce and drop the result
+    --
+    -- That will result in less overhead because `Extendss` reduces into a single
+    -- contraint unit `()` instead of cons-list `((), ((), ()))` produced by `(,)`
+    type family SeqConstraintUnit (a :: Constraint) (b :: Constraint) :: Constraint where
+      SeqConstraintUnit () b = b
+      
     type family Extendss (p :: [Type] -> Type) (xs :: [Type]) :: Constraint where
       Extendss p '[]      = ()
-      Extendss p (x : xs) = (Extends p x, Extendss p xs)
+      Extendss p (x : xs) = Extends p x `SeqConstraintUnit` Extendss p xs
 
     class PokeChain es where
       withChain :: Chain es -> (Ptr (Chain es) -> IO a) -> IO a

openxr/src/OpenXR/CStruct/Extends.hs

@@ -583,9 +583,17 @@ pattern e :& es = (e, es)
 infixr 7 :&
 {-# complete (:&) #-}
 
+-- | We don't really need constraint units produced by `Extends`, so this type
+-- family will ensure that it would reduce and drop the result
+--
+-- That will result in less overhead because `Extendss` reduces into a single
+-- contraint unit `()` instead of cons-list `((), ((), ()))` produced by `(,)`
+type family SeqConstraintUnit (a :: Constraint) (b :: Constraint) :: Constraint where
+  SeqConstraintUnit () b = b
+  
 type family Extendss (p :: [Type] -> Type) (xs :: [Type]) :: Constraint where
   Extendss p '[]      = ()
-  Extendss p (x : xs) = (Extends p x, Extendss p xs)
+  Extendss p (x : xs) = Extends p x `SeqConstraintUnit` Extendss p xs
 
 class PokeChain es where
   withChain :: Chain es -> (Ptr (Chain es) -> IO a) -> IO a

openxr/src/OpenXR/CStruct/Extends.hs-boot

@@ -31,10 +31,19 @@ instance FromCStruct BaseOutStructure
 
 class PeekChain (xs :: [Type])
 class PokeChain (xs :: [Type])
-type family Extends (p :: [Type] -> Type) (x :: Type) :: Constraint
+type family Extends (p :: [Type] -> Type) (x :: Type) :: Constraint where ..
+
+-- | We don't really need constraint units produced by `Extends`, so this type
+-- family will ensure that it would reduce and drop the result
+--
+-- That will result in less overhead because `Extendss` reduces into a single
+-- contraint unit `()` instead of cons-list `((), ((), ()))` produced by `(,)`
+type family SeqConstraintUnit (a :: Constraint) (b :: Constraint) :: Constraint where
+  SeqConstraintUnit () b = b
+
 type family Extendss (p :: [Type] -> Type) (xs :: [Type]) :: Constraint where
   Extendss p '[]      = ()
-  Extendss p (x : xs) = (Extends p x, Extendss p xs)
+  Extendss p (x : xs) = Extends p x `SeqConstraintUnit` Extendss p xs
 type family Chain (xs :: [a]) = (r :: a) | r -> xs where
   Chain '[]    = ()
   Chain (x:xs) = (x, Chain xs)

src/Vulkan/CStruct/Extends.hs

@@ -2952,9 +2952,17 @@ pattern e :& es = (e, es)
 infixr 7 :&
 {-# complete (:&) #-}
 
+-- | We don't really need constraint units produced by `Extends`, so this type
+-- family will ensure that it would reduce and drop the result
+--
+-- That will result in less overhead because `Extendss` reduces into a single
+-- contraint unit `()` instead of cons-list `((), ((), ()))` produced by `(,)`
+type family SeqConstraintUnit (a :: Constraint) (b :: Constraint) :: Constraint where
+  SeqConstraintUnit () b = b
+  
 type family Extendss (p :: [Type] -> Type) (xs :: [Type]) :: Constraint where
   Extendss p '[]      = ()
-  Extendss p (x : xs) = (Extends p x, Extendss p xs)
+  Extendss p (x : xs) = Extends p x `SeqConstraintUnit` Extendss p xs
 
 class PokeChain es where
   withChain :: Chain es -> (Ptr (Chain es) -> IO a) -> IO a

src/Vulkan/CStruct/Extends.hs-boot

@@ -32,9 +32,18 @@ instance FromCStruct BaseOutStructure
 class PeekChain (xs :: [Type])
 class PokeChain (xs :: [Type])
 type family Extends (p :: [Type] -> Type) (x :: Type) :: Constraint where ..
+
+-- | We don't really need constraint units produced by `Extends`, so this type
+-- family will ensure that it would reduce and drop the result
+--
+-- That will result in less overhead because `Extendss` reduces into a single
+-- contraint unit `()` instead of cons-list `((), ((), ()))` produced by `(,)`
+type family SeqConstraintUnit (a :: Constraint) (b :: Constraint) :: Constraint where
+  SeqConstraintUnit () b = b
+
 type family Extendss (p :: [Type] -> Type) (xs :: [Type]) :: Constraint where
   Extendss p '[]      = ()
-  Extendss p (x : xs) = (Extends p x, Extendss p xs)
+  Extendss p (x : xs) = Extends p x `SeqConstraintUnit` Extendss p xs
 type family Chain (xs :: [a]) = (r :: a) | r -> xs where
   Chain '[]    = ()
   Chain (x:xs) = (x, Chain xs)