Drop Syntactic in favour of ShaderData

Important move away from Syntactic which was being incorrectly used into
a ShaderData new class which represents data which can be serialized
according to the memory layout of some shader primitive type, and that
we can match against the type used in the shader (this match is still
quite primitive, we may want to go a little bit deeper (e.g. use kind
'SPIRV.PrimTy', although that looks like a heavy hammer).

Eventually, we want to move away from Storable into Poke, and drop Sized
too in favor of SizeOf of Poke.

Another TODO: deriving generically the ShaderData class.

examples/common/Common.hs

@@ -27,6 +27,7 @@ import Ghengin.Core.Render.Pipeline
 import Ghengin.Core.Render.Property
 import Ghengin.Core.Render.Queue
 import Ghengin.Core.Shader (StructVec2(..), StructVec3(..), StructMat4(..), StructFloat(..))
+import Ghengin.Core.Shader.Data
 import Ghengin.Core.Type.Compatible
 import Ghengin.Vulkan.Renderer.Sampler
 import Vulkan.Core10.FundamentalTypes (Extent2D(..))
@@ -55,11 +56,11 @@ viewportIndices
 
 newtype MousePos = MousePos Vec2
   deriving Storable
-  deriving FIR.Syntactic via (StructVec2 "mousePos")
+  deriving ShaderData via (StructVec2 "mousePos")
 
 newtype Time = Time Float
   deriving Storable
-  deriving FIR.Syntactic via (StructFloat "val")
+  deriving ShaderData via (StructFloat "val")
 
 type PipelineProps = [MousePos, Time]
 

ghengin-core-indep/ghengin-core-indep.cabal

@@ -85,6 +85,7 @@ library
                       Ghengin.Core.Type.Utils,
 
                       Ghengin.Core.Shader,
+                      Ghengin.Core.Shader.Data,
                       Ghengin.Core.Shader.Pipeline,
                       Ghengin.Core.Shader.Canonical,
 

ghengin-core-indep/ghengin-core-indep/Ghengin/Core/Shader.hs

@@ -8,6 +8,7 @@ module Ghengin.Core.Shader
   )
   where
 
+import Foreign.Storable
 import Data.Kind
 import GHC.TypeLits
 import Ghengin.Core.Shader.Canonical
@@ -27,6 +28,8 @@ import qualified FIR
 import qualified FIR.AST as FIR
 import qualified Data.Type.Map as M
 
+import Ghengin.Core.Shader.Data
+
 type VertexShaderModule defs
   = FIR.ShaderModule "main" FIR.VertexShader
                      (("main" 'FIR.:-> FIR.EntryPoint '[] FIR.Vertex) ': CanonicalizeDefs defs)
@@ -59,102 +62,40 @@ type FragmentShaderModule defs
 
 type StructFloat :: Symbol -> Type
 newtype StructFloat name = StructFloat Float
+  deriving newtype Storable
 
 type StructVec2 :: Symbol -> Type
 newtype StructVec2 name = StructVec2 Vec2
+  deriving newtype Storable
 
 type StructVec3 :: Symbol -> Type
 newtype StructVec3 name = StructVec3 Vec3
+  deriving newtype Storable
 
 type StructMat4 :: Symbol -> Type
 newtype StructMat4 name = StructMat4 Mat4
+  deriving newtype Storable
+
+instance ShaderData FIR.Float where
+  type FirType FIR.Float = FIR.Float
+
+instance ShaderData Vec2 where
+  type FirType Vec2 = V 2 FIR.Float
+
+instance KnownSymbol name => ShaderData (StructVec2 name) where
+  type FirType (StructVec2 name) = FIR.Struct '[ name 'FIR.:-> V 2 FIR.Float ]
+
+instance ShaderData Vec3 where
+  type FirType Vec3 = V 3 FIR.Float
+
+instance KnownSymbol name => ShaderData (StructVec3 name) where
+  type FirType (StructVec3 name) = FIR.Struct '[ name 'FIR.:-> V 3 FIR.Float ]
+
+instance ShaderData Mat4 where
+  type FirType Mat4 = M 4 4 FIR.Float
 
