3 files changed, 1104 insertions, 0 deletions

diff --git a/testdata/hlist.ignore/Builtins.lc b/testdata/hlist.ignore/Builtins.lc
new file mode 100644
index 00000000..190bc6eb
--- /dev/null
+++ b/testdata/hlist.ignore/Builtins.lc
@@ -0,0 +1,590 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Builtins
+    ( module Internals
+    , module Builtins
+    ) where
+
+import Internals
+
+id x = x
+
+---------------------------------------
+
+class AttributeTuple a
+instance AttributeTuple a -- TODO
+class ValidOutput a
+instance ValidOutput a -- TODO
+
+data VecS (a :: Type) :: Nat -> Type where
+  V2 :: a -> a -> VecS a 2
+  V3 :: a -> a -> a -> VecS a 3
+  V4 :: a -> a -> a -> a -> VecS a 4
+
+type family Vec (n :: Nat) t  where Vec n t = VecS t n
+
+type family VecScalar (n :: Nat) a where
+    VecScalar 1 a = a
+    VecScalar ('Succ ('Succ n)) a = Vec ('Succ ('Succ n)) a
+
+-- may be a data family?
+type family TFVec (n :: Nat) a where
+    TFVec n a = Vec n a     -- TODO: check range: n = 2,3,4;  a is Float, Int, Word, Bool
+
+-- todo: use less constructors with more parameters
+data Mat :: Nat -> Nat -> Type -> Type where
+  M22F :: Vec 2 Float -> Vec 2 Float -> Mat 2 2 Float
+  M32F :: Vec 3 Float -> Vec 3 Float -> Mat 3 2 Float
+  M42F :: Vec 4 Float -> Vec 4 Float -> Mat 4 2 Float
+  M23F :: Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Mat 2 3 Float
+  M33F :: Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Mat 3 3 Float
+  M43F :: Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Mat 4 3 Float
+  M24F :: Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Mat 2 4 Float
+  M34F :: Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Mat 3 4 Float
+  M44F :: Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Mat 4 4 Float
+
+type family MatVecScalarElem a where
+    MatVecScalarElem Float = Float
+    MatVecScalarElem Bool = Bool
+    MatVecScalarElem Int = Int
+    MatVecScalarElem (VecS a n) = a
+    MatVecScalarElem (Mat i j a) = a
+
+--------------------------------------- swizzling
+
+data Swizz = Sx | Sy | Sz | Sw
+
+-- todo: use pattern matching
+mapVec :: forall a b m . (a -> b) -> Vec m a -> Vec m b
+mapVec @a @b @m f v = 'VecSCase (\m _ -> 'Vec m b)
+    (\x y -> V2 (f x) (f y))
+    (\x y z -> V3 (f x) (f y) (f z))
+    (\x y z w -> V4 (f x) (f y) (f z) (f w))
+    @m
+    v
+
+-- todo: make it more type safe
+swizzscalar :: forall n . Vec n a -> Swizz -> a
+swizzscalar (V2 x y) Sx = x
+swizzscalar (V2 x y) Sy = y
+swizzscalar (V3 x y z) Sx = x
+swizzscalar (V3 x y z) Sy = y
+swizzscalar (V3 x y z) Sz = z
+swizzscalar (V4 x y z w) Sx = x
+swizzscalar (V4 x y z w) Sy = y
+swizzscalar (V4 x y z w) Sz = z
+swizzscalar (V4 x y z w) Sw = w
+
+-- used to prevent unfolding of swizzvector on variables (behind GPU lambda)
+definedVec :: forall a m . Vec m a -> Bool
+definedVec (V2 _ _) = True
+definedVec (V3 _ _ _) = True
+definedVec (V4 _ _ _ _) = True
+
+swizzvector :: forall n . forall m . Vec n a -> Vec m Swizz -> Vec m a
+swizzvector v w | definedVec v = mapVec (swizzscalar v) w
+
+
+--------------------------------------- type classes
+
+class Signed a
+
+instance Signed         Int
+instance Signed         Float
+
+class Component a where
+  zeroComp :: a
+  oneComp :: a
+
+instance Component Int where
+  zeroComp = 0 :: Int
+  oneComp = 1 :: Int
+instance Component Word where
+  zeroComp = 0 :: Word
+  oneComp = 1 :: Word
+instance Component Float where
+  zeroComp = 0.0
+  oneComp = 1.0
+instance Component (VecS Float 2) where
+  zeroComp = V2 0.0 0.0
+  oneComp = V2 1.0 1.0
+instance Component (VecS Float 3) where
+  zeroComp = V3 0.0 0.0 0.0
+  oneComp = V3 1.0 1.0 1.0
+instance Component (VecS Float 4) where
+  zeroComp = V4 0.0 0.0 0.0 0.0
+  oneComp = V4 1.0 1.0 1.0 1.0
+instance Component Bool where
+  zeroComp = False
+  oneComp = True
+instance Component (VecS Bool 2) where
+  zeroComp = V2 False False
+  oneComp = V2 True True
+instance Component (VecS Bool 3) where
+  zeroComp = V3 False False False
+  oneComp = V3 True True True
+instance Component (VecS Bool 4) where
+  zeroComp = V4 False False False False
+  oneComp = V4 True True True True
+
+class Integral a
+
+instance Integral       Int
+instance Integral       Word
+
+class Floating a
+
+instance Floating       Float
+instance Floating       (VecS Float 2)  -- todo: use Vec
+instance Floating       (VecS Float 3)
+instance Floating       (VecS Float 4)
+instance Floating       (Mat 2 2 Float)
+instance Floating       (Mat 2 3 Float)
+instance Floating       (Mat 2 4 Float)
+instance Floating       (Mat 3 2 Float)
+instance Floating       (Mat 3 3 Float)
+instance Floating       (Mat 3 4 Float)
+instance Floating       (Mat 4 2 Float)
+instance Floating       (Mat 4 3 Float)
+instance Floating       (Mat 4 4 Float)
+
+data BlendingFactor
+    = Zero' --- FIXME: modified
+    | One
+    | SrcColor
+    | OneMinusSrcColor
+    | DstColor
+    | OneMinusDstColor
+    | SrcAlpha
+    | OneMinusSrcAlpha
+    | DstAlpha
+    | OneMinusDstAlpha
+    | ConstantColor
+    | OneMinusConstantColor
+    | ConstantAlpha
+    | OneMinusConstantAlpha
+    | SrcAlphaSaturate
+
+data BlendEquation
+    = FuncAdd
+    | FuncSubtract
+    | FuncReverseSubtract
+    | Min
+    | Max
+
+data LogicOperation
+    = Clear
+    | And
+    | AndReverse
+    | Copy
+    | AndInverted
+    | Noop
+    | Xor
+    | Or
+    | Nor
+    | Equiv
+    | Invert
+    | OrReverse
+    | CopyInverted
+    | OrInverted
+    | Nand
+    | Set
+
+data StencilOperation
+    = OpZero
+    | OpKeep
+    | OpReplace
+    | OpIncr
+    | OpIncrWrap
+    | OpDecr
+    | OpDecrWrap
+    | OpInvert
+
+data ComparisonFunction
+    = Never
+    | Less
+    | Equal
+    | Lequal
+    | Greater
+    | Notequal
+    | Gequal
+    | Always
+
+data ProvokingVertex
+    = LastVertex
+    | FirstVertex
+
+data CullMode
+    = CullFront
+    | CullBack
+    | CullNone
+
+data PointSize a
+    = PointSize Float
+    | ProgramPointSize (a -> Float)
+
+data PolygonMode a
+    = PolygonFill
+    | PolygonPoint (PointSize a)
+    | PolygonLine Float
+
+data PolygonOffset
+    = NoOffset
+    | Offset Float Float
+
+data PointSpriteCoordOrigin
+    = LowerLeft
+    | UpperLeft
+
+data ImageSemantics = Depth Type | Stencil Type | Color Type
+
+data PrimitiveType
+    = Triangle
+    | Line
+    | Point
+    | TriangleAdjacency
+    | LineAdjacency
+
+-- builtin
+primTexture :: () -> Vec 2 Float -> Vec 4 Float
+
+-- builtins
+Uniform   :: String -> t
+Attribute :: String -> t
+
+data RasterContext a :: PrimitiveType -> Type where
+  TriangleCtx         :: CullMode -> PolygonMode a -> PolygonOffset -> ProvokingVertex -> RasterContext a Triangle
+  PointCtx            :: PointSize a -> Float -> PointSpriteCoordOrigin                -> RasterContext a Point
+  LineCtx             :: Float -> ProvokingVertex                                      -> RasterContext a Line
+
+map _ []     = []
+map f (x:xs) = f x : map f xs
+
+type family ListElem a
+type instance ListElem [a] = a
+
+type family FTRepr' a where
+    FTRepr' (HList l) = HList (map ListElem l)
+{-
+type family FTRepr' a where
+    -- TODO
+    FTRepr' [a] = a
+    FTRepr' ([a], [b]) = (a, b)
+-}
+data Blending :: Type -> Type where
+  NoBlending          ::                                   Blending t
+  BlendLogicOp        :: (Integral t) => LogicOperation -> Blending t
+  Blend               :: (BlendEquation, BlendEquation)
+                         -> ((BlendingFactor, BlendingFactor), (BlendingFactor, BlendingFactor))
+                         -> Vec 4 Float ->                 Blending Float
+
+{- TODO: more precise kinds
+  FragmentOperation    :: Semantic -> *
+  FragmentOut          :: Semantic -> *
+-}
+
+data StencilTests
+data StencilOps
+data Int32
+
+data FragmentOperation :: ImageSemantics -> Type where
+  ColorOp             :: (mask ~ VecScalar d Bool, color ~ VecScalar d c, Num c) => Blending c -> mask
+                                                                   -> FragmentOperation (Color color)
+  DepthOp             :: ComparisonFunction -> Bool                -> FragmentOperation (Depth Float)
+  StencilOp           :: StencilTests -> StencilOps -> StencilOps  -> FragmentOperation (Stencil Int32)
+
+[]   ++ ys = ys
+x:xs ++ ys = x : xs ++ ys
+
+foldr f e [] = e
+foldr f e (x: xs) = f x (foldr f e xs)
+
+concat = foldr (++) []
+
+concatMap :: (a -> [b]) -> [a] -> [b]
+concatMap f x = concat (map f x)
+
+data Primitive a :: PrimitiveType -> Type where
+    PrimPoint    :: a           -> Primitive a Point
+    PrimLine     :: a -> a      -> Primitive a Line
+    PrimTriangle :: a -> a -> a -> Primitive a Triangle
+
+type PrimitiveStream a t = [Primitive t a]
+
+mapPrimitive :: (a -> b) -> Primitive a p -> Primitive b p
+{- todo
+mapPrimitive f (PrimPoint a) = PrimPoint (f a)
+mapPrimitive f (PrimLine a b) = PrimLine (f a) (f b)
+mapPrimitive f (PrimTriangle a b c) = PrimTriangle (f a) (f b) (f c)
+-}
+
+fetch_               :: forall a t . (AttributeTuple t) => String -> t -> PrimitiveStream a t
+fetchArrays_         :: forall a t t' . (AttributeTuple t, t ~ FTRepr' t') => t' -> PrimitiveStream a t
+
+mapPrimitives :: (a -> b) -> PrimitiveStream p a -> PrimitiveStream p b
+mapPrimitives f = map (mapPrimitive f)
+
+fetch s a t = fetch_ @a s t
+fetchArrays a t = fetchArrays_ @a t
+
+-------------------
+
+data Maybe a
+    = Nothing
+    | Just a
+--    deriving (Eq, Ord, Show)
+
+data Vector (n :: Nat) t
+
+type Fragment n t = Vector n (Maybe (SimpleFragment t))
+
+data SimpleFragment t = SimpleFragment
+    { sFragmentCoords   :: Vec 3 Float
+    , sFragmentValue    :: t
+    }
+
+type FragmentStream n t = [Fragment n t]
+
+customizeDepth :: (a -> Float) -> Fragment n a -> Fragment n a
+
+customizeDepths :: (a -> Float) -> FragmentStream n a -> FragmentStream n a
+customizeDepths f = map (customizeDepth f)
+
+filterFragment :: (a -> Bool) -> Fragment n a -> Fragment n a
+
+filterFragments :: (a -> Bool) -> FragmentStream n a -> FragmentStream n a
+filterFragments p = map (filterFragment p)
+
+mapFragment :: (a -> b) -> Fragment n a -> Fragment n b
+
+mapFragments :: (a -> b) -> FragmentStream n a -> FragmentStream n b
+mapFragments f = map (mapFragment f)
+
+
+data Interpolated t where
+  Smooth, NoPerspective
+                      :: (Floating t) => Interpolated t
+  Flat                ::                 Interpolated t
+
+type family GetInterpolatedType a
+type instance GetInterpolatedType (Interpolated a) = a
+
+interpolatedType = map 'GetInterpolatedType
+{-
+type family InterpolatedType a where
+    InterpolatedType () = ()
+    InterpolatedType (Interpolated a) = a
+    InterpolatedType (Interpolated a, Interpolated b) = (a, b)
+    InterpolatedType (Interpolated a, Interpolated b, Interpolated c) = (a, b, c)
+-}
+
+
+rasterizePrimitive
+    :: ( map Interpolated b ~ interpolation
+       , a ~ '( '(Vec 4 Float) : b) )
+    => HList interpolation                -- tuple of Smooth & Flat
+    -> RasterContext (HList a) x
+    -> Primitive (HList a) x
+    -> FragmentStream 1 (HList b)
+
+rasterizePrimitives ctx is s = concat (map (rasterizePrimitive is ctx) s)
+
+data Image (n :: Nat) (t :: ImageSemantics) -- = Vector n [[t]]
+
+ColorImage          :: forall a d t color . (Num t, color ~ VecScalar d t)
+                    => color  -> Image a (Color color)
+DepthImage          :: forall a . Float  -> Image a (Depth Float)
+StencilImage        :: forall a . Int    -> Image a (Stencil Int)
+
+type family ImageLC a :: Nat
+type instance ImageLC (Image n t) = n
+
+allSame :: [a] -> Type
+allSame [] = 'Unit
+allSame [x] = 'Unit
+allSame (x: y: xs) = 'T2 (x ~ y) (allSame (y:xs))
+
+sameLayerCounts a = allSame (map 'ImageLC a)
+{-
+type family SameLayerCounts a where
+    SameLayerCounts (Image n1 t1) = Unit
+    SameLayerCounts (Image n1 t1, Image n2 t2) = EqCT Nat n1 n2
+    SameLayerCounts (Image n1 t1, Image n2 t2, Image n3 t3) = T2 (EqCT Nat n1 n2) (EqCT Nat n1 n3)
+-}
+
+{-
+class DefaultFragOp a where defaultFragOp :: FragmentOperation a
+instance DefaultFragOp (Color (VecS Float 4)) where defaultFragOp = ColorOp NoBlending (V4 True True True True)
+instance DefaultFragOp (Depth Float) where defaultFragOp = DepthOp Less True
+
+class DefaultFragOps a where defaultFragOps :: a
+instance (DefaultFragOp a, DefaultFragOp b) => DefaultFragOps (FragmentOperation a, FragmentOperation b) where
+    defaultFragOps = -- (undefined @(), undefined) 
+            (defaultFragOp @a @_, defaultFragOp @b @_)
+-}
+data FrameBuffer (n :: Nat) (t :: [ImageSemantics])
+
+remSemantics :: ImageSemantics -> Type
+remSemantics (Color a) = a
+remSemantics (Depth a) = a
+remSemantics (Stencil a) = a
+
+remSemantics' :: [ImageSemantics] -> [Type]
+remSemantics' (Depth _: x) = map remSemantics x 
+remSemantics' x = map remSemantics x 
+
+type family FragmentOperationSem a :: ImageSemantics
+type instance FragmentOperationSem (FragmentOperation x) = x
+
+Accumulate :: forall (n :: Nat) (c :: [Type]) . (b ~ map FragmentOperationSem c) => HList c -> FragmentStream n (HList (remSemantics' b)) -> FrameBuffer n b -> FrameBuffer n b
+
+type family ImageSem a  :: ImageSemantics
+type instance ImageSem (Image n t) = t
+
+tfFrameBuffer t = map 'ImageSem t
+{-
+type family TFFrameBuffer a where
+    TFFrameBuffer (Image n1 t1) = FrameBuffer n1 '[t1]
+    TFFrameBuffer (Image n1 t1, Image n2 t2) = FrameBuffer n1 '[t1, t2]
+    TFFrameBuffer (Image n1 t1, Image n2 t2, Image n3 t3) = FrameBuffer n1 '[t1, t2, t3]
+-}
+
+class ValidFrameBuffer (a :: [ImageSemantics])
+instance ValidFrameBuffer a -- TODO
+
+head (x: _) = x
+
+FrameBuffer  :: forall (a :: [Type]) . (sameLayerCounts a) => HList a -> FrameBuffer (ImageLC (head a)) (tfFrameBuffer a)
+
+accumulate ctx fshader fstr fb = Accumulate ctx (mapFragments fshader fstr) fb
+
+accumulationContext x = x
+
+-- texture support
+PrjImage            :: FrameBuffer 1 '[a] -> Image 1 a
+PrjImageColor       :: FrameBuffer 1 '[Depth 'Float, Color '(Vec 4 Float)] -> Image 1 (Color (Vec 4 Float))
+
+data Output where
+  ScreenOut           :: FrameBuffer a b -> Output
+
+-------------------------------------------------------------------
+-- * Builtin Primitive Functions *
+-- Arithmetic Functions (componentwise)
+
+PrimAdd, PrimSub, PrimMul     :: Num (MatVecScalarElem a) => a -> a -> a
+PrimAddS, PrimSubS, PrimMulS  :: (t ~ MatVecScalarElem a, Num t) => a -> t -> a
+PrimDiv, PrimMod              :: (Num t, a ~ VecScalar d t) => a -> a -> a
+PrimDivS, PrimModS            :: (Num t, a ~ VecScalar d t) => a -> t -> a
+PrimNeg                       :: Signed (MatVecScalarElem a) => a -> a
+-- Bit-wise Functions
+PrimBAnd, PrimBOr, PrimBXor   :: (Integral t, a ~ VecScalar d t) => a -> a -> a
+PrimBAndS, PrimBOrS, PrimBXorS:: (Integral t, a ~ VecScalar d t) => a -> t -> a
+PrimBNot                      :: (Integral t, a ~ VecScalar d t) => a -> a
+PrimBShiftL, PrimBShiftR      :: (Integral t, a ~ VecScalar d t, b ~ VecScalar d Word) => a -> b -> a
+PrimBShiftLS, PrimBShiftRS    :: (Integral t, a ~ VecScalar d t) => a -> Word -> a
+-- Logic Functions
+PrimAnd, PrimOr, PrimXor      :: Bool -> Bool -> Bool
+PrimNot                       :: forall a d . (a ~ VecScalar d Bool) => a -> a
+PrimAny, PrimAll              :: VecScalar d Bool -> Bool
+
+-- Angle, Trigonometry and Exponential Functions
+PrimACos, PrimACosH, PrimASin, PrimASinH, PrimATan, PrimATanH, PrimCos, PrimCosH, PrimDegrees, PrimRadians, PrimSin, PrimSinH, PrimTan, PrimTanH, PrimExp, PrimLog, PrimExp2, PrimLog2, PrimSqrt, PrimInvSqrt
+                              :: (a ~ VecScalar d Float) => a -> a
+PrimPow, PrimATan2            :: (a ~ VecScalar d Float) => a -> a -> a
+-- Common Functions
+PrimFloor, PrimTrunc, PrimRound, PrimRoundEven, PrimCeil, PrimFract
+                              :: (a ~ VecScalar d Float) => a -> a
+PrimMin, PrimMax              :: (Num t, a ~ VecScalar d t) => a -> a -> a
+PrimMinS, PrimMaxS            :: (Num t, a ~ VecScalar d t) => a -> t -> a
+PrimIsNan, PrimIsInf          :: (a ~ VecScalar d Float, b ~ VecScalar d Bool) => a -> b
+PrimAbs, PrimSign             :: (Signed t, a ~ VecScalar d t) => a -> a
+PrimModF                      :: (a ~ VecScalar d Float) => a -> (a, a)
+PrimClamp                     :: (Num t, a ~ VecScalar d t) => a -> a -> a -> a
+PrimClampS                    :: (Num t, a ~ VecScalar d t) => a -> t -> t -> a
+PrimMix                       :: (a ~ VecScalar d Float) => a -> a -> a -> a
+PrimMixS                      :: (a ~ VecScalar d Float) => a -> a -> Float -> a
+PrimMixB                      :: (a ~ VecScalar d Float, b ~ VecScalar d Bool) => a -> a -> b -> a
+PrimStep                      :: (a ~ TFVec d Float) => a -> a -> a
+PrimStepS                     :: (a ~ VecScalar d Float) => Float -> a -> a
+PrimSmoothStep                :: (a ~ TFVec d Float) => a -> a -> a -> a
+PrimSmoothStepS               :: (a ~ VecScalar d Float) => Float -> Float -> a -> a
+
+-- Integer/Floatonversion Functions
+PrimFloatBitsToInt            :: VecScalar d Float -> VecScalar d Int
+PrimFloatBitsToUInt           :: VecScalar d Float -> VecScalar d Word
+PrimIntBitsToFloat            :: VecScalar d Int   -> VecScalar d Float
+PrimUIntBitsToFloat           :: VecScalar d Word  -> VecScalar d Float
+-- Geometric Functions
+PrimLength                    :: (a ~ VecScalar d Float) => a -> Float
+PrimDistance, PrimDot         :: (a ~ VecScalar d Float) => a -> a -> Float
+PrimCross                     :: (a ~ VecScalar 3 Float) => a -> a -> a
+PrimNormalize                 :: (a ~ VecScalar d Float) => a -> a
+PrimFaceForward, PrimRefract  :: (a ~ VecScalar d Float) => a -> a -> a -> a
+PrimReflect                   :: (a ~ VecScalar d Float) => a -> a -> a
+-- Matrix Functions
+PrimTranspose                 :: Mat h w a -> Mat w h a
+PrimDeterminant               :: Mat s s a -> Float
+PrimInverse                   :: Mat s s a -> Mat s s a
+PrimOuterProduct              :: Vec w a   -> Vec h a   -> Mat h w a
+PrimMulMatVec                 :: Mat h w a -> Vec w a   -> Vec h a
+PrimMulVecMat                 :: Vec h a   -> Mat h w a -> Vec w a
+PrimMulMatMat                 :: Mat i j a -> Mat j k a -> Mat i k a
+-- Vector and Scalar Relational Functions
+PrimLessThan, PrimLessThanEqual, PrimGreaterThan, PrimGreaterThanEqual, PrimEqualV, PrimNotEqualV
+                              :: forall a d t b . (Num t, a ~ VecScalar d t, b ~ VecScalar d Bool) => a -> a -> b
+PrimEqual, PrimNotEqual       :: forall a t . (t ~ MatVecScalarElem a) => a -> a -> Bool
+-- Fragment Processing Functions
+PrimDFdx, PrimDFdy, PrimFWidth
+                              :: (a ~ VecScalar d Float) => a -> a
+-- Noise Functions
+PrimNoise1                    :: VecScalar d Float -> Float
+PrimNoise2                    :: VecScalar d Float -> Vec 2 Float
+PrimNoise3                    :: VecScalar d Float -> Vec 3 Float
+PrimNoise4                    :: VecScalar d Float -> Vec 4 Float
+
+{-
+-- Vec/Mat (de)construction
+PrimTupToV2                   :: Component a => PrimFun stage ((a,a)     -> V2 a)
+PrimTupToV3                   :: Component a => PrimFun stage ((a,a,a)   -> V3 a)
+PrimTupToV4                   :: Component a => PrimFun stage ((a,a,a,a) -> V4 a)
+PrimV2ToTup                   :: Component a => PrimFun stage (V2 a     -> (a,a))
+PrimV3ToTup                   :: Component a => PrimFun stage (V3 a   -> (a,a,a))
+PrimV4ToTup                   :: Component a => PrimFun stage (V4 a -> (a,a,a,a))
+-}
+
+--------------------
+-- * Texture support
+-- FIXME: currently only Float RGBA 2D texture is supported
+
+data Texture where
+  Texture2DSlot :: String -- texture slot name
+                -> Texture
+
+  Texture2D     :: Vec 2 Int -- FIXME: use Word here
+                -> Image 1 (Color (Vec 4 Float))
+                -> Texture
+
+data Filter
+  = PointFilter
+  | LinearFilter
+
+data EdgeMode
+  = Repeat
+  | MirroredRepeat
+  | ClampToEdge
+
+data Sampler = Sampler Filter EdgeMode Texture
+
+-- builtin
+texture2D :: Sampler -> Vec 2 Float -> Vec 4 Float
+
+
+accumulateWith ctx x = (ctx, x)
+overlay cl (ctx, str) = Accumulate ctx str cl
+renderFrame = ScreenOut
+imageFrame = FrameBuffer
+emptyDepthImage = DepthImage @1
+emptyColorImage = ColorImage @1
+
+infixl 0 `overlay`
+
diff --git a/testdata/hlist.ignore/Internals.lc b/testdata/hlist.ignore/Internals.lc
new file mode 100644
index 00000000..245a29d3
--- /dev/null
+++ b/testdata/hlist.ignore/Internals.lc
@@ -0,0 +1,152 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+-- declarations of builtin functions and data types used by the compiler
+module Internals where
+
+-- used for type annotations
+typeAnn x = x
+
+undefined :: forall (a :: Type) . a
+
+primFix :: forall (a :: Type) . (a -> a) -> a
+
+data Unit = TT
+data String
+data Empty (a :: String)
+
+unsafeCoerce :: forall a b . a -> b
+
+-- equality constraints
+type family EqCT (t :: Type) (a :: t) (b :: t)
+{-
+coe :: forall (a :: Type) (b :: Type) -> EqCT Type a b -> a -> b
+coe a b TT x = unsafeCoerce @a @b x
+-}
+
+-- ... TODO
+
+-- builtin used for overlapping instances
+parEval :: forall a -> a -> a -> a
+
+-- conjuction of constraints
+type family T2 a b
+
+match'Type :: forall (m :: Type -> Type) -> m Type -> forall (t :: Type) -> m t -> m t
+
+type EqCTt = EqCT _
+
+-- builtin conjuction of constraint witnesses
+t2C :: Unit -> Unit -> Unit
+
+-- builtin type constructors
+data Int
+data Word
+data Float
+data Char
+
+data Bool = False | True
+
+data Ordering = LT | EQ | GT
+
+data Nat = Zero | Succ Nat
+
+-- builtin primitives
+primIntToWord       :: Int   -> Word
+primIntToFloat      :: Int   -> Float
+primIntToNat        :: Int   -> Nat
+primCompareInt      :: Int   -> Int   -> Ordering
+primCompareWord     :: Word  -> Word  -> Ordering
+primCompareFloat    :: Float -> Float -> Ordering
+primCompareChar     :: Char  -> Char  -> Ordering
+primCompareString   :: String -> String -> Ordering
+primNegateInt       :: Int   -> Int
+primNegateWord      :: Word  -> Word
+primNegateFloat     :: Float -> Float
+primAddInt          :: Int   -> Int   -> Int
+primSubInt          :: Int   -> Int   -> Int
+primModInt          :: Int   -> Int   -> Int
+primSqrtFloat       :: Float -> Float
+primRound           :: Float -> Int
+
+
+primIfThenElse :: Bool -> a -> a -> a
+primIfThenElse True  a b = a
+primIfThenElse False a b = b
+
+isEQ EQ = True
+isEQ _ = False
+
+-- fromInt is needed for integer literal
+class Num a where
+  fromInt :: Int -> a
+  compare :: a -> a -> Ordering
+  negate :: a -> a
+
+instance Num Int where
+  fromInt = \x -> x
+  compare = primCompareInt
+  negate  = primNegateInt
+instance Num Word where
+  fromInt = primIntToWord
+  compare = primCompareWord
+  negate  = primNegateWord
+instance Num Float where
+  fromInt = primIntToFloat
+  compare = primCompareFloat
+  negate  = primNegateFloat
+instance Num Nat where
+  fromInt = primIntToNat --if isEQ (primCompareInt n zero') then Zero else Succ (fromInt (primSubInt n one'))
+  compare = undefined
+  negate  = undefined
+
+class Eq a where
+    (==) :: a -> a -> Bool     -- todo: use (==) sign
+
+infix 4 ==
+
+instance Eq String where a == b = isEQ (primCompareString a b)
+instance Eq Char where a == b = isEQ (primCompareChar a b)
+instance Eq Int where a == b = isEQ (primCompareInt a b)
+instance Eq Float where a == b = isEQ (primCompareFloat a b)
+instance Eq Bool where
+    True == True = True
+    False == False = True
+    _ == _ = False
+instance Eq Nat where
+    Zero   == Zero   = True
+    Succ a == Succ b = a == b
+    _      == _      = False
+
+data List a = Nil | Cons a (List a)
+
+infixr 5 :
+
+data HList :: [Type] -> Type where
+    HNil :: HList '[]
+    HCons :: x -> HList xs -> HList '(x: xs)
+
+-- TODO: generate?
+data Tuple0 = Tuple0
+data Tuple1 a = Tuple1 a
+data Tuple2 a b = Tuple2 a b
+data Tuple3 a b c = Tuple3 a b c
+data Tuple4 a b c d = Tuple4 a b c d
+data Tuple5 a b c d e = Tuple5 a b c d e
+
+--testmt :: forall (t :: Type) -> t -> t
+--testmt 'Type = \'Tuple0 -> 'Tuple0
+--testmt t x = (match'Type (\q -> (q -> q)) (\x -> match'Tuple0 (\q -> & 'Type) 'Tuple0 x undefined) t undefined) x
+--testmt t x = (match'Type (\q -> (q -> q)) (\x -> match'Tuple0 (\q -> 'Type) 'Tuple0 x undefined) t undefined) x
+
+--type instance EqCT Type = \'Type 'Type -> 'Unit
+--type instance EqCT Type = \'(a, b) '(JoinTupleType a' b') -> '(T2 (EqCT Type a a') (EqCT Type b b'))
+
+type family JoinTupleType t1 t2 where
+    -- TODO
+    JoinTupleType a () = a
+    JoinTupleType a (b, c) = (a, b, c)
+    JoinTupleType a (b, c, d) = (a, b, c, d)
+    JoinTupleType a (b, c, d, e) = (a, b, c, d, e)
+    JoinTupleType a b = (a, b)
+
+joinTupleType = HCons
+
diff --git a/testdata/hlist.ignore/Prelude.lc b/testdata/hlist.ignore/Prelude.lc
new file mode 100644
index 00000000..69ba3348
--- /dev/null
+++ b/testdata/hlist.ignore/Prelude.lc
@@ -0,0 +1,362 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Prelude 
+    ( module Prelude
+    , module Builtins
+    ) where
+
+import Builtins
+
+infixr 9 .
+infixl 7 `PrimMulMatVec`, `PrimDot`
+infixr 5 ++
+infixr 3 ***
+infixr 0 $
+--infixl 0 &
+
+const x y = x
+
+otherwise = True
+
+x & f = f x
+
+($) = \f x -> f x
+(.) = \f g x -> f (g x)
+
+uncurry f (x, y) = f x y
+
+(***) f g (x, y) = (f x, g y)
+
+pi = 3.14
+
+zip :: [a] -> [b] -> [(a,b)]
+zip []      xs     = []
+zip xs      []     = []
+zip (a: as) (b: bs) = (a,b): zip as bs
+
+unzip :: [(a,b)] -> ([a],[b])
+unzip [] = ([],[])
+unzip ((a,b):xs) = (a:as,b:bs)
+  where (as,bs) = unzip xs
+
+filter pred []    = []
+filter pred (x:xs) = case pred x of
+                       True -> (x : filter pred xs)
+                       False -> (filter pred xs)
+
+--head :: [a] -> a
+--head (a: _) = a
+
+tail :: [a] -> [a]
+tail (_: xs) = xs
+
+pairs :: [a] -> [(a, a)]
+pairs v = zip v (tail v)
+
+foldl' f e [] = e
+foldl' f e (x: xs) = foldl' f (f e x) xs
+
+foldr1 f (x: xs) = foldr f x xs
+
+split [] = ([], [])
+split (x: xs) = (x: bs, as)  where (as, bs) = split xs
+
+mergeBy f (x:xs) (y:ys) = case f x y of
+    LT -> x: mergeBy f xs (y:ys)
+    _ -> y: mergeBy f (x:xs) ys
+mergeBy f [] xs = xs
+mergeBy f xs [] = xs
+
+sortBy f [] = []
+sortBy f [x] = [x]
+sortBy f xs = uncurry (mergeBy f) ((sortBy f *** sortBy f) (split xs))
+
+iterate :: (a -> a) -> a -> [a]
+iterate f x =  x : iterate f (f x)
+
+fst (a, b) = a
+snd (a, b) = b
+
+tuptype :: [Type] -> Type
+tuptype [] = '()
+tuptype (x:xs) = '(x, tuptype xs)
+
+data RecordC (xs :: [(String, Type)])
+    = RecordCons (tuptype (map snd xs))
+
+False ||| x = x
+True ||| x = True
+
+infixr 2 |||
+
+True &&& x = x
+False &&& x = False
+
+infixr 3 &&&
+
+------------------------------------ Row polymorphism
+-- todo: sorted field names (more efficient & easier to use)
+
+{-
+isKey _ [] = False
+isKey s ((s', _): ss) = s == s' ||| isKey s ss
+
+subList [] _ = []
+subList ((s, t): xs) ys = if isKey s ys then subList xs ys else (s, t): subList xs ys
+
+addList [] ys = ys
+addList ((s, t): xs) ys = if isKey s ys then addList xs ys else (s, t): addList xs ys
+
+findEq x [] = 'Unit
+findEq (s, t) ((s', t'):xs) = if s == s' then 'T2 (t ~ t') (findEq (s, t) xs) else findEq (s, t) xs
+
+sameEq [] _ = 'Unit
+sameEq (x: xs) ys = 'T2 (findEq x ys) (sameEq xs ys)
+
+defined [] = True
+defined (x: xs) = defined xs
+
+type family Split a b c
+type instance Split (RecordC xs) (RecordC ys) z | defined xs &&& defined ys = T2 (sameEq xs ys) (z ~ RecordC (subList xs ys))
+type instance Split (RecordC xs) z (RecordC ys) | defined xs &&& defined ys = T2 (sameEq xs ys) (z ~ RecordC (subList xs ys))
+type instance Split z (RecordC xs) (RecordC ys) | defined xs &&& defined ys = T2 (sameEq xs ys) (z ~ RecordC (addList xs ys))
+
+-- builtin
+-- TODO
+record :: [(String, Type)] -> Type
+--record xs = RecordCons ({- TODO: sortBy fst-} xs)
+-}
+
+isKeyC _ _ [] = 'Empty ""
+isKeyC s t ((s', t'): ss) = if s == s' then t ~ t' else isKeyC s t ss
+
+-- todo: don't use unsafeCoerce
+project :: forall a (xs :: [(String, Type)]) . forall (s :: String) -> 'isKeyC s a xs => RecordC xs -> a
+project @a @((s', a'): xs) s @_ (RecordCons ts) | s == s' = fst (unsafeCoerce @_ @(a, tuptype (map snd xs)) ts)
+project @a @((s', a'): xs) s @_ (RecordCons ts) = project @a @xs s @(undefined @(isKeyC s a xs)) (RecordCons (snd (unsafeCoerce @_ @(a, tuptype (map snd xs)) ts)))
+
+--------------------------------------- HTML colors
+
+rgb r g b = V4 r g b 1.0
+
+black   = rgb 0.0 0.0 0.0
+gray    = rgb 0.5 0.5 0.5
+silver  = rgb 0.75 0.75 0.75
+white   = rgb 1.0 1.0 1.0
+maroon  = rgb 0.5 0.0 0.0
+red     = rgb 1.0 0.0 0.0
+olive   = rgb 0.5 0.5 0.0
+yellow  = rgb 1.0 1.0 0.0
+green   = rgb 0.0 0.5 0.0
+lime    = rgb 0.0 1.0 0.0
+teal    = rgb 0.0 0.5 0.5
+aqua    = rgb 0.0 1.0 1.0
+navy    = rgb 0.0 0.0 0.5
+blue    = rgb 0.0 0.0 1.0
+purple  = rgb 0.5 0.0 0.5
+fuchsia = rgb 1.0 0.0 1.0
+
+colorImage1 = ColorImage @1
+colorImage2 = ColorImage @2
+
+depthImage1 = DepthImage @1
+
+v3FToV4F :: Vec 3 Float -> Vec 4 Float
+v3FToV4F v = V4 v%x v%y v%z 1
+
+------------
+-- * WebGL 1
+------------
+
+-- angle and trigonometric
+radians = PrimRadians
+degrees = PrimDegrees
+sin = PrimSin
+cos = PrimCos
+tan = PrimTan
+sinh = PrimSinH
+cosh = PrimCosH
+tanh = PrimTanH
+asin = PrimASin
+asinh = PrimASinH
+acos = PrimACos
+acosh = PrimACosH
+atan = PrimATan
+atanh = PrimATanH
+atan2 = PrimATan2
+
+-- exponential functions
+pow = PrimPow
+exp = PrimExp
+log = PrimLog
+exp2 = PrimExp2
+log2 = PrimLog2
+sqrt = PrimSqrt
+inversesqrt = PrimInvSqrt
+
+-- common functions
+abs = PrimAbs
+sign = PrimSign
+floor = PrimFloor
+trunc = PrimTrunc
+round = PrimRound
+roundEven = PrimRoundEven
+ceil = PrimCeil
+fract = PrimFract
+mod = PrimMod
+min = PrimMin
+max = PrimMax
+modF = PrimModF
+clamp = PrimClamp
+clampS = PrimClampS
+mix = PrimMix
+mixS = PrimMixS
+mixB = PrimMixB
+step = PrimStep
+stepS = PrimStepS
+smoothstep = PrimSmoothStep
+smoothstepS = PrimSmoothStepS
+isNan = PrimIsNan
+isInf = PrimIsInf
+
+dFdx = PrimDFdx
+dFdy = PrimDFdy
+fWidth = PrimFWidth
+
+noise1 = PrimNoise1
+noise2 = PrimNoise2
+noise3 = PrimNoise3
+noise4 = PrimNoise4
+
+-- geometric functions
+length = PrimLength
+distance = PrimDistance
+dot = PrimDot
+cross = PrimCross
+normalize = PrimNormalize
+faceforward = PrimFaceForward
+reflect = PrimReflect
+refract = PrimRefract
+
+transpose = PrimTranspose
+det = PrimDeterminant
+inv = PrimInverse
+outer = PrimOuterProduct
+
+-- operators
+infixl 7  *, /, %
+infixl 6  +, -
+infix  4  /=, <, <=, >=, >
+
+infixr 3  &&
+infixr 2  ||
+
+infix 7 `dot`   -- dot
+infix 7 `cross` -- cross
+
+infixr 7 *.     -- mulmv
+infixl 7 .*     -- mulvm
+infixl 7 .*.    -- mulmm
+
+-- arithemtic
+a + b = PrimAdd a b
+a - b = PrimSub a b
+a * b = PrimMul a b
+a / b = PrimDiv a b
+a % b = PrimMod a b
+
+neg a = PrimNeg a
+
+-- comparison
+--a == b = PrimEqual a b
+a /= b = PrimNotEqual a b
+a < b = PrimLessThan a b
+a <= b = PrimLessThanEqual a b
+a >= b = PrimGreaterThanEqual a b
+a > b = PrimGreaterThan a b
+
+-- logical
+a && b = PrimAnd a b
+a || b = PrimOr a b
+xor = PrimXor
+not a = PrimNot a
+any a = PrimAny a
+all a = PrimAll a
+
+-- matrix functions
+a .*. b = PrimMulMatMat a b
+a *. b = PrimMulMatVec a b
+a .* b = PrimMulVecMat a b
+
+-- temp hack for vector <---> scalar operators
+infixl 7  *!, /!, %!
+infixl 6  +!, -!
+
+-- arithemtic
+a +! b = PrimAddS a b
+a -! b = PrimSubS a b
+a *! b = PrimMulS a b
+a /! b = PrimDivS a b
+a %! b = PrimModS a b
+
+------------------
+-- common matrices
+------------------
+{-
+-- | Perspective transformation matrix in row major order.
+perspective :: Float  -- ^ Near plane clipping distance (always positive).
+            -> Float  -- ^ Far plane clipping distance (always positive).
+            -> Float  -- ^ Field of view of the y axis, in radians.
+            -> Float  -- ^ Aspect ratio, i.e. screen's width\/height.
+            -> Mat 4 4 Float
+perspective n f fovy aspect = --transpose $
+    M44F (V4F (2*n/(r-l))       0       (-(r+l)/(r-l))        0)
+         (V4F     0        (2*n/(t-b))  ((t+b)/(t-b))         0)
+         (V4F     0             0       (-(f+n)/(f-n))  (-2*f*n/(f-n)))
+         (V4F     0             0            (-1)             0)
+  where
+    t = n*tan(fovy/2)
+    b = -t
+    r = aspect*t
+    l = -r
+-}
+rotMatrixZ a = M44F (V4 c s 0 0) (V4 (-s) c 0 0) (V4 0 0 1 0) (V4 0 0 0 1)
+  where
+    c = cos a
+    s = sin a
+
+rotMatrixY a = M44F (V4 c 0 (-s) 0) (V4 0 1 0 0) (V4 s 0 c 0) (V4 0 0 0 1)
+  where
+    c = cos a
+    s = sin a
+
+rotMatrixX a = M44F (V4 1 0 0 0) (V4 0 c s 0) (V4 0 (-s) c 0) (V4 0 0 0 1)
+  where
+    c = cos a
+    s = sin a
+
+rotationEuler a b c = rotMatrixY a .*. rotMatrixX b .*. rotMatrixZ c
+
+{-
+-- | Camera transformation matrix.
+lookat :: Vec 3 Float  -- ^ Camera position.
+       -> Vec 3 Float  -- ^ Target position.
+       -> Vec 3 Float  -- ^ Upward direction.
+       -> M44F
+lookat pos target up = translateBefore4 (neg pos) (orthogonal $ toOrthoUnsafe r)
+  where
+    w = normalize $ pos - target
+    u = normalize $ up `cross` w
+    v = w `cross` u
+    r = transpose $ Mat3 u v w
+-}
+
+scale t v = v * V4 t t t 1.0
+
+fromTo :: Float -> Float -> [Float]
+fromTo a b = if a > b then [] else a: fromTo (a +! 1.0) b
+
+(!!) :: [a] -> Int -> a
+(x : _)  !! 0  =  x
+(_ : xs) !! n  =  xs !! (n-1)
+
+