Some type signatures (and build fix?).

1 files changed, 104 insertions, 1 deletions

diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs
index 357702f5..45bfa1ad 100644
--- a/src/LambdaCube/Compiler/CoreToIR.hs
+++ b/src/LambdaCube/Compiler/CoreToIR.hs
@@ -21,6 +21,7 @@ import Data.List
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Vector as Vector
+import Data.String
 import GHC.Stack
 import GHC.Word
 import Control.Arrow hiding ((<+>))
@@ -73,16 +74,39 @@ type CG = State (List IR.StreamData, Map IR.Program Int, List IR.RenderTarget, M
 
 type List a = (Int, [a])
 
+streamLens :: ((t1 -> (t1, t2, t3, t4, t5)) -> t6 -> t7)
+              -> (t6, t2, t3, t4, t5) -> t7
 streamLens  f (a,b,c,d,e) = f (,b,c,d,e) a
+programLens :: ((t1 -> (t2, t1, t3, t4, t5)) -> t6 -> t7)
+               -> (t2, t6, t3, t4, t5) -> t7
 programLens f (a,b,c,d,e) = f (a,,c,d,e) b
+targetLens :: ((t1 -> (t2, t3, t1, t4, t5)) -> t6 -> t7)
+              -> (t2, t3, t6, t4, t5) -> t7
 targetLens  f (a,b,c,d,e) = f (a,b,,d,e) c
+slotLens :: ((t1 -> (t2, t3, t4, t1, t5)) -> t6 -> t7)
+            -> (t2, t3, t4, t6, t5) -> t7
 slotLens    f (a,b,c,d,e) = f (a,b,c,,e) d
+textureLens :: ((t1 -> (t2, t3, t4, t5, t1)) -> t6 -> t7)
+               -> (t2, t3, t4, t5, t6) -> t7
 textureLens f (a,b,c,d,e) = f (a,b,c,d,) e
 
+modL :: MonadState s m =>
+        (((b -> c) -> a1 -> (d, c)) -> s -> (a2, s))
+        -> (a1 -> (d, b)) -> m a2
 modL gs f = state $ gs $ \fx -> second fx . f
 
+addL' :: (MonadState s m, Ord k) =>
+         (((Map k (Int, t) -> c) -> Map k (Int, t) -> (Int, c))
+          -> s -> (a, s))
+         -> k -> (t -> t -> t) -> t -> m a
 addL' l p f x = modL l $ \sv -> maybe (length sv, Map.insert p (length sv, x) sv) (\(i, x') -> (i, Map.insert p (i, f x x') sv)) $ Map.lookup p sv
+addL :: (MonadState s m, Num a1) =>
+        ((((a1, [a2]) -> c) -> (a1, [a2]) -> (a1, c)) -> s -> (a3, s))
+        -> a2 -> m a3
 addL l x = modL l $ \(i, sv) -> (i, (i+1, x: sv))
+addLEq :: (MonadState s m, Ord k) =>
+          (((Map k Int -> c) -> Map k Int -> (Int, c)) -> s -> (a, s))
+          -> k -> m a
 addLEq l x = modL l $ \sv -> maybe (let i = length sv in i `seq` (i, Map.insert x i sv)) (\i -> (i, sv)) $ Map.lookup x sv
 
 ---------------------------------------------------------
@@ -251,6 +275,7 @@ type SamplerBinding = (IR.UniformName,IR.ImageRef)
 
 ----------------------------------------------------------------
 
+frameBufferType :: ExpTV -> ExpTV
 frameBufferType (A2 "FrameBuffer" _ ty) = ty
 frameBufferType x = error $ "illegal target type: " ++ ppShow x
 
@@ -266,44 +291,55 @@ getImageTextureTypes = map (imageInputTypeTextureType . compImageInputType) . ge
 getImageInputTypes :: ExpTV -> [IR.InputType]
 getImageInputTypes = map compImageInputType . getFramebufferType
 
+getFragFilter :: ExpTV -> (Maybe ExpTV, ExpTV)
 getFragFilter (A2 "map" (EtaPrim2 "filterFragment" p) x) = (Just p, x)
 getFragFilter x = (Nothing, x)
 
+getVertexShader :: ExpTV -> ((Maybe ExpTV, Ty), ExpTV)
 getVertexShader (A2 "map" (EtaPrim2 "mapPrimitive" f@(etaReds -> Just (_, o))) x) = ((Just f, tyOf o), x)
 --getVertexShader (A2 "map" (EtaPrim2 "mapPrimitive" f) x) = error $ "gff: " ++ show (case f of ExpTV x _ _ -> x) --ppShow (mapVal unFunc' f)
 --getVertexShader x = error $ "gf: " ++ ppShow x
 getVertexShader x = ((Nothing, getPrim' $ tyOf x), x)
 
+getFragmentShader :: ExpTV -> ((Maybe ExpTV, Ty), ExpTV)
 getFragmentShader (A2 "map" (EtaPrim2 "mapFragment" f@(etaReds -> Just (_, o))) x) = ((Just f, tyOf o), x)
 --getFragmentShader (A2 "map" (EtaPrim2 "mapFragment" f) x) = error $ "gff: " ++ ppShow f
 --getFragmentShader x = error $ "gf: " ++ ppShow x
 getFragmentShader x = ((Nothing, getPrim'' $ tyOf x), x)
 
+getPrim :: ExpTV -> ExpTV
 getPrim (A1 "List" (A2 "Primitive" _ p)) = p
+getPrim' :: ExpTV -> ExpTV
 getPrim' (A1 "List" (A2 "Primitive" a _)) = a
+getPrim'' :: ExpTV -> ExpTV
 getPrim'' (A1 "List" (A2 "Vector" _ (A1 "Maybe" (A1 "SimpleFragment" (TTuple [a]))))) = a
 getPrim'' x = error $ "getPrim'':" ++ ppShow x
 
+compFrameBuffer :: ExpTV -> IR.ClearImage
 compFrameBuffer = \case
   A1 "DepthImage" a -> IR.ClearImage IR.Depth $ compValue a
   A1 "ColorImage" a -> IR.ClearImage IR.Color $ compValue a
   x -> error $ "compFrameBuffer " ++ ppShow x
 
+compList :: ExpTV -> [ExpTV]
 compList (A2 ":" a x) = a : compList x
 compList (A0 "Nil") = []
 compList x = error $ "compList: " ++ ppShow x
 
+compFilter :: ExpTV -> IR.Filter
 compFilter = \case
   A0 "PointFilter"  -> IR.Nearest
   A0 "LinearFilter" -> IR.Linear
   x -> error $ "compFilter: " ++ ppShow x
 
+compEdgeMode :: ExpTV -> IR.EdgeMode
 compEdgeMode = \case
   A0 "Repeat"         -> IR.Repeat
   A0 "MirroredRepeat" -> IR.MirroredRepeat
   A0 "ClampToEdge"    -> IR.ClampToEdge
   x -> error $ "compEdgeMode: " ++ ppShow x
 
+compSemantic :: ExpTV -> IR.ImageSemantic
 compSemantic = \case
   A0 "Depth"     -> IR.Depth
   A0 "Stencil"   -> IR.Stencil
@@ -338,14 +374,17 @@ compImageInputType = \case
     _ -> error $ "Unexpected color image element type: " <> ppShow c
   x -> error $ "compImageType: " ++ ppShow x
 
+compAC :: ExpTV -> IR.AccumulationContext
 compAC (ETuple x) = IR.AccumulationContext Nothing $ map compFrag x
 
+compBlending :: ExpTV -> IR.Blending
 compBlending x = case x of
   A0 "NoBlending" -> IR.NoBlending
   A1 "BlendLogicOp" a -> IR.BlendLogicOp (compLO a)
   A3 "Blend" (ETuple [a,b]) (ETuple [ETuple [c,d],ETuple [e,f]]) (compValue -> IR.VV4F g) -> IR.Blend (compBE a) (compBE b) (compBF c) (compBF d) (compBF e) (compBF f) g
   x -> error $ "compBlending " ++ ppShow x
 
+compBF :: ExpTV -> IR.BlendingFactor
 compBF x = case x of
   A0 "ZeroBF" -> IR.Zero
   A0 "OneBF" -> IR.One
@@ -364,6 +403,7 @@ compBF x = case x of
   A0 "SrcAlphaSaturate" -> IR.SrcAlphaSaturate
   x -> error $ "compBF " ++ ppShow x
 
+compBE :: ExpTV -> IR.BlendEquation
 compBE x = case x of
   A0 "FuncAdd" -> IR.FuncAdd
   A0 "FuncSubtract" -> IR.FuncSubtract
@@ -372,6 +412,7 @@ compBE x = case x of
   A0 "Max" -> IR.Max
   x -> error $ "compBE " ++ ppShow x
 
+compLO :: ExpTV -> IR.LogicOperation
 compLO x = case x of
   A0 "Clear" -> IR.Clear
   A0 "And" -> IR.And
@@ -391,6 +432,7 @@ compLO x = case x of
   A0 "Set" -> IR.Set
   x -> error $ "compLO " ++ ppShow x
 
+compComparisonFunction :: ExpTV -> IR.ComparisonFunction
 compComparisonFunction x = case x of
   A0 "Never" -> IR.Never
   A0 "Less" -> IR.Less
@@ -404,19 +446,24 @@ compComparisonFunction x = case x of
 
 pattern EBool a <- (compBool -> Just a)
 
+compBool :: ExpTV -> Maybe Bool
 compBool x = case x of
   A0 "True" -> Just True
   A0 "False" -> Just False
   x -> Nothing
 
+compFrag :: ExpTV -> IR.FragmentOperation
 compFrag x = case x of
   A2 "DepthOp" (compComparisonFunction -> a) (EBool b) -> IR.DepthOp a b
   A2 "ColorOp" (compBlending -> b) (compValue -> v) -> IR.ColorOp b v
   x -> error $ "compFrag " ++ ppShow x
 
+toGLSLType :: IsString p => [Char] -> ExpTV -> p
 toGLSLType msg x = showGLSLType msg $ compInputType msg x
 
 -- move to lambdacube-ir?
+showGLSLType :: IsString p =>
+                [Char] -> IR.InputType -> p
 showGLSLType msg = \case
     IR.Bool  -> "bool"
     IR.Word  -> "uint"
@@ -446,6 +493,7 @@ showGLSLType msg = \case
     IR.FTexture2D -> "sampler2D"
     t -> error $ "toGLSLType: " ++ msg ++ " " ++ show t
 
+supType :: ExpTV -> Bool
 supType = isJust . compInputType_
 
 compInputType_ :: ExpTV -> Maybe IR.InputType
@@ -477,12 +525,16 @@ compInputType_ x = case x of
   TMat 4 4 TFloat -> Just IR.M44F
   _ -> Nothing
 
+compInputType :: [Char] -> ExpTV -> IR.InputType
 compInputType msg x = fromMaybe (error $ "compInputType " ++ msg ++ " " ++ ppShow x) $ compInputType_ x
 
+is234 :: Integer -> Bool
 is234 = (`elem` [2,3,4])
 
-compInputType'' (ETuple attrs) = map compAttribute attrs
+compInputType'' :: ExpTV -> [(String, IR.InputType)]
+compInputType'' (ETuple attrs) = map compAttribute attrs -- pattern fail.
 
+compAttribute :: ExpTV -> (String, IR.InputType)
 compAttribute = \case
   x@(A1 "Attribute" (EString s)) -> (s, compInputType "compAttr" $ tyOf x)
   x -> error $ "compAttribute " ++ ppShow x
@@ -510,6 +562,7 @@ compAttributeValue (ETuple x) = checkLength $ map go x
       where (A1 "List" (compInputType "compAV" -> t)) = tyOf a
             values = map compValue $ compList a
 
+compFetchPrimitive :: ExpTV -> IR.FetchPrimitive
 compFetchPrimitive x = case x of
   A0 "Point" -> IR.Points
   A0 "Line" -> IR.Lines
@@ -533,52 +586,62 @@ compValue x = case x of
   A4 "V4" (EBool a) (EBool b) (EBool c) (EBool d) -> IR.VV4B $ IR.V4 a b c d
   x -> error $ "compValue " ++ ppShow x
 
+compRC :: ExpTV -> IR.RasterContext
 compRC x = case x of
   A3 "PointCtx" a (EFloat b) c -> IR.PointCtx (compPS a) (realToFrac b) (compPSCO c)
   A2 "LineCtx" (EFloat a) b -> IR.LineCtx (realToFrac a) (compPV b)
   A4 "TriangleCtx" a b c d -> IR.TriangleCtx (compCM a) (compPM b) (compPO c) (compPV d)
   x -> error $ "compRC " ++ ppShow x
 
+compRC' :: ExpTV -> Maybe ExpTV
 compRC' x = case x of
   A3 "PointCtx" a _ _ -> compPS' a
   A4 "TriangleCtx" _ b _ _ -> compPM' b
   x -> Nothing
 
+compPSCO :: ExpTV -> IR.PointSpriteCoordOrigin
 compPSCO x = case x of
   A0 "LowerLeft" -> IR.LowerLeft
   A0 "UpperLeft" -> IR.UpperLeft
   x -> error $ "compPSCO " ++ ppShow x
 
+compCM :: ExpTV -> IR.CullMode
 compCM x = case x of
   A0 "CullNone" -> IR.CullNone
   A0 "CullFront" -> IR.CullFront IR.CCW
   A0 "CullBack" -> IR.CullBack IR.CCW
   x -> error $ "compCM " ++ ppShow x
 
+compPM :: ExpTV -> IR.PolygonMode
 compPM x = case x of
   A0 "PolygonFill" -> IR.PolygonFill
   A1 "PolygonLine" (EFloat a) -> IR.PolygonLine $ realToFrac a
   A1 "PolygonPoint" a  -> IR.PolygonPoint $ compPS a
   x -> error $ "compPM " ++ ppShow x
 
+compPM' :: ExpTV -> Maybe ExpTV
 compPM' x = case x of
   A1 "PolygonPoint" a  -> compPS' a
   x -> Nothing
 
+compPS :: ExpTV -> IR.PointSize
 compPS x = case x of
   A1 "PointSize" (EFloat a) -> IR.PointSize $ realToFrac a
   A1 "ProgramPointSize" _ -> IR.ProgramPointSize
   x -> error $ "compPS " ++ ppShow x
 
+compPS' :: ExpTV -> Maybe ExpTV
 compPS' x = case x of
   A1 "ProgramPointSize" x -> Just x
   x -> Nothing
 
+compPO :: ExpTV -> IR.PolygonOffset
 compPO x = case x of
   A2 "Offset" (EFloat a) (EFloat b) -> IR.Offset (realToFrac a) (realToFrac b)
   A0 "NoOffset" -> IR.NoOffset
   x -> error $ "compPO " ++ ppShow x
 
+compPV :: ExpTV -> IR.ProvokingVertex
 compPV x = case x of
     A0 "FirstVertex" -> IR.FirstVertex
     A0 "LastVertex" -> IR.LastVertex
@@ -741,8 +804,10 @@ data Uniform
 
 type Uniforms = Map String (Uniform, IR.InputType)
 
+tellUniform :: (MonadWriter (a, b) m, Monoid b) => a -> m ()
 tellUniform x = tell (x, mempty)
 
+simpleExpr :: ExpTV -> Bool
 simpleExpr = \case
     Con cn xs -> case cn of
         "Uniform" -> True
@@ -944,8 +1009,10 @@ type Ty = ExpTV
 tyOf :: ExpTV -> Ty
 tyOf (ExpTV _ t vs) = t .@ vs
 
+expOf :: ExpTV -> I.Exp
 expOf (ExpTV x _ _) = x
 
+mapVal :: (I.Exp -> I.Exp) -> ExpTV -> ExpTV
 mapVal f (ExpTV a b c) = ExpTV (f a) b c
 
 toExp :: I.ExpType -> ExpTV
@@ -964,18 +1031,23 @@ pattern EString s <- ELit (LString s)
 pattern EFloat s  <- ELit (LFloat s)
 pattern EInt s    <- ELit (LInt s)
 
+(.@) :: I.Exp -> [I.Exp] -> ExpTV
 t .@ vs = ExpTV t I.TType vs
 infix 1 .@
 
+mkVar :: ExpTV -> Maybe (Int, ExpTV)
 mkVar (ExpTV (I.Var i) t vs) = Just (i, t .@ vs)
 mkVar _ = Nothing
 
+mkPi :: ExpTV -> Maybe (Visibility, ExpTV, ExpTV)
 mkPi (ExpTV (I.Pi b x y) _ vs) = Just (b, x .@ vs, y .@ addToEnv x vs)
 mkPi _ = Nothing
 
+mkLam :: ExpTV -> Maybe (Visibility, ExpTV, ExpTV)
 mkLam (ExpTV (I.Lam y) (I.Pi b x yt) vs) = Just (b, x .@ vs, ExpTV y yt $ addToEnv x vs)
 mkLam _ = Nothing
 
+mkCon :: ExpTV -> Maybe (SName, [ExpTV])
 mkCon (ExpTV (I.Con s n (reverse -> xs)) et vs) = Just (untick $ show s, chain vs (I.conType et s) $ I.mkConPars n et ++ xs)
 mkCon (ExpTV (I.TyCon s (reverse -> xs)) et vs) = Just (untick $ show s, chain vs (nType s) xs)
 mkCon (ExpTV (I.Neut (I.Fun s@(I.FunName _ loc _{-I.DeltaDef{}-} _) (reverse -> xs) def)) et vs) = Just (untick $ show s, drop loc $ chain vs (nType s) xs)
@@ -983,14 +1055,17 @@ mkCon (ExpTV (I.CaseFun s xs n) et vs) = Just (untick $ show s, chain vs (nType
 mkCon (ExpTV (I.TyCaseFun s [m, t, f] n) et vs) = Just (untick $ show s, chain vs (nType s) [m, t, I.Neut n, f])
 mkCon _ = Nothing
 
+mkApp :: ExpTV -> Maybe (ExpTV, ExpTV)
 mkApp (ExpTV (I.Neut (I.App_ a b)) et vs) = Just (ExpTV (I.Neut a) t vs, head $ chain vs t [b])
   where t = neutType' (mkEnv vs) a
 mkApp _ = Nothing
 
+removeRHS :: (Num t, Ord t) => t -> I.Exp -> Maybe I.Exp
 removeRHS 0 (I.RHS x) = Just x
 removeRHS n (I.Lam x) | n > 0 = I.Lam <$> removeRHS (n-1) x
 removeRHS _ _ = Nothing
 
+mkFunc :: ExpTV -> Maybe ([Char], ExpTV, Ty, [ExpTV])
 mkFunc r@(ExpTV (I.Neut (I.Fun (I.FunName (show -> n) loc (I.ExpDef def_) nt) xs I.RHS{})) ty vs)
     | Just def <- removeRHS (length xs) def_
     , all (supType . tyOf) (r: xs') && n `notElem` ["typeAnn"] && all validChar n
@@ -1015,19 +1090,24 @@ mkFunc r@(ExpTV (I.Neut (I.Fun (I.FunName (show -> n) loc (I.ExpDef def_) nt) xs
 -}
 mkFunc _ = Nothing
 
+chain :: [I.Exp] -> I.Exp -> [I.Exp] -> [ExpTV]
 chain vs t@(I.Pi Hidden at y) (a: as) = chain vs (I.appTy t a) as
 chain vs t xs = map snd $ chain' vs t xs
 
+chain' :: [I.Exp] -> I.Exp -> [I.Exp] -> [(Visibility, ExpTV)]
 chain' vs t [] = []
 chain' vs t@(I.Pi b at y) (a: as) = (b, ExpTV a at vs): chain' vs (I.appTy t a) as
 chain' vs t _ = error $ "chain: " ++ ppShow t
 
+mkTVar :: Int -> ExpTV -> ExpTV
 mkTVar i (ExpTV t _ vs) = ExpTV (I.Var i) t vs
 
+unLab' :: I.Exp -> I.Exp
 unLab' (I.Reduced x) = unLab' x
 unLab' (I.RHS x) = unLab' x   -- TODO: remove
 unLab' x = x
 
+unFunc' :: I.Exp -> I.Exp
 unFunc' (I.Reduced x) = unFunc' x   -- todo: remove?
 unFunc' (I.Neut (I.Fun (I.FunName _ _ I.ExpDef{} _) _ y)) = unFunc' y
 unFunc' (I.RHS x) = unFunc' x   -- TODO: remove
@@ -1036,7 +1116,9 @@ unFunc' x = x
 instance Subst I.Exp ExpTV where
     subst_ i0 dx x (ExpTV a at vs) = ExpTV (subst_ i0 dx x a) (subst_ i0 dx x at) (zipWith (\i -> subst_ (i0+i) (I.shiftFreeVars i dx) $ up i x{-todo: review-}) [1..] vs)
 
+addToEnv :: a -> [a] -> [a]
 addToEnv x xs = x: xs
+mkEnv :: Rearrange c => [c] -> [c]
 mkEnv xs = {-trace_ ("mk " ++ show (length xs)) $ -} zipWith up [1..] xs
 
 instance HasFreeVars ExpTV where
@@ -1045,15 +1127,18 @@ instance HasFreeVars ExpTV where
 instance PShow ExpTV where
     pShow (ExpTV x t _) = pShow (x, t)
 
+isSampler :: I.Exp -> Bool
 isSampler (I.TyCon n _) = show n == "'Sampler"
 isSampler _ = False
 
 -------------------------------------------------------------------------------- ExpTV conversion -- TODO: remove
 
+removeLams :: (Eq t, Num t) => t -> ExpTV -> ExpTV
 removeLams 0 x = x
 removeLams i (ELam _ x) = removeLams (i-1) x
 removeLams i (Lam Hidden _ x) = removeLams i x
 
+etaReds :: ExpTV -> Maybe ([ExpTV], ExpTV)
 etaReds (ELam _ (App (down 0 -> Just f) (EVar 0))) = etaReds f
 etaReds (ELam _ (hlistLam -> x@Just{})) = x
 etaReds (ELam p i) = Just ([p], i)
@@ -1064,6 +1149,8 @@ hlistLam (A3 "hlistNilCase" _ (down 0 -> Just x) (EVar 0)) = Just ([], x)
 hlistLam (A3 "hlistConsCase" _ (down 0 -> Just (getPats 2 -> Just ([p, px], x))) (EVar 0)) = first (p:) <$> hlistLam x
 hlistLam _ = Nothing
 
+getPats :: (Eq a, Num a, Show a) =>
+           a -> ExpTV -> Maybe ([ExpTV], ExpTV)
 getPats 0 e = Just ([], e)
 getPats i (ELam p e) = first (p:) <$> getPats (i-1) e
 getPats i (Lam Hidden p (down 0 -> Just e)) = getPats i e
@@ -1076,12 +1163,15 @@ pattern EtaPrim4 s x1 x2 x3 <- (getEtaPrim -> Just (s, [x1, x2, x3]))
 pattern EtaPrim5 s x1 x2 x3 x4 <- (getEtaPrim -> Just (s, [x1, x2, x3, x4]))
 pattern EtaPrim2_2 s <- (getEtaPrim2 -> Just (s, []))
 
+getEtaPrim :: ExpTV -> Maybe (SName, [ExpTV])
 getEtaPrim (ELam _ (Con s (initLast -> Just (traverse (down 0) -> Just xs, EVar 0)))) = Just (s, xs)
 getEtaPrim _ = Nothing
 
+getEtaPrim2 :: ExpTV -> Maybe (SName, [ExpTV])
 getEtaPrim2 (ELam _ (ELam _ (Con s (initLast -> Just (initLast -> Just (traverse (down 0) -> Just (traverse (down 0) -> Just xs), EVar 0), EVar 0))))) = Just (s, xs)
 getEtaPrim2 _ = Nothing
 
+initLast :: [b] -> Maybe ([b], b)
 initLast [] = Nothing
 initLast xs = Just (init xs, last xs)
 
@@ -1117,9 +1207,11 @@ fromNat _ = Nothing
 pattern TTuple xs <- (getTTuple -> Just xs)
 pattern ETuple xs <- (getTuple -> Just xs)
 
+getTTuple :: ExpTV -> Maybe [ExpTV]
 getTTuple (A1 "HList" l) = Just $ compList l
 getTTuple _ = Nothing
 
+getTuple :: ExpTV -> Maybe [ExpTV]
 getTuple (A0 "HNil") = Just []
 getTuple (A2 "HCons" x (getTuple -> Just xs)) = Just (x: xs)
 getTuple _ = Nothing
@@ -1308,6 +1400,14 @@ genHLSL dns e = case e of
 
     showSwizzProj x a = parens a <> "." <> text x
 
+genHLSLs :: Traversable t =>
+            Backend
+            -> t ExpTV
+            -> ExpTV
+            -> (Maybe ExpTV, ExpTV)
+            -> (Maybe ExpTV, ExpTV)
+            -> Maybe ExpTV
+            -> ([[Char]], Uniforms, Doc, Doc)
 genHLSLs backend
     rp                  -- program point size
     (ETuple ints)       -- interpolations
@@ -1453,9 +1553,12 @@ genHLSLs backend
     shaderDecl a b c = shaderDecl' (a <+> b) c
     shaderDecl' b c = shaderStmt $ b <+> c
 
+toHLSLType :: IsString p => [Char] -> ExpTV -> p
 toHLSLType msg x = showHLSLType msg $ compInputType msg x
 
 -- move to lambdacube-ir?
+showHLSLType :: IsString p =>
+                [Char] -> IR.InputType -> p
 showHLSLType msg = \case
     IR.Bool  -> "bool"
     IR.Word  -> "uint"