--- Temporary? See ticket in fir
--- NO! Plain wrong, we need to completely move away from Syntactic for our use case
-instance FIR.Syntactic FIR.Float where
-  type Internal FIR.Float = FIR.Val FIR.Float
-  toAST = FIR.Lit
-  fromAST (FIR.Lit x) = x
-
-instance FIR.Syntactic Vec2 where
-  type Internal Vec2 = FIR.Val (V 2 FIR.Float)
-  toAST (WithVec2 x y) = FIR.toAST (V2 x y)
-  fromAST (FIR.fromAST -> V2 x y) = vec2 x y
-
-instance KnownSymbol name => FIR.Syntactic (StructVec2 name) where
-  type Internal (StructVec2 name) = FIR.Val (FIR.Struct '[ name 'FIR.:-> V 2 FIR.Float ])
-  toAST (StructVec2 v2) = FIR.Struct (FIR.toAST v2 FIR.:& FIR.End)
-  fromAST (FIR.fromAST FIR.. FIR.view @(FIR.Name name) -> v3) = StructVec2 v3
-
-instance FIR.Syntactic Vec3 where
-  type Internal Vec3 = FIR.Val (V 3 FIR.Float)
-  toAST (WithVec3 x y z) = FIR.toAST (V3 x y z)
-  fromAST (FIR.fromAST -> V3 x y z) = vec3 x y z
-
-instance KnownSymbol name => FIR.Syntactic (StructVec3 name) where
-  type Internal (StructVec3 name) = FIR.Val (FIR.Struct '[ name 'FIR.:-> V 3 FIR.Float ])
-  toAST (StructVec3 v3) = FIR.Struct (FIR.toAST v3 FIR.:& FIR.End)
-  fromAST (FIR.fromAST FIR.. FIR.view @(FIR.Name name) -> v3) = StructVec3 v3
-
-instance FIR.Syntactic Mat4 where
-  type Internal Mat4 = FIR.Val (M 4 4 FIR.Float)
-
-  toAST mat
-    = withColMajor mat
-         \ m00 m10 m20 m30
-           m01 m11 m21 m31
-           m02 m12 m22 m32
-           m03 m13 m23 m33 ->
-             FIR.toAST ( M FIR.$
-                            V4 (V4 m00 m10 m20 m30)
-                               (V4 m01 m11 m21 m31)
-                               (V4 m02 m12 m22 m32)
-                               (V4 m03 m13 m23 m33)
-                       )
-
-  fromAST (FIR.fromAST
-            -> M (V4 (V4 m00 m10 m20 m30)
-                     (V4 m01 m11 m21 m31)
-                     (V4 m02 m12 m22 m32)
-                     (V4 m03 m13 m23 m33))
-          ) = colMajor m00 m10 m20 m30
-                       m01 m11 m21 m31
-                       m02 m12 m22 m32
-                       m03 m13 m23 m33
-
-
-instance KnownSymbol name => FIR.Syntactic (StructMat4 name) where
-  type Internal (StructMat4 name) = FIR.Val (FIR.Struct '[ name 'FIR.:-> M 4 4 FIR.Float ])
-
-  toAST (StructMat4 mat)
-    = withColMajor mat
-         \ m00 m10 m20 m30
-           m01 m11 m21 m31
-           m02 m12 m22 m32
-           m03 m13 m23 m33 ->
-             FIR.Struct ( FIR.toAST ( M FIR.$
-                            V4 (V4 m00 m10 m20 m30)
-                               (V4 m01 m11 m21 m31)
-                               (V4 m02 m12 m22 m32)
-                               (V4 m03 m13 m23 m33)
-                                    )
-                          FIR.:& FIR.End )
-  fromAST (FIR.fromAST FIR.. FIR.view @(FIR.Name name)
-            -> M (V4 (V4 m00 m10 m20 m30)
-                     (V4 m01 m11 m21 m31)
-                     (V4 m02 m12 m22 m32)
-                     (V4 m03 m13 m23 m33))
-              ) = StructMat4 (colMajor m00 m10 m20 m30
-                                       m01 m11 m21 m31
-                                       m02 m12 m22 m32
-                                       m03 m13 m23 m33
-                             )
-
-instance KnownSymbol name => FIR.Syntactic (StructFloat name) where
-  type Internal (StructFloat name) = FIR.Val (FIR.Struct '[ name 'FIR.:-> FIR.Float ])
-  -- we don't call these methods, they are needed by FIR only; our
-  -- serialization is currently done by Storable (though it should really be
-  -- through gl-block)
-  toAST (StructFloat f) = FIR.Struct (FIR.Lit f FIR.:& FIR.End)
-  fromAST = undefined -- bad!, we don't want syntactic really, this cannot be implemented correctly
+instance KnownSymbol name => ShaderData (StructMat4 name) where
+  type FirType (StructMat4 name) = FIR.Struct '[ name 'FIR.:-> M 4 4 FIR.Float ]
 
+instance KnownSymbol name => ShaderData (StructFloat name) where
+  type FirType (StructFloat name) = FIR.Struct '[ name 'FIR.:-> FIR.Float ]

ghengin-core-indep/ghengin-core-indep/Ghengin/Core/Shader/Canonical.hs

@@ -12,14 +12,16 @@ type CanonicalizeDefs :: [ k FIR.:-> FIR.Definition ] -> [ k FIR.:-> FIR.Defini
 type family CanonicalizeDefs m where
   CanonicalizeDefs '[] = '[]
   CanonicalizeDefs ((k 'FIR.:-> def) ': xs)
+-- ROMES:TODO: Perhaps it is better not to canonicalize definitions, and have
+-- it be that the 'ShaderData' type family has to match exactly the shader
+-- type? (See where this is applied)
     = (k 'FIR.:-> CanonicalizeDef def) ': CanonicalizeDefs xs
 
 -- | Canonicalize tries to transform all non-primitive types into primitive
--- types using the 'Syntactic' instance.
+-- types using the 'CanonicalType' instance.
 type CanonicalizeDef :: FIR.Definition -> FIR.Definition
 type family CanonicalizeDef a where
   CanonicalizeDef ( 'FIR.Global storageClass decorations ty ) = 'FIR.Global storageClass decorations (CanonicalType ty)
-  -- TODO: The following two should also probably be canonicalized
   CanonicalizeDef ( 'FIR.Function a b c ) = 'FIR.Function a b c
   CanonicalizeDef ( 'FIR.EntryPoint a b ) = 'FIR.EntryPoint a b
 
@@ -28,6 +30,17 @@ type family CanonicalizeDef a where
 
 -- | Canonical type is a primitive type unchanged or, if the type isn't
 -- primitive, is its FIR.InternalType
+--
+-- ROMES:TODO: An alternative to doing this is probably to have a type family
+-- for instances of the "ToGPU" (to be renamed) class which determines which
+-- types are deemed compatible with the instance..., instead of having to
+-- canonicalize the definitions of the shader in order to guarantee matches
+-- against the "primitive/internal" representations of the ToGPU class
+-- But this may be better:
+--
+--  Ultimately, for every definition in the shader, all types need to have an
+--  "internal" representation that matches something that can be understood by
+--  SPIRV primitives, right?...
 type family CanonicalType a where
   -- We can't handle all primtys through their PrimTy, because of incoherency in instances,
   -- so, instead, we manually implement HasCanonicalType for each PrimTy instance

ghengin-core-indep/ghengin-core-indep/Ghengin/Core/Shader/Data.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE QuantifiedConstraints #-}
+-- | This module defines the main class which powers all of the serialization
+-- and compatibility logic between CPU and GPU data types.
+module Ghengin.Core.Shader.Data
+  ( ShaderData(..)
+    -- ** Re-exports
+  , Poke(..), Layout(..)
+  ) where
+
+import Data.Kind
+import Foreign.Storable
+import FIR.Prim.Types
+import FIR.Layout
+
+-- ROMES:TODO: For now, we still define 'Compatible' by means of 'InternalType', but that should change! See 'ShaderData'.
+
+-- | The class which powers all of the serialization and compatibility logic
+-- between CPU and GPU data types.
+--
+-- If a type instances 'ShaderData', it means it can be serialized according to
+-- the [Shader Memory Layout](https://docs.vulkan.org/guide/latest/shader_memory_layout.html) (using 'Poke') into
+-- a primitive datatype ('PrimTy') such as @V 3 Float@, which has a matching
+-- [SPIRV type](https://registry.khronos.org/SPIR-V/specs/unified1/SPIRV.html#_types).
+--
+-- You can derive @'Poke'@ instances automatically (provide this using
+-- @gl-block@ (TODO: May be hard bc of top-level info)). Another simple way to
+-- get a 'Poke' instance is to convert the type to its primitive representation
+-- and then leverage that representation's 'Poke' instance.
+class -- (∀ lay. Poke ty (lay :: Layout)) => -- ROMES:TODO: We can't migrate to 'Poke' yet, drop 'Syntactic' first.
+    Storable ty =>
+    ShaderData ty where
+
+  -- | The primitive shader type whose memory representation matches the result
+  -- of serializing this datatype using 'Poke'. This is the promise that if
+  -- your shader expects @firTy@ in a uniform location, writing @ty@ into the
+  -- buffer will be sound, and the shader will find @ty@'s laid out in memory
+  -- according to @firTy@'s expected memory layout.
+  --
+  -- romes:todo: I don't think we will be able to compare primitive types for
+  -- 'Compatible' at runtime, so we'll likely have to resort to something else,
+  -- like getting the 'FieldsOfType' of the 'PrimTy' instance of the type
+  -- resulting from applying this type family.
+  type family FirType (ty :: Type) :: Type
+
+  -- ROMES:TODO: Perhaps we could instead have a family whose return kind is
+  -- lifted 'SPIRV.PrimTy', and comparing that is easy (as long as we implement
+  -- ShaderData for the common shader datatypes such as V 3 Float).
+  -- Though that is quite considerably more burdensome (e.g. images, decorations...)
+  -- Not sure if would be better.
+  -- type family SpirType ty :: 'SPIRV.PrimTy
+

ghengin-core-indep/ghengin-core-indep/Ghengin/Core/Type/Compatible.hs

@@ -23,12 +23,12 @@ import FIR.Pipeline
       PrimitiveTopology,
       VertexLocationDescriptions,
       GetVertexInputInfo )
-import FIR (Syntactic, InternalType)
 import FIR.ProgramState
     ( EntryPointInfo(EntryPointInfo), TLInterfaceVariable )
 import SPIRV.Decoration (Decoration(..))
 import qualified SPIRV.Image as SPIRV
 
+import Ghengin.Core.Shader.Data hiding (SizeOf) -- TODO: ultimately, we don't want to hide SizeOf, and want to get rid of Sized
 import Ghengin.Core.Type.Utils
 import Ghengin.Core.Type.Sized
 
@@ -69,10 +69,10 @@ type CompatibleVertex' :: [(Nat,Type)] -> PipelineInfo -> Constraint
 type family CompatibleVertex' as p where
   CompatibleVertex' '[] _ = ()
   CompatibleVertex' ('(n,x) ': xs) p
-    = ( Syntactic x
-      , Match (SizeOf (InternalType x)) (SizeOf (InputByLocation' n p))
+    = ( ShaderData x
+      , Match (SizeOf (FirType x)) (SizeOf (InputByLocation' n p))
                         (Text "Vertex property #" :<>: ShowType n :<>: TypeAndInternalType x
-                          :<>: Text " whose internal type is " :<>: ShowType (InternalType x)
+                          :<>: Text " whose internal type is " :<>: ShowType (FirType x)
                           :<>: Text " isn't compatible with the shader vertex property #" :<>: ShowType n :<>: Text " of type " :<>: ShowType (InputByLocation' n p))
       , CompatibleVertex' xs p
       )
@@ -84,8 +84,8 @@ type CompatibleMesh' :: [(Nat,Type)] -> PipelineInfo -> Constraint
 type family CompatibleMesh' as p where
   CompatibleMesh' '[] _ = ()
   CompatibleMesh' ('(n,x) ': xs) p
-    = ( Syntactic x
-      , Match (InternalType x) (DSetBinding' 2 n p)
+    = ( ShaderData x
+      , Match (FirType x) (DSetBinding' 2 n p)
               (Text "Mesh binding #" :<>: ShowType n :<>: TypeAndInternalType x
                :<>: Text " isn't compatible with the descriptor binding #" :<>: ShowType n :<>: Text " of type " :<>: ShowType (DSetBinding' 2 n p))
       , CompatibleMesh' xs p
@@ -98,8 +98,8 @@ type CompatibleMaterial' :: [(Nat,Type)] -> PipelineInfo -> Constraint
 type family CompatibleMaterial' as p where
   CompatibleMaterial' '[] _ = ()
   CompatibleMaterial' ('(n,x) ': xs) p
-    = ( Syntactic x
-      , Match (InternalType x) (DSetBinding' 1 n p)
+    = ( ShaderData x
+      , Match (FirType x) (DSetBinding' 1 n p)
               (Text "Material binding #" :<>: ShowType n :<>: TypeAndInternalType x
                :<>: Text " isn't compatible with the descriptor binding #" :<>: ShowType n :<>: Text " of type " :<>: ShowType (DSetBinding' 1 n p))
       , CompatibleMaterial' xs p
@@ -112,16 +112,16 @@ type CompatiblePipeline' :: [(Nat,Type)] -> PipelineInfo -> Constraint
 type family CompatiblePipeline' as p where
   CompatiblePipeline' '[] p = ()
   CompatiblePipeline' ('(n,x) ': xs) p
-    = ( Syntactic x
-      , Match (InternalType x) (DSetBinding' 0 n p)
+    = ( ShaderData x
+      , Match (FirType x) (DSetBinding' 0 n p)
               (Text "Render property binding #" :<>: ShowType n :<>: TypeAndInternalType x
                 :<>: Text " isn't compatible with the descriptor binding #" :<>: ShowType n :<>: Text " of type " :<>: ShowType (DSetBinding' 0 n p))
       , CompatiblePipeline' xs p
       )
 
 type TypeAndInternalType :: Type -> ErrorMessage
 type family TypeAndInternalType x where
-  TypeAndInternalType x = Text " of type " :<>: ShowType x :<>: Text " and internal type " :<>: ShowType (InternalType x)
+  TypeAndInternalType x = Text " of type " :<>: ShowType x :<>: Text " and internal type " :<>: ShowType (FirType x)
 
 
 ------- Matching -----------------------------------

ghengin-core-indep/ghengin-core-indep/Ghengin/Core/Type/Sized.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE UndecidableInstances #-}
 module Ghengin.Core.Type.Sized where
 
+-- ROMES:TODO: Should this be merged with our type for "internal canonical representation"
+
 import GHC.TypeLits
 import GHC.Float
 
@@ -9,6 +11,10 @@ import qualified SPIRV.Image as SPIRV
 import Math.Linear (V(..), M(..))
 import Data.Type.Map
 
+-- ROMES:TODO: I no longer think we should be using this. Instead, we should
+-- use the name of the same method from 'Poke', which we now require instead of
+-- 'Storable'.
+
 class Sized a where
   type SizeOf a :: Nat
 

ghengin-core/ghengin-core/Ghengin/Core/Renderer/Texture.hsig

@@ -17,4 +17,4 @@ texture :: FilePath -> Alias Sampler ⊸ Renderer (Alias Texture2D)
 --                  -> Sampler
 --                  -> Renderer Texture2D
 
-instance FIR.Syntactic Texture2D
+-- ROMES:TODO: instance FIR.Syntactic Texture2D

ghengin/ghengin/Ghengin/Shader/Syntactic.hs

@@ -12,6 +12,8 @@ import qualified SPIRV.Image as SPIRV
 import qualified SPIRV.ScalarTy
 import Math.Linear
 
+-- ROMES:TODO: Completely Deprecated. We want to drop all of this.
+
 instance Syntactic Vec3 where
   type Internal Vec3 = Val (V 3 Float)
   toAST (WithVec3 x y z) = FIR.Vec3 (Lit x) (Lit y) (Lit z)