switch to new compiler

137 files changed, 256 insertions, 4712 deletions

diff --git a/prototypes/CGExp.hs b/CGExp.hs
index 5477e485..5477e485 100644
--- a/prototypes/CGExp.hs
+++ b/CGExp.hs
diff --git a/CoreToGLSL.hs b/CoreToGLSL.hs
index 6de88452..0bd045e9 100644
--- a/CoreToGLSL.hs
+++ b/CoreToGLSL.hs
@@ -22,7 +22,7 @@ import Data.Foldable (Foldable)
 import qualified Data.Foldable as F
 
 import Pretty
-import Type
+import CGExp
 import IR(Backend(..))
 
 encodeChar :: Char -> String
diff --git a/CoreToIR.hs b/CoreToIR.hs
index 0d05413a..4debdc8b 100644
--- a/CoreToIR.hs
+++ b/CoreToIR.hs
@@ -20,8 +20,7 @@ import Data.Vector (Vector,(!))
 import qualified Data.Vector as Vector
 
 import Pretty
-import qualified Type as AST
-import Type
+import CGExp
 import CoreToGLSL
 import qualified IR as IR
 import qualified Linear as IR
diff --git a/Driver.hs b/Driver.hs
index 36a8ed32..8b81a0e6 100644
--- a/Driver.hs
+++ b/Driver.hs
@@ -34,11 +34,9 @@ import System.FilePath
 import Debug.Trace
 
 import Pretty hiding ((</>))
-import Type
+import CGExp
 import IR
 import qualified CoreToIR as IR
-import Parser
-import Typecheck hiding (Exp(..))
 
 type Modules = Map FilePath (Either Doc PolyEnv)
 type ModuleFetcher m = MName -> m (FilePath, String)
diff --git a/prototypes/Infer.hs b/Infer.hs
index d4cb8775..d4cb8775 100644
--- a/prototypes/Infer.hs
+++ b/Infer.hs
diff --git a/Parser.hs b/Parser.hs
deleted file mode 100644
index 80271495..00000000
--- a/Parser.hs
+++ /dev/null
@@ -1,695 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-module Parser
-    ( parseLC
-    , application
-    , appP'
-    , addContext
-    , P, valueDef
-    , toGuardTree, guardNodes
-    , eLam, pVar, eVar, eApp
-    , compileCasesOld
-    ) where
-
-import Data.Function
-import Data.Char
-import Data.List
-import Data.Maybe
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Monoid
-import Control.Applicative (some,liftA2,Alternative())
-import Control.Arrow
-import Control.Monad
-import Control.Monad.Except
-import Control.Monad.State
-import Control.Monad.Trans
-import qualified Text.Parsec.Indentation.Char as I
-import Text.Parsec.Indentation
-import Text.Parsec hiding (optional)
-
-import qualified Pretty as P
-import Type
-import ParserUtil
-
--- import Debug.Trace
-
--------------------------------------------------------------------------------- parser combinators
-
-type P = P_ ()      -- no state for the parser
-
--- see http://blog.ezyang.com/2014/05/parsec-try-a-or-b-considered-harmful/comment-page-1/#comment-6602
-try' s m = try m <?> s
-
-qualified_ id = do
-    q <- try' "qualification" $ upperCase' <* dot
-    (N t qs n i) <- qualified_ id
-    return $ N t (q:qs) n i
-  <|>
-    id
-  where
-    upperCase' = (:) <$> satisfy isUpper <*> many (satisfy isAlphaNum)
-
--------------------------------------------------------------------------------- position handling
-
--- compose ranges through getTag
-infixl 9 <->
-a <-> b = getTag a `mappend` getTag b
-
-addPos :: (Range -> a -> b) -> P a -> P b
-addPos f m = do
-    p1 <- position
-    a <- m
-    p2 <- positionBeforeSpace
-    return $ f (Range p1 p2) a
-
-addDPos = addPos (,)
-addPPos = addPos PatR
-addEPos = addPos ExpR
-
--------------------------------------------------------------------------------- identifiers
-
-check msg p m = try' msg $ do
-    x <- m
-    if p x then return x else fail $ msg ++ " expected"
-
-upperCase, lowerCase, symbols, colonSymbols :: P String
-upperCase = check "uppercase ident" (isUpper . head) $ ident lcIdents
-lowerCase = check "lowercase ident" (isLower . head) (ident lcIdents) <|> try (('_':) <$ char '_' <*> ident lcIdents)
-symbols   = check "symbols" ((/=':') . head) $ ident lcOps
-colonSymbols = "Cons" <$ operator ":" <|> check "symbols" ((==':') . head) (ident lcOps)
-
---------------------------------------------------------------------------------
-
-typeConstructor, upperCaseIdent, typeVar, var, varId, qIdent, operator', conOperator, moduleName :: P Name
-typeConstructor = upperCase <&> \i -> TypeN' i (P.text i)
-upperCaseIdent  = upperCase <&> ExpN
-typeVar         = (\p i -> TypeN' i $ P.text $ i ++ show p) <$> position <*> lowerCase
-var             = (\p i -> ExpN' i $ P.text $ i ++ show p) <$> position <*> lowerCase
-qIdent          = qualified_ (var <|> upperCaseIdent)
-conOperator     = (\p i -> ExpN' i $ P.text $ i ++ show p) <$> position <*> colonSymbols
-varId           = var <|> parens operator'
-backquotedIdent = try' "backquoted" $ char '`' *> (ExpN <$> ((:) <$> satisfy isAlpha <*> many (satisfy isAlphaNum))) <* char '`' <* whiteSpace
-operator'       = (\p i -> ExpN' i $ P.text $ i ++ show p) <$> position <*> symbols
-              <|> conOperator
-              <|> backquotedIdent
-moduleName      = qualified_ upperCaseIdent
-
--------------------------------------------------------------------------------- literals
-
-literal :: P Lit
-literal
-    =   LFloat <$> try double
-    <|> LInt <$> try natural
-    <|> LChar <$> charLiteral
-    <|> LString <$> stringLiteral
-
--------------------------------------------------------------------------------- patterns
-
-getP (PatR _ x) = x
-appP' (PCon' r n []) ps = PCon' r n ps
-appP' p ps = error $ "appP' " ++ P.ppShow (p, ps)
-
----------------------
-
-pattern', patternAtom :: P PatR
-pattern'
-    = addPPos $ PPrec_ <$> pat <*> ((op >>= pat') <|> return [])
-  where
-    pat' o = do
-            (e, o') <- try $ (,) <$> pat <*> op
-            es <- pat' o'
-            return $ (o, e): es
-        <|> do
-            e <- pattern'
-            return [(o, e)]
-
-    pat = addPPos (PCon_ TWildcard <$> upperCaseIdent <*> many patternAtom) <|> patternAtom
-
-    op = addPPos $ PCon_ TWildcard <$> conOperator <*> pure []
-
-patternAtom = addPPos $
-        PLit_ <$> literal
-    <|> PAt_ <$> try' "at pattern'" (var <* operator "@") <*> patternAtom
-    <|> PVar_ TWildcard <$> var
-    <|> Wildcard_ TWildcard <$ operator "_"
-    <|> PCon_ TWildcard <$> upperCaseIdent <*> pure []
-    <|> pTuple <$> parens (commaSep1 pattern')
-    <|> PRecord_ <$> braces (commaSep $ (,) <$> var <* colon <*> pattern')
-    <|> getP . mkList <$> brackets (commaSep pattern')
-  where
-    mkList = foldr cons nil
-      where
-        nil = PCon' mempty (ExpN "Nil") []
-        cons a b = PCon' mempty (ExpN "Cons") [a, b]
-
-    pTuple [PatR _ x] = x
-    pTuple xs = PTuple_ xs
-
--------------------------------------------------------------------------------- expressions
-
-eTuple p [ExpR _ x] = ExpR p x
-eTuple p xs = ExpR p $ ETuple_ xs
-eRecord p xs = ExpR p $ ERecord_ xs
-eNamedRecord p n xs = ExpR p $ ENamedRecord_ n xs
-eVar p n = ExpR p $ EVar_ TWildcard n
-eLam p e = ExpR (p <-> e) $ ELam_ Nothing p e
-eApp a b = ExpR (a <-> b) $ EApp_ TWildcard a b
-eTyping a b = ExpR (a <-> b) $ ETypeSig_ a b
-eTyApp a b = ExpR (a <-> b) $ ETyApp_ TWildcard a b
-
-application :: [ExpR] -> ExpR
-application = foldl1 eApp
-
-eLet :: DefinitionR -> ExpR -> ExpR
-eLet (r, DValueDef False (ValueDef _{-TODO-} a b)) x = ExpR (r `mappend` getTag x) $ ELet_ a b x
-eLet a b = error $ "eLet: " ++ P.ppShow a
-
-eLets :: [DefinitionR] -> ExpR -> ExpR
-eLets l a = foldr ($) a $ map eLet $ groupDefinitions l
-
-desugarSwizzling :: [Char] -> ExpR -> ExpR
-desugarSwizzling cs e = case map trC cs of
-    [c] -> c
-    cs -> application $ eVar mempty (vecName $ length cs): cs
-  where
-    trC c = eApp (expR $ EFieldProj_ TWildcard $ ExpN [tr c]) e
-    vecName n = ExpN $ "V" ++ show n
-    tr = \case
-        'r' -> 'x'
-        'g' -> 'y'
-        'b' -> 'z'
-        'a' -> 'w'
-        c   -> c
-
----------------------
-
-withTypeSig p = do
-    e <- p 
-    t <- optional $ operator "::" *> polytype
-    return $ maybe e (eTyping e) t
-
-expression :: P ExpR
-expression = withTypeSig $
-        ifthenelse
-    <|> caseof
-    <|> letin
-    <|> lambda
-    <|> eApp <$> addPos eVar (const (ExpN "negate") <$> operator "-") <*> expressionOpAtom -- TODO: precedence
-    <|> expressionOpAtom
- where
-    lambda :: P ExpR
-    lambda = (\(ps, e) -> foldr eLam e ps) <$> (operator "\\" *> ((,) <$> many patternAtom <* operator "->" <*> expression))
-
-    ifthenelse :: P ExpR
-    ifthenelse = addPos (\r (a, b, c) -> eApp (eApp (eApp (eVar r (ExpN "PrimIfThenElse")) a) b) c) $
-        (,,) <$ keyword "if" <*> expression <* keyword "then" <*> expression <* keyword "else" <*> expression
-
-    caseof :: P ExpR
-    caseof = addPos (uncurry . compileCases) $ (,)
-        <$ keyword "case" <*> expression <* keyword "of"
-        <*> localIndentation Ge (localAbsoluteIndentation $ some $ (,) <$> pattern' <*> localIndentation Gt (whereRHS $ operator "->"))
-
-    letin :: P ExpR
-    letin = eLets
-        <$ keyword "let" <*> localIndentation Ge (localAbsoluteIndentation $ some valueDef)
-        <* keyword "in" <*> expression
-
-    expressionOpAtom = addEPos $ EPrec_ <$> exp <*> ((op >>= expression') <|> return [])
-      where
-        expression' o = do
-                (e, o') <- try $ (,) <$> exp <*> op
-                es <- expression' o'
-                return $ (o, e): es
-            <|> (:[]) . (,) o <$> expression
-
-        exp = application <$> some expressionAtom
-
-        op = addPos eVar operator'
-
-generator :: P (ExpR -> ExpR)
-generator = do
-    pat <- try $ pattern' <* operator "<-"
-    exp <- expression
-    let v = ExpN "genVar"
-        pv = pVar mempty v
-        ev = eVar mempty v
-    return $ \e -> application
-        [ eVar mempty $ ExpN "concatMap"
-        , FunAlts 1
-            [ ([toParPat pat], GuardExp e)
-            , ([mempty], GuardExp $ eVar mempty (ExpN "Nil"))
-            ]
-        , exp
-        ]
-
-letdecl :: P (ExpR -> ExpR)
-letdecl = keyword "let" *> (eLets . (:[]) <$> valueDef)
-
-boolExpression :: P (ExpR -> ExpR)
-boolExpression = do
-    pred <- expression
-    return $ \e -> application [eVar mempty $ ExpN "PrimIfThenElse", pred, e, eVar mempty (ExpN "Nil")]
-
-listComprExp :: P ExpR
-listComprExp = foldr ($) <$>
-    try' "List comprehension" (operator "[" *> (eApp (eVar mempty $ ExpN "singleton") <$> expression) <* operator "|") <*>
-    commaSep1 (generator <|> letdecl <|> boolExpression) <* operator "]"
-
-listFromTo :: P ExpR
-listFromTo = do
-    e1 <- try $ do
-      operator "["
-      e1 <- expression
-      operator ".."
-      return e1
-    e2 <- expression
-    operator "]"
-    return $ application [eVar mempty $ ExpN "fromTo", e1, e2]
-
-expressionAtom :: P ExpR
-expressionAtom = do
-    e <- expressionAtom_
-    sw <- optional $ char '%' *> some (satisfy (`elem` ("xyzwrgba" :: [Char]))) <* whiteSpace
-    ts <- many $ do
-        operator "@"
-        typeAtom
-    return $ foldl eTyApp (maybe id desugarSwizzling sw e) ts
-  where
-    expressionAtom_ :: P ExpR
-    expressionAtom_ =
-            listFromTo
-        <|> listComprExp
-        <|> listExp
-        <|> addEPos (eLit <$> literal)
-        <|> recordExp
-        <|> recordExp'
-        <|> recordFieldProjection
-        <|> addPos eVar qIdent
-        <|> addPos eVar (try $ parens operator')
-        <|> addPos eTuple (parens $ commaSep expression)
-     where
-      recordExp :: P ExpR
-      recordExp = addPos eRecord $ braces $ commaSep $ (,) <$> var <* colon <*> expression
-
-      recordExp' :: P ExpR
-      recordExp' = try $ addPos (uncurry . eNamedRecord) $ (,) <$> upperCaseIdent <*> braces (commaSep $ (,) <$> var <* keyword "=" <*> expression)
-
-      recordFieldProjection :: P ExpR
-      recordFieldProjection = try $ flip eApp <$> addPos eVar var <*>
-            addEPos (EFieldProj_ TWildcard <$ {-runUnspaced $-} dot <*> {-Unspaced-} var)
-
-      eLit l@LInt{} = EApp_ TWildcard (eVar mempty (ExpN "fromInt")) $ expR $ ELit_ l
-      eLit l = ELit_ l
-
-      listExp :: P ExpR
-      listExp = addPos (\p -> foldr cons (nil p)) $ brackets $ commaSep expression
-        where
-          nil r = eVar (r{-TODO-}) $ ExpN "Nil"
-          cons a b = eApp (eApp (eVar mempty{-TODO-} (ExpN "Cons")) a) b
-
--------------------------------------------------------------------------------- types
-
-tArr t a = ExpR (t <-> a) $ Forall_ Visible Nothing t a
-tArrH t a = ExpR (t <-> a) $ Forall_ Hidden Nothing t a
-addContext :: [ExpR] -> ExpR -> ExpR
-addContext cs e = foldr tArrH e cs
-
----------------------
-
-typeVarKind :: P (Name, ExpR)
-typeVarKind =
-      parens ((,) <$> typeVar <* operator "::" <*> monotype)
-  <|> (,) <$> typeVar <*> addEPos (pure Star_)
-
-context :: P [ExpR]   -- TODO
-context = try' "type context" $ ((:[]) <$> tyC <|> parens (commaSep tyC)) <* operator "=>"
-  where
-    tyC = 
-        (   addEPos (CEq_ <$> try (monotype <* operator "~") <*> (mkTypeFun <$> monotype))
-        <|> foldl1 eApp <$> ((:) <$> (addEPos $ TCon_ TWildcard <$> typeConstructor) <*> many typeAtom)
-        )
-
-    mkTypeFun e = case getArgs e of (n, reverse -> ts) -> TypeFun n ts
-      where
-        getArgs = \case
-            ExpR _ (TCon_ _ n) -> (n, [])
-            ExpR _ (EApp_ _ x y) -> id *** (y:) $ getArgs x
-            x -> error $ "mkTypeFun: " ++ P.ppShow x
-
-polytype :: P ExpR
-polytype =
-    do  vs <- keyword "forall" *> some (addDPos typeVarKind) <* dot
-        t <- polytype
-        return $ foldr (\(p, (v, k)) t -> ExpR (p <> getTag t) $ Forall_ Visible (Just v) k t) t vs
-  <|> addContext <$> context <*> polytype
-  <|> monotype
-
-polytypeCtx :: P [(Maybe Name, ExpR)]
-polytypeCtx =
-    do  vs <- keyword "forall" *> some typeVarKind <* dot
-        t <- polytypeCtx
-        return $ map (Just *** id) vs ++ t
-  <|> (++) <$> (map ((,) Nothing) <$> context) <*> polytypeCtx
-  <|> return []
-
-monotype :: P ExpR
-monotype = do
-    t <- foldl1 eApp <$> some typeAtom
-    maybe t (tArr t) <$> optional (operator "->" *> polytype)
-
-typeAtom :: P ExpR
-typeAtom = addEPos $
-        typeRecord
-    <|> Star_ <$ operator "*"
-    <|> EVar_ TWildcard <$> typeVar
-    <|> ELit_ <$> (LNat . fromIntegral <$> natural <|> literal)
-    <|> TCon_ TWildcard <$> typeConstructor
-    <|> tTuple <$> parens (commaSep monotype)
-    <|> EApp_ TWildcard (expR $ TCon_ TWildcard (TypeN' "List" "List")) <$> brackets monotype
-  where
-    tTuple [ExpR _ t] = t
-    tTuple ts = TTuple_ ts
-
-    typeRecord = undef "trec" $ do
-        braces (commaSep1 typeSignature >> optional (operator "|" >> void typeVar))
-      where
-        undef msg = (const (error $ "not implemented: " ++ msg) <$>)
-
--------------------------------------------------------------------------------- function and value definitions
-
-compileCasesOld :: Range -> ExpR -> [(PatR, Exp)] -> ExpR
-compileCasesOld r e rs = eApp (alts 1 [eLam p r | (p, r) <- rs]) e
-  where
-    alts :: Int -> [ExpR] -> ExpR
-    alts _ [e] = e
-    alts i es = foldr eLam (ExpR (foldMap getTag es) $ EAlts_ [foldl eApp e vs | e <- es]) ps where
-        ps = take i $ map (pVar mempty . ExpN . ("alt" ++) . show) [1..]
-        vs = take i $ map (eVar mempty . ExpN . ("alt" ++) . show) [1..]
-
-pVar r x = PatR r $ PVar_ TWildcard x
-
-whereToBinds :: WhereBlock -> Binds Exp
-whereToBinds = map eLet . groupDefinitions
-  where
-    eLet (r, DValueDef False (ValueDef _{-TODO-} a b)) = (a, b)
-    eLet a = error $ "eLet: " ++ P.ppShow a
-
-compileWhereRHS :: WhereRHS -> GuardTree Exp
-compileWhereRHS (WhereRHS r md) = maybe x (\w -> GuardWhere (whereToBinds w) x) md where
-    x = case r of
-        NoGuards e -> GuardExp e
-        Guards r{-TODO-} gs -> GuardAlts [GuardCon b (ConName $ ExpN "True") [] $ GuardExp e | (b, e) <- gs]
-
-toParPat :: Pat -> ParPat Exp
-toParPat (Pat p) = case p of
-    PLit_ l ->  [PatLit l]
-    PTuple_ ps -> [PatCon (TupleName $ length ps) $ map toParPat ps]
-    PRecord_ rs -> error $ "toParPat: record " ++ P.ppShow rs --[(Name, b)]
-    PVar_ t v -> [PatVar v]
-    PCon_ t c ps -> [PatCon (ConName c) $ map toParPat ps]
-    PAt_ v p -> PatVar v: toParPat p
-    Wildcard_ _ -> []
-    PPrec_ p ps -> [PatPrec (toParPat p) $ map (toParPat *** toParPat) ps]
-
-funAlts0 :: GuardTree Exp -> Exp
-funAlts0 t = FunAlts 0 [([], t)]
-
-guardNodes :: [(Exp, ParPat Exp)] -> GuardTree Exp -> GuardTree Exp
-guardNodes [] l = l
-guardNodes ((v, ws): vs) e = GuardPat v ws $ guardNodes vs e
-
-toGuardTree :: [Exp] -> [([ParPat Exp], GuardTree Exp)] -> GuardTree Exp
-toGuardTree vs cs
-    = GuardAlts [guardNodes (zip vs ps) rhs | (ps, rhs) <- cs]
-
-compileCases :: Range -> ExpR -> [(PatR, WhereRHS)] -> ExpR
-compileCases r{-TODO-} e rs = funAlts0 $ toGuardTree [e] [([toParPat p], compileWhereRHS r) | (p, r) <- rs]
-
-groupDefinitions :: [DefinitionR] -> [DefinitionR]
-groupDefinitions defs = concatMap mkDef . map compileRHS . groupBy (f `on` snd) $ defs
-  where
-    f (h -> Just x) (h -> Just y) = x == y
-    f _ _ = False
-
-    h ( (PreValueDef (_, n) _ _)) = Just n
-    h ( (DValueDef _ (ValueDef _ p _))) = name p        -- TODO
-    h ( (DTypeSig (TypeSig n _))) = Just n
-    h _ = Nothing
-
-    name (PVar' _ n) = Just n
-    name _ = Nothing
-
-    mkDef = \case
---         (r, PreInstanceDef c t ds) -> [(r, InstanceDef c t [v | (r, DValueDef v) <- groupDefinitions ds])]
-         x -> [x]
-
-    compileRHS :: [DefinitionR] -> DefinitionR
-    compileRHS ds = case ds of
-        ((r1, DTypeSig (TypeSig _ t)): ds@((r2, PreValueDef{}): _)) -> (r1 `mappend` r2, mkAlts (`eTyping` t) ds)
-        ds@((r, PreValueDef{}): _) -> (r, mkAlts id ds)
-        [x] -> x
-      where
-        mkAlts f ds@( (_, PreValueDef (r, n) _ _): _)
-            = DValueDef False $ ValueDef True (PVar' r n) $ f $ FunAlts i als
-          where
-            i = allSame $ map (length . fst) als
-            allSame (n:ns) | all (==n) ns = n
-                           | otherwise = error $ "function alternatives have different arity: " ++ P.ppShow (n:ns)
-            als = [(map toParPat pats, compileWhereRHS rhs) |  (_, PreValueDef _ pats rhs) <- ds]
-
----------------------
-
-valueDef :: P DefinitionR
-valueDef = addDPos $
-   (do
-    try' "function definition" $ do
-      n <- addDPos varId
-      localIndentation Gt $ do
-        pats <- many patternAtom
-        lookAhead $ operator "=" <|> operator "|"
-        return $ PreValueDef n pats
-   <|> do
-    try' "value definition" $ do
-      n <- pattern'
-      n2 <- optional $ do
-          op <- addDPos operator'
-          n2 <- pattern'
-          return (op, n2)
-      localIndentation Gt $ do
-        lookAhead $ operator "=" <|> operator "|"
-        return $ case n2 of
-            Nothing -> \e -> DValueDef False $ ValueDef True n $ funAlts0 $ compileWhereRHS e
-            Just (op, n2) -> PreValueDef op [n, n2]
-    )
- <*> localIndentation Gt (whereRHS $ operator "=")
-
-whereRHS :: P () -> P WhereRHS
-whereRHS delim =
-    WhereRHS <$>
-    (   NoGuards <$ delim <*> expression
-    <|> addPos Guards (many $ (,) <$ operator "|" <*> expression <* delim <*> expression)
-    ) <*>
-    (   Just . concat <$> (keyword "where" *> localIndentation Ge (localAbsoluteIndentation $ some $ (:[]) <$> valueDef <|> typeSignature))
-    <|> return Nothing
-    )
-
--------------------------------------------------------------------------------- class and instance definitions
-
-whereBlock p = fromMaybe [] <$> optional (keyword "where" *> localIndentation Ge (localAbsoluteIndentation $ many p))
-
-classDef :: P DefinitionR
-classDef = addDPos $ do
-  keyword "class"
-  localIndentation Gt $ ClassDef
-    <$> (fromMaybe [] <$> optional context)
-    <*> typeConstructor
-    <*> many typeVarKind
-    <*> (whereBlock typeSignature <&> \ds -> [d | (_, DTypeSig d) <- concat ds])
-
-instanceDef :: P DefinitionR
-instanceDef = addDPos $ do
-  keyword "instance"
-  localIndentation Gt $ InstanceDef
-    <$> (fromMaybe [] <$> optional context)
-    <*> typeConstructor
-    <*> many typeAtom
-    <*> (whereBlock valueDef <&> \ds -> [v | (r, DValueDef False v) <- groupDefinitions ds])
-
--------------------------------------------------------------------------------- data definition
-
-fields =  braces (commaSep $ FieldTy <$> (Just <$> ((,) <$> varId <*> pure False)) <* keyword "::" <* optional (operator "!") <*> polytype)
-      <|> many (FieldTy Nothing <$ optional (operator "!") <*> typeAtom)
-
-fields' =  braces (commaSep $ FieldTy <$> (Just <$> ((,) <$> varId <*> pure False)) <* keyword "::" <* optional (operator "!") <*> polytype)
-      <|> many (try $ FieldTy Nothing <$ optional (operator "!") <*> ty <* operator "->")
- where
-    ty = foldl1 eApp <$> some typeAtom
-
-dataDef :: P DefinitionR
-dataDef = addDPos $ do
- keyword "data"
- localIndentation Gt $ do
-  tc <- typeConstructor
-  tvs <- many typeVarKind
-  do
-    do
-      keyword "where"
-      ds <- localIndentation Ge $ localAbsoluteIndentation $ many $ do
-        cs <- commaSep1 (addDPos upperCaseIdent)
-        localIndentation Gt $ do
-            t <- ConDef' <$ operator "::" <*> polytypeCtx <*> fields' <*> monotype
-            return [(p, (c, t)) | (p, c) <- cs]
-      return $ GADT tc tvs $ concat ds
-   <|>
-    do
-      operator "="
-      ds <- sepBy (addDPos $ ConDef <$> upperCaseIdent <*> fields) $ operator "|"
-      derivingStm
-      return $ DDataDef tc tvs ds
-  where
-    derivingStm = optional $ keyword "deriving" <* (void typeConstructor <|> void (parens $ commaSep typeConstructor))
-
--------------------------------------------------------------------------------- type synonym
-
-typeSynonym :: P ()
-typeSynonym = void $ do
-  keyword "type"
-  localIndentation Gt $ do
-    typeConstructor
-    many typeVar
-    operator "="
-    void polytype
-
--------------------------------------------------------------------------------- type family
-
-typeFamily :: P DefinitionR
-typeFamily = addDPos $ do
-    try $ keyword "type" >> keyword "family"
-    tc <- typeConstructor
-    tvs <- many typeVarKind
-    res <- optional $ do
-        operator "::"
-        monotype
-    return $ TypeFamilyDef tc tvs $ fromMaybe (expR Star_) res
-
--------------------------------------------------------------------------------- type signature
-
-typeSignature :: P [DefinitionR]
-typeSignature = do
-  ns <- try' "type signature" $ do
-    ns <- commaSep1 varId
-    localIndentation Gt $ operator "::"
-    return ns
-  t <- localIndentation Gt $ do
-    optional (operator "!") *> polytype
-  return [(mempty, DTypeSig $ TypeSig n t) | n <- ns]
-
-axiom :: P [DefinitionR]
-axiom = do
-  ns <- try' "axiom" $ do
-    ns <- commaSep1 (varId <|> upperCaseIdent)
-    localIndentation Gt $ operator "::"
-    return ns
-  t <- localIndentation Gt $ do
-    optional (operator "!") *> polytype
-  return [(mempty, DAxiom $ TypeSig n t) | n <- ns]
-
--------------------------------------------------------------------------------- fixity declarations
-
-fixityDef :: P [DefinitionR]
-fixityDef = do
-  dir <-    Nothing      <$ keyword "infix" 
-        <|> Just FDLeft  <$ keyword "infixl"
-        <|> Just FDRight <$ keyword "infixr"
-  localIndentation Gt $ do
-    i <- natural
-    ns <- commaSep1 (addDPos operator')
-    return [(p, PrecDef n (dir, fromIntegral i)) | (p, n) <- ns]
-
--------------------------------------------------------------------------------- modules
-
-importDef :: P Name
-importDef = do
-  keyword "import"
-  optional $ keyword "qualified"
-  n <- moduleName
-  let importlist = parens (commaSep (varId <|> upperCaseIdent))
-  optional $
-        (keyword "hiding" >> importlist)
-    <|> importlist
-  optional $ do
-    keyword "as"
-    moduleName
-  return n
-
-parseExtensions :: P [Extension]
-parseExtensions = do
-    try (string "{-#")
-    simpleSpace
-    string "LANGUAGE"
-    simpleSpace
-    s <- commaSep ext
-    simpleSpace
-    string "#-}"
-    simpleSpace
-    return s
-  where
-    simpleSpace = skipMany (satisfy isSpace)
-
-    ext = do
-        s <- some $ satisfy isAlphaNum
-        case s of
-            "NoImplicitPrelude" -> return NoImplicitPrelude
-            _ -> fail $ "language extension expected instead of " ++ s
-
-export :: P Export
-export =
-        ExportModule <$ keyword "module" <*> moduleName
-    <|> ExportId <$> varId
-
-moduleDef :: FilePath -> P ModuleR
-moduleDef fname = do
-  exts <- concat <$> many parseExtensions
-  whiteSpace
-  header <- optional $ do
-    modn <- keyword "module" *> moduleName
-    exps <- optional (parens $ commaSep export)
-    keyword "where"
-    return (modn, exps)
-  -- localAbsoluteIndentation $ do
-  do
-    idefs <- many importDef
-    -- TODO: unordered definitions
-    defs <- groupDefinitions . concat <$> many
-        (   (:[]) <$> dataDef
-        <|> concat <$ keyword "builtins" <*> localIndentation Gt (localAbsoluteIndentation $ many axiom)
-        <|> typeSignature
-        <|> (:[]) <$> typeFamily
-        <|> const [] <$> typeSynonym
-        <|> (:[]) <$> classDef
-        <|> (:[]) <$> valueDef
-        <|> fixityDef
-        <|> (:[]) <$> instanceDef
-        )
-    return $ Module
-      { extensions = exts
-      , moduleImports = if NoImplicitPrelude `elem` exts
-            then idefs
-            else ExpN "Prelude": idefs
-      , moduleExports = join $ snd <$> header
-      , definitions   = defs
-      }
-
---------------------------------------------------------------------------------
-
-parseLC :: MonadError ErrorMsg m => FilePath -> String -> m ModuleR
-parseLC fname src = either throwParseError return . runParser' fname (moduleDef fname) $ src
-
diff --git a/ParserUtil.hs b/ParserUtil.hs
deleted file mode 100644
index 153d685f..00000000
--- a/ParserUtil.hs
+++ /dev/null
@@ -1,69 +0,0 @@
-module ParserUtil
-    ( module ParserUtil
-    , ParseError
-    ) where
-
-import Control.Monad.Reader
-import Control.Monad.Identity
-import qualified Text.Parsec.Indentation.Char as I
-import qualified Text.Parsec.Indentation.Token as I
-import qualified Text.Parsec.Token as P
-import Text.Parsec.Indentation as I
-import Text.Parsec.Language (haskellDef)
-import Text.Parsec hiding (optional)
-import Text.Parsec.Pos
-
-type P_ st = Parsec (I.IndentStream (I.CharIndentStream String)) SourcePos
-
-{-# NoInline lexer #-}
-lexer :: P.GenTokenParser
-       (I.IndentStream
-          (I.CharIndentStream String))
-       SourcePos
-       Identity
-lexer = I.makeTokenParser $ I.makeIndentLanguageDef haskellDef
-
-position :: P_ st SourcePos
-position = getPosition
-
-positionBeforeSpace :: P_ st SourcePos
-positionBeforeSpace = getState
-
-optional :: P_ st a -> P_ st (Maybe a)
-optional = optionMaybe
-
-keyword :: String -> P_ st ()
-keyword = P.reserved lexer
-
-operator :: String -> P_ st ()
-operator = P.reservedOp lexer
-
-lcIdents = P.identifier lexer
-lcOps = P.operator lexer
-
-ident = id
---ident _   = P.identifier lexer
---identOp   = P.operator lexer
-parens    = P.parens lexer
-braces    = P.braces lexer
-brackets  = P.brackets lexer
-commaSep  = P.commaSep lexer
-commaSep1 = P.commaSep1 lexer
-dot       = P.dot lexer
-comma     = P.comma lexer
-colon     = P.colon lexer
-natural   = P.natural lexer
-integer   = P.integer lexer
-double    = P.float lexer
-charLiteral   = P.charLiteral lexer
-stringLiteral = P.stringLiteral lexer
-whiteSpace    = P.whiteSpace lexer
-
-runParser' :: SourceName -> P_ st a -> String -> Either ParseError a
-runParser' fname p src = runParser p' (newPos "" 0 0) "" $ mkIndentStream 0 infIndentation True Ge $ I.mkCharIndentStream src
-  where
-    p' = do
-        getPosition >>= setState
-        setPosition =<< flip setSourceName fname <$> getPosition
-        p <* eof
-
diff --git a/prototypes/TODO b/TODO
index 9329cd9f..9329cd9f 100644
--- a/prototypes/TODO
+++ b/TODO
diff --git a/Type.hs b/Type.hs
deleted file mode 100644
index af0a1206..00000000
--- a/Type.hs
+++ /dev/null
@@ -1,1707 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE UndecidableInstances #-}
-module Type where
-
-import Data.Function
-import Data.Char
-import Data.Either
-import Data.String
-import Data.Maybe
-import Data.List
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Monoid
-import Data.Foldable hiding (foldr)
-import Data.Traversable
-import Control.Monad.Except
-import Control.Monad.State
-import Control.Monad.Identity
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Applicative
-import Control.Arrow hiding ((<+>))
-import Text.Parsec.Pos
-import Text.Parsec.Error
-import GHC.Exts (Constraint)
-import Debug.Trace
-
-import ParserUtil (ParseError)
-import Pretty
-
-trace' x = trace (ppShow x) x
-
-(<&>) = flip (<$>)
-
--------------------------------------------------------------------------------- literals
-
-data Lit
-    = LInt    Integer
-    | LNat    Int       -- invariant property: >= 0
-    | LChar   Char
-    | LString String
-    | LFloat  Double
-    deriving (Eq, Ord)
-
--- literals in expressions
-pattern EInt a      = ELit (LInt a)
-pattern ENat a      = ELit (LNat a)
-pattern EChar a     = ELit (LChar a)
-pattern EString a   = ELit (LString a)
-pattern EFloat a    = ELit (LFloat a)
-
--------------------------------------------------------------------------------- patterns
-
--- TODO: remove
-data Pat_ t c v b  -- type; constructor info; variable info; sub-pattern
-    = PLit_ Lit
-    | PVar_ t v
-    | PCon_ t c [b]
-    | PTuple_ [b]
-    | PRecord_ [(Name, b)]
-    | PAt_ v b      -- used before pattern compilation
-    | Wildcard_ t   -- TODO: merge into PVar
-    -- aux
-    | PPrec_ b [(b{-TODO: Name-}, b)]     -- used before precedence calculation
-    deriving (Functor,Foldable,Traversable)
-
--- TODO: remove
-instance Eq Pat where (==) = error "Eq Pat"
-instance Ord Pat where compare = error "Ord Pat"
-
-mapPat :: (t -> t') -> (c -> c') -> (v -> v') -> Pat_ t c v b -> Pat_ t' c' v' b
-mapPat tf f g = \case
-    PLit_ l     -> PLit_ l
-    PVar_ t v   -> PVar_ (tf t) $ g v
-    PCon_ t c p -> PCon_ (tf t) (f c) p
-    PTuple_ p   -> PTuple_ p
-    PRecord_ p  -> PRecord_ p -- $ map (g *** id) p
-    PAt_ v p    -> PAt_ (g v) p
-    Wildcard_ t -> Wildcard_ (tf t)
-    PPrec_ b bs -> PPrec_ b bs
-
---------------------------------------------
-
-data PatR = PatR Range (Pat_ ExpR Name Name PatR)
-
--- TODO: remove
-pattern PatR' a <- PatR _ a where
-    PatR' a = PatR mempty a
-
-pattern PVar' a b = PatR a (PVar_ TWildcard b)
-pattern PCon' a b c = PatR a (PCon_ TWildcard b c)
-
---------------------------------------------
-
-type Pat = PatR
-
-pattern Pat a <- PatR _ a where
-    Pat a = PatR mempty a
-
-pattern PAt v l = Pat (PAt_ v l)
-pattern PLit l = Pat (PLit_ l)
-pattern PVar t l = Pat (PVar_ t l)
-pattern PCon t c l = Pat (PCon_ t c l)
-pattern PTuple l = Pat (PTuple_ l)
-pattern Wildcard t = Pat (Wildcard_ t)
-
-patternVars' :: ParPat Exp -> [Name]
-patternVars' = concatMap $ \case
-    PatVar n -> [n]
-    PatCon _ ps -> foldMap patternVars' ps
-    PatLit{} -> []
-    ViewPat _ p -> patternVars' p
-    PatPrec p ps -> patternVars' p ++ foldMap patternVars' (map snd ps)
-
-patternVars :: Pat -> [(Name, Exp)]
-patternVars (Pat p) = case p of
-    PVar_ t v -> [(v, t)]
-    PAt_ v p -> [(v, tyOfPat p)]
-    p -> foldMap patternVars p
-
--------------------------------------------------------------------------------- expressions
-
-data Exp_ v p b     -- TODO: remove p
-    = Star_
-    | ELit_     Lit
-
-    | EVar_     b v
-    | TCon_     b v         -- TODO: use it or remove it
-    | TWildcard_            -- star kinded type variable
-    -- | TFun_    v [a]     -- TODO
-
-    | Forall_   Visibility (Maybe v) b b
-    | ELam_     (Maybe b){-Just:hidden + type-} p b
-    | EApp_     b b b
-    | ETyApp_   b b b
-    | EPrec_    b [(b, b)]      -- aux: used only before precedence calculation
-    | ELet_     p b b       -- TODO: remove?
-
-    | TRecord_  (Map v b)
-    | ERecord_  [(Name, b)]
-    | EFieldProj_ b Name
-
-    | TTuple_   [b]     -- TODO: remove?
-    | ETuple_   [b]     -- TODO: remove?
-    | ENamedRecord_ Name [(Name, b)]
-
-    | WRefl_    b
-    | CEq_      b (TypeFun v b) -- unification between a type and a fully applied type function; CEq t f:  t ~ f
-                                -- TODO: merge with CUnify?
-    | CUnify_   b b             -- unification between (non-type-function) types; CUnify t s:  t ~ s
-    | Split_    b b b           -- Split x y z:  x, y, z are records; fields of x = disjoint union of the fields of y and z
-
-    | ETypeSig_ b b
-    | Case_     b b [(p {-Name, [Name{-v-}]-}, b)]   -- simple case expression, not used yet
-    | WhereBlock_ [(Name{-v-}, b)] b         -- not used yet
-    | PrimFun   b Name [b] Int  -- type, name, collected args, arity
-    | FunAlts_  Int{-number of parameters-} [([ParPat b], GuardTree b)]
-    -- TODO: remove
-    | EAlts_    [b]             -- function alternatives
-    | ENext_ Doc   b           -- go to next alternative
-
-    deriving (Eq,Ord,Functor,Foldable,Traversable) -- TODO: elim Eq instance
-
--- TODO! remove
-instance Eq Doc where _ == _ = True
-instance Ord Doc where _ `compare` _ = EQ
-
-type ParPat e = [Pat' e]
-
-data ConName
-    = TupleName Int
-    | ConName Name
---    | ConLit Lit
-    deriving (Eq, Ord)
-
-data Pat' e
-    = PatVar Name   -- v
-    | PatCon ConName [ParPat e]
-    | PatLit Lit
-    | ViewPat e (ParPat e)
-    | PatPrec (ParPat e) [(ParPat e{-TODO: Name-}, ParPat e)]     -- used before precedence calculation
-    deriving (Eq,Ord,Functor,Foldable,Traversable) -- TODO: elim Eq instance
-
-data GuardTree e
-    = GuardCon e ConName [ParPat e] (GuardTree e)
-    | GuardWhere (Binds e) (GuardTree e)
-    | GuardAlts [GuardTree e]
-    | GuardExp e
-    | GuardPat e (ParPat e) (GuardTree e)  -- used only before precedence calculation
-    deriving (Eq,Ord,Functor,Foldable,Traversable) -- TODO: elim Eq instance
-
-type Binds e = [(Pat, e)]  -- TODO: replace with Env
-
-data Visibility = Visible | Hidden | Irrelevant deriving (Eq, Ord)
-
-type ExpR = Exp
-
-pattern ExpR r e <- (peelThunkR -> (r, e)) where
-    ExpR r e = ExpTh r mempty e
-
-expR = ExpR mempty
-pattern EVarR' a b = ExpR a (EVar_ TWildcard b)
-pattern EAppR' a b c = ExpR a (EApp_ TWildcard b c)
---pattern ELamR' a b c = ExpR a (ELam_ False b c)
-
-pattern ExpR' a <- ExpR _ a where
-    ExpR' a = ExpR mempty a
-
-pattern TWildcard = ExpR' TWildcard_
-
-data Exp = ExpTh Range Subst Exp'
-type Exp' = Exp_ Name Pat Exp
-
-type Ty = Exp
-
-pattern Exp a <- (peelThunk -> a) where
-    Exp a = thunk a
-
-thunk = ExpTh mempty{-TODO: review this-} mempty
-
--- TODO: eliminate or improve
-instance Eq Exp where Exp a == Exp b = a == b
-instance Ord Exp where Exp a `compare` Exp b = a `compare` b
-
-pattern TCon k a <- Exp (TCon_ k (TypeIdN a)) where
-    TCon k a = Exp (TCon_ k (TypeIdN' a "typecon"))
-
-pattern Con0 t a = TVar t (ExpN a)
-
-pattern Star = Exp Star_
-
-pattern TRecord b = Exp (TRecord_ b)
-pattern TTuple b = Exp (TTuple_ b)
-pattern TUnit = TTuple []
-pattern CEq a b = Exp (CEq_ a b)
-pattern CUnify a b = Exp (CUnify_ a b)
-pattern Split a b c = Exp (Split_ a b c)
-pattern Forall a b c = Exp (Forall_ Visible (Just a) b c)
-pattern TArr a b = Exp (Forall_ Visible Nothing a b)
-pattern ELit a = Exp (ELit_ a)
-pattern EVar a <- Exp (EVar_ _ a)
-pattern TVar k b = Exp (EVar_ k b)
-pattern EApp a b <- Exp (EApp_ _ a b)
-pattern TApp k a b = Exp (EApp_ k a b)
-pattern ETyApp k a b = Exp (ETyApp_ k a b)
-pattern ELam a b = Exp (ELam_ Nothing a b)
-pattern ELet a b c = Exp (ELet_ a b c)
-pattern ETuple a = Exp (ETuple_ a)
-pattern ERecord b = Exp (ERecord_ b)
-pattern EFieldProj k a = Exp (EFieldProj_ k a)
-pattern EAlts b = Exp (EAlts_ b)
-pattern ENext i k = Exp (ENext_ i k)
-pattern Case t b as = Exp (Case_ t b as)
-pattern WRefl k = Exp (WRefl_ k)
-pattern FunAlts i as = Exp (FunAlts_ i as)
-
-pattern A0 x <- EVar (ExpIdN x)
-pattern A1 f x <- EApp (A0 f) x
-pattern A2 f x y <- EApp (A1 f x) y
-pattern A3 f x y z <- EApp (A2 f x y) z
-pattern A4 f x y z v <- EApp (A3 f x y z) v
-pattern A5 f x y z v w <- EApp (A4 f x y z v) w
-pattern A6 f x y z v w q <- EApp (A5 f x y z v w) q
-pattern A7 f x y z v w q r <- EApp (A6 f x y z v w q) r
-pattern A8 f x y z v w q r s <- EApp (A7 f x y z v w q r) s
-pattern A9 f x y z v w q r s t <- EApp (A8 f x y z v w q r s) t
-pattern A10 f x y z v w q r s t a <- EApp (A9 f x y z v w q r s t) a
-pattern A11 f x y z v w q r s t a b <- EApp (A10 f x y z v w q r s t a) b
-
-infixr 7 ~>, ~~>
-a ~> b = TArr a b
-
-(~~>) :: [Exp] -> Exp -> Exp
-args ~~> res = foldr (~>) res args
-
-infix 4 ~~, ~~~
-(~~) = CEq
-(~~~) = CUnify
-
-buildApp :: (Exp -> Exp) -> Exp -> [Exp] -> Exp
-buildApp n restype args = f restype $ reverse args
-  where
-    f ty [] = n ty
-    f ty (a:as) = TApp ty (f (tyOf a ~> ty) as) a
-
-
-mapExp_ :: (PShow v, PShow p, PShow b, Ord v') => (v -> v') -> (p -> p') -> Exp_ v p b -> Exp_ v' p' b
-mapExp_ vf f = \case
-    ELit_      x       -> ELit_ x
-    EVar_      k x     -> EVar_ k $ vf x
-    EApp_      k x y   -> EApp_ k x y
-    ELam_ h    x y     -> ELam_ h (f x) y
-    ELet_      x y z   -> ELet_ (f x) y z
-    ETuple_    x       -> ETuple_ x
-    ERecord_   x       -> ERecord_ $ x --map (vf *** id) x
-    ENamedRecord_ n x  -> ENamedRecord_ n x --(vf n) $ map (vf *** id) x
-    EFieldProj_ k x    -> EFieldProj_ k x -- $ vf x
-    ETypeSig_  x y     -> ETypeSig_ x y
-    EAlts_     x       -> EAlts_ x
-    Case_      t x xs  -> Case_ t x $ map (f *** id) xs
-    ENext_ i k         -> ENext_ i k
-    ETyApp_ k b t      -> ETyApp_ k b t
-    PrimFun k a b c    -> PrimFun k a b c
-    Star_              -> Star_
-    TCon_    k v       -> TCon_ k (vf v)
-    -- | TFun_    f [a]
-    Forall_ h mv b1 b2  -> Forall_ h (vf <$> mv) b1 b2
-    TTuple_  bs        -> TTuple_ bs
-    TRecord_ m         -> TRecord_ $ Map.fromList $ map (vf *** id) $ Map.toList m -- (Map v b)
-    CEq_ a (TypeFun n as) -> CEq_ a (TypeFun (vf n) as)
-    CUnify_ a1 a2      -> CUnify_ a1 a2
-    Split_ a1 a2 a3    -> Split_ a1 a2 a3
-    WRefl_ k           -> WRefl_ k
-    TWildcard_         -> TWildcard_
-    EPrec_ e es        -> EPrec_ e es
-    FunAlts_ i as      -> FunAlts_ i as
-    x                  -> error $ "mapExp: " ++ ppShow x
-
---traverseExp :: (Applicative m, Ord v') => (v -> v') -> (t -> m t') -> Exp_ v p t -> m (Exp_ v' p t')
-traverseExp nf f = fmap (mapExp_ nf id) . traverse f
-
-----------------
-
-data TypeFun n a = TypeFun n [a]
-    deriving (Eq,Ord,Functor,Foldable,Traversable)
-
-type TypeFunT = TypeFun IdN Exp
-
--------------------------------------------------------------------------------- cached type inference 
-
-inferLit :: Lit -> Exp
-inferLit a = thunk $ TCon_ (thunk Star_) $ flip TypeIdN' "typecon" $ case a of
-    LInt _    -> "Int"
-    LChar _   -> "Char"
-    LFloat _  -> "Float"
-    LString _ -> "String"
-    LNat _    -> "Nat"
-
-tyFunRes :: Exp -> Exp
-tyFunRes = \case
-  TArr a b -> b
-  x -> error $ "tyFunRes: not implemented " ++ ppShow x
-
-tyOf :: Exp -> Exp
-tyOf = \case
-    Exp t -> case t of
-        ELit_ l -> inferLit l
-        EVar_ k _ -> k
-        EApp_ k _ _ -> k
-        ETyApp_ k _ _ -> k
-        ETuple_ es -> TTuple $ map tyOf es 
-        ELam_ (Just k) _ _ -> k
-        ELam_ Nothing (tyOfPat -> a) (tyOf -> b) -> Exp $ Forall_ Visible Nothing{-TODO-} a b
-        Case_ t _ _ -> t
-        ETypeSig_ b t -> t -- tyOf b
-        ELet_ _ _ e -> tyOf e
-        ERecord_ (unzip -> (fs, es)) -> TRecord $ Map.fromList $ zip fs $ map tyOf es
-        EFieldProj_ k _ -> k
-        EAlts_ bs -> tyOf $ head bs
-        ENext_ _ k -> k
-        PrimFun k _ _ _ -> k
-        -- was types
-        Star_ -> Star
-        TCon_ k _ -> k
-        Forall_ _ _ _ _ -> Star
-        TTuple_ _ -> Star
-        TRecord_ _ -> Star
-        CEq_ _ _ -> Star
-        CUnify_ _ _ -> Star
-        Split_ _ _ _ -> Star
-        WRefl_ k -> k
-        TWildcard_ -> TWildcard
-        e -> error $ "tyOf " ++ ppShow e
-
-tyOfPat :: Pat -> Exp
-tyOfPat = \case
-    PCon t _ _ -> t
-    PVar t _ -> t
-    Wildcard t -> t
-    PLit l -> inferLit l
-    PTuple xs -> thunk $ TTuple_ $ map tyOfPat xs
---    PRecord xs ->  [(Name, b)]
-    PAt _ p -> tyOfPat p
-    e -> error $ "tyOfPat " ++ ppShow e
-
-isStar = \case
-    Star -> True
-    _ -> False
-
--------------------------------------------------------------------------------- tag handling
-
-class GetTag c where
-    type Tag c
-    getTag :: c -> Tag c
-
-instance GetTag ExpR where
-    type Tag ExpR = Range
-    getTag (ExpR a _) = a
-instance GetTag PatR where
-    type Tag PatR = Range
-    getTag (PatR a _) = a
-
--------------------------------------------------------------------------------- names
-
-data NameSpace = TypeNS | ExpNS
-    deriving (Eq, Ord)
-
--- TODO: more structure instead of Doc
-data NameInfo = NameInfo (Maybe Fixity) Doc
-
-data N = N
-    { nameSpace :: NameSpace
-    , qualifier :: [String]
-    , nName :: String
-    , nameInfo :: NameInfo
-    }
-
-instance Eq N where N a b c d == N a' b' c' d' = (a, b, c) == (a', b', c')
-instance Ord N where N a b c d `compare` N a' b' c' d' = (a, b, c) `compare` (a', b', c')
-
-type Fixity = (Maybe FixityDir, Int)
-data FixityDir = FDLeft | FDRight
-
-pattern ExpN n <- N ExpNS [] n _ where
-    ExpN n = N ExpNS [] n (NameInfo Nothing "exp")
-pattern ExpN' n i = N ExpNS [] n (NameInfo Nothing i)
-pattern TypeN n <- N TypeNS [] n _ where
-    TypeN n = N TypeNS [] n (NameInfo Nothing "type")
-pattern TypeN' n i = N TypeNS [] n (NameInfo Nothing i)
-
-addPrefix :: String -> Name -> Name
-addPrefix s (N a b c d) = N a b (s ++ c) d
-
--- TODO: rename/eliminate
-type Name = N
-type TName = N
-type TCName = N    -- type constructor name; if this turns out to be slow use Int or ADT instead of String
-type EName = N
-type FName = N
-type MName = N     -- module name
-type ClassName = N
-
-toExpN (N _ a b i) = N ExpNS a b i
-toTypeN (N _ a b i) = N TypeNS a b i
-isTypeVar (N ns _ _ _) = ns == TypeNS
-isConstr (N _ _ (c:_) _) = isUpper c || c == ':'
-
--------------------------------------------------------------------------------- error handling
-
--- TODO: add more structure to support desugaring
-data Range
-    = Range SourcePos SourcePos
-    | NoRange
-
-instance Monoid Range where
-    mempty = NoRange
-    Range a1 a2 `mappend` Range b1 b2 = Range (min a1 a2) (max b1 b2)
-    NoRange `mappend` a = a
-    a `mappend` b = a
-
-type WithRange = (,) Range
-pattern WithRange a b = (a, b)
-
---------------------------------------------------------------------------------
-
-type WithExplanation = (,) Doc
-
-pattern WithExplanation d x = (d, x)
-
--- TODO: add more structure
-data ErrorMsg
-    = AddRange Range ErrorMsg
-    | InFile String ErrorMsg
-    | ErrorCtx Doc ErrorMsg
-    | ErrorMsg Doc
-    | EParseError ParseError
-    | UnificationError Exp Exp [WithExplanation [Exp]]
-
-instance Monoid ErrorMsg where
-    mempty = ErrorMsg "<<>>"
-    mappend a b = a
-
-instance Show ErrorMsg where
-    show = show . f Nothing Nothing Nothing where
-        f d file rng = \case
-            InFile s e -> f d (Just s) Nothing e
-            AddRange NoRange e -> {- showRange file (Just r) <$$> -} f d file rng e
-            AddRange r e -> {- showRange file (Just r) <$$> -} f d file (Just r) e
-            ErrorCtx d e -> {-"during" <+> d <$$> -} f (Just d) file rng e
-            EParseError pe -> text $ show pe
-            ErrorMsg e -> maybe "" ("during" <+>) d <$$> (showRange file rng) <$$> e
-            UnificationError a b tys -> maybe "" ("during" <+>) d <$$> (showRange file rng) <$$> "cannot unify" <+> pShow a </> "with" <+> pShow b
-                <$$> "----------- equations"
-                <$$> vcat (map (\(s, l) -> s <$$> vcat (map pShow l)) tys)
-
-dummyPos = newPos "" 0 0
-
-showErr :: ErrorMsg -> (SourcePos, SourcePos, String)
-showErr e = (i, j, show msg)
-  where
-    (r, msg) = f Nothing e
-    (i, j) = case r of
-        Just (Range i j) -> (i, j)
-        _ -> (dummyPos, dummyPos)
-    f rng = \case
-        InFile s e -> f Nothing e
-        AddRange r e -> f (Just r) e
-        ErrorCtx d e -> {-(("during" <+> d) <+>) <$> -} f rng e
-        EParseError pe -> (Just $ Range p (incSourceColumn p 1), {-vcat $ map (text . messageString) $ errorMessages-} text $ show pe)
-            where p = errorPos pe
-        ErrorMsg d -> (rng, d)
-        UnificationError a b tys -> (rng, "cannot unify" <+> pShow a </> "with" <+> pShow b)
-
-type ErrorT = ExceptT ErrorMsg
-
-throwParseError = throwError . EParseError
-
-mapError f m = catchError m $ throwError . f
-
-addCtx d = mapError (ErrorCtx d)
-
-addRange :: MonadError ErrorMsg m => Range -> m a -> m a
-addRange NoRange = id
-addRange r = mapError $ AddRange r
-
---throwErrorTCM :: Doc -> TCM a
-throwErrorTCM = throwError . ErrorMsg
-
-showRange :: Maybe String -> Maybe Range -> Doc
-showRange Nothing Nothing = "no file position"
-showRange Nothing (Just _) = "no file"
-showRange (Just _) Nothing = "no position"
-showRange (Just src) (Just (Range s e)) = str
-    where
-      startLine = sourceLine s - 1
-      endline = sourceLine e - if sourceColumn e == 1 then 1 else 0
-      len = endline - startLine
-      str = vcat $ ("position:" <+> text (show s) <+> "-" <+> text (show e)):
-                   map text (take len $ drop startLine $ lines src)
-                ++ [text $ replicate (sourceColumn s - 1) ' ' ++ replicate (sourceColumn e - sourceColumn s) '^' | len == 1]
-
--------------------------------------------------------------------------------- parser output
-
-data ValueDef p e = ValueDef Bool{-recursive-} p e
-data TypeSig n t = TypeSig n t
-
-data ModuleR
-  = Module
-  { extensions    :: [Extension]
-  , moduleImports :: [Name]    -- TODO
-  , moduleExports :: Maybe [Export]
-  , definitions   :: [DefinitionR]
-  }
-
-type DefinitionR = WithRange Definition
-data Definition
-    = DValueDef Bool{-True: use in instance search-} (ValueDef PatR ExpR)
-    | DAxiom (TypeSig Name ExpR)
-    | DDataDef Name [(Name, ExpR)] [WithRange ConDef]      -- TODO: remove, use GADT
-    | GADT Name [(Name, ExpR)] [WithRange (Name, ConDef')]
-    | ClassDef [ExpR] Name [(Name, ExpR)] [TypeSig Name ExpR]
-    | InstanceDef [ExpR] Name [ExpR] [ValueDef PatR ExpR]
-    | TypeFamilyDef Name [(Name, ExpR)] ExpR
-    | PrecDef Name Fixity
--- used only during parsing
-    | PreValueDef (Range, EName) [PatR] WhereRHS
-    | DTypeSig (TypeSig EName ExpR)
-    | ForeignDef Name ExpR
-
--- used only during parsing
-data WhereRHS = WhereRHS GuardedRHS (Maybe WhereBlock)
-type WhereBlock = [DefinitionR]
-
--- used only during parsing
-data GuardedRHS
-    = Guards Range [(ExpR, ExpR)]
-    | NoGuards ExpR
-
-data ConDef = ConDef Name [FieldTy]
-data ConDef' = ConDef' [(Maybe Name, ExpR)] [FieldTy] ExpR
-data FieldTy = FieldTy {fieldName :: Maybe (Name, Bool{-True: context projection-}), fieldType :: ExpR}
-
-type TypeFunR = TypeFun Name ExpR
-type ValueDefR = ValueDef PatR ExpR
-
-data Extension
-    = NoImplicitPrelude
-    deriving (Eq, Ord, Show)
-
-data Export
-    = ExportModule Name
-    | ExportId Name
-
--------------------------------------------------------------------------------- names with unique ids
-
-type IdN = N
-pattern IdN a = a
---newtype IdN = IdN N deriving (Eq, Ord)
-{- TODO
-data IdN = IdN !Int N
-
-instance Eq IdN where IdN i _ == IdN j _ = i == j
-instance Ord IdN where IdN i _ `compare` IdN j _ = i `compare` j
--}
-
-pattern TypeIdN n <- IdN (TypeN n)
-pattern TypeIdN' n i = IdN (TypeN' n i)
-pattern ExpIdN n <- IdN (ExpN n)
-pattern ExpIdN' n i = IdN (ExpN' n i)
-
-type FreshVars = [String]     -- fresh typevar names
-
-type VarMT = StateT FreshVars
-
-show5 :: Int -> String
-show5 i = replicate (5 - length s) '0' ++ s where s = show i
-
-freshTypeVars :: FreshVars
-freshTypeVars = map ('t':) $ map show5 [0..]
-
-resetVars :: MonadState FreshVars m => m ()
-resetVars = put freshTypeVars
-
-newName :: MonadState FreshVars m => Doc -> m IdN
-newName info = do
-    i <- gets head
-    modify tail
-    return $ TypeN' i info
-
-newEName = do
-    i <- gets head
-    modify tail
-    return $ ExpN $ "e" ++ i
-
-
--------------------------------------------------------------------------------- environments
-
-type Env' a = Map Name a
-type Env a = Map IdN a
-
-data Item = ISubst Bool{-True: found & replaced def-}  Exp | ISig Bool{-True: Rigid-} Exp
-
-tyOfItem = eitherItem (const tyOf) $ const id
-
-eitherItem f g (ISubst r x) = f r x
-eitherItem f g (ISig r x) = g r x
-
-pureSubst se = null [x | ISig rigid x <- Map.elems $ getTEnv se]
-onlySig (TEnv x) = TEnv $ Map.filter isSig x
-isSig = eitherItem (\_ -> const False) (\rigid -> const True)
-
-newtype Subst = Subst {getSubst :: Env Exp}
-
-instance Monoid Subst where
-    mempty = Subst mempty
-    -- semantics: subst (m1 <> m2) = subst m1 . subst m2
-    -- example:  subst ({y -> z} <> {x -> y}) = subst {y -> z} . subst {x -> y} = subst {y -> z, x -> z}
-    -- example2: subst ({x -> z} <> {x -> y}) = subst {x -> z} . subst {x -> y} = subst {x -> y}
-    m1@(Subst y1) `mappend` Subst y2 = Subst $ (subst_ m1 <$> y2) <> y1
-
-subst_ = subst
-singSubst' a b = Subst $ Map.singleton a b
-
-nullSubst (Subst s) = Map.null s
-toTEnv (Subst s) = TEnv $ ISubst False <$> s
-toSubst (TEnv s) = Subst $ Map.map (\(ISubst _ e) -> e) $ Map.filter (eitherItem (\_ -> const True) (\_ -> const False)) s
-
-newtype TEnv = TEnv {getTEnv :: Env Item}  -- either substitution or bound name
-
-instance Monoid TEnv where
-    mempty = TEnv mempty
-    -- semantics: apply (m1 <> m2) = apply m1 . apply m2
-    -- example:  subst ({y -> z} <> {x -> y}) = subst {y -> z} . subst {x -> y} = subst {y -> z, x -> z}
-    -- example2: subst ({x -> z} <> {x -> y}) = subst {x -> z} . subst {x -> y} = subst {x -> y}
-    m1@(TEnv y1) `mappend` TEnv y2 = TEnv $ Map.unionWith mergeSubsts (subst (toSubst m1) <$> y2) y1
-
-mergeSubsts (ISubst _ s) (ISig _ _) = ISubst True s
-mergeSubsts (ISubst b s) (ISubst b' _) = ISubst (b || b') s
-mergeSubsts (ISig _ _) (ISubst _ s) = ISubst True s
-mergeSubsts a _ = a
-
-singSubst a b = TEnv $ Map.singleton a $ ISubst False b
-singSubstTy_ a b = TEnv $ Map.singleton a $ ISig False b
-
--- build recursive environment  -- TODO: generalize
-recEnv :: Pat -> Exp -> Exp
-recEnv (PVar _ v) th_ = th where th = subst (singSubst' v th) th_
-recEnv _ th = th
-
-mapExp' f nf pf e = mapExp_ nf pf $ f <$> e
-
-peelThunkR :: Exp -> (Range, Exp')
-peelThunkR e@(ExpTh r _ _) = (r, peelThunk e)
-
-peelThunk :: Exp -> Exp'
-peelThunk (ExpTh _ env@(Subst m) e)
---  | Map.null m = e
-  | otherwise = case e of
-    Forall_ h (Just n) a b -> Forall_ h (Just n) (f a) $ subst_ (delEnv n (f a) env) b
-    ELam_ h x y -> ELam_ (f <$> h) (mapPat' x) $ subst_ (delEnvs (patternVars x) env) y
-    Case_ t e cs -> Case_ (f t) (f e) [(mapPat' x, subst_ (delEnvs (patternVars x) env) y) | (x, y) <- cs]
-    ELet_ x y z -> ELet_ (mapPat' x) (g y) (g z) where
-        g = subst_ (delEnvs (patternVars x) env)
-    EVar_ k v -> case Map.lookup v m of
-        Just e -> case peelThunk e of
-            PrimFun _ a b c -> PrimFun (f k) a b c -- hack!
-            x -> x
-        _ -> EVar_ (f k) v
-    FunAlts_ i ts -> FunAlts_ i $ flip map ts $ \(p, t) -> (p, subst (delEnvs' (foldMap patternVars' p) env) t)
-    _ -> mapExp' f id (error "peelT") e
-  where
-    f = subst_ env
-
-    mapPat' :: Pat -> Pat
-    mapPat' (Pat p) = Pat $ mapPat f id id $ mapPat' <$> p
-
-    delEnv n x = delEnvs [(n, x)]
-
-delEnvs xs (Subst env) = Subst $ foldr Map.delete env $ map fst xs
-delEnvs' xs (Subst env) = Subst $ foldr Map.delete env xs
-
-subst1 :: Subst -> Exp -> Exp
-subst1 s@(Subst m) = \case
-    TVar k v -> case Map.lookup v m of
-        Just e -> subst1 s e
-        _ -> TVar k v
-    e -> e
-
---------------------------------------------------------------------------------
---  fix :: forall (a :: *) . (a -> a) -> a
---  fix = \{a :: *} (f :: a -> a) -> [ x |-> f x ]  x :: a
-
-fixName = ExpN "fix"
-
-fixBody :: Exp
-fixBody = Exp $ ELam_ (Just ty) (PVar Star an) $ Exp $ ELam_ Nothing (PVar a fn) fx
-  where
-    ty = Exp $ Forall_ Hidden (Just an) Star $ (a ~> a) ~> a
-
-    fx = ExpTh mempty{-TODO: review this-} (singSubst' x $ TApp a f fx) $ EVar_ a x
-
-    an = TypeN "a"
-    a = TVar Star an
-    fn = ExpN "f"
-    f = TVar (a ~> a) fn
-    x = ExpN "x"
-
---------------------------------------------------------------------------------
-
-data PolyEnv = PolyEnv
-    { instanceDefs :: InstanceDefs
-    , getPolyEnv :: Env' Item
-    , constructors :: Env' [(Name, Int)]
-    , precedences :: PrecMap
-    , typeFamilies :: InstEnv
-    , infos :: Infos
-    }
-
-type Info = (SourcePos, SourcePos, String)
-type Infos = [Info]
-
-type InstEnv = Env' Exp
-
-type PrecMap = Env' Fixity
-
-type InstanceDefs = Env' (Map Name ())
-
-emptyPolyEnv :: PolyEnv
-emptyPolyEnv = PolyEnv mempty mempty mempty mempty mempty mempty
-
-startPolyEnv = emptyPolyEnv {getPolyEnv = Map.singleton fixName $ ISubst True fixBody}
-
-joinPolyEnvs :: forall m. MonadError ErrorMsg m => Bool -> [PolyEnv] -> m PolyEnv
-joinPolyEnvs allownameshadow ps = PolyEnv
-    <$> mkJoin' instanceDefs
-    <*> mkJoin allownameshadow getPolyEnv
-    <*> mkJoin allownameshadow constructors
-    <*> mkJoin False precedences
-    <*> mkJoin False typeFamilies
-    <*> pure (concatMap infos ps)
-  where
-    mkJoin :: Bool -> (PolyEnv -> Env a) -> m (Env a)
-    mkJoin True f = return $ Map.unions $ map f ps
-    mkJoin False f = case filter (not . Map.null) . map f $ ps of
-        [m] -> return m
-        ms -> case filter (not . null . drop 1 . snd) $ Map.toList ms' of
-            [] -> return $ fmap head $ Map.filter (not . null) ms'
-            xs -> throwErrorTCM $ "Definition clash:" <+> pShow (map fst xs)
-          where
-            ms' = Map.unionsWith (++) $ map ((:[]) <$>) ms
-
-    mkJoin' f = case [(n, x) | (n, s) <- Map.toList ms', (x, is) <- Map.toList s, not $ null $ drop 1 is] of
-        _ -> return $ fmap head . Map.filter (not . null) <$> ms'
---        xs -> throwErrorTCM $ "Definition clash':" <+> pShow xs
-       where
-        ms' = Map.unionsWith (Map.unionWith (++)) $ map ((((:[]) <$>) <$>) . f) ps
-
-addPolyEnv pe m = do
-    env <- ask
-    env <- joinPolyEnvs True [pe, env]
-    local (const env) m
-
--- reversed order!
-getApp (Exp x) = case x of
-    EApp_ _ f x -> (id *** (x:)) <$> getApp f
-    TCon_ _ n -> Just (n, [])
-    _ -> Nothing
-
-withTyping ts = addPolyEnv $ emptyPolyEnv {getPolyEnv = ISig False <$> ts}
-
--------------------------------------------------------------------------------- monads
-
-nullTEnv (TEnv m) = Map.null m
-
-type TypingT = WriterT' TEnv
-
-type EnvType = (TEnv, Exp)
-
-hidden = \case
-    Visible -> False
-    _ -> True
-
-toEnvType :: Exp -> ([(Visibility, (Name, Exp))], Exp)
-toEnvType = \case
-    Exp (Forall_ v@(hidden -> True) (Just n) t x) -> ((v, (n, t)):) *** id $ toEnvType x
-    x -> (mempty, x)
-
-envType d = TEnv $ Map.fromList $ map ((id *** ISig False) . snd) d
-
-addInstance n ((envType *** id) . toEnvType -> (_, getApp -> Just (c, _)))
-    = addPolyEnv $ emptyPolyEnv {instanceDefs = Map.singleton c $ Map.singleton n ()}
-
-monoInstType v k = Map.singleton v k
-
-toTCMS :: Exp -> TCMS ([Exp], Exp)
-toTCMS (toEnvType -> (typ@(envType -> TEnv se), ty)) = WriterT' $ do
-    let fv = map (fst . snd) typ
-    newVars <- forM fv $ \case
-        TypeN' n i -> newName $ "instvar" <+> text n <+> i
-        v -> error $ "instT: " ++ ppShow v
-    let s = Map.fromList $ zip fv newVars
-    return (TEnv $ repl s se, (map (repl s . uncurry (flip TVar)) $ hiddenVars typ, repl s ty))
-
-hiddenVars ty = [x | (Hidden, x) <- ty]
-
-instantiateTyping_ vis info se ty = do
-    ambiguityCheck ("ambcheck" <+> info) se ty --(subst su se) (subst su ty)
-    typingToTy_ vis ".." (se, ty)
-  where
-    su = toSubst se
-
-splitEnv (TEnv se) = TEnv *** TEnv $ cycle (f gr') (se', gr')
-  where
-    (se', gr') = flip Map.partition se $ \case
-        ISubst False _ -> False
-        _ -> True
-    f = foldMap (\(k, ISubst False x) -> Set.insert k $ freeVars x) . Map.toList
-    f' = foldMap (\(k, ISig False x) -> Set.insert k $ freeVars x) . Map.toList
-    cycle acc (se, gr) = (if Set.null s then id else cycle (acc <> s)) (se', gr <> gr')
-      where
-        (se', gr') = flip Map.partitionWithKey se $ \k -> \case
-            ISig False t -> not $ Set.insert k (freeVars t) `hasSame` acc
-            _ -> True
-        s = f' gr'
-
-hasSame a b = not $ Set.null $ a `Set.intersection` b
-
-instantiateTyping_' :: Bool -> Doc -> TEnv -> Exp -> TCM ([(IdN, Exp)], Exp)
-instantiateTyping_' typ info se ty = do
-    ty <- instantiateTyping_ (if typ then Hidden else Irrelevant) info se ty
-    return (hiddenVars $ fst $ toEnvType ty, ty)
-
--- Ambiguous: (Int ~ F a) => Int
--- Not ambiguous: (Show a, a ~ F b) => b
---ambiguityCheck :: Doc -> TCMS Exp -> TCMS Exp
-ambiguityCheck msg se ty = do
-    pe <- asks getPolyEnv
-    let defined = dependentVars (Map.toList $ getTEnv se) $ Map.keysSet pe <> freeVars ty
-    case [(n, c) | (n, ISig rigid c) <- Map.toList $ getTEnv se, not $ any (`Set.member` defined) $ Set.insert n $ freeVars c] of
-        [] -> return ()
-        err -> do
-            tt <- typingToTy' (se, ty)
-            throwErrorTCM $
-                "during" <+> msg </> "ambiguous type:" <$$> pShow tt <$$> "problematic vars:" <+> pShow err
-
--- compute dependent type vars in constraints
--- Example:  dependentVars [(a, b) ~ F b c, d ~ F e] [c] == [a,b,c]
-dependentVars :: [(IdN, Item)] -> Set TName -> Set TName
-dependentVars ie s = cycle mempty s
-  where
-    cycle acc s
-        | Set.null s = acc
-        | otherwise = cycle (acc <> s) (grow s Set.\\ acc)
-
-    grow = flip foldMap ie $ \case
-      (n, ISig rigid t) -> (Set.singleton n <-> freeVars t) <> case t of
-        CEq ty f -> freeVars ty <-> freeVars f
-        Split a b c -> freeVars a <-> (freeVars b <> freeVars c)
---        CUnify{} -> mempty --error "dependentVars: impossible" 
-        _ -> mempty
---      (n, ISubst False x) -> (Set.singleton n <-> freeVars x)
-      _ -> mempty
-      where
-        a --> b = \s -> if Set.null $ a `Set.intersection` s then mempty else b
-        a <-> b = (a --> b) <> (b --> a)
-
---typingToTy' :: EnvType -> Exp
-typingToTy' (s, t) = typingToTy "typingToTy" s t
-
---typingToTy :: Doc -> TEnv -> Exp -> Exp
-typingToTy msg env ty = removeStar . renameVars <$> typingToTy_ Hidden msg (env, ty)
-  where
-    removeStar (Exp (Forall_ (hidden -> True) _ Star t)) = removeStar t
-    removeStar t = t
-
-    renameVars :: Exp -> Exp
-    renameVars = flip evalState (map (:[]) ['a'..]) . f mempty
-      where
-        f m (Exp e) = Exp <$> case e of
-            Forall_ h (Just n) k e -> do
-                n' <- gets (TypeN . head)
-                modify tail
-                Forall_ h (Just n') <$> f m k <*> f (Map.insert n n' m) e
-            e -> traverseExp nf (f m) e
-          where
-            nf n = fromMaybe n $ Map.lookup n m
-
---typingToTy_ :: Visibility -> Doc -> EnvType -> Exp
-typingToTy_ vs msg (env, ty) = do
-    pe <- asks getPolyEnv
-    return $ f (Map.keysSet pe) l
-  where
-    l = sortBy (compare `on` constrKind . snd) [(n, t) | (n, ISig rigid t) <- Map.toList $ getTEnv env]
-    forall_ n k t
---        | n `Set.notMember` freeVars t = TArrH k t
-        | otherwise = Exp $ Forall_ vs (Just n) k t
-
-    constrKind = \case
-        Star -> 0
-        _ -> 2
-
-    -- TODO: make more efficient?
-    f s [] = ty
-    f s ts = case [x | x@((n, t), ts') <- getOne ts, let fv = freeVars t, fv `Set.isSubsetOf` s] of
-        (((n, t), ts): _) -> forall_ n t $ f (Set.insert n s) ts
-        _ -> error $ show $ "orderEnv:" <+> msg <$$> pShow ts <$$> pShow l <$$> pShow ty
-
-getOne xs = [(b, a ++ c) | (a, b: c) <- zip (inits xs) (tails xs)]
-
-instance PShow Subst where
-    pShowPrec p (Subst t) = "Subst" <+> pShow t
-
--- type checking monad transformer
-type TCMT m = ReaderT PolyEnv (ErrorT (WriterT Infos (VarMT m)))
-
-type TCM = TCMT Identity
-
-type TCMS = TypingT TCM
-
-catchExc :: TCM a -> TCM (Maybe a)
-catchExc = mapReaderT $ lift . fmap (either (const Nothing) Just) . runExceptT
-
--------------------------------------------------------------------------------- free variables
-
-class FreeVars a where freeVars :: a -> Set IdN
-
-instance FreeVars Exp where
-    freeVars = \case
-        Exp x -> case x of
-            ELam_ h x y -> freeVars y Set.\\ Set.fromList (map fst $ patternVars x)     -- TODO: h?
-            Case_ t e cs -> freeVars t <> freeVars e <> foldMap (\(x, y) -> freeVars y Set.\\ Set.fromList (map fst $ patternVars x)) cs
-            ELet_ x y z -> (freeVars y <> freeVars z) Set.\\ Set.fromList (map fst $ patternVars x) -- TODO: revise
-            EVar_ k a -> Set.singleton a <> freeVars k
-            Forall_ h (Just v) k t -> freeVars k <> Set.delete v (freeVars t)
-            x -> foldMap freeVars x
-
-instance FreeVars a => FreeVars [a]                 where freeVars = foldMap freeVars
-instance FreeVars a => FreeVars (TypeFun n a)       where freeVars = foldMap freeVars
-instance FreeVars a => FreeVars (Env a)         where freeVars = foldMap freeVars
-
--------------------------------------------------------------------------------- replacement
-
-type Repl = Map IdN IdN
-
--- TODO: express with Substitute?
-class Replace a where repl :: Repl -> a -> a
-
--- TODO: make more efficient
-instance Replace Exp where
-    repl st = \case
-        ty | Map.null st -> ty -- optimization
-        Exp s -> Exp $ case s of
-            ELam_ h _ _ -> error "repl lam"
-            Case_ _ _ _ -> error "repl case"
-            ELet_ _ _ _ -> error "repl let"
-            Forall_ h (Just n) a b -> Forall_ h (Just n) (f a) (repl (Map.delete n st) b)
-            t -> mapExp' f rn (error "repl") t
-      where
-        f = repl st
-        rn a
-            | Just t <- Map.lookup a st = t
-            | otherwise = a
-
-instance Replace a => Replace (Env a) where
-    repl st e = Map.fromList $ map (r *** repl st) $ Map.toList e
-      where
-        r x = fromMaybe x $ Map.lookup x st
-
-instance (Replace a, Replace b) => Replace (Either a b) where
-    repl st = either (Left . repl st) (Right . repl st)
-instance Replace Item where
-    repl st = eitherItem (\r -> ISubst r . repl st) (\r -> ISig r . repl st)
-
--------------------------------------------------------------------------------- substitution
-
--- TODO: review usage (use only after unification)
-class Substitute x a where subst :: x -> a -> a
-
---instance Substitute a => Substitute (Constraint' n a)      where subst = fmap . subst
-instance Substitute x a => Substitute x [a]                    where subst = fmap . subst
-instance (Substitute x a, Substitute x b) => Substitute x (a, b) where subst s (a, b) = (subst s a, subst s b)
-instance (Substitute x a, Substitute x b) => Substitute x (Either a b) where subst s = subst s +++ subst s
-instance Substitute x Exp => Substitute x Item where subst s = eitherItem (\r -> ISubst r . subst s) (\r -> ISig r . subst s)
-{-
-instance Substitute Pat where
-    subst s = \case
-        PVar t v -> PVar $ subst s v
-        PCon t n l -> PCon (VarE n $ subst s ty) $ subst s l
-        Pat p -> Pat $ subst s <$> p
--}
---instance Substitute TEnv Exp where subst = subst . toSubst --m1 (ExpTh m exp) = ExpTh (toSubst m1 <> m) exp
-instance Substitute Subst Exp where subst m1 (ExpTh r m exp) = ExpTh r (m1 <> m) exp
---instance Substitute TEnv TEnv where subst s (TEnv m) = TEnv $ subst s <$> m
-instance Substitute Subst TEnv where subst s (TEnv m) = TEnv $ subst s <$> m
-{-
-instance Substitute Subst (Pat' Exp) where
-    subst s = \case
-        = PatVar v ->Name   -- v
-        | PatCon ConName [ParPat e]
-        | PatLit Lit
-        | ViewPat e (ParPat e)
-        | PatPrec (ParPat e) [(ParPat e{-TODO-}, ParPat e)]     -- used before precedence calculation
-        x -> fmap (subst s) x
--}
-instance Substitute Subst (GuardTree Exp) where
-    subst s = \case
-        GuardPat e p t -> GuardPat e p $ subst (delEnvs' (patternVars' p) s) t
-        GuardCon e n ps t -> GuardCon e n ps $ subst (delEnvs' (foldMap patternVars' ps) s) t
-        GuardWhere bs t -> GuardWhere (map (id *** subst s') bs) $ subst s' t
-          where s' = delEnvs (foldMap patternVars $ map fst bs) s
-        x -> fmap (subst s) x
-
--------------------------------------------------------------------------------- LambdaCube specific definitions
--- TODO: eliminate most of these
-pattern StarStar = TArr Star Star
-
-pattern TCon0 a = TCon Star a
-pattern TCon1 a b = TApp Star (TCon StarStar a) b
-pattern TCon2 a b c = TApp Star (TApp StarStar (TCon (TArr Star StarStar) a) b) c
-pattern TCon2' a b c = TApp Star (TApp StarStar (TCon VecKind a) b) c
-pattern TCon3' a b c d = TApp Star (TApp StarStar (TApp VecKind (TCon (TArr Star VecKind) a) b) c) d
-
-pattern TVec a b = TCon2' "Vec" (ENat a) b
-pattern TMat a b c = TApp Star (TApp StarStar (TApp VecKind (TCon MatKind "Mat") (ENat a)) (ENat b)) c
-pattern TSingRecord x t <- TRecord (singletonView -> Just (x, t))
-singletonView m = case Map.toList m of
-    [a] -> Just a
-    _ -> Nothing
-
--- basic types
-pattern TChar = TCon0 "Char"
-pattern TString = TCon0 "String"
-pattern TBool = TCon0 "Bool"
-pattern TOrdering = TCon0 "Ordering"
-pattern TWord = TCon0 "Word"
-pattern TInt = TCon0 "Int"
-pattern TNat = TCon0 "Nat"
-pattern TFloat = TCon0 "Float"
-pattern VecKind = TArr TNat StarStar
-pattern MatKind = TArr TNat (TArr TNat StarStar)
-pattern TList a = TCon1 "List" a
-
-pattern Ordering = TCon0 "Ordering"
-
--- Semantic
-pattern Depth a = TCon1 "Depth" a
-pattern Stencil a = TCon1 "Stencil" a
-pattern Color a = TCon1 "Color" a
-
--- GADT
-pattern TFragmentOperation b = TCon1 "FragmentOperation" b
-pattern TImage b c = TCon2' "Image" b c
-pattern TInterpolated b = TCon1 "Interpolated" b
-pattern TFrameBuffer b c = TCon2' "FrameBuffer" b c
-pattern TSampler = TCon0 "Sampler"
-
-pattern ClassN n <- TypeN n where
-    ClassN n = TypeN' n "class"
-pattern IsValidOutput = ClassN "ValidOutput"
-pattern IsTypeLevelNatural = ClassN "TNat"
-pattern IsValidFrameBuffer = ClassN "ValidFrameBuffer"
-pattern IsAttributeTuple = ClassN "AttributeTuple"
-
-pattern TypeFunS a b <- TypeFun (TypeN a) b where
-    TypeFunS a b = TypeFun (TypeN' a "typefun") b
-pattern TFMat a b               = TypeFunS "TFMat" [a, b]      -- may be data family
-pattern TFVec a b               = TypeFunS "TFVec" [a, b]      -- may be data family
-pattern TFMatVecElem a          = TypeFunS "MatVecElem" [a]
-pattern TFMatVecScalarElem a    = TypeFunS "MatVecScalarElem" [a]
-pattern TFVecScalar a b         = TypeFunS "VecScalar" [a, b]
-pattern TFFTRepr' a             = TypeFunS "FTRepr'" [a]
-pattern TFColorRepr a           = TypeFunS "ColorRepr" [a]
-pattern TFFrameBuffer a         = TypeFunS "TFFrameBuffer" [a]
-pattern TFFragOps a             = TypeFunS "FragOps" [a]
-pattern TFJoinTupleType a b     = TypeFunS "JoinTupleType" [a, b]
-
---------------------------------------------------------------------------------
--- reducer implemented following
--- "A Tutorial Implementation of a Dependently Typed Lambda Calculus"
---    Andres Löh, Conor McBride and Wouter Swierstra following 
-
-reduceNew :: Exp -> Exp
-reduceNew e = quote (tyOf e) 0 $ eEval mempty e mempty
-
-vQuote = VNeutral . NGlobal
-qname i = ExpN $ "quote" ++ show i
-
-quote :: Exp -> Int -> Value -> Exp
-quote ty ii VStar = Star
-quote ty ii (VLit i) = ELit i
-quote ty ii (VCCon t (TupleName _) vs) = ETuple $ zipWith (\ty x -> quote ty ii x) (tupleTypes vs t) vs
-quote ty ii val@(VCCon t (ConName n) vs) = mkApp t (Exp $ EVar_ t n) vs
-  where
-    mkApp t@(Exp (Forall_ _ _ a b)) e (x:xs) = mkApp b (Exp $ EApp_ b e $ quote a ii x) xs
-    mkApp t e [] = e
-    mkApp a b c = error $ "mkApp: " ++ ppShow t ++ "; " ++ show val
-quote ty ii (VLam_ t) = Exp $ ELam_ Nothing (PVar a n) $ quote b (ii + 1) $ t $ vQuote n where
-    n = qname ii
-    (a, b) = case ty of
-        Exp (Forall_ _ _ a b) -> (a, b)
-        TWildcard -> (TWildcard, TWildcard)
-        _ -> error $ "quote: " ++ ppShow ty
-quote ty ii (VPi v f)
-    = error $ "quote: " ++ "2"
-quote ty ii (VNeutral n) = neutralQuote ty ii n
-
-neutralQuote :: Exp -> Int -> Neutral -> Exp
-neutralQuote ty ii (NGlobal v) = Exp $ EVar_ ty v
-neutralQuote ty ii (NQuote k)
-    = error $ "nquote: " ++ "3"
-neutralQuote ty ii (NApp_ n v)
-    = error $ "nquote: " ++ "4"
-neutralQuote ty ii (NCase ts x)
-    = error $ "nquote: " ++ "5"
-neutralQuote ty ii val@(NPrim t n vs) = Exp $ PrimFun ty n (mkApp t vs) 0
-  where
-    mkApp t@(Exp (Forall_ _ _ a b)) (x:xs) = quote a ii x: mkApp b xs
-    mkApp t [] = []
-    mkApp a c = error $ "mkApp2: " ++ ppShow t ++ "; " ++ show val
-
-arity :: Exp -> Int
-arity (Exp a) = {-trace (ppShow a) $ -} case a of
-    Forall_ Visible _ _ b -> 1 + arity b
-    Forall_ Hidden _ _ b -> 1 + arity b
-    Forall_ Irrelevant _ _ b -> error "arity" --0 + arity b
-    _ -> 0
-
-primType ty l = foldr (~>) ty $ map tyOf l
-tupleType es = foldr (~>) (tyOf $ ETuple es) $ map tyOf es
-tupleTypes xs t = f xs t where
-    f (_: xs) (Exp (Forall_ _ _ a b)) = a: f xs b
-    f [] (TTuple _) = []
-    f _ _ = error $ "tupleTypes: " ++ ppShow (xs, t)
-
-eEval :: [Name] -> Exp -> Env_ -> Value
-eEval ne (Exp e) = case e of
-    Star_ -> const VStar
-    ELit_ l -> const $ VLit l
-    EVar_ t v | isConstr v -> -- trace (show i ++ " " ++ ppShow v ++ " :: " ++ ppShow t) $ 
-        \d -> ff i id
-      where
-        i = arity t
-        ff :: Int -> ([Value] -> [Value]) -> Value
-        ff 0 acc = {- trace (ppShow (v, t)) $ -} VCCon t (ConName v) (acc [])
-        ff i acc = VLam_ $ \x -> ff (i-1) (acc . (x:))
-    EVar_ _ v -> \d -> maybe (VNeutral $ NGlobal v) (d !!) $ findIndex (== v) ne
-    TCon_     b v
-        -> error $ "eEval" ++ "3"
-    TWildcard_
-        -> error $ "eEval" ++ "4"
-    Forall_  v m a b-- Visibility (Maybe v) b b
-        -> error $ "eEval" ++ "5"
-    ELam_ _ (PVar _ n) b -> \d -> VLam_ (eEval (n: ne) b . (: d))
-    ELam_ ty p b -> eEval ne $ Exp $ ELam_ ty (PVar (tyOfPat p) n) $ Case (tyOf b) (Exp $ EVar_ (tyOfPat p) n) [(p, b)]
-        where n = ExpN "lamvar"
-    EApp_ _ f x -> \d -> vapp_ (eEval ne f d) (eEval ne x d)
-    ETyApp_ a b c--  b b b
-        -> error $ "eEval" ++ "8"
-    EPrec_ _ _ --   b [(b, b)]      -- aux: used only before precedence calculation
-        -> error $ "eEval" ++ "9"
-    ELet_ p a b -> eEval ne $ Exp $ EApp_ (tyOf b) (Exp $ ELam_ Nothing p b) a       -- TODO
-    TRecord_ m -- (Map v b)
-        -> error $ "eEval" ++ "11"
-    ERecord_ l -- [(Name, b)]
-        -> error $ "eEval" ++ "12"
-    EFieldProj_ b n --b Name
-        -> error $ "eEval" ++ "13"
-    TTuple_ l --  [b]
-        -> error $ "eEval" ++ "14"
-    ETuple_ l -> \d -> VCCon (tupleType l) (TupleName $ length l) $ map ($ d) $ map (eEval ne) l
-    ENamedRecord_ n l --Name [(Name, b)]
-        -> error $ "eEval" ++ "16"
-    WRefl_    b
-        -> error $ "eEval" ++ "17"
-    CEq_ b t --     b (TypeFun v b)
-        -> error $ "eEval" ++ "18"
-    CUnify_ a b--  b b
-        -> error $ "eEval" ++ "19"
-    Split_ a b c--   b b b
-        -> error $ "eEval" ++ "20"
-    ETypeSig_ a b --b b
-        -> error $ "eEval" ++ "21"
-    Case_ _ a l -> {-traceShow (length l) $ -} let
-            l' = map ff l
-            ne' ps = reverse (map fst $ foldMap patternVars ps) ++ ne
-            ff (PCon _ c ps, x) = (ConName c, foldr llam (eEval (ne' ps) x) ps)
-            ff (PTuple ps, x) = (TupleName $ length ps, foldr llam (eEval (reverse [n | PVar _ n <- ps] ++ ne) x) ps)
-         in \d -> case eEval ne a d of
-            VCCon _ con' args -> head [foldl vapp_ (x d) args | (c, x) <- l', c == con']
-            VNeutral n  ->  VNeutral $ NCase (map (id *** ($ d)) l') n
-            x            ->  error $ "eEval case: " ++ ppShow x
-      where
-        llam :: PatR -> (Env_ -> Value) -> Env_ -> Value
-        llam (PVar _ n) e = \d -> VLam_ (e . (: d))
-        llam (Wildcard _) e = e
-        llam p e = error $ "llam: " ++ ppShow p
-
-
-    WhereBlock_ l a-- [(Name{-v-}, b)] b
-        -> error $ "eEval" ++ "23"
-    PrimFun ty n@(ExpN s) l i -> \d -> ff i id d
-      where
-        l' = map (eEval ne) l
-        ff :: Int -> ([Value] -> [Value]) -> Env_ -> Value
-        ff 0 acc d = f s ({-reverse ??? -} (map ($ d) l') ++ acc [])
-        ff i acc d = VLam_ $ \x -> ff (i-1) (acc . (x:)) d
-
-        f "primIntToFloat" [VInt i] = VFloat $ fromIntegral i
-        f "primNegateFloat" [VFloat i] = VFloat $ negate i
-        f "PrimSin" [VFloat i] = VFloat $ sin i
-        f "PrimCos" [VFloat i] = VFloat $ cos i
-        f "PrimExp" [VFloat i] = VFloat $ exp i
-        f "PrimLog" [VFloat i] = VFloat $ log i
-        f "PrimAbs" [VFloat i] = VFloat $ abs i
-        f "PrimAddS" [VFloat i, VFloat j] = VFloat $ i + j
-        f "PrimSubS" [VFloat i, VFloat j] = VFloat $ i - j
-        f "PrimAddS" [VInt i, VInt j] = VInt $ i + j
-        f "PrimSubS" [VInt i, VInt j] = VInt $ i - j
-        f "PrimMulS" [VFloat i, VFloat j] = VFloat $ i * j
-        f "PrimDivS" [VFloat i, VFloat j] = VFloat $ i / j
-        f "PrimModS" [VInt i, VInt j] = VInt $ i `mod` j
-        f "PrimSqrt" [VInt i] = VInt $ round $ sqrt $ fromInteger i
-        f "PrimIfThenElse" [VTrue,t,_] = t
-        f "PrimIfThenElse" [VFalse,_,e] = e
-        f "PrimGreaterThan" [VFloat i, VFloat j] = vBool $ i > j
-        f "primCompareInt" [VInt i,VInt j] = VOrdering (show $ compare i j)
-        f "primCompareNat" [VNat i,VNat j] = VOrdering (show $ compare i j)
-        f "primCompareFloat" [VFloat i,VFloat j] = VOrdering (show $ compare i j)
-        f "primCompareString" [VString i,VString j] = VOrdering (show $ compare i j)
-
-        f s xs = VNeutral $ NPrim (primType ty l) n xs
-
-    FunAlts_ i l -- Int{-number of parameters-} [([ParPat b], GuardTree b)]
-        -> error $ "eEval" ++ "25"
-    -- TODO: remove
-    EAlts_ l --   [b]             -- function alternatives
-        -> error $ "eEval" ++ "26"
-    ENext_ d b --Doc   b           -- go to next alternative
-        -> error $ "eEval" ++ "27"
-
---------------------------------------------------------------------------------
-
-data Value
-     =  VLam_ (Value -> Value)
-     |  VPi Value (Value -> Value)
-     |  VStar
-     |  VCCon Exp{-constructor type-} ConName [Value]
---     |  VCon IConName [Value] -- not used
-     |  VLit !Lit
-     |  VNeutral Neutral
-
-data Neutral
-     =  NGlobal Name
-     |  NLocal Int  -- not used..
-     |  NQuote Int  -- not used.. -- TODO
-     |  NApp_ Neutral Value
-     |  NCase [(ConName, Value)] Neutral
-     |  NPrim Exp PrimName [Value]
-
-type Env_ = [Value]
-type NameEnv v = Map.Map N v
-
-type PrimName = N
-
-pattern VInt i = VLit (LInt i)
-pattern VNat i = VLit (LNat i)
-pattern VFloat i = VLit (LFloat i)
-pattern VString i = VLit (LString i)
-pattern VFalse = VCCon TBool (ConName (ExpN "False")) []
-pattern VTrue = VCCon TBool (ConName (ExpN "True")) []
-pattern VOrdering s = VCCon TOrdering (ConName (ExpN s)) []
-
-vBool False = VFalse
-vBool True = VTrue
-
-vapp_ :: Value -> Value -> Value
-vapp_ (VLam_ f)      v  =  f v
-vapp_ (VNeutral n)  v  =  VNeutral (NApp_ n v)
-
----------------------- TODO: remove
-
-instance Show Lit where show = ppShow
-instance Show PatR where show = ppShow
-
-instance PShow Value where
-    pShowPrec p = pShowPrec p . quote TWildcard 0
-
-instance Show Value where
-    show = ppShow . quote TWildcard 0
-instance Show Neutral where
-    show = show . VNeutral
-
-instance Show N where show = ppShow
-
---------------------------------------------------------------------------------
-
-type ReduceM = ExceptT String (State Int)
-
-isNext (Exp a) = case a of
-    ENext_ _ _ -> Nothing
-    e -> Just $ Exp e
-
-e &. f = maybe e f $ isNext e
-e >>=. f = isNext e >>= f
-
-msum' (x: xs) = fromMaybe (msum' xs) $ isNext x
-msum' _ = error "pattern match failure."
-
-reduceFail' msg = Nothing
-
--- full reduction
--- TODO! reduction under lambda needs alpha-conversion!
-reduce :: Exp -> Exp
-reduce = reduce_ False
-reduce_ lam e = reduceHNF_ lam e & \(Exp e) -> Exp $ case e of
---    ELam_ _ (PVar _ n) (EApp (Exp f) (EVar n')) | n == n' && n `Set.notMember` freeVars (Exp f) -> f
-    ELam_ a b c -> ELam_ (reduce_ lam <$> a) b (reduce_ True c)
---    ELet_ p x e -> ELet_ p x e
---    Forall_ a b c d -> Forall_ a b (reduce_ lam c) (reduce_ True d)
-    e -> reduce_ lam <$> e
-
--- don't reduce under lambda
-reduce' :: Exp -> Exp
-reduce' e = reduceHNF e & \(Exp e) -> case e of
-    ELam_ _ _ _ -> Exp e
-    Forall_ a b c d -> Exp e -- TODO: reduce c?
-    _ -> Exp $ reduce' <$> e
-
-reduceHNF :: Exp -> Exp       -- Left: pattern match failure
-reduceHNF = reduceHNF_ False
-
-isSTy = \case
-{-
-    TInt -> True
-    TBool -> True
-    TFloat -> True
-    TVec n t -> n `elem` [2,3,4] && t `elem` [TFloat, TBool, TInt]
-    TMat n m TFloat -> n `elem` [2,3,4] && n == m
--}
-    _ -> False
-
-reduceHNF_ lam (Exp exp) = case exp of
-
-    ELet_ p x e
-        | lam && isSTy (tyOf x) -> keep
-        | otherwise -> reduceHNF $ TApp (tyOf e) (ELam p e) x
-
-    PrimFun k (ExpN f) acc 0 -> evalPrimFun keep id k f $ map reduceHNF (reverse acc)
-
-    EAlts_ (map reduceHNF -> es) -> msum' $ es ++ error ("pattern match failure: " ++ ppShow es)
-    EApp_ _ f x -> reduceHNF f &. \(Exp f) -> case f of
-
-        PrimFun (TArr _ k) f acc i
-            | i > 0 -> reduceHNF $ Exp $ PrimFun k f (x: acc) (i-1)
---            | otherwise -> error $ "too much argument for primfun " ++ ppShow f ++ ": " ++ ppShow exp
-
-        EFieldProj_ _ fi -> reduceHNF x &. \case
-            ERecord fs -> case [e | (fi', e) <- fs, fi' == fi] of
-                [e] -> reduceHNF e
-            e -> case fi of
-                ExpN "x" -> case e of
-                    A4 "V4" x y z w -> x
-                    A3 "V3" x y z -> x
-                    A2 "V2" x y -> x
-                    _ -> keep
-                ExpN "y" -> case e of
-                    A4 "V4" x y z w -> y
-                    A3 "V3" x y z -> y
-                    A2 "V2" x y -> y
-                    _ -> keep
-                ExpN "z" -> case e of
-                    A4 "V4" x y z w -> z
-                    A3 "V3" x y z -> z
-                    _ -> keep
-                ExpN "w" -> case e of
-                    A4 "V4" x y z w -> w
-                    _ -> keep
-                _ -> keep
-
-        ELam_ _ p e -> bind' (pShow (p, getTag e)) (matchPattern (reduce' x) p) $ \case
-            Just m' -> reduceHNF $ subst m' e
-            _ -> keep
-        _ -> keep
-    _ -> keep
-  where
-    reduceHNF = reduceHNF_ lam
-
-    keep = Exp exp
-
-    bind' err e f = maybe (Exp $ ENext_ err $ tyOf keep) f e
-
-    -- TODO: make this more efficient (memoize reduced expressions)
-    matchPattern :: Exp -> Pat -> Maybe (Maybe Subst)       -- Left: pattern match failure; Right Nothing: can't reduce
-    matchPattern e = \case
-        Wildcard _ -> return $ Just mempty
-        PLit l -> e >>=. \case
-            ELit l'
-                | l == l' -> return $ Just mempty
-                | otherwise -> reduceFail' $ "literals doesn't match:" <+> pShow (l, l')
-            _ -> return Nothing
-        PVar _ v -> return $ Just $ singSubst' v e
-        PTuple ps -> e >>=. \e -> case e of
-            ETuple xs -> fmap mconcat . sequence <$> sequence (zipWith matchPattern xs ps)
-            _ -> return Nothing
-        PCon t c ps -> getApp [] e >>= \case
-            Just (c', xs)
-                | c == c' && length xs == length ps -> fmap mconcat . sequence <$> sequence (zipWith matchPattern xs ps)
-                | otherwise -> reduceFail' $ "constructors doesn't match:" <+> pShow (c, c')
-            _ -> return Nothing
-        p -> error $ "matchPattern: " ++ ppShow p
-      where
-        getApp acc e = e >>=. \e -> case e of
-            EApp a b -> getApp (b: acc) a
-            EVar n | isConstr n -> return $ Just (n, acc)
-            _ -> return Nothing
-
-evalPrimFun :: Exp -> (Exp -> Exp) -> Exp -> String -> [Exp] -> Exp
-evalPrimFun keep red k = f where
-    f "primIntToFloat" [EInt i] = EFloat $ fromIntegral i
-    f "primNegateFloat" [EFloat i] = EFloat $ negate i
-    f "PrimSin" [EFloat i] = EFloat $ sin i
-    f "PrimCos" [EFloat i] = EFloat $ cos i
-    f "PrimExp" [EFloat i] = EFloat $ exp i
-    f "PrimLog" [EFloat i] = EFloat $ log i
-    f "PrimAbs" [EFloat i] = EFloat $ abs i
-    f "PrimAddS" [EFloat i, EFloat j] = EFloat $ i + j
-    f "PrimSubS" [EFloat i, EFloat j] = EFloat $ i - j
-    f "PrimSubS" [EInt i, EInt j] = EInt $ i - j
-    f "PrimMulS" [EFloat i, EFloat j] = EFloat $ i * j
-    f "PrimDivS" [EFloat i, EFloat j] = EFloat $ i / j
-    f "PrimModS" [EInt i, EInt j] = EInt $ i `mod` j
-    f "PrimSqrt" [EInt i] = EInt $ round $ sqrt $ fromInteger i
-    f "PrimIfThenElse" [A0 "True",t,_] = red t
-    f "PrimIfThenElse" [A0 "False",_,e] = red e
-    f "PrimGreaterThan" [EFloat i, EFloat j] = if i > j then TVar TBool (ExpN "True") else TVar TBool (ExpN "False")
-    f "primCompareInt" [EInt i,EInt j] = Con0 Ordering (show $ compare i j)
-    f "primCompareNat" [ENat i,ENat j] = Con0 Ordering (show $ compare i j)
-    f "primCompareFloat" [EFloat i,EFloat j] = Con0 Ordering (show $ compare i j)
-    f "primCompareString" [EString i,EString j] = Con0 Ordering (show $ compare i j)
-    f _ _ = keep
-
-pattern Prim a b <- Exp (PrimFun _ (ExpN a) b 0)
-pattern Prim1 a b <- Prim a [b]
-pattern Prim2 a b c <- Prim a [c, b]
-pattern Prim3 a b c d <- Prim a [d, c, b]
-
--------------------------------------------------------------------------------- Pretty show instances
-
--- TODO: eliminate
-showN :: N -> String
-showN (N _ qs s _) = show $ hcat (punctuate (pShow '.') $ map text $ qs ++ [s])
-
-showVar (N q _ n (NameInfo _ i)) = pShow q <> text n <> "{" <> i <> "}"
-
-instance PShow N where
-    pShowPrec p = \case
-        N _ qs s (NameInfo _ i) -> hcat (punctuate (pShow '.') $ map text $ qs ++ [s]) -- <> "{" <> i <> "}"
-
-instance PShow NameSpace where
-    pShowPrec p = \case
-        TypeNS -> "'"
-        ExpNS -> ""
-
-instance Show ConName where show = ppShow
-instance PShow ConName where
-    pShowPrec p = \case
-        ConName n -> pShow n
---        ConLit l -> pShow l
-        TupleName i -> "Tuple" <> pShow i
-
---instance PShow IdN where pShowPrec p (IdN n) = pShowPrec p n
-
-instance PShow Lit where
-    pShowPrec p = \case
-        LInt    i -> pShow i
-        LChar   i -> text $ show i
-        LString i -> text $ show i
-        LFloat  i -> pShow i
-        LNat    i -> pShow i
-
---        Exp k i -> pInfix (-2) "::" p i k
-instance (PShow v, PShow p, PShow b) => PShow (Exp_ v p b) where
-    pShowPrec p = \case
-        EPrec_ e es -> pApps p e $ concatMap (\(a, b) -> [a, b]) es
-        ELit_ l -> pShowPrec p l
-        EVar_ k v -> pShowPrec p v
-        EApp_ k a b -> pApp p a b
-        ETyApp_ k a b -> pTyApp p a b
-        ETuple_ a -> tupled $ map pShow a
-        ELam_ Nothing p b -> pParens True ("\\" <> pShow p </> "->" <+> pShow b)
-        ELam_ _ p b -> pParens True ("\\" <> braces (pShow p) </> "->" <+> pShow b)
-        ETypeSig_ b t -> pShow b </> "::" <+> pShow t
-        ELet_ a b c -> "let" <+> pShow a </> "=" <+> pShow b </> "in" <+> pShow c
-        ENamedRecord_ n xs -> pShow n <+> showRecord xs
-        ERecord_ xs -> showRecord xs
-        EFieldProj_ k n -> "." <> pShow n
-        EAlts_ b -> braces (vcat $ punctuate (pShow ';') $ map pShow b)
-        Case_ t x xs -> "case" <+> pShow x <+> "of" </> vcat [pShow p <+> "->" <+> pShow e | (p, e) <- xs]
-        ENext_ info k -> "SKIP" <+> info
-        PrimFun k a b c -> "primfun" <+> pShow a <+> pShow b <+> pShow c
-
-        Star_ -> "*"
-        TCon_ k n -> pShow n
-        Forall_ Visible Nothing a b -> pInfixr' (-1) "->" p a b
-        Forall_ Irrelevant Nothing a b -> pInfixr' (-1) "==>" p a b
-        Forall_ Hidden Nothing a b -> pInfixr' (-1) "=>" p a b
-        Forall_ Visible (Just n) a b -> "forall" <+> pParens True (pShow n </> "::" <+> pShow a) <> "." <+> pShow b
-        Forall_ Irrelevant (Just n) a b -> "forall" <+> "." <> braces (pShow n </> "::" <+> pShow a) <> "." <+> pShow b
-        Forall_ Hidden (Just n) a b -> "forall" <+> braces (pShow n </> "::" <+> pShow a) <> "." <+> pShow b
-        TTuple_ a -> tupled $ map pShow a
-        TRecord_ m -> "Record" <+> showRecord (Map.toList m)
-        CEq_ a b -> pShow a <+> "~" <+> pShow b
-        CUnify_ a b -> pShow a <+> "~" <+> pShow b
-        Split_ a b c -> pShow a <+> "<-" <+> "(" <> pShow b <> "," <+> pShow c <> ")"
-        WRefl_ k -> "refl" <+> pShow k
-        TWildcard_ -> "twildcard"
-        FunAlts_ i as -> "alts" <+> pShow i </> vcat [hsep (map (hcat . intersperse "@" . map pShow) ps) <+> "->" <+> pShow t | (ps, t) <- as]
---- Int{-number of parameters-} [([ParPat b], GuardTree b)]
-
-getConstraints = \case
-    Exp (Forall_ (hidden -> True) n c t) -> ((n, c):) *** id $ getConstraints t
-    t -> ([], t)
-
-showConstraints cs x
-    = (case cs of [(Nothing, c)] -> pShow c; _ -> tupled (map pShow' cs)) 
-    </> "=>" <+> pShowPrec (-2) x
-  where
-    pShow' (Nothing, x) = pShow x
-    pShow' (Just n, x) = pShow n <+> "::" <+> pShow x
-
-instance PShow e => PShow (Pat' e) where
-    pShowPrec p = \case
-        PatVar v -> pShow v
-        PatLit l -> pShow l
-        PatCon n ps -> hsep $ pShow n: map pShow ps
-        PatPrec p ps -> hsep $ map pShow $ p: concatMap (\(x,y) -> [x,y]) ps
-        -- | ViewPat e (ParPat e)
-
-instance PShow e => PShow (GuardTree e) where
-    pShowPrec p = \case
-        GuardCon e c ps t -> pShow (PatCon c ps) <+> "<-" <+> pShow e <+> "->" <+> pShow t
-        GuardPat e p t -> pShow p <+> "<-" <+> pShow e <+> "->" <+> pShow t
-        -- GuardWhere (Binds e) (GuardTree e)
-        GuardAlts as -> braces $ vcat $ map pShow as
-        GuardExp e -> pShow e
-
-instance PShow Exp where
-    pShowPrec p = \case
-      (getConstraints -> (cs@(_:_), t)) -> showConstraints cs t
-      t -> case getLams t of
-        ([], Exp e) -> pShowPrec p e
-        (ps, Exp e) -> pParens (p > 0) $ "\\" <> hsep (map (pShowPrec 10) ps) </> "->" <+> pShow e
-      where
-        getLams (ELam p e) = (p:) *** id $ getLams e
-        getLams e = ([], e)
-
-instance (PShow c, PShow v, PShow b) => PShow (Pat_ t c v b) where
-    pShowPrec p = \case
-        PLit_ l -> pShow l
-        PVar_ t v -> pShow v
-        PCon_ t s xs -> pApps p s xs
-        PTuple_ a -> tupled $ map pShow a
-        PRecord_ xs -> "Record" <+> showRecord xs
-        PAt_ v p -> pShow v <> "@" <> pShow p
-        Wildcard_ t -> "_"
-        PPrec_ e es -> pApps p e $ concatMap (\(a, b) -> [a, b]) es
-
-instance PShow Pat where
-    pShowPrec p (Pat e) = pShowPrec p e
-
-instance (PShow n, PShow a) => PShow (TypeFun n a) where
-    pShowPrec p (TypeFun s xs) = pApps p s xs
-
-
-instance PShow TEnv where
-    pShowPrec p (TEnv e) = showRecord $ Map.toList e
-
-instance PShow Item where
-    pShowPrec p = eitherItem (\r -> (("Subst" <> if r then "!" else "") <+>) . pShow) (\rigid -> (("Sig" <> if rigid then "!" else "") <+>) . pShow)
-
-instance PShow Range where
-    pShowPrec p = \case
-        Range a b -> text (show a) <+> "--" <+> text (show b)
-        NoRange -> ""
-
-instance PShow Definition where
-    pShowPrec p = \case
-        DValueDef False (ValueDef False x _) -> "ValueDef" <+> pShow x
-        DValueDef False (ValueDef rec x _) -> "ValueDef rec" <+> pShow x
-        DValueDef True (ValueDef False x _) -> "ValueDef [instance]" <+> pShow x
-        DAxiom (TypeSig x _) -> "axiom" <+> pShow x
-        DDataDef n _ _ -> "data" <+> pShow n
-        GADT n _ _ -> "gadt" <+> pShow n
-        ClassDef _ n _ _ -> "class" <+> pShow n
-        InstanceDef _ n _ _ -> "instance" <+> pShow n
-        TypeFamilyDef n _ _ -> "type family" <+> pShow n
-    -- used only during parsing
-        PreValueDef (_, n) _ _ -> "pre valuedef" <+> pShow n
-        DTypeSig (TypeSig n _) -> "typesig" <+> pShow n
-        ForeignDef n _ -> "foreign" <+> pShow n
-        PrecDef n p -> "precdef" <+> pShow n
-
-instance PShow FixityDir where
-    pShowPrec p = \case
-        FDLeft -> "infixl"
-        FDRight -> "infixr"
-
--------------------------------------------------------------------------------- WriterT'
-
-class Monoid' e where
-    type MonoidConstraint e :: * -> *
-    mempty' :: e
-    mappend' :: e -> e -> MonoidConstraint e e
-
-newtype WriterT' e m a
-  = WriterT' {runWriterT' :: m (e, a)}
-    deriving (Functor,Foldable,Traversable)
-
-instance (Monoid' e) => MonadTrans (WriterT' e) where
-    lift m = WriterT' $ (,) mempty' <$> m
-
-instance forall m e . (Monoid' e, MonoidConstraint e ~ m, Monad m) => Applicative (WriterT' e m) where
-    pure a = WriterT' $ pure (mempty' :: e, a)
-    a <*> b = join $ (<$> b) <$> a
-
-instance (Monoid' e, MonoidConstraint e ~ m, Monad m) => Monad (WriterT' e m) where
-    WriterT' m >>= f = WriterT' $ do
-            (e1, a) <- m
-            (e2, b) <- runWriterT' $ f a
-            e <- mappend' e1 e2
-            return (e, b)
-
-instance (Monoid' e, MonoidConstraint e ~ m, MonadReader r m) => MonadReader r (WriterT' e m) where
-    ask = lift ask
-    local f (WriterT' m) = WriterT' $ local f m
-
-instance (Monoid' e, MonoidConstraint e ~ m, MonadWriter w m) => MonadWriter w (WriterT' e m) where
-    tell = lift . tell
-    listen = error "WriterT' listen"
-    pass = error "WriterT' pass"
-
-instance (Monoid' e, MonoidConstraint e ~ m, MonadState s m) => MonadState s (WriterT' e m) where
-    state f = lift $ state f
-
-instance (Monoid' e, MonoidConstraint e ~ m, MonadError err m) => MonadError err (WriterT' e m) where
-    catchError (WriterT' m) f = WriterT' $ catchError m $ runWriterT' <$> f
-    throwError e = lift $ throwError e
-
-mapWriterT' f (WriterT' m) = WriterT' $ f m
-
diff --git a/Typecheck.hs b/Typecheck.hs
deleted file mode 100644
index c8ecbc67..00000000
--- a/Typecheck.hs
+++ /dev/null
@@ -1,1052 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE FlexibleContexts #-} -- for ghc-7.10.1
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE RankNTypes #-}
-module Typecheck where
-
-import Data.Function
-import Data.List
-import Data.Maybe
-import Data.Either
-import Data.Monoid
-import Data.Foldable (Foldable, foldMap, toList, foldrM)
-import qualified Data.Traversable as T
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Control.Applicative
-import Control.Monad.Except
-import Control.Monad.State
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Monad.Identity
-import Control.Arrow hiding ((<+>))
-import Debug.Trace
-import GHC.Exts (Constraint)
-
-import Text.Parsec.Pos
-
-import Pretty
-import Type
-import Parser
-
---------------------------------------------------------------------------------
-
-trace'' _ x = x
-
-pairsWith f xs = zipWith f xs $ drop 1 xs
-
-unifyMaps_ :: (Ord a) => (a -> Doc) -> [Map a b] -> [WithExplanation [b]]
-unifyMaps_ f ms = {-case filter (not . Map.null) ms of
-    [] -> []
-    [m] -> []
-    ms -> -} map (f *** id) . filter (not . null . drop 1 . snd) . Map.toList . Map.unionsWith (++) . map ((:[]) <$>) $ ms
-
-unifyMaps :: (Ord a, PShow a) => [Map a b] -> [WithExplanation [b]]
-unifyMaps = unifyMaps_ pShow
-
-groupByFst :: (Ord a, PShow a) => [(a, b)] -> [WithExplanation [b]]
-groupByFst = unifyMaps . map (uncurry Map.singleton)
-
-matches TVar{} _ = True
-matches x ts = x `elem'` ts
-
-elem' a b = b a
-
-isRec TRecord{} = True
-isRec t = isVar t
-
-isVar TVar{} = True
-isVar _ = False
-
-nat234 (ENat i) = i `elem` [2..4]
-nat234 _ = False
-
-floatIntWordBool = \case
-    TFloat -> True
-    TInt -> True
-    TWord -> True
-    TBool -> True
-    _ -> False
-
-data InjType
-    = ITMat | ITVec | ITVecScalar
-    deriving (Show, Eq, Ord)
-
-instance PShow InjType where
-    pShowPrec p = text . show
-
-injType :: TypeFunT -> Maybe (InjType, [Exp])
-injType = \case
-    TFMat a b -> Just (ITMat, [a, b])
-    TFVec a b -> Just (ITVec, [a, b])
-    TFVecScalar a b -> Just (ITVecScalar, [a, b])
-    _ -> Nothing
-
-
-{- TODO
-  type family NoStencilRepr a :: *
-    type instance NoStencilRepr ZZ = ZZ
-    type instance NoStencilRepr (Stencil a :+: b) = NoStencilRepr b
-    type instance NoStencilRepr (Color a :+: b) = Color a :+: NoStencilRepr b
-    type instance NoStencilRepr (Depth a :+: b) = Depth a :+: NoStencilRepr b
--}
-
-{- currently not used
-  [injective] type family PrimitiveVertices (primitive :: PrimitiveType) a
-    type instance PrimitiveVertices Point a             = a
-    type instance PrimitiveVertices Line a              = (a,a)
-    type instance PrimitiveVertices LineAdjacency a     = (a,a,a,a)
-    type instance PrimitiveVertices Triangle a          = (a,a,a)
-    type instance PrimitiveVertices TriangleAdjacency a = (a,a,a,a,a,a)
--}
-{- currently not used
-  - texturing -
-  [semiinjective] type family TexDataRepr arity (t :: TextureSemantics *)
-    type instance TexDataRepr Red  (v a) = a
-    type instance TexDataRepr RG   (v a) = V2 a
-    type instance TexDataRepr RGB  (v a) = V3 a
-    type instance TexDataRepr RGBA (v a) = V4 a
-
-  [injective if (= SigleTex)] type family TexArrRepr (a :: Nat) :: TextureArray
-    --type instance TexArrRepr 1 = SingleTex
-    --type instance TexArrRepr ((2 <= t) => t) = ArrayTex
-    -- FIXME: implement properly
-    type instance TexArrRepr 1 = SingleTex
-    type instance TexArrRepr 2 = ArrayTex
-    type instance TexArrRepr 3 = ArrayTex
-    type instance TexArrRepr 4 = ArrayTex
-    type instance TexArrRepr 5 = ArrayTex
-    type instance TexArrRepr 6 = ArrayTex
-    type instance TexArrRepr 7 = ArrayTex
-    type instance TexArrRepr 8 = ArrayTex
-    type instance TexArrRepr 9 = ArrayTex
-
-  [semiinjective] type family TexSizeRepr (a :: TextureShape)
-    type instance TexSizeRepr (Tex1D)   = Word32
-    type instance TexSizeRepr (Tex2D)   = V2U
-    type instance TexSizeRepr (TexRect) = V2U
-    type instance TexSizeRepr (Tex3D)   = V3U
-
-  [injective in 4th param, semiinjective in 3rd param] type family TexelRepr sampler
-    type instance TexelRepr (Sampler dim arr (v t) Red)     = t
-    type instance TexelRepr (Sampler dim arr (v t) RG)      = V2 t
-    type instance TexelRepr (Sampler dim arr (v t) RGB)     = V3 t
-    type instance TexelRepr (Sampler dim arr (v t) RGBA)    = V4 t
--}
-
-
--------------------------------------------------------------------------------- constraints reduction
-
-type ConstraintSolvRes = (TEnv, [WithExplanation [Exp]])
-
-reduceConstraint :: IdN -> Exp -> TCM ConstraintSolvRes
-reduceConstraint a b = reduceConstraint_ a b b
-
-reduceConstraint_ :: forall m . (m ~ TCM) => IdN -> Exp -> Exp -> m ConstraintSolvRes
-reduceConstraint_ cvar orig x = do
-  builtinInstances <- asks instanceDefs
-  pe <- asks getPolyEnv
-  case x of
-    -- hack for swizzling; TODO: define Vec as a structural record instead
-    Split (TVec n a) c@TVar{} (TSingRecord s a') -> case n of
-        4 | s `elem` (map ExpN ["x","y","z","w"]) -> discard' [WithExplanation "vec-split" [a, a'], WithExplanation "vec-split'" [c, TVec 3 a]]
-        3 | s `elem` (map ExpN ["x","y","z"]) -> discard' [WithExplanation "vec-split" [a, a'], WithExplanation "vec-split'" [c, TVec 2 a]]
-        2 | s `elem` (map ExpN ["x","y"]) -> discard' [WithExplanation "vec-split" [a, a'], WithExplanation "vec-split'" [c, TVec 1 a]]
-        _ -> fail "bad swizzling"
-    Split (TRecord a) (TRecord b) (TRecord c) ->
-      case (Map.keys $ Map.intersection b c, Map.keys $ a Map.\\ (b <> c), Map.keys $ (b <> c) Map.\\ a) of
-        ([], [], []) -> discard' $ unifyMaps [a, b, c]
---        ks -> failure $ "extra keys:" <+> pShow ks
-    Split (TRecord a) (TRecord b) c@TVar{} -> diff a b c
-    Split (TRecord a) c@TVar{} (TRecord b) -> diff a b c
-    Split c@TVar{} (TRecord a) (TRecord b) -> case Map.keys $ Map.intersection a b of
-        [] -> discard' [WithExplanation "???" [c, TRecord $ a <> b]]
---        ks -> failure $ "extra keys:" <+> pShow ks
-    Split a b c
-        | isRec a && isRec b && isRec c -> nothing
---        | otherwise -> failure $ "bad split:" <+> pShow x
-
-    ctr@(getApp -> Just (c, ts))
-      | all isVar ts -> nothing
-      | otherwise -> case c of
-
-        IsTypeLevelNatural -> case ts of
-            [TNat{}] -> discard' []
-            _ -> noInstance
-
-        IsValidOutput -> discard' [] -- TODO
-
-        IsValidFrameBuffer -> case ts of
-            [TTuple ts]
-                | any isVar ts -> nothing
-                | sum [1 | Depth{} <- ts] <= 1 && sum [1 | Stencil{} <- ts] <= 1 -> discard' []
-                | otherwise -> noInstance
-            [_] -> discard' []
---            _ -> noInstance     -- impossible?
-
-        IsAttributeTuple -> case ts of
-            [TTuple ts]
-                | any isVar ts -> nothing
-                | length [() | a <- ts, Set.member a validAttributes] == length ts -> discard' []
-                | otherwise -> noInstance
-            [_] -> discard' []
-          where
-            validAttributes = Set.fromList $ [ TMat 2 2 TFloat, TMat 2 3 TFloat, TMat 2 4 TFloat
-                                             , TMat 3 2 TFloat, TMat 3 3 TFloat, TMat 3 4 TFloat
-                                             , TMat 4 2 TFloat, TMat 4 3 TFloat, TMat 4 4 TFloat
-                                             , TFloat, TInt, TWord, TBool
-                                             ] ++ concat [[TVec 2 a, TVec 3 a, TVec 4 a] | a <- [TFloat, TInt, TWord, TBool]]
-
-        _ -> findInstance (const nothing) cvar ctr
-      where
-        findInstance failure cvar ctr@(getApp -> Just (c, ts))
-            | all isVar ts = nothing
-            | otherwise = maybe nothing (findWitness failure cvar ctr) $ Map.lookup c builtinInstances
-        findInstance _ _ ctr = error $ "findInstance: " ++ ppShow ctr
-
-        findWitness failure' cvar tt m = do
-          let is :: [(Name, Exp)]
-              is = [(n, tyOfItem e) | n@(flip Map.lookup pe -> Just e) <- Map.keys m]
-
-          res <- trace'' (ppShow is) $ forM is $ \(n, t') -> catchExc $ do
-                (se_, (fn, t_)) <- runWriterT' $ do
-                    (fn, t'') <- toTCMS t'
-                    trace'' ("checking " ++ ppShow (t', (fn, t''), tt)) $ 
-                     addUnifOneDir t'' tt
-                    trace'' "ok" $ return (fn, t'')
-                css <- forM (zip fn $ subst (toSubst se_) fn) $ \case
-                    (TVar _ cc, TVar ctr _)  -> do
-                        (cs, []) <- findInstance failure cc ctr
-                        return cs
-                    _ -> return mempty
-                se <- joinSE $ se_: css
-                let x = subst (toSubst se) $ buildApp (`TVar` n) t_ fn
-                trace'' ("eer: " ++ ppShow (se, cvar, x)) $ return ((n, t'), (singSubst cvar x <> se, []))
-          case [x | Just x <- res] of
-            [x] -> return $ snd x
-            [] -> failure' $ msg' </> "possible instances:" </> pShow [x | (n, x) <- is]
-            ws -> failure $ msg' </> "overlapping instances:" </> pShow (map fst ws)
-          where
-            msg' = "no instance for" <+> pShow tt
-            noInstance = failure msg'
-
-        msg' = "no" <+> pShow c <+> "instance for" <+> pShow ts
-        noInstance = failure msg'
-
-    CUnify a b -> discard' [WithExplanation "~~~" [a, b]]
-
-    CEq res f -> case f of
-
-        TFMat (TVec n TFloat) (TVec m TFloat) -> reduced $ TMat n m TFloat
-        TFMat a b -> observe res $ \case
-            TMat n m t -> keep [WithExplanation "Mat res 1" [a, TVec n t], WithExplanation "Mat res 2" [b, TVec m t]]
-            _ -> fail "no instance"
-
-        TFVec (ENat n) ty | n `elem` [2,3,4] {- && ty `elem'` floatIntWordBool -} -> reduced $ TVec n ty
-        TFVec a b -> check (a `matches` nat234 && b `matches` floatIntWordBool {- -- FIXME -}) $ observe res $ \case
-            TVec n t -> keep [WithExplanation "Vec res 1" [a, ENat n], WithExplanation "Vec res 2" [b, t]]
-            _ -> fail "no instance tfvec"
-
-        TFVecScalar a b -> case a of
-            ENat 1 -> case b of
-                TVar{} | res `matches` floatIntWordBool -> keep [WithExplanation "VecScalar dim 1" [b, res]]
-                b -> check (b `elem'` floatIntWordBool) $ reduced b
-            TVar{} -> check (b `matches` floatIntWordBool) $ observe res $ \case
-                t | t `elem'` floatIntWordBool -> keep [WithExplanation "VecScalar res 1" [a, ENat 1], WithExplanation "VecScalar res 2" [b, t]]
-                TVec n t -> keep [WithExplanation "VecScalar res 1" [a, ENat n], WithExplanation "VecScalar res 2" [b, t]]
-                _ -> nothing --like $ TFVec a b
-            _ -> like $ TFVec a b
-
-        TFMatVecElem t -> observe t $ \case
-            TVec _ t -> reduced t
-            TMat _ _ t -> reduced t
-            _ -> fail $ "no instance matvecelem" <+> pShow t
-
-        TFMatVecScalarElem t -> observe t $ \case
-            t | t `elem'` floatIntWordBool -> reduced t
-            t -> like $ TFMatVecElem t
-
-        TFColorRepr ty -> observe ty $ \case
-            TTuple ts -> reduced . TTuple $ map Color ts
-            ty -> reduced $ Color ty
-
-        TFFTRepr' ty -> caseTuple "expected List/Interpolated/Depth/Color" ty (reduced . tTuple) $ \case
-            TInterpolated a -> reduce' a
-            Depth a         -> reduce' a
-            Color a         -> reduce' a
-            TList a         -> reduce' a
-            _ -> fail'
-
-        TFFragOps ty -> caseTuple "expected FragmentOperation" ty (reduced . tTuple) $ \case
-            TFragmentOperation a -> reduce' a
-            _ -> fail'
-
-        TFFrameBuffer ty -> caseTuple "expected (Image Nat)" ty end $ \case
-            TImage a b -> observe' a $ \case
-                ENat n -> reduce' (n, b)
-                _ -> fail'
-            _ -> fail'
-          where
-            end (unzip -> (n: ns, tys))
-                | all (==n) ns = reduced $ TFrameBuffer (ENat n) $ tTuple tys
-                | otherwise = fail "frambuffer number of layers differ"
-
-        TFJoinTupleType (TTuple []) x -> reduced x
-        TFJoinTupleType x (TTuple []) -> reduced x
-        TFJoinTupleType TVar{} _ -> nothing  -- TODO: observe res?
-        TFJoinTupleType _ TVar{} -> nothing  -- TODO: observe res?
-        TFJoinTupleType (TTuple l) (TTuple r) -> reduced $ TTuple (l ++ r)
-        TFJoinTupleType l (TTuple r) -> reduced $ TTuple (l : r)
-        TFJoinTupleType (TTuple l) r -> reduced $ TTuple (l ++ [r])
-        TFJoinTupleType l r -> reduced $ TTuple [l,r]
-
-        _ -> error $ "Unknown type function: " ++ ppShow f
-
-      where
-        like f = reduceConstraint_ cvar x (CEq res f)
-        reduced t = discard' [WithExplanation "type family reduction" [res, t]]
-        check b m = if b then m else fail "no instance (1)"
-        fail :: Doc -> m ConstraintSolvRes
-        fail = failure . (("error during reduction of" </> pShow res <+> "~" <+> pShow f) </>)
-
-        reduce' = Just . Just
-        nothing' = Just Nothing
-        fail' = Nothing
-        observe' TVar{} _ = nothing'
-        observe' x f = f x
-
-        caseTuple :: Doc -> Exp -> ([a] -> m ConstraintSolvRes) -> (Exp -> Maybe (Maybe a)) -> m ConstraintSolvRes
-        caseTuple msg ty end f = observe ty $ \case
-            TTuple ts -> maybe (fail $ msg <+> "inside tuple") (maybe nothing end . sequence) $ mapM f' ts
-            _ -> maybe (fail msg) (maybe nothing (end . (:[]))) $ f' ty
-          where f' x = observe' x f
-
-        tTuple [x] = x
-        tTuple xs = TTuple xs
-    _ -> nothing
-
-  where
-    diff a b c = case Map.keys $ b Map.\\ a of
-        [] -> discard' $ WithExplanation "???" [c, TRecord $ a Map.\\ b]: unifyMaps [a, b]
---        ks -> failure $ "extra keys:" <+> pShow ks
-    discard w xs = return (singSubst cvar w, xs)
-    discard' xs = discard (WRefl orig) xs
-    keep xs = return (mempty, xs)
-    failure :: Doc -> m ConstraintSolvRes
-    failure = throwErrorTCM
-
-    nothing = return mempty
-    observe TVar{} _ = nothing
-    observe x f = f x
-
---------------------------------------------------------------------------------
-
--- unify each types in the sublists
-unifyTypes :: forall m . (MonadPlus m, MonadState FreshVars m, MonadError ErrorMsg m) => Bool -> [WithExplanation [Exp]] -> m TEnv
-unifyTypes bidirectional tys = flip execStateT mempty $ forM_ tys $ sequence_ . pairsWith uni . snd
-  where
---    uni :: Exp -> Exp -> StateT TEnv TCM ()
-    uni a b = gets (subst1{-could be subst-} . toSubst) >>= \f -> unifyTy (f $ reduceHNF a) (f $ reduceHNF b)
-
-    -- make single tvar substitution; check infinite types
-    bindVar n t = do
-        s <- get
-        let t' = subst_ (toSubst s) t
-        if n `Set.member` freeVars t'
-            then throwErrorTCM $ "Infinite type, type variable" <+> pShow n <+> "occurs in" <+> pShow t'
-            else put $ singSubst n t' <> s
-
-    bindVars a@(TVar tu u) b@(TVar tv v) = case (compare u v, bidirectional) of
-        (EQ, _) -> return ()
-        (GT, True) -> bindVar v (TVar tu u)
-        _ -> bindVar u (TVar tv v)
-
---    unifyTy :: Exp -> Exp -> StateT Subst m ()
-    unifyTy (Exp t) (Exp t') = unifyTy' t t'
-      where
---        unifyTy' (Forall_ Hidden n a1 b1) x = maybe (lift $ newName "?") return n >>= \n -> put (singSubstTy_ n a1) >> uni b1 (Exp x)
---        unifyTy' x (Forall_ Hidden n a1 b1) = maybe (lift $ newName "?") return n >>= \n -> put (singSubstTy_ n a1) >> uni b1 (Exp x)
-        unifyTy' (Forall_ Visible (Just a) k t) (Forall_ Visible (Just a') k' t') = do
-            uni k k'
-            a'' <- lift $ newName "unifyTy"
-            modify $ TEnv . Map.insert a'' (ISig False k) . getTEnv
-            -- TODO! protect a in t
---            if ppShow a' == "t1755" then throwErrorTCM "!!!" else 
-            uni (subst (Subst $ Map.singleton a $ TVar k a'') t) ({-trace (ppShow (a', a, k)) $ -} subst (Subst $ Map.singleton a' $ TVar k a'') t')
-            --bindVars (TVar k a) (TVar k' a') >> uni t t'
-        unifyTy' (Forall_ Visible Nothing a1 b1) (Forall_ Visible Nothing a2 b2) = uni a1 a2 >> uni b1 b2
-        unifyTy' (EVar_ k u) (EVar_ k' v) = uni k k' >> bindVars (Exp t) (Exp t')
-        unifyTy' (EVar_ k u) _ = bindVar u (Exp t')
-        unifyTy' _ (EVar_ k v) | bidirectional = bindVar v (Exp t)
-        unifyTy' (ELit_ l) (ELit_ l') | l == l' = return ()
-        unifyTy' (TCon_ k u) (TCon_ k' v) | u == v = uni k k' >> return ()
-        unifyTy' (TTuple_ t1) (TTuple_ t2) = sequence_ $ zipWith uni t1 t2
-        unifyTy' (EApp_ k a1 b1) (EApp_ k' a2 b2) = uni k k' >> uni a1 a2 >> uni b1 b2
-        unifyTy' Star_ Star_ = return ()
-        unifyTy' (TRecord_ xs) (TRecord_ xs') | Map.keys xs == Map.keys xs' = sequence_ $ zipWith uni (Map.elems xs) (Map.elems xs')
-        unifyTy' (CUnify_ a b) (CUnify_ a' b') = uni a a' >> uni b b'   -- ???
-        unifyTy' (CEq_ a (TypeFun n b)) (CEq_ a' (TypeFun n' b')) | n == n' = uni a a' >> sequence_ (zipWith uni b b')   -- ???
-        unifyTy' (Split_ a b c) (Split_ a' b' c') = uni a a' >> uni b b' >> uni c c'   -- ???
-        unifyTy' (WRefl_ a) (WRefl_ b) = uni a b
-        unifyTy' _ _
-          | otherwise = throwError $ UnificationError (Exp t) (Exp t') $ filter (not . null . drop 1 . snd) tys
-
--- TODO: revise applications
-appSES :: (Substitute Subst x, PShow x, Monad m) => TypingT m x -> TypingT m x
-appSES = mapWriterT' $ fmap $ \(se, x) -> 
-   let
-    su = toSubst se
-   in (subst su $ TEnv $ Map.filter (eitherItem (\r _ -> not r) (\_ _ -> True)) $ getTEnv se, subst su x)
-
-removeMonoVars = mapWriterT' $ fmap $ \(en@(TEnv se), (s, x)) -> let
-        su = toSubst en
-    in (TEnv $ foldr Map.delete se $ {-map (subst' su) $ -} Set.toList s, subst su x)
-{-
-  where
-    subst' (Subst m) n | Just (EVar i) <- Map.lookup n m = i
-        | otherwise = n
--}
-runWriterT'' = runWriterT' . appSES
-
-closeSubst (TEnv m) = s where s = TEnv $ subst (toSubst s) <$> m
-
-joinSubsts :: [TEnv] -> TCM TEnv
-joinSubsts (map getTEnv -> ss) = case filter (not . Map.null) ss of
-  [] -> return mempty
-  [x] -> return $ TEnv x
-  ss -> do
-    s <- addCtx "joinSubsts" $ unifyTypes True $ concatMap ff $ unifyMaps ss
-    if nullTEnv s
-        then return $ closeSubst $ TEnv $ Map.unionsWith mergeSubsts ss
-        else joinSubsts [s, TEnv $ Map.unionsWith mergeSubsts ss]
-  where
-    ff (expl, ss) = case ( WithExplanation (expl <+> "subst") [s | ISubst _ s <- ss]
-                         , WithExplanation (expl <+> "typesig") [s | ISig rigid s <- ss]) of 
-        (WithExplanation _ [], ss) -> [ss]
-        (ss, WithExplanation _ []) -> [ss]
-        (subs@(WithExplanation i (s:_)), sigs@(WithExplanation i' (s':_))) -> [subs, sigs, WithExplanation ("subskind" <+> i <+> i') [tyOf s, s']]
-
-joinSE :: [TEnv] -> TCM TEnv
-joinSE ts = case ts of
-    [a, b]
-        | Map.null $ getTEnv a -> return b     -- optimization
-        | Map.null $ getTEnv b -> return a     -- optimization
-    ab -> swapRule <$> (joinSubsts ab >>= untilNoUnif)
-
-swapRule (TEnv te) = TEnv $ foldr f te vs
-  where
-    vs = [(v1, v2, t) | (v1, ISubst False (TVar t v2)) <- Map.toList te, v1 < v2]
-    f (v1, v2, t) m = case Map.lookup v2 m of
-        Just (ISubst True (TVar _ v))
-            | v == v1 -> Map.delete v1 m
-            | otherwise -> m
-        Just (ISig False _) -> Map.insert v2 (ISubst True $ TVar t v1) $ Map.delete v1 m
-        Nothing -> m
-
-writerT' x = WriterT' $ do
-    (me, t) <- x
-    me <- untilNoUnif me
-    return (me, t)
-
-addUnif, addUnifOneDir :: Exp -> Exp -> TCMS ()
-addUnif a b = addUnifs True [[a, b]]
-addUnifOneDir a b = addUnifs True [[a, b]]
-
-addUnifs :: Bool -> [[Exp]] -> TCMS ()
-addUnifs twodir ts = writerT' $ do
-    m <- addCtx "addUnifs" (unifyTypes twodir $ map (WithExplanation "~~~") ts)
-    return (m, ())
-
-untilNoUnif :: TEnv -> TCM TEnv
-untilNoUnif es = do
-    let cs = [(n, c) | (n, ISig False c) <- Map.toList $ getTEnv es]
-    (unzip -> (ss, concat -> eqs)) <- mapM (uncurry reduceConstraint) cs
-    s0 <- addCtx "untilNoUnif" $ unifyTypes True
-        -- unify left hand sides where the right hand side is equal:  (t1 ~ F a, t2 ~ F a)  -->  t1 ~ t2
-         $ groupByFst [(f, ty) | CEq ty f <- map snd cs]
-        -- injectivity test:  (t ~ Vec a1 b1, t ~ Vec a2 b2)  -->  a1 ~ a2, b1 ~ b2
-        ++ concatMap (\(s, l) -> map ((,) s) $ transpose l)
-                (groupByFst
-                [((ty, it), is) | CEq ty (injType -> Just (it, is)) <- map snd cs])
-        ++ eqs
-
-    -- (a :: Num X, b :: Num X) ----> a := TVar (Num X) b
-    let ff ((n, _):xs) = [(n, TVar c x) | (x, c) <- xs] 
-    let s1 = Subst $ Map.fromList $ concatMap (\(WithExplanation _ xs) -> ff xs) $ groupByFst [(x, (n, x)) | (n, x) <- cs, isConstraint x]
- --   trace ("---" ++ ppShow s1) $ 
-    if nullTEnv s0 && nullSubst s1 && all nullTEnv ss then return es else do
-        joinSubsts (s0: toTEnv s1: es: ss) >>= untilNoUnif
-
-isConstraint (getApp -> Just _) = True
-isConstraint _ = False
-
-instance Monoid' TEnv where
-    type MonoidConstraint TEnv = TCM
-    mempty' = mempty
-    mappend' a b = joinSE [a, b]
-
---------------------------------------------------------------------------------
-
-singSubstTy a b = addConstraints $ singSubstTy_ a b
-singSubstTy' a b = WriterT' $ pure (singSubstTy_ a b, ())
-
-newStarVar' :: Doc -> Name -> TCMS Exp
-newStarVar' i n = do
-    t <- newStarVar $ i <+> pShow n
-    singSubstTy' n t
-    return t
-
-newStarVar :: Doc -> TCMS Exp
-newStarVar i = newVar i Star
-
-newVar :: Doc -> Exp -> TCMS Exp
-newVar i k = do
-    n <- newName i
-    singSubstTy' n k
-    return $ TVar k n
-
-addConstraints m = writerT' $ pure (m, ())
-addConstraint c = newName "constraint" >>= \n -> singSubstTy n c
-
-checkStarKind Star = return ()
-checkStarKind t = addUnif Star $ tyOf t
-
-----------------------------
-
-instantiateTyping :: Doc -> TCMS Exp -> TCM Exp
-instantiateTyping i ty = do
-    (se, ty) <- runWriterT'' ty
-    x <- instantiateTyping_' False i se ty
-    return $ snd x
-
-
-lookEnv :: Name -> TCMS ([Exp], Exp) -> TCMS ([Exp], Exp)
-lookEnv n m = asks (Map.lookup n . getPolyEnv) >>= maybe m (toTCMS . tyOfItem)
-
-lookEnv' n m = asks (Map.lookup n . typeFamilies) >>= maybe m toTCMS
-
---------------------------------------------------------------------------------
-
-calcPrec
-  :: (MonadError ErrorMsg m, PShow e)
-     => (e -> e -> e -> e)
-     -> (e -> Name)
-     -> PrecMap
-     -> e
-     -> [(e, e)]
-     -> m e
-calcPrec app getname ps e es = do
-    compileOps [((Nothing, -1), undefined, e)] es
-  where
-    compileOps [(_, _, e)] [] = return e
-    compileOps acc [] = compileOps (shrink acc) []
-    compileOps acc@((p, g, e1): ee) es_@((op, e'): es) = case compareFixity (pr, op) (p, g) of
-        Right GT -> compileOps ((pr, op, e'): acc) es
-        Right LT -> compileOps (shrink acc) es_
-        Left err -> throwErrorTCM err
-      where
-        pr = fromMaybe --(error $ "no prec for " ++ ppShow n)
-                       (Just FDLeft, 9)
-                       $ Map.lookup (getname op) ps
-
-    shrink ((_, op, e): (pr, op', e'): es) = (pr, op', app op e' e): es
-
-    compareFixity ((dir, i), op) ((dir', i'), op')
-        | i > i' = Right GT
-        | i < i' = Right LT
-        | otherwise = case (dir, dir') of
-            (Just FDLeft, Just FDLeft) -> Right LT
-            (Just FDRight, Just FDRight) -> Right GT
-            _ -> Left $ "fixity error:" <+> pShow (op, op')
-
---------------------------------------------------------------------------------
-
-appTy (TArr ta v) ta' = addUnif ta ta' >> return v      -- optimalization
-appTy tf ta = newStarVar ("tapp" <+> pShow tf <+> "|" <+> pShow ta) >>= \v -> addUnif tf (ta ~> v) >> return v
-
-forallApp (Forall x k y) t = do
-    addUnif (tyOf t) k
-    return $ subst (Subst $ Map.singleton x t) y
-forallApp tt t = do -- ???
-    throwErrorTCM $ "can't unify" <+> pShow tt <+> "with" <+> "forall"
-{-
-    x' <- newName "forallApp"
-    y <- newStarVar "etyapp"
-    addUnif tt (Forall x' (tyOf t) y)
-    return y -- $ subst (Subst $ Map.singleton x $ TVar k x') y
--}
-
-
-getRes 0 x = Just ([], x)
-getRes i (TArr a b) = ((a:) *** id) <$> getRes (i-1) b
-getRes _ _ = Nothing
-
-starV (TVar t n) = monoInstType n t
-
-inferPatTyping :: Bool -> PatR -> TCMS (Pat, InstEnv)
-inferPatTyping polymorph p_@(PatR pt p) = addRange pt $ addCtx ("type inference of pattern" <+> pShow p_) $ case p of
-
-  PPrec_ e es -> do
-        ps <- asks precedences
-        inferPatTyping polymorph =<< calcPrec (\a b c -> appP' a [b, c]) (\(PCon' _ n []) -> n) ps e es
-
-  PVar_ _{-TODO-} n -> do
-        t <- newStarVar $ "pvar" <> pShow pt
-        return (PVar t n, monoInstType n t)
-  _ -> do
-    p <- traverse (inferPatTyping polymorph) p
-    (res, tr) <- case p of
-      PCon_ _{-TODO-} n ps -> do
-            (fn, tn) <- lookEnv n $ lift $ throwErrorTCM $ "Constructor" <+> pShow n <+> "is not in scope."
-            v <- case getRes (length ps) tn of
-                Just (ts, x) -> do
-                    addUnifs True $ zipWith (\a b -> [a, b]) ts $ map (tyOfPat . fst) ps
-                    return x
-                _ -> do
-                    v <- newStarVar "pcon"
-                    addUnif tn $ map (tyOfPat . fst) ps ~~> v
-                    return v
-            return (PCon v n $ [Pat $ PVar_ t n | TVar t n <- fn] ++ (fst <$> ps), mempty)
-
-      _ -> do
-       (t, tr) <- case tyOfPat . fst <$> p of
-        Wildcard_ _{-TODO-} -> noTr $ newStarVar ("_p" <> pShow pt)  >>= pure
-
-        PAt_ n p -> return (error "impossible patty", monoInstType n p)
-
-        PTuple_ ps -> {-mapM_ checkStarKind (map tyOf ps) >> -}return (error "impossible patty", mempty)
-
-        PRecord_ (unzip -> (fs, ps)) -> noTr $ do
-            v <- newStarVar "pfp2"
-            v' <- newStarVar "pfp3"
-            addConstraint $ Split v v' $ TRecord $ Map.fromList $ zip fs ps
-            return v
-
-        _ -> return (error "impossible patty", mempty)
-       return (Pat $ mapPat (const t) id id $ fst <$> p, tr)
-
-    let trs = Map.unionsWith (++) . map ((:[]) <$>) $ tr: map snd (toList p)
-    tr <- case filter (not . null . drop 1 . snd) $ Map.toList trs of
-        [] -> return $ Map.map head trs
-        ns -> lift $ throwErrorTCM $ "conflicting definitions for" <+> pShow (map fst ns)
-    return (res, tr)
-  where
-    noTr = addTr $ const mempty
-    addTr tr m = (\x -> (x, tr x)) <$> m
-
-eLam' (n, t) e = Exp $ ELam_ (Just $ Exp $ Forall_ Hidden (Just n) t $ tyOf e) (PVar t n) e
-
-inferType = inferType_ True True
-inferTyping = inferType_ True False
-
-info (Range i j) x = tell [(i, j, ppShow x)]
-info _ x = return ()
-
-withSE = mapWriterT' $ fmap $ \(se, x) -> (se, (se, x))
-
-addRange' msg = addRangeBy' msg id
-addRangeBy' msg f r m = addRange r $ do
-    (se, x) <- withSE m
-    addRange_ msg r se $ f x
-    return x
-
-addRangeBy f r m = addRange r $ do
-    x <- m
-    info r =<< typingToTy' (f x)
-    return x
-
-addRange_ msg r se x = info r =<< typingToTy msg se (tyOf x)
-
-unWhereAlts :: GuardTree Exp -> Maybe (Binds Exp, [GuardTree Exp])
-unWhereAlts = f [] where
-    f acc = \case
-        GuardWhere bs t -> f (acc ++ bs) t
-        GuardAlts xs -> g acc xs
-        x -> Just (acc, [x])
-
-    g acc [] = Nothing
-    g acc (x: xs) = case unWhereAlts x of
-        Nothing -> g acc xs
-        Just (wh, ts) -> Just (acc ++ wh, ts ++ xs)
-
-undef :: Exp
-undef = eVar mempty $ ExpN "undefined"
-
-where_ :: Binds Exp -> Exp -> Exp
-where_ bs a = foldr ($) a [ELet p e | (p, e) <- bs]
-
-contable :: ConName -> TCMS [(ConName, Int)]
-contable (TupleName i) = return [(TupleName i, i)]
-contable (ConName n) = asks (Map.lookup n . constructors) >>= \case
-    Nothing -> error $ "contable: " ++ ppShow n
-    Just x -> return $ map (ConName *** id) x
-
-
-guardNode :: Exp -> ParPat Exp -> GuardTree Exp -> GuardTree Exp
-guardNode v [] e = e
-guardNode v (w: ws) e = case w of
-    PatVar x -> guardNode v ws {-(subst d ws)-} $ subst d e
-        where d = Subst $ Map.singleton x v
-    ViewPat f p -> guardNode (eApp f v) p $ guardNode v ws e
-    PatCon s ps' -> GuardCon v s ps' $ guardNode v ws e
-    PatLit l -> GuardCon (compareLit l v) (ConName $ ExpN "EQ") [] $ guardNode v ws e
-    PatPrec p ps -> error $ "guardNode: " ++ ppShow (p, ps)
-
-compareLit :: Lit -> Exp -> Exp
-compareLit l e = eApp (Exp $ PrimFun (inferLit l ~> Ordering) n [ELit l] 1) e where
-    n = case l of
-        LInt{} -> ExpN "primCompareInt"
-        LFloat{} -> ExpN "primCompareFloat"
-        LNat{} -> ExpN "primCompareNat"
-        LString{} -> ExpN "primCompareString"
-
-computePatPrec t = do
-    precs <- asks precedences
-    let
-        f = \case
-            GuardPat e p t -> guardNode e <$> comp p <*> f t
-            GuardCon e n ps t -> GuardCon e n <$> mapM comp ps <*> f t
-            GuardWhere bs t -> GuardWhere bs <$> f t
-            GuardAlts ts -> GuardAlts <$> mapM f ts
-            GuardExp e -> return $ GuardExp e
---        comp :: ParPat Exp -> ParPat Exp
-        comp = concatMapM $ \case
-            PatVar n -> return [PatVar n]
-            PatLit n -> return [PatLit n]
-            PatCon n ps -> (:[]) . PatCon n <$> mapM comp ps
-            ViewPat e p -> (:[]) . ViewPat e <$> comp p
---            PatPrec e es | any null (e: map snd es) -> return []
-            PatPrec e es -> do
-                e' <- comp e
-                es' <- mapM (\(a,b) -> (,) <$> comp a <*> comp b) es
-                calcPrec (\a b c -> appP' a [b, c]) (\[PatCon (ConName n) []] -> n) precs e' es'
-
-        appP' [PatCon n []] ps = [PatCon n ps]
-        appP' p ps = error $ "appP' " ++ ppShow (p, ps)
-
-      in f t
-
-concatMapM f x = concat <$> mapM f x
-
--- TODO: eliminate
-case_ :: Exp -> [(ConName, [Name], Exp)] -> Maybe Exp
-case_ e [] = Nothing
-case_ e as = Just $ {- Exp $ Case_ TWildcard e -} compileCasesOld mempty e
-    [ (case c of
-        TupleName i -> PatR mempty $ PTuple_ vs
-        ConName c -> PCon' mempty c vs
-      , e)
-    | (c, ns, e) <- as
-    , let vs = map (PVar' mempty) ns
-    ]
-
-guardTreeToCases :: GuardTree Exp -> TCMS (Maybe{-workaround-} Exp)
-guardTreeToCases t = case unWhereAlts t of
-    Nothing -> return Nothing
-    Just (wh, GuardExp e: _) -> return $ Just $ where_ wh e
-    Just (wh, cs@(GuardCon f s _ _: _)) -> do
-      ct <- contable s
-      fmap (where_ wh) . case_ f . catMaybes <$> sequence
-        [ do
-            ns <- forM [1..cv] $ \j -> newName $ "cparam" <> pShow j <> "_"
-            fmap (fmap ((,,) cn ns)) $ guardTreeToCases $ GuardAlts $ map (filterGuardTree f cn ns) cs
-        | (cn, cv) <- ct
-        ]
-    e -> error $ "gtc: " ++ ppShow e
-
-filterGuardTree :: Exp -> ConName -> [Name] -> GuardTree Exp -> GuardTree Exp
-filterGuardTree f s ns = \case
-    GuardWhere bs t -> GuardWhere bs $ filterGuardTree f s ns t        -- TODO: shadowing
-    GuardAlts ts -> GuardAlts $ map (filterGuardTree f s ns) ts
-    GuardExp e -> GuardExp e
-    GuardCon f' s' ps gs
-        | f /= f'   -> GuardCon f' s' ps $ filterGuardTree f s ns gs
-        | s == s'   -> filterGuardTree f s ns $ guardNodes' (zip (map (eVar mempty) ns) ps) gs
-        | otherwise -> GuardAlts []
-
-guardNodes' :: [(Exp, ParPat Exp)] -> GuardTree Exp -> GuardTree Exp
-guardNodes' [] l = l
-guardNodes' ((v, ws): vs) e = guardNode v ws $ guardNodes' vs e
-
-compileAlts :: Int -> [([ParPat Exp], GuardTree Exp)] -> TCMS Exp
-compileAlts i as = do
-    vs <- forM [1..i] $ \j -> newName $ "param" <> pShow j <> "_"
-    flip (foldr eLam) (map (pVar mempty) vs) <$> (computePatPrec >=> fmap (fromMaybe undef) . guardTreeToCases) (toGuardTree (map (eVar mempty) vs) as)
-
-inferType_ :: Bool -> Bool -> ExpR -> TCMS Exp
-inferType_ addcst allowNewVar e_@(ExpR r e) = addRange' (pShow e_) r $ addCtx ("type inference of" <+> pShow e) $ appSES $ case e of
-    FunAlts_ i as -> infer =<< compileAlts i as
-
-    EPrec_ e es -> do
-        ps <- asks precedences
-        infer =<< calcPrec (\a b c -> application [a, b, c]) (\(EVarR' _ n) -> n) ps e es
-    -- hack
-    ENamedRecord_ n (unzip -> (fs, es)) ->
-        inferTyping $ foldl (EAppR' mempty) (EVarR' mempty n) es
-
-    Case_ TWildcard e cs -> do
-        e <- infer e
-        cs <- forM cs $ \(p, f) -> do
-            (se, (p, tr)) <- lift $ runWriterT' $ inferPatTyping False p
-            addConstraints se
-            f <- addCtx "?" $ withTyping (tr <> (tyOfItem <$> getTEnv se)) $ inferTyping f
-            return (p, f)
-        let te = tyOf e
-            tp = map (\(p, x) -> tyOfPat p ~> tyOf x) cs
-        addUnifs True [tp]
-        t <- appTy (head tp) te
-        return $ Exp $ Case_ t e cs
-
-    ELam_ h p f -> {-mapWriterT' (fmap $ \(se, x) -> trace (" -- " ++ ppShow p ++ ppShow se) (se, x) ) $ -} do
-        h <- traverse infer h
-        (se, (p, tr)) <- lift $ runWriterT' $ inferPatTyping False p
-        addConstraints se
-        f <- addCtx "?" $ withTyping (tr <> (tyOfItem <$> getTEnv se)) $ inferTyping f
-        case h of
-            Just t -> removeMonoVars $ do
-                n <- newName $ "?" <> pShow p <> pShow r
-                let t' = Exp $ Forall_ Hidden (Just n) (tyOfPat p) (tyOf f)
-                    tp = tyOfPat p
-                addUnif t t'
-                singSubstTy n tp
-                return (Set.singleton n, Exp $ ELam_ (Just t') p f)
-            Nothing -> return $ Exp $ ELam_ Nothing p f
-
-    ELet_ p@(PVar' _ n) x_ e -> do
-        (se, x) <- lift $ do
-            (se, x) <- runWriterT'' $ inferTyping x_
-            let (se', se'') = splitEnv se
-            (fs, it) <- addRange (getTag x_) $ addCtx "let" $ instantiateTyping_' True (pShow n) se' $ tyOf x
-            return (se'', foldr eLam' x fs)
---            addRange_ ("var" <+> pShow n) (getTag p `mappend` getTag x_) se x
-        addConstraints $ TEnv $ Map.filter (eitherItem (\r -> const $ not r) (\_ -> const False)) $ getTEnv se
-        e <- withTyping (Map.singleton n $ tyOf x) $ inferTyping e
-        return $ ELet (PVar (tyOf x) n) x e
-    ELet_ p x e -> infer $ ExpR mempty $ EApp_ TWildcard (ExpR mempty $ ELam_ Nothing p e) x             -- monomorph let; TODO
-    ETypeSig_ e ty -> do
-        e <- inferTyping e
-        ty <- inferType ty
-        addUnifOneDir (tyOf e) ty
-        return e
-    ETyApp_ TWildcard f t -> do
-        f <- inferTyping f
-        t <- inferType t
-        v <- forallApp (tyOf f) t
-        return $ TApp v f t
-
-    Forall_ h (Just n) k t -> removeMonoVars $ do
-        k <- inferType k
-        singSubstTy n k
-        t <- withTyping (monoInstType n k) $ inferType t
-        return $ (,) (Set.fromList [n]) $ Exp $ Forall_ h (Just n) k t
-
-    EVar_ TWildcard n -> do
-        (ty, t) <- lookEnv n $ if allowNewVar
-                then newStarVar' "tvar" n >>= \t -> return ([], t)
-                else throwErrorTCM $ "Variable" <+> pShow n <+> "is not in scope."
-        return $ buildApp (`TVar` n) t ty
-
-    TCon_ TWildcard n -> do
-        (fn, t) <- lookEnv n $ lookLifted $ throwErrorTCM $ "Type constructor" <+> pShow n <+> "is not in scope."
-        return $ buildApp (Exp . (`TCon_` n)) t fn
-      where
-        lookLifted = if isTypeVar n then lookEnv (toExpN n) else id
-
-    EApp_ TWildcard tf_ ta_ -> do
-        tf <- infer tf_
-        ta <- infer ta_
-        t <- appTy (tyOf tf) (tyOf ta)
-        return $ Exp $ EApp_ t tf ta
-
-    TWildcard_ -> newStarVar $ "_e" <> pShow r
-
-    _ -> do
-        e <- mapExp_ id (error "infertype") <$> traverse infer e
-        case e of
-            EFieldProj_ t fn -> do
-                a <- newStarVar "fp1"
-                r <- newStarVar "fp2"
-                r' <- newStarVar "fp3"
-                addConstraint $ Split r r' $ TRecord $ Map.singleton (IdN fn) a
-                addUnif t $ r ~> a
-
-            EAlts_ xs -> addUnifs True [map tyOf xs]
-            TTuple_ ts -> mapM_ checkStarKind ts
-
-            CEq_ (tyOf -> t) (TypeFun f (map tyOf -> ts)) -> do
-                (_, tf) <- lookEnv' f $ throwErrorTCM $ "Type family" <+> pShow f <+> "is not in scope."
-                addUnif tf $ ts ~~> t
-
-            Forall_ _ Nothing a b -> checkStarKind a >> checkStarKind b
-
-            x -> return ()
-        case e of
-            Forall_ (hidden -> True) Nothing c b | addcst -> do
-                addConstraint c
-                return b
-            e -> return $ Exp e
-  where
-    infer = inferType_ addcst allowNewVar
-
---------------------------------------------------------------------------------
-
-tyConKind :: [ExpR] -> TCM Exp
-tyConKind = tyConKind_ $ ExpR mempty Star_
-
-tyConKind_ :: ExpR -> [ExpR] -> TCM Exp
-tyConKind_ res vs = instantiateTyping "tyconkind" $ inferType $ foldr (\a b -> ExpR' $ Forall_ Visible Nothing a b) res vs
-
-inferConDef :: Name -> [(Name, ExpR)] -> WithRange ConDef -> TCM InstEnv
-inferConDef con ks (r, ConDef n tys) = addRange r $ do
-    ty <- instantiateTyping (pShow con) $ inferType $ foldr
-            (\(vn, vt) b -> ExpR' $ Forall_ Irrelevant (Just vn) vt b)
-            (foldr (\a b -> ExpR' (Forall_ Visible Nothing a b)) (tyConResTy con $ map fst ks) [t | FieldTy _ t <- tys])
-            ks
-    return $ Map.singleton n ty
-
-inferConDef' :: Name -> [(Name, ExpR)] -> WithRange (Name, ConDef') -> TCM InstEnv
-inferConDef' con ks (r, (n, ConDef' ctx tys res)) = addRange r $ do
-    ty <- instantiateTyping (pShow con) $ inferType $ {-foldr
-            (\(vn, vt) b -> ExpR' $ Forall_ Irrelevant (Just vn) vt b)-}
-            (foldr
-                (\(n, a) b -> ExpR' (maybe (Forall_ Hidden Nothing) (Forall_ Visible . Just) n a b))
-                (foldr (\a b -> ExpR' (Forall_ Visible Nothing a b)) res [t | FieldTy _ t <- tys])
-                ctx
-            )
-     {-       $ filter (not . (`elem` map fst ctx) . Just . fst)
-             ks -}
-    return $ Map.singleton n ty
-
-tyConResTy con vn
-    = application $ (ExpR' $ TCon_ TWildcard con): map (ExpR' . EVar_ TWildcard) vn
-tyConResTy' con vn
-    = application $ (ExpR' $ TCon_ TWildcard con): vn
-
-selectorDefs :: DefinitionR -> [DefinitionR]
-selectorDefs (r, DDataDef n _ cs) =
-    [ (r, DValueDef False $ ValueDef False
-      ( PatR' $ PVar_ TWildcard sel)
-      ( ExpR' $ ELam_ (if ctx then Just TWildcard else Nothing)
-            (PatR' $ PCon_ TWildcard cn
-                [ if i == j then PVar' mempty (ExpN "x") else PatR mempty (Wildcard_ TWildcard)
-                | (j, _) <- zip [0..] tys]
-            )
-            (EVarR' mempty $ ExpN "x")
-      ))
-    | (rc, ConDef cn tys) <- cs
-    , (i, FieldTy (Just (sel, ctx)) t) <- zip [0..] tys
-    ]
-selectorDefs (r, GADT n _ cs) =
-    [ (r, DValueDef False $ ValueDef False
-      ( PatR' $ PVar_ TWildcard sel)
-      ( ExpR' $ ELam_ (if ctx then Just TWildcard else Nothing)
-            (PatR' $ PCon_ TWildcard cn
-                [ if i == j then PVar' mempty (ExpN "x") else PatR mempty (Wildcard_ TWildcard)
-                | (j, _) <- zip [0..] tys]
-            )
-            (EVarR' mempty $ ExpN "x")
-      ))
-    | (rc, (cn, ConDef' _ctx' tys _res)) <- cs
-    , (i, FieldTy (Just (sel, ctx)) t) <- zip [0..] tys
-    ]
-
---inferDef :: ValueDefR -> TCM (TCM a -> TCM a)
-inferDef (ValueDef True p e)
-    = inferDef $ ValueDef False p $ application [EVarR' mempty fixName, ExpR' $ ELam_ Nothing p e]
-inferDef (ValueDef False p@(PVar' _ n) e) = do
-    (se, exp) <- runWriterT' $ inferTyping e
-    (fs, f) <- addCtx ("inst" <+> pShow p) $ instantiateTyping_' True (pShow p) se $ tyOf exp
-    the <- asks getPolyEnv
-    let th = subst ( toSubst (TEnv the)
-                   )
-           $ flip (foldr eLam') fs exp
-    return (n, th)
-inferDef (ValueDef _ p e) = error $ "inferDef: " ++ ppShow p
-
-classDictName = toExpN . addPrefix "Dict"
-
-withThunk n th = addPolyEnv $ emptyPolyEnv {getPolyEnv = Map.singleton n $ ISubst True th}
-
-inferDefs :: [DefinitionR] -> TCM PolyEnv
-inferDefs [] = ask
-inferDefs (dr@(r, d): ds@(inferDefs -> cont)) = {-addRange r $ -}case d of
-    PrecDef n p -> addPolyEnv (emptyPolyEnv {precedences = Map.singleton n p}) cont
-    DValueDef inst d -> do
-        (n, th) <- addRangeBy (\(_,th) -> envType *** id $ toEnvType $ tyOf th) r $ inferDef d
-        withThunk n th . (if inst then addInstance n $ tyOf th else id) $ cont
-    TypeFamilyDef con vars res -> do
-        tk <- tyConKind_ res $ map snd vars
-        addPolyEnv (emptyPolyEnv {typeFamilies = Map.singleton con tk}) cont
-    DAxiom (TypeSig n t) -> do
-        t <- instantiateTyping (pShow n) $ inferType t
-        let res (Exp (Forall_ _ _ a b)) = res b
-            res t = t
-            n' = (if isStar $ res t then toTypeN else id) n
-            isPrim (ExpN s) = take 4 s `elem` ["prim", "Prim"]
-            arity = f t where
-                f (Exp (Forall_ h _ _ x)) = (case h of Visible -> 1; _ -> 0) + f x
-                f _ = 0
-            f | isPrim n = withThunk n $ Exp $ PrimFun t n [] arity
-              | otherwise = withTyping $ Map.singleton n' t
-        f cont
-    GADT con vars cdefs -> do
-        tk <- tyConKind $ map snd vars
-        let as = [(n, length ps) | (_, (n, ConDef' _ ps _)) <- cdefs]
-        withTyping (Map.singleton con tk) $ addPolyEnv (emptyPolyEnv {constructors = Map.fromList $ zip (map fst as) $ repeat as }) $ do
-            ev <- mapM (inferConDef' con vars) cdefs
-            withTyping (mconcat ev) $ inferDefs $ selectorDefs dr ++ ds
-    DDataDef con vars cdefs -> do
-        tk <- tyConKind $ map snd vars
-        let as = [(n, length ps) | (_, ConDef n ps) <- cdefs]
-        withTyping (Map.singleton con tk) $ addPolyEnv (emptyPolyEnv {constructors = Map.fromList $ zip (map fst as) $ repeat as }) $ do
-            ev <- mapM (inferConDef con vars) cdefs
-            withTyping (mconcat ev) $ inferDefs $ selectorDefs dr ++ ds
-
-    ClassDef ctx{-TODO-} con vars cdefs -> inferDefs $ (r, d'): ds
-      where
-        d' = DDataDef con vars
-                [WithRange mempty $ ConDef (classDictName con) [FieldTy (Just (n, True)) t | TypeSig n t <- cdefs]]
-
-    InstanceDef ctx con vars xs -> inferDefs $ (r, d'): ds
-      where
-        iname = addPrefix "instance" $ ExpN $ ppShow $ application $ ExpR' (EVar_ TWildcard con): vars
-        d' = DValueDef True $ ValueDef True (PatR' $ PVar_ TWildcard iname) $
-                ExpR' $ ETypeSig_
-                    (application $ (ExpR' $ EVar_ TWildcard $ classDictName con): [e | ValueDef _ (PVar' _ n{-TODO-}) e <- xs])
-                    (tyConResTy' con vars)
-
-    _ -> error $ "inferDefs: " ++ ppShow d
-
-inference_ :: PolyEnv -> ModuleR -> ErrorT (WriterT Infos (VarMT Identity)) PolyEnv
-inference_ penv@PolyEnv{..} Module{..} = do
-    resetVars
-    ExceptT $ mapWriterT (fmap $ (id +++ diffEnv) *** id) (runExceptT $ flip runReaderT penv $ addPolyEnv startPolyEnv $ inferDefs definitions)
-  where
-    diffEnv (PolyEnv i g c p tf _) = PolyEnv
-        (Map.differenceWith (\a b -> Just $ a Map.\\ b) i instanceDefs)
-        (g Map.\\ getPolyEnv)
-        (c Map.\\ constructors)
-        (p Map.\\ precedences)
-        (tf Map.\\ typeFamilies)
-        mempty --infos
-
diff --git a/prototypes/create-test-report.sh b/create-test-report.sh
index 4d26467a..4d26467a 100755
--- a/prototypes/create-test-report.sh
+++ b/create-test-report.sh
diff --git a/lambdacube-compiler.cabal b/lambdacube-compiler.cabal
index 7ce26001..89ff5798 100644
--- a/lambdacube-compiler.cabal
+++ b/lambdacube-compiler.cabal
@@ -2,40 +2,36 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                lambdacube-compiler
-version:             0.1.0.0
--- synopsis:            
--- description:         
+version:             0.2.0.0
 homepage:            lambdacube3d.com
 license:             BSD3
 license-file:        LICENSE
 author:              Csaba Hruska, Peter Divianszky
 maintainer:          csaba.hruska@gmail.com
--- copyright:           
 category:            Graphics
 build-type:          Simple
--- extra-source-files:  
 cabal-version:       >=1.10
 
+Flag profiling
+  Description: Enable profiling
+  Default: False
+
 library
   -- indentation parser modules
   exposed-modules:   Text.Parser.Indentation.Implementation,
                      Text.Parsec.Indentation,
                      Text.Parsec.Indentation.Char,
                      Text.Parsec.Indentation.Token
-
   exposed-modules:
     -- Compiler
     Pretty
-    Type
-    Typecheck
-    Parser
-    ParserUtil
     IR
     Linear
     CoreToIR
     CoreToGLSL
+    Infer
+    CGExp
     Driver
-  -- other-modules:
   other-extensions:
     LambdaCase
     PatternSynonyms
@@ -57,28 +53,41 @@ library
     ParallelListComp
   build-depends:
     -- compiler
+    aeson >= 0.9 && <1,
     base >=4.7 && <4.9,
     containers >=0.5 && <0.6,
+    deepseq,
     directory,
+    exceptions >= 0.8 && <0.9,
     filepath,
     mtl >=2.2 && <2.3,
     parsec >= 3.1 && <3.2,
     pretty-compact >=1.0 && <1.1,
-    exceptions >= 0.8 && <0.9,
-    deepseq,
-    vector >= 0.11 && <0.12,
-    aeson >= 0.9 && <1,
-    text >= 1.2 && <1.3
+    text >= 1.2 && <1.3,
+    vector >= 0.11 && <0.12
   hs-source-dirs:      .
   default-language:    Haskell2010
 
---test-suite runtests
---  type:             exitcode-stdio-1.0
---  hs-source-dirs:   tests
---  main-is:          runTests.hs
---
---  build-depends:    base < 4.9
---                  , filepath
---                  , directory
---                  , lambdacube-dsl
---  default-language:    Haskell2010
+executable lambdacube-compiler-test-suite
+  hs-source-dirs:   .
+  main-is:          runTests.hs
+
+  build-depends:
+    aeson >= 0.9 && <1,
+    base < 4.9,
+    containers >=0.5 && <0.6,
+    deepseq,
+    directory,
+    exceptions >= 0.8 && <0.9,
+    filepath,
+    mtl >=2.2 && <2.3,
+    lambdacube-compiler,
+    parsec >= 3.1 && <3.2,
+    pretty-compact >=1.0 && <1.1,
+    text >= 1.2 && <1.3,
+    vector >= 0.11 && <0.12
+  default-language:    Haskell2010
+  if flag(profiling)
+    GHC-Options: -O2 -fhpc -hpcdir dist/hpc/lambdacube-compiler -prof -fprof-auto -rtsopts
+  else
+    GHC-Options: -O2 -fhpc -hpcdir dist/hpc/lambdacube-compiler
diff --git a/prototypes/CoreToGLSL.hs b/prototypes/CoreToGLSL.hs
deleted file mode 120000
index b9ebdd27..00000000
--- a/prototypes/CoreToGLSL.hs
+++ /dev/null
@@ -1 +0,0 @@
-../CoreToGLSL.hs
\ No newline at end of file
diff --git a/prototypes/CoreToIR.hs b/prototypes/CoreToIR.hs
deleted file mode 120000
index 7f32ac4d..00000000
--- a/prototypes/CoreToIR.hs
+++ /dev/null
@@ -1 +0,0 @@
-../CoreToIR.hs
\ No newline at end of file
diff --git a/prototypes/Driver.hs b/prototypes/Driver.hs
deleted file mode 120000
index 882f3164..00000000
--- a/prototypes/Driver.hs
+++ /dev/null
@@ -1 +0,0 @@
-../Driver.hs
\ No newline at end of file
diff --git a/prototypes/IR.hs b/prototypes/IR.hs
deleted file mode 120000
index ae04b92e..00000000
--- a/prototypes/IR.hs
+++ /dev/null
@@ -1 +0,0 @@
-../IR.hs
\ No newline at end of file
diff --git a/prototypes/Linear.hs b/prototypes/Linear.hs
deleted file mode 120000
index 5f80cf33..00000000
--- a/prototypes/Linear.hs
+++ /dev/null
@@ -1 +0,0 @@
-../Linear.hs
\ No newline at end of file
diff --git a/prototypes/Parser.hs b/prototypes/Parser.hs
deleted file mode 100644
index 75a3a722..00000000
--- a/prototypes/Parser.hs
+++ /dev/null
@@ -1 +0,0 @@
-module Parser where
diff --git a/prototypes/Pretty.hs b/prototypes/Pretty.hs
deleted file mode 120000
index eb36e481..00000000
--- a/prototypes/Pretty.hs
+++ /dev/null
@@ -1 +0,0 @@
-../Pretty.hs
\ No newline at end of file
diff --git a/prototypes/Text b/prototypes/Text
deleted file mode 120000
index 4ea788ba..00000000
--- a/prototypes/Text
+++ /dev/null
@@ -1 +0,0 @@
-../Text
\ No newline at end of file
diff --git a/prototypes/Type.hs b/prototypes/Type.hs
deleted file mode 100644
index 8e1e6af5..00000000
--- a/prototypes/Type.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-module Type ( module CGExp ) where
-import CGExp
diff --git a/prototypes/Typecheck.hs b/prototypes/Typecheck.hs
deleted file mode 100644
index dc82a9a0..00000000
--- a/prototypes/Typecheck.hs
+++ /dev/null
@@ -1 +0,0 @@
-module Typecheck where
diff --git a/prototypes/lambdacube-compiler.cabal b/prototypes/lambdacube-compiler.cabal
deleted file mode 100644
index 76d26c98..00000000
--- a/prototypes/lambdacube-compiler.cabal
+++ /dev/null
@@ -1,96 +0,0 @@
--- Initial lambdacube-dsl.cabal generated by cabal init.  For further 
--- documentation, see http://haskell.org/cabal/users-guide/
-
-name:                lambdacube-compiler
-version:             0.2.0.0
-homepage:            lambdacube3d.com
-license:             BSD3
-license-file:        LICENSE
-author:              Csaba Hruska, Peter Divianszky
-maintainer:          csaba.hruska@gmail.com
-category:            Graphics
-build-type:          Simple
-cabal-version:       >=1.10
-
-Flag profiling
-  Description: Enable profiling
-  Default: False
-
-library
-  -- indentation parser modules
-  exposed-modules:   Text.Parser.Indentation.Implementation,
-                     Text.Parsec.Indentation,
-                     Text.Parsec.Indentation.Char,
-                     Text.Parsec.Indentation.Token
-  exposed-modules:
-    -- Compiler
-    Pretty
-    Type
-    Typecheck
-    Parser
-    IR
-    Linear
-    CoreToIR
-    CoreToGLSL
-    Infer
-    CGExp
-    Driver
-  other-extensions:
-    LambdaCase
-    PatternSynonyms
-    ViewPatterns
-    TypeSynonymInstances
-    FlexibleInstances
-    NoMonomorphismRestriction
-    TypeFamilies
-    RecordWildCards
-    DeriveFunctor
-    DeriveFoldable
-    DeriveTraversable
-    GeneralizedNewtypeDeriving
-    OverloadedStrings
-    TupleSections
-    MonadComprehensions
-    ExistentialQuantification
-    ScopedTypeVariables
-    ParallelListComp
-  build-depends:
-    -- compiler
-    aeson >= 0.9 && <1,
-    base >=4.7 && <4.9,
-    containers >=0.5 && <0.6,
-    deepseq,
-    directory,
-    exceptions >= 0.8 && <0.9,
-    filepath,
-    mtl >=2.2 && <2.3,
-    parsec >= 3.1 && <3.2,
-    pretty-compact >=1.0 && <1.1,
-    text >= 1.2 && <1.3,
-    vector >= 0.11 && <0.12
-  hs-source-dirs:      .
-  default-language:    Haskell2010
-
-executable lambdacube-compiler-test-suite
-  hs-source-dirs:   .
-  main-is:          runTests.hs
-
-  build-depends:
-    aeson >= 0.9 && <1,
-    base < 4.9,
-    containers >=0.5 && <0.6,
-    deepseq,
-    directory,
-    exceptions >= 0.8 && <0.9,
-    filepath,
-    mtl >=2.2 && <2.3,
-    lambdacube-compiler,
-    parsec >= 3.1 && <3.2,
-    pretty-compact >=1.0 && <1.1,
-    text >= 1.2 && <1.3,
-    vector >= 0.11 && <0.12
-  default-language:    Haskell2010
-  if flag(profiling)
-    GHC-Options: -O2 -fhpc -hpcdir dist/hpc/lambdacube-compiler -prof -fprof-auto -rtsopts
-  else
-    GHC-Options: -O2 -fhpc -hpcdir dist/hpc/lambdacube-compiler
diff --git a/prototypes/runTests.hs b/prototypes/runTests.hs
deleted file mode 120000
index 74e37a7a..00000000
--- a/prototypes/runTests.hs
+++ /dev/null
@@ -1 +0,0 @@
-../runTests.hs
\ No newline at end of file
diff --git a/prototypes/tests/accept/Builtins.lc b/prototypes/tests/accept/Builtins.lc
deleted file mode 100644
index 187a6e9e..00000000
--- a/prototypes/tests/accept/Builtins.lc
+++ /dev/null
@@ -1,568 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
--- module Builtins where
-
-builtins
-    cstr :: Type -> Type -> Type
---    reflCstr :: forall (a :: Type) -> cstr a a
-    T2 :: Type -> Type -> Type
-    T2C :: Unit -> Unit -> Unit
-
-data Unit = TT
-
--- 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
-
-id x = x
-
-data Bool = False | True
-
-data Ordering = LT | EQ | GT
-
-primIfThenElse :: Bool -> a -> a -> a
-primIfThenElse True  a b = a
-primIfThenElse False a b = b
-
----------------------------------------
-
-data Nat = Zero | Succ Nat
-
-builtintycons
-    Int     :: Type
-    Word    :: Type
-    Float   :: Type
-    Char    :: Type
-    String  :: Type
-
-{-
-type family TFVec (n :: Nat) a                  -- may be a data family
-type family VecScalar (n :: Nat) a
-type family TFMat i j                           -- may be a data family
-type family MatVecElem a
-type family MatVecScalarElem a
-type family FTRepr' a
-type family ColorRepr a
-type family TFFrameBuffer a
-type family FragOps a
-type family JoinTupleType t1 t2
-class AttributeTuple a
-class ValidOutput a
-class ValidFrameBuffer a
--}
-builtins
-    TFVec           :: Nat -> Type -> Type
-    VecScalar       :: Nat -> Type -> Type
-    TFMat           :: Type -> Type -> Type
-    MatVecElem      :: Type -> Type
-    MatVecScalarElem :: Type -> Type
-    FTRepr'         :: Type -> Type
-    ColorRepr       :: Type -> Type
-    TFFrameBuffer   :: Type -> Type
-    FragOps         :: Type -> Type
-    JoinTupleType   :: Type -> Type -> Type
-
-    AttributeTuple  :: Type -> Type
-    ValidOutput     :: Type -> Type
-    ValidFrameBuffer :: Type -> Type
-
-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
-
-builtins
-    Vec :: Nat -> Type -> Type
---Vec n t = VecS t n
-
-
-data Mat :: Nat -> Nat -> Type -> Type where
-  M22F :: Vec 2 Float -> Vec 2 Float -> Mat 2 2 Float
-  M23F :: Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Mat 2 3 Float
-  M24F :: Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Mat 2 4 Float
-  M32F :: Vec 3 Float -> Vec 3 Float -> Mat 3 2 Float
-  M33F :: Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Mat 3 3 Float
-  M34F :: Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Vec 3 Float -> Mat 3 4 Float
-  M42F :: Vec 4 Float -> Vec 4 Float -> Mat 4 2 Float
-  M43F :: Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Mat 4 3 Float
-  M44F :: Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Mat 4 4 Float
-
-
-builtins
-    CNum, Signed, Num, Component, Integral, NumComponent, Floating :: Type -> Type
-
-    fromInt :: Num a => Int -> a
-    compare :: Num a => a -> a -> Ordering
-    negate :: Num a => a -> a
-
-    vec2 :: Component a => a -> a -> Vec 2 a
-    vec3 :: Component a => a -> a -> a -> Vec 3 a
-    vec4 :: Component a => a -> a -> a -> a -> Vec 4 a
-    zeroComp :: Component a => a
-    oneComp :: Component a => a
-
---------------------------------------- swizzling
-
-data Swizz = Sx | Sy | Sz | Sw
-
-builtins
-  swizzvector :: forall n . forall m . Vec n a -> Vec m Swizz -> Vec m a
-  swizzscalar :: forall n . Vec n a -> Swizz -> a
-
-{-
---------------------------------------- type classes
-
-class CNum a
-
-instance CNum           Int
-instance CNum           Float
-
-class Signed a
-
-instance Signed         Int
-instance Signed         Float
-
-class Num a where
-  fromInt :: Int -> a
-  compare :: a -> a -> Ordering
-  negate :: a -> a
--}
-builtins
-  primIntToWord  :: Int -> Word
-  primIntToFloat :: Int -> Float
-  primCompareInt   :: Int   -> Int   -> Ordering
-  primCompareWord  :: Word  -> Word  -> Ordering
-  primCompareFloat :: Float -> Float -> Ordering
-  primNegateInt   :: Int   -> Int
-  primNegateWord  :: Word  -> Word
-  primNegateFloat :: Float -> Float
-
-{-
-instance Num Int where
-  fromInt = id
-  compare = primCompareInt
-  negate = primNegateInt
-instance Num Word where
-  fromInt = primIntToWord
-  compare = primCompareWord
-  negate = primNegateWord
-instance Num Float where
-  fromInt = primIntToFloat
-  compare = primCompareFloat
-  negate = primNegateFloat
-
-class Component a where
-  vec2 :: a -> a -> Vec 2 a
-  vec3 :: a -> a -> a -> Vec 3 a
-  vec4 :: a -> a -> a -> a -> Vec 4 a
-  zeroComp :: a
-  oneComp :: a
---  PrimZero, PrimOne :: {- (Component a) => -- TODO -} a
-
-
-instance Component Bool where
-  vec2 = V2
-  vec3 = V3
-  vec4 = V4
-  zeroComp = False
-  oneComp = True
-
-instance Component Int where
-  vec2 = V2
-  vec3 = V3
-  vec4 = V4
-  zeroComp = 0
-  oneComp = 1
-
-instance Component Word where
-  vec2 = V2
-  vec3 = V3
-  vec4 = V4
-  zeroComp = 0
-  oneComp = 1
-
-instance Component Float where
-  vec2 = V2
-  vec3 = V3
-  vec4 = V4
-  zeroComp = 0
-  oneComp = 1
-
-instance Component (Vec 2 Float) where
-  vec2 = V2
-  vec3 = V3
-  vec4 = V4
-  zeroComp = V2 0.0 0.0
-  oneComp = V2 1.0 1.0
-instance Component (Vec 3 Float) where
-  vec2 = V2
-  vec3 = V3
-  vec4 = V4
-  zeroComp = V3 0.0 0.0 0.0
-  oneComp = V3 1.0 1.0 1.0
-instance Component (Vec 4 Float) where
-  vec2 = V2
-  vec3 = V3
-  vec4 = V4
-  zeroComp = V4 0.0 0.0 0.0 0.0
-  oneComp = V4 1.0 1.0 1.0 1.0
-
---instance Component (Vec 2 Bool) where
---instance Component (Vec 3 Bool) where
-
-instance Component (Vec 4 Bool) where
-  vec2 = V2
-  vec3 = V3
-  vec4 = V4
-  zeroComp = V4 False False False False
-  oneComp = V4 True True True True
-
-class Integral a
-
-instance Integral       Int
-instance Integral       Word
-
-class NumComponent a
-
-instance NumComponent   Int
-instance NumComponent   Word
-instance NumComponent   Float
-instance NumComponent   (Vec 2 Float)
-instance NumComponent   (Vec 3 Float)
-instance NumComponent   (Vec 4 Float)
-
-class Floating a
-
-instance Floating       Float
-instance Floating       (Vec 2 Float)
-instance Floating       (Vec 3 Float)
-instance Floating       (Vec 4 Float)
-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 FrontFace
-    = CW
-    | CCW
-
-data CullMode
-    = CullFront FrontFace
-    | CullBack FrontFace
-    | CullNone
-
-data PointSize
-    = PointSize Float
-    | ProgramPointSize
-
-data PolygonMode
-    = PolygonFill
-    | PolygonPoint PointSize
-    | PolygonLine Float
-
-data PolygonOffset
-    = NoOffset
-    | Offset Float Float
-
-data PointSpriteCoordOrigin
-    = LowerLeft
-    | UpperLeft
-
-
-data Depth a where
-data Stencil a where
-data Color a where
-
-data PrimitiveType
-    = Triangle
-    | Line
-    | Point
-    | TriangleAdjacency
-    | LineAdjacency
-
-builtincons
-  PrimTexture :: () -> Vec 2 Float -> Vec 4 Float
-
-builtincons
-  Uniform   :: String -> t
-  Attribute :: String -> t
-
-data FragmentOut a where
-  FragmentOut          :: (a ~ ColorRepr t) => t                -> FragmentOut a
-  FragmentOutDepth     :: (x ~ ColorRepr t, a ~ JoinTupleType (Depth Float) x) => Float -> t
-                                                                -> FragmentOut a
-  FragmentOutRastDepth :: (x ~ ColorRepr t, a ~ JoinTupleType (Depth Float) x) => t
-                                                                -> FragmentOut a
-
-data VertexOut a where
-  VertexOut           :: (a ~ FTRepr' x) => Vec 4 Float -> Float -> (){-TODO-} -> x -> VertexOut a
-
-data RasterContext :: PrimitiveType -> Type where
-  TriangleCtx         :: CullMode -> PolygonMode -> PolygonOffset -> ProvokingVertex -> RasterContext Triangle
-  PointCtx            :: PointSize -> Float -> PointSpriteCoordOrigin                -> RasterContext Point
-  LineCtx             :: Float -> ProvokingVertex                                    -> RasterContext Line
-
-data FetchPrimitive :: PrimitiveType -> Type where
-   Points              :: FetchPrimitive Point
-   Lines               :: FetchPrimitive Line
-   Triangles           :: FetchPrimitive Triangle
-   LinesAdjacency      :: FetchPrimitive LineAdjacency
-   TrianglesAdjacency  :: FetchPrimitive TriangleAdjacency
-
-data AccumulationContext a where
-  AccumulationContext  :: (a ~ FragOps t) => t -> AccumulationContext a
-
-data Image (a :: Nat) :: Type -> Type where
-  ColorImage          :: (Num t, color ~ VecScalar d t)
-                      => color  -> Image a (Color color)
-  DepthImage          :: Float  -> Image a (Depth Float)
-  StencilImage        :: Int    -> Image a (Stencil Int)
-
-data Interpolated t where
-  Smooth, NoPerspective
-                      :: (Floating t) => t -> Interpolated t
-  Flat                ::                 t -> Interpolated t
-
-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 -> *
-  VertexOut            :: ???
--}
-
-data FragmentOperation :: Type -> 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)
-
-data FragmentFilter t where
-  PassAll             ::                FragmentFilter t
-  Filter              :: (t -> Bool) -> FragmentFilter t
-
-data VertexStream (a :: PrimitiveType) t where
-  Fetch               :: (AttributeTuple t) => String -> FetchPrimitive a -> t -> VertexStream a t
-  FetchArrays         :: (AttributeTuple t, t ~ FTRepr' t') => FetchPrimitive a -> t' -> VertexStream a t
-
-data PrimitiveStream (p :: PrimitiveType) :: Nat -> Type -> Type where
-  Transform           :: (a -> VertexOut b) -> VertexStream p a -> PrimitiveStream p 1 b
-
-  -- Render Operations
-data FragmentStream (n :: Nat) a where
-  Rasterize           :: RasterContext x -> PrimitiveStream x n a -> FragmentStream n a
-
-data FrameBuffer (n :: Nat) b where
-  Accumulate          :: (ValidOutput b) =>
-                           AccumulationContext b
-                        -> FragmentFilter a
-                        -> (a -> FragmentOut b)
-                        -> FragmentStream n a
-                        -> FrameBuffer n b
-                        -> FrameBuffer n b
-
-  FrameBuffer        :: (ValidFrameBuffer b, FrameBuffer n b ~ TFFrameBuffer a)
-                        => a -> FrameBuffer n b
-
-
-data Output where
-  ScreenOut           :: FrameBuffer a b -> Output
-
-builtins
-  -- * Primitive Functions *
-  -- Arithmetic Functions (componentwise)
-
-  PrimAdd, PrimSub, PrimMul     :: (t ~ MatVecElem a, Num t) => 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                       :: (t ~ MatVecScalarElem a, Signed t) => 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                       :: (a ~ VecScalar d Bool) => a -> a
-  PrimAny, PrimAll              :: (a ~ VecScalar d Bool) => a -> 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  :: (fv ~ VecScalar d Float, iv ~ VecScalar d Int)  => fv -> iv
-  PrimFloatBitsToUInt :: (fv ~ VecScalar d Float, uv ~ VecScalar d Word) => fv -> uv
-  PrimIntBitsToFloat  :: (fv ~ VecScalar d Float, iv ~ VecScalar d Int)  => iv -> fv
-  PrimUIntBitsToFloat :: (fv ~ VecScalar d Float, uv ~ VecScalar d Word) => uv -> fv
-  -- 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       :: (a ~ TFMat h w, b ~ TFMat w h) => a -> b
-  PrimDeterminant     :: (m ~ TFMat s s) => m -> Float
-  PrimInverse         :: (m ~ TFMat s s) => m -> m
-  PrimOuterProduct    :: (m ~ TFMat h w) => w -> h -> m
-  PrimMulMatVec       :: (m ~ TFMat h w) => m -> w -> h
-  PrimMulVecMat       :: (m ~ TFMat h w) => h -> m -> w
-  PrimMulMatMat       :: (a ~ TFMat i j, b ~ TFMat j k, c ~ TFMat i k) => a -> b -> c
-  -- Vector and Scalar Relational Functions
-  PrimLessThan, PrimLessThanEqual, PrimGreaterThan, PrimGreaterThanEqual, PrimEqualV, PrimNotEqualV
-                      :: (Num t, a ~ VecScalar d t, b ~ VecScalar d Bool) => a -> a -> b
-  PrimEqual, PrimNotEqual
-                      :: (t ~ MatVecScalarElem a) => a -> a -> Bool
-  -- Fragment Processing Functions
-  PrimDFdx, PrimDFdy, PrimFWidth
-                      :: (a ~ VecScalar d Float) => a -> a
-  -- Noise Functions
-  PrimNoise1          :: (a ~ VecScalar d Float) => a -> Float
-  PrimNoise2          :: (a ~ VecScalar d Float, b ~ VecScalar 2 Float) => a -> b
-  PrimNoise3          :: (a ~ VecScalar d Float, b ~ VecScalar 3 Float) => a -> b
-  PrimNoise4          :: (a ~ VecScalar d Float, b ~ VecScalar 4 Float) => a -> b
-
-{-
-    -- 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
-
-builtincons
-  PrjImage      :: FrameBuffer 1 a -> Image 1 a
-  PrjImageColor :: FrameBuffer 1 (Depth Float, Color (Vec 4 Float)) -> Image 1 (Color (Vec 4 Float))
-
-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
-
-builtincons
-  texture2D :: Sampler -> Vec 2 Float -> Vec 4 Float
-
diff --git a/prototypes/tests/accept/Graphics.lc b/prototypes/tests/accept/Graphics.lc
deleted file mode 120000
index 974d8372..00000000
--- a/prototypes/tests/accept/Graphics.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/Graphics.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/Material.lc b/prototypes/tests/accept/Material.lc
deleted file mode 120000
index d8ac6673..00000000
--- a/prototypes/tests/accept/Material.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/Material.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/NewStyle.lc b/prototypes/tests/accept/NewStyle.lc
deleted file mode 120000
index 68032c3f..00000000
--- a/prototypes/tests/accept/NewStyle.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/NewStyle.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/Prelude.lc b/prototypes/tests/accept/Prelude.lc
deleted file mode 100644
index 35d27f0a..00000000
--- a/prototypes/tests/accept/Prelude.lc
+++ /dev/null
@@ -1,311 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-module Prelude 
-    ( module Prelude
-    , module Builtins
-    ) where
-
-import Builtins
-
-infixr 9 .
-infixl 7 `PrimMulMatVec`, `PrimDot`
-infixr 3 ***
-infixr 5 :
-infixr 0 $
---infixl 0 &
-
-const x y = x
-
-otherwise = True
-
---undefined = undefined
-
-builtins
-    undefined :: forall (a :: Type) . a
-
-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)
-
-data List a = Nil | Cons a (List a)
-
-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)
-
-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
-
-singleton a = [a]
-
-append []     ys = ys
-append (x:xs) ys = x : append xs ys
-
-concat = foldl' append []
-
-map _ []     = []
-map f (x:xs) = f x : map f xs
-
-concatMap :: (a -> [b]) -> [a] -> [b]
-concatMap f x = concat (map f x)
-
-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))
-
-data Maybe a
-    = Nothing
-    | Just a
---    deriving (Eq, Ord, Show)
-
-
-snd (Tuple2 a b) = b
-
--- Row polymorphism
-builtins
-  Split :: Type -> Type -> Type -> Type {- TODO - LATER: Constraint -}
-
-tuptype :: List Type -> Type
-tuptype [] = 'Tuple0
-tuptype (x:xs) = 'Tuple2 x (tuptype xs)
-
-data RecordC (xs :: List (Tuple2 String Type))
-    = RecordCons (tuptype (map snd xs))
-
-builtins
-  record :: List (Tuple2 String Type) -> Type
---record xs = RecordCons ({- TODO: sortBy fst-} xs)
-
-builtins
-    project :: forall (xs :: List (Tuple2 String Type)) . forall (s :: String) -> Split (RecordC xs) (RecordC ('Cons ('Tuple2 s a) 'Nil)) b => RecordC xs -> a
-
-
---------------------------------------- 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 0.0 0.0 0.0 1.0  --- todo! -- V4 v%x v%y v%z 1
-
-------------
--- * WebGL 1
-------------
-
--- angle and trigonometric
-radians = PrimRadians
-degrees = PrimDegrees
-sin = PrimSin
-cos = PrimCos
-tan = PrimTan
-asin = PrimASin
-acos = PrimACos
-atan = PrimATan
-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
-ceil = PrimCeil
-fract = PrimFract
-mod = PrimMod
-min = PrimMin
-max = PrimMax
-clamp = PrimClamp
-clampS = PrimClampS
-mix = PrimMix
-step = PrimStep
-smoothstep = PrimSmoothStep
-
--- geometric functions
-length = PrimLength
-distance = PrimDistance
-dot = PrimDot
-cross = PrimCross
-normalize = PrimNormalize
-faceforward = PrimFaceForward
-reflect = PrimReflect
-refract = PrimRefract
-
--- 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
-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
-
-dFdx = PrimDFdx
-dFdy = PrimDFdy
-
--- extra
-round = PrimRound
-
-
--- 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
-
diff --git a/prototypes/tests/accept/PrimReduce.lc b/prototypes/tests/accept/PrimReduce.lc
deleted file mode 120000
index 587d6508..00000000
--- a/prototypes/tests/accept/PrimReduce.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/PrimReduce.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/SampleMaterial.lc b/prototypes/tests/accept/SampleMaterial.lc
deleted file mode 120000
index b8627b81..00000000
--- a/prototypes/tests/accept/SampleMaterial.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/SampleMaterial.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/ambig.lc b/prototypes/tests/accept/ambig.lc
deleted file mode 120000
index 9259c4a8..00000000
--- a/prototypes/tests/accept/ambig.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/ambig.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/concatmap01.lc b/prototypes/tests/accept/concatmap01.lc
deleted file mode 120000
index 43cee1d5..00000000
--- a/prototypes/tests/accept/concatmap01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/concatmap01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/dotdot01.lc b/prototypes/tests/accept/dotdot01.lc
deleted file mode 120000
index 8274c557..00000000
--- a/prototypes/tests/accept/dotdot01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/dotdot01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/dotdot02.lc b/prototypes/tests/accept/dotdot02.lc
deleted file mode 120000
index 78248be7..00000000
--- a/prototypes/tests/accept/dotdot02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/dotdot02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/example06.lc b/prototypes/tests/accept/example06.lc
deleted file mode 120000
index 9a1cd6f1..00000000
--- a/prototypes/tests/accept/example06.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/example06.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/example07.lc b/prototypes/tests/accept/example07.lc
deleted file mode 120000
index 70995cd0..00000000
--- a/prototypes/tests/accept/example07.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/example07.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/example08.lc b/prototypes/tests/accept/example08.lc
deleted file mode 120000
index 206a7ce5..00000000
--- a/prototypes/tests/accept/example08.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/example08.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/fetcharrays01.lc b/prototypes/tests/accept/fetcharrays01.lc
deleted file mode 120000
index 190d5855..00000000
--- a/prototypes/tests/accept/fetcharrays01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/fetcharrays01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/fragment01.lc b/prototypes/tests/accept/fragment01.lc
deleted file mode 120000
index 9a7d18cb..00000000
--- a/prototypes/tests/accept/fragment01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/fragment01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/fragment03swizzling.lc b/prototypes/tests/accept/fragment03swizzling.lc
deleted file mode 120000
index f9b6c97e..00000000
--- a/prototypes/tests/accept/fragment03swizzling.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/fragment03swizzling.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/fragment04ifthenelse.lc b/prototypes/tests/accept/fragment04ifthenelse.lc
deleted file mode 120000
index 15510f2c..00000000
--- a/prototypes/tests/accept/fragment04ifthenelse.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/fragment04ifthenelse.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/fragment07let.lc b/prototypes/tests/accept/fragment07let.lc
deleted file mode 120000
index 42f8d268..00000000
--- a/prototypes/tests/accept/fragment07let.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/fragment07let.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/framebuffer01.lc b/prototypes/tests/accept/framebuffer01.lc
deleted file mode 120000
index f6f5b060..00000000
--- a/prototypes/tests/accept/framebuffer01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/framebuffer01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/framebuffer02.lc b/prototypes/tests/accept/framebuffer02.lc
deleted file mode 120000
index 8a5e36e8..00000000
--- a/prototypes/tests/accept/framebuffer02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/framebuffer02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/framebuffer03.lc b/prototypes/tests/accept/framebuffer03.lc
deleted file mode 120000
index ab6ddf42..00000000
--- a/prototypes/tests/accept/framebuffer03.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/framebuffer03.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/framebuffer04.lc b/prototypes/tests/accept/framebuffer04.lc
deleted file mode 120000
index ddd9144d..00000000
--- a/prototypes/tests/accept/framebuffer04.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/framebuffer04.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/framebuffer05.lc b/prototypes/tests/accept/framebuffer05.lc
deleted file mode 120000
index 99d73bbd..00000000
--- a/prototypes/tests/accept/framebuffer05.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/framebuffer05.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/fromto.lc b/prototypes/tests/accept/fromto.lc
deleted file mode 120000
index 3656552c..00000000
--- a/prototypes/tests/accept/fromto.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/fromto.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/gfx00.lc b/prototypes/tests/accept/gfx00.lc
deleted file mode 120000
index ac68f6dc..00000000
--- a/prototypes/tests/accept/gfx00.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/gfx00.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/gfx01.lc b/prototypes/tests/accept/gfx01.lc
deleted file mode 120000
index fdcd64c2..00000000
--- a/prototypes/tests/accept/gfx01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/gfx01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/gfx02.lc b/prototypes/tests/accept/gfx02.lc
deleted file mode 120000
index 7ac40c46..00000000
--- a/prototypes/tests/accept/gfx02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/gfx02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/gfx03.lc b/prototypes/tests/accept/gfx03.lc
deleted file mode 120000
index 01d05167..00000000
--- a/prototypes/tests/accept/gfx03.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/gfx03.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/gfx04.lc b/prototypes/tests/accept/gfx04.lc
deleted file mode 120000
index 8ab3d531..00000000
--- a/prototypes/tests/accept/gfx04.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/gfx04.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/gfx05.lc b/prototypes/tests/accept/gfx05.lc
deleted file mode 120000
index 8ff2c366..00000000
--- a/prototypes/tests/accept/gfx05.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/gfx05.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/heartbeat01.lc b/prototypes/tests/accept/heartbeat01.lc
deleted file mode 120000
index 4915e9e2..00000000
--- a/prototypes/tests/accept/heartbeat01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/heartbeat01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/id.lc b/prototypes/tests/accept/id.lc
deleted file mode 120000
index 033be71e..00000000
--- a/prototypes/tests/accept/id.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/id.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/ifThenElse01.lc b/prototypes/tests/accept/ifThenElse01.lc
deleted file mode 120000
index 910b04fa..00000000
--- a/prototypes/tests/accept/ifThenElse01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/ifThenElse01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/instantiate.lc b/prototypes/tests/accept/instantiate.lc
deleted file mode 120000
index 4bba908b..00000000
--- a/prototypes/tests/accept/instantiate.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/instantiate.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/let.lc b/prototypes/tests/accept/let.lc
deleted file mode 120000
index fce72e3b..00000000
--- a/prototypes/tests/accept/let.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/let.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/letIndent.lc b/prototypes/tests/accept/letIndent.lc
deleted file mode 120000
index ef9d2cc4..00000000
--- a/prototypes/tests/accept/letIndent.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/letIndent.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/line01.lc b/prototypes/tests/accept/line01.lc
deleted file mode 120000
index a7dbf6ec..00000000
--- a/prototypes/tests/accept/line01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/line01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/listcompr01.lc b/prototypes/tests/accept/listcompr01.lc
deleted file mode 120000
index 9245a221..00000000
--- a/prototypes/tests/accept/listcompr01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/listcompr01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/listcompr02.lc b/prototypes/tests/accept/listcompr02.lc
deleted file mode 120000
index 14a8e390..00000000
--- a/prototypes/tests/accept/listcompr02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/listcompr02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/listcompr03.lc b/prototypes/tests/accept/listcompr03.lc
deleted file mode 120000
index b612974c..00000000
--- a/prototypes/tests/accept/listcompr03.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/listcompr03.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/listcompr04.lc b/prototypes/tests/accept/listcompr04.lc
deleted file mode 120000
index 0bb81d2c..00000000
--- a/prototypes/tests/accept/listcompr04.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/listcompr04.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/listcompr05.lc b/prototypes/tests/accept/listcompr05.lc
deleted file mode 120000
index cd8cacd0..00000000
--- a/prototypes/tests/accept/listcompr05.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/listcompr05.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/point01.lc b/prototypes/tests/accept/point01.lc
deleted file mode 120000
index 279582fa..00000000
--- a/prototypes/tests/accept/point01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/point01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/record01.lc b/prototypes/tests/accept/record01.lc
deleted file mode 120000
index 22769059..00000000
--- a/prototypes/tests/accept/record01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/record01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/record02.lc b/prototypes/tests/accept/record02.lc
deleted file mode 120000
index b6adcf48..00000000
--- a/prototypes/tests/accept/record02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/record02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/recursivetexture02.lc b/prototypes/tests/accept/recursivetexture02.lc
deleted file mode 120000
index 97bf2b71..00000000
--- a/prototypes/tests/accept/recursivetexture02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/recursivetexture02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/reduce01.lc b/prototypes/tests/accept/reduce01.lc
deleted file mode 120000
index 4907dfa3..00000000
--- a/prototypes/tests/accept/reduce01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/reduce01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/reduce02.lc b/prototypes/tests/accept/reduce02.lc
deleted file mode 120000
index 3a26d616..00000000
--- a/prototypes/tests/accept/reduce02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/reduce02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/reduce03.lc b/prototypes/tests/accept/reduce03.lc
deleted file mode 120000
index a39bc4b3..00000000
--- a/prototypes/tests/accept/reduce03.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/reduce03.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/reduce04.lc b/prototypes/tests/accept/reduce04.lc
deleted file mode 120000
index 2d6d9cd5..00000000
--- a/prototypes/tests/accept/reduce04.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/reduce04.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/reduce05.lc b/prototypes/tests/accept/reduce05.lc
deleted file mode 120000
index 29b9a695..00000000
--- a/prototypes/tests/accept/reduce05.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/reduce05.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/reduce06.lc b/prototypes/tests/accept/reduce06.lc
deleted file mode 120000
index d8415c9c..00000000
--- a/prototypes/tests/accept/reduce06.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/reduce06.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/simple02.lc b/prototypes/tests/accept/simple02.lc
deleted file mode 120000
index 9daa3328..00000000
--- a/prototypes/tests/accept/simple02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/simple02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/simple03.lc b/prototypes/tests/accept/simple03.lc
deleted file mode 120000
index 12f5db1e..00000000
--- a/prototypes/tests/accept/simple03.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/simple03.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/swizzling.lc b/prototypes/tests/accept/swizzling.lc
deleted file mode 120000
index a36ac043..00000000
--- a/prototypes/tests/accept/swizzling.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/swizzling.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/texture01.lc b/prototypes/tests/accept/texture01.lc
deleted file mode 120000
index 69504d89..00000000
--- a/prototypes/tests/accept/texture01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/texture01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/texture02.lc b/prototypes/tests/accept/texture02.lc
deleted file mode 120000
index ec570de7..00000000
--- a/prototypes/tests/accept/texture02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/texture02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/typeclass0.lc b/prototypes/tests/accept/typeclass0.lc
deleted file mode 120000
index 87bfef05..00000000
--- a/prototypes/tests/accept/typeclass0.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/typeclass0.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/uniformparam01.lc b/prototypes/tests/accept/uniformparam01.lc
deleted file mode 120000
index 52da0bc6..00000000
--- a/prototypes/tests/accept/uniformparam01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/uniformparam01.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/uniformparam02.lc b/prototypes/tests/accept/uniformparam02.lc
deleted file mode 120000
index a4337d3a..00000000
--- a/prototypes/tests/accept/uniformparam02.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/uniformparam02.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/uniformparam03.lc b/prototypes/tests/accept/uniformparam03.lc
deleted file mode 120000
index 13143d6e..00000000
--- a/prototypes/tests/accept/uniformparam03.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/uniformparam03.lc
\ No newline at end of file
diff --git a/prototypes/tests/accept/zip01.lc b/prototypes/tests/accept/zip01.lc
deleted file mode 120000
index 8854d4fa..00000000
--- a/prototypes/tests/accept/zip01.lc
+++ /dev/null
@@ -1 +0,0 @@
-../../../tests/accept/zip01.lc
\ No newline at end of file
diff --git a/prototypes/tests/demo/.placeholder b/prototypes/tests/demo/.placeholder
deleted file mode 100644
index e69de29b..00000000
--- a/prototypes/tests/demo/.placeholder
+++ /dev/null
diff --git a/prototypes/tests/reject/.placeholder b/prototypes/tests/reject/.placeholder
deleted file mode 100644
index e69de29b..00000000
--- a/prototypes/tests/reject/.placeholder
+++ /dev/null
diff --git a/prototypes/run-test-suite.sh b/run-test-suite.sh
index 9ced8e55..9ced8e55 100755
--- a/prototypes/run-test-suite.sh
+++ b/run-test-suite.sh
diff --git a/runTests.hs b/runTests.hs
index ce15ebbd..c8bd3177 100644
--- a/runTests.hs
+++ b/runTests.hs
@@ -16,9 +16,7 @@ import Control.Monad.Catch
 import Control.DeepSeq
 
 import Pretty hiding ((</>))
-import Type
-import Typecheck
-import Parser
+import CGExp
 import Driver
 import CoreToIR
 import IR (Backend(..))
diff --git a/tests/accept/Builtins.lc b/tests/accept/Builtins.lc
index f0df2726..187a6e9e 100644
--- a/tests/accept/Builtins.lc
+++ b/tests/accept/Builtins.lc
@@ -1,5 +1,21 @@
 {-# LANGUAGE NoImplicitPrelude #-}
-module Builtins where
+-- module Builtins where
+
+builtins
+    cstr :: Type -> Type -> Type
+--    reflCstr :: forall (a :: Type) -> cstr a a
+    T2 :: Type -> Type -> Type
+    T2C :: Unit -> Unit -> Unit
+
+data Unit = TT
+
+-- 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
 
 id x = x
 
@@ -7,18 +23,22 @@ data Bool = False | True
 
 data Ordering = LT | EQ | GT
 
-builtins
-  PrimIfThenElse :: Bool -> a -> a -> a
+primIfThenElse :: Bool -> a -> a -> a
+primIfThenElse True  a b = a
+primIfThenElse False a b = b
 
 ---------------------------------------
 
-data Nat where
-data Int where
-data Word where
-data Float where
-data Char where
-data String where
+data Nat = Zero | Succ Nat
 
+builtintycons
+    Int     :: Type
+    Word    :: Type
+    Float   :: Type
+    Char    :: Type
+    String  :: Type
+
+{-
 type family TFVec (n :: Nat) a                  -- may be a data family
 type family VecScalar (n :: Nat) a
 type family TFMat i j                           -- may be a data family
@@ -32,16 +52,34 @@ type family JoinTupleType t1 t2
 class AttributeTuple a
 class ValidOutput a
 class ValidFrameBuffer a
+-}
+builtins
+    TFVec           :: Nat -> Type -> Type
+    VecScalar       :: Nat -> Type -> Type
+    TFMat           :: Type -> Type -> Type
+    MatVecElem      :: Type -> Type
+    MatVecScalarElem :: Type -> Type
+    FTRepr'         :: Type -> Type
+    ColorRepr       :: Type -> Type
+    TFFrameBuffer   :: Type -> Type
+    FragOps         :: Type -> Type
+    JoinTupleType   :: Type -> Type -> Type
+
+    AttributeTuple  :: Type -> Type
+    ValidOutput     :: Type -> Type
+    ValidFrameBuffer :: Type -> Type
+
+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
 
-data Vec (n :: Nat) a where
-  V2 :: a -> a -> Vec 2 a
-  V3 :: a -> a -> a -> Vec 3 a
-  V4 :: a -> a -> a -> a -> Vec 4 a
+builtins
+    Vec :: Nat -> Type -> Type
+--Vec n t = VecS t n
 
--- builtins
---  V1 :: a -> Vec 2 a            -- TODO: eliminate
 
-data Mat (i :: Nat) (j :: Nat) a where
+data Mat :: Nat -> Nat -> Type -> Type where
   M22F :: Vec 2 Float -> Vec 2 Float -> Mat 2 2 Float
   M23F :: Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Mat 2 3 Float
   M24F :: Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Vec 2 Float -> Mat 2 4 Float
@@ -52,6 +90,29 @@ data Mat (i :: Nat) (j :: Nat) a where
   M43F :: Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Mat 4 3 Float
   M44F :: Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Vec 4 Float -> Mat 4 4 Float
 
+
+builtins
+    CNum, Signed, Num, Component, Integral, NumComponent, Floating :: Type -> Type
+
+    fromInt :: Num a => Int -> a
+    compare :: Num a => a -> a -> Ordering
+    negate :: Num a => a -> a
+
+    vec2 :: Component a => a -> a -> Vec 2 a
+    vec3 :: Component a => a -> a -> a -> Vec 3 a
+    vec4 :: Component a => a -> a -> a -> a -> Vec 4 a
+    zeroComp :: Component a => a
+    oneComp :: Component a => a
+
+--------------------------------------- swizzling
+
+data Swizz = Sx | Sy | Sz | Sw
+
+builtins
+  swizzvector :: forall n . forall m . Vec n a -> Vec m Swizz -> Vec m a
+  swizzscalar :: forall n . Vec n a -> Swizz -> a
+
+{-
 --------------------------------------- type classes
 
 class CNum a
@@ -68,7 +129,7 @@ class Num a where
   fromInt :: Int -> a
   compare :: a -> a -> Ordering
   negate :: a -> a
-
+-}
 builtins
   primIntToWord  :: Int -> Word
   primIntToFloat :: Int -> Float
@@ -79,6 +140,7 @@ builtins
   primNegateWord  :: Word  -> Word
   primNegateFloat :: Float -> Float
 
+{-
 instance Num Int where
   fromInt = id
   compare = primCompareInt
@@ -158,7 +220,6 @@ instance Component (Vec 4 Bool) where
   zeroComp = V4 False False False False
   oneComp = V4 True True True True
 
-
 class Integral a
 
 instance Integral       Int
@@ -188,10 +249,10 @@ 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'
+    = Zero' --- FIXME: modified
     | One
     | SrcColor
     | OneMinusSrcColor
@@ -294,29 +355,29 @@ data PrimitiveType
     | TriangleAdjacency
     | LineAdjacency
 
-builtins
+builtincons
   PrimTexture :: () -> Vec 2 Float -> Vec 4 Float
 
-builtins
+builtincons
   Uniform   :: String -> t
   Attribute :: String -> t
 
 data FragmentOut a where
-  FragmentOut         :: (a ~ ColorRepr t) => t                 -> FragmentOut a
-  FragmentOutDepth    :: (a ~ ColorRepr t, b ~ JoinTupleType (Depth Float) a) => Float -> t
-                                                                -> FragmentOut b
-  FragmentOutRastDepth :: (a ~ ColorRepr t, b ~ JoinTupleType (Depth Float) a) => t
-                                                                -> FragmentOut b
+  FragmentOut          :: (a ~ ColorRepr t) => t                -> FragmentOut a
+  FragmentOutDepth     :: (x ~ ColorRepr t, a ~ JoinTupleType (Depth Float) x) => Float -> t
+                                                                -> FragmentOut a
+  FragmentOutRastDepth :: (x ~ ColorRepr t, a ~ JoinTupleType (Depth Float) x) => t
+                                                                -> FragmentOut a
 
 data VertexOut a where
-  VertexOut           :: (t ~ FTRepr' a) => Vec 4 Float -> Float -> (){-TODO-} -> a -> VertexOut t
+  VertexOut           :: (a ~ FTRepr' x) => Vec 4 Float -> Float -> (){-TODO-} -> x -> VertexOut a
 
-data RasterContext (a :: PrimitiveType) where
+data RasterContext :: PrimitiveType -> Type where
   TriangleCtx         :: CullMode -> PolygonMode -> PolygonOffset -> ProvokingVertex -> RasterContext Triangle
   PointCtx            :: PointSize -> Float -> PointSpriteCoordOrigin                -> RasterContext Point
   LineCtx             :: Float -> ProvokingVertex                                    -> RasterContext Line
 
-data FetchPrimitive (a :: PrimitiveType) where
+data FetchPrimitive :: PrimitiveType -> Type where
    Points              :: FetchPrimitive Point
    Lines               :: FetchPrimitive Line
    Triangles           :: FetchPrimitive Triangle
@@ -324,20 +385,20 @@ data FetchPrimitive (a :: PrimitiveType) where
    TrianglesAdjacency  :: FetchPrimitive TriangleAdjacency
 
 data AccumulationContext a where
-  AccumulationContext :: (t' ~ FragOps t) => t -> AccumulationContext t'
+  AccumulationContext  :: (a ~ FragOps t) => t -> AccumulationContext a
 
-data Image (a :: Nat) b{-Semantic-} where
+data Image (a :: Nat) :: Type -> Type where
   ColorImage          :: (Num t, color ~ VecScalar d t)
-                      => forall (a :: Nat) . color  -> Image a (Color color)
-  DepthImage          :: forall (a :: Nat) . Float  -> Image a (Depth Float)
-  StencilImage        :: forall (a :: Nat) . Int    -> Image a (Stencil Int)
+                      => color  -> Image a (Color color)
+  DepthImage          :: Float  -> Image a (Depth Float)
+  StencilImage        :: Int    -> Image a (Stencil Int)
 
 data Interpolated t where
   Smooth, NoPerspective
                       :: (Floating t) => t -> Interpolated t
   Flat                ::                 t -> Interpolated t
 
-data Blending a where
+data Blending :: Type -> Type where
   NoBlending          ::                                   Blending t
   BlendLogicOp        :: (Integral t) => LogicOperation -> Blending t
   Blend               :: (BlendEquation, BlendEquation)
@@ -349,28 +410,29 @@ data Blending a where
   FragmentOut          :: Semantic -> *
   VertexOut            :: ???
 -}
-data FragmentOperation a where
+
+data FragmentOperation :: Type -> 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)
+  StencilOp           :: StencilTests -> StencilOps -> StencilOps -> FragmentOperation (Stencil Int32)
 
 data FragmentFilter t where
   PassAll             ::                FragmentFilter t
   Filter              :: (t -> Bool) -> FragmentFilter t
 
-data VertexStream (a :: PrimitiveType) b where
+data VertexStream (a :: PrimitiveType) t where
   Fetch               :: (AttributeTuple t) => String -> FetchPrimitive a -> t -> VertexStream a t
   FetchArrays         :: (AttributeTuple t, t ~ FTRepr' t') => FetchPrimitive a -> t' -> VertexStream a t
 
-data PrimitiveStream (p :: PrimitiveType) (n :: Nat) b where
+data PrimitiveStream (p :: PrimitiveType) :: Nat -> Type -> Type where
   Transform           :: (a -> VertexOut b) -> VertexStream p a -> PrimitiveStream p 1 b
 
   -- Render Operations
 data FragmentStream (n :: Nat) a where
-  Rasterize           :: RasterContext a -> PrimitiveStream a b c -> FragmentStream b c
+  Rasterize           :: RasterContext x -> PrimitiveStream x n a -> FragmentStream n a
 
-data FrameBuffer (n :: Nat) a where
+data FrameBuffer (n :: Nat) b where
   Accumulate          :: (ValidOutput b) =>
                            AccumulationContext b
                         -> FragmentFilter a
@@ -378,8 +440,10 @@ data FrameBuffer (n :: Nat) a where
                         -> FragmentStream n a
                         -> FrameBuffer n b
                         -> FrameBuffer n b
-  FrameBuffer         :: (ValidFrameBuffer t, FrameBuffer n t ~ TFFrameBuffer a)
-                        => a -> FrameBuffer n t
+
+  FrameBuffer        :: (ValidFrameBuffer b, FrameBuffer n b ~ TFFrameBuffer a)
+                        => a -> FrameBuffer n b
+
 
 data Output where
   ScreenOut           :: FrameBuffer a b -> Output
@@ -388,33 +452,33 @@ builtins
   -- * Primitive Functions *
   -- Arithmetic Functions (componentwise)
 
-  PrimAdd, PrimSub, PrimMul :: (t ~ MatVecElem a, Num t) => a -> a -> a
+  PrimAdd, PrimSub, PrimMul     :: (t ~ MatVecElem a, Num t) => 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                           :: (t ~ MatVecScalarElem a, Signed t) => a -> a
+  PrimDiv, PrimMod              :: (Num t, a ~ VecScalar d t) => a -> a -> a
+  PrimDivS, PrimModS            :: (Num t, a ~ VecScalar d t) => a -> t -> a
+  PrimNeg                       :: (t ~ MatVecScalarElem a, Signed t) => 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
+  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                           :: (a ~ VecScalar d Bool) => a -> a
-  PrimAny, PrimAll                :: (a ~ VecScalar d Bool) => a -> Bool
+  PrimNot                       :: (a ~ VecScalar d Bool) => a -> a
+  PrimAny, PrimAll              :: (a ~ VecScalar d Bool) => a -> 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
-  --ommon Functions
+                                :: (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
+                                :: (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
@@ -434,11 +498,11 @@ builtins
   -- Geometric Functions
   PrimLength          :: (a ~ VecScalar d Float) => a -> Float
   PrimDistance, PrimDot
-                        :: (a ~ VecScalar d Float) => a -> a -> Float
+                      :: (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
+                      :: (a ~ VecScalar d Float) => a -> a -> a -> a
   PrimReflect         :: (a ~ VecScalar d Float) => a -> a -> a
   -- Matrix Functions
   PrimTranspose       :: (a ~ TFMat h w, b ~ TFMat w h) => a -> b
@@ -450,12 +514,12 @@ builtins
   PrimMulMatMat       :: (a ~ TFMat i j, b ~ TFMat j k, c ~ TFMat i k) => a -> b -> c
   -- Vector and Scalar Relational Functions
   PrimLessThan, PrimLessThanEqual, PrimGreaterThan, PrimGreaterThanEqual, PrimEqualV, PrimNotEqualV
-                        :: (Num t, a ~ VecScalar d t, b ~ VecScalar d Bool) => a -> a -> b
+                      :: (Num t, a ~ VecScalar d t, b ~ VecScalar d Bool) => a -> a -> b
   PrimEqual, PrimNotEqual
-                        :: (t ~ MatVecScalarElem a) => a -> a -> Bool
+                      :: (t ~ MatVecScalarElem a) => a -> a -> Bool
   -- Fragment Processing Functions
   PrimDFdx, PrimDFdy, PrimFWidth
-                        :: (a ~ VecScalar d Float) => a -> a
+                      :: (a ~ VecScalar d Float) => a -> a
   -- Noise Functions
   PrimNoise1          :: (a ~ VecScalar d Float) => a -> Float
   PrimNoise2          :: (a ~ VecScalar d Float, b ~ VecScalar 2 Float) => a -> b
@@ -476,7 +540,7 @@ builtins
 -- * Texture support
 -- FIXME: currently only Float RGBA 2D texture is supported
 
-builtins
+builtincons
   PrjImage      :: FrameBuffer 1 a -> Image 1 a
   PrjImageColor :: FrameBuffer 1 (Depth Float, Color (Vec 4 Float)) -> Image 1 (Color (Vec 4 Float))
 
@@ -499,5 +563,6 @@ data EdgeMode
 
 data Sampler = Sampler Filter EdgeMode Texture
 
-builtins
+builtincons
   texture2D :: Sampler -> Vec 2 Float -> Vec 4 Float
+
diff --git a/prototypes/tests/accept/DepPrelude.lc b/tests/accept/DepPrelude.lc
index facb4b7b..facb4b7b 100644
--- a/prototypes/tests/accept/DepPrelude.lc
+++ b/tests/accept/DepPrelude.lc
diff --git a/tests/accept/Graphics.out b/tests/accept/Graphics.out
index 7d6eefb5..3fa5594e 100644
--- a/tests/accept/Graphics.out
+++ b/tests/accept/Graphics.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("t01453",Parameter {name = "position", ty = V3F}),("t01454",Parameter {name = "color", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 t01453 ;\nin vec4 t01454 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = t01454;\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( t01453 ).x,( t01453 ).y,( t01453 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( ( 1.0 ) - ( ( v0 ).x ),( 1.0 ) - ( ( v0 ).y ),( 1.0 ) - ( ( v0 ).z ),1.0 );\n}\n"},Program {programUniforms = fromList [("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("t01357",Parameter {name = "position", ty = V3F}),("t01358",Parameter {name = "color", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 t01357 ;\nin vec4 t01358 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = vec4 ( ( t01358 ).x,( t01358 ).y,( t01358 ).z,0.5 );\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( t01357 ).x,( t01357 ).y,( t01357 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"},Program {programUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("t01125",Parameter {name = "position", ty = V3F}),("t01126",Parameter {name = "normal", ty = V3F}),("t01127",Parameter {name = "diffuseUV", ty = V2F}),("t01128",Parameter {name = "lightmapUV", ty = V2F}),("t01129",Parameter {name = "color", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform float identityLight ;\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 t01125 ;\nin vec3 t01126 ;\nin vec2 t01127 ;\nin vec2 t01128 ;\nin vec4 t01129 ;\nsmooth out vec2 v0 ;\nsmooth out vec4 v1 ;\nvoid main() {\nv0 = t01127;\nv1 = vec4 ( ( ( vec3 ( ( t01129 ).x,( t01129 ).y,( t01129 ).z ) ) * ( identityLight ) ).x,( ( vec3 ( ( t01129 ).x,( t01129 ).y,( t01129 ).z ) ) * ( identityLight ) ).y,( ( vec3 ( ( t01129 ).x,( t01129 ).y,( t01129 ).z ) ) * ( identityLight ) ).z,( t01129 ).w );\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( t01125 ).x,( t01125 ).y,( t01125 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler0 ;\nsmooth in vec2 v0 ;\nsmooth in vec4 v1 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v1 ) * ( texture2D ( sampler0,v0 ) );\n}\n"},Program {programUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("t01125",Parameter {name = "position", ty = V3F}),("t01126",Parameter {name = "normal", ty = V3F}),("t01127",Parameter {name = "diffuseUV", ty = V2F}),("t01128",Parameter {name = "lightmapUV", ty = V2F}),("t01129",Parameter {name = "color", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform float identityLight ;\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 t01125 ;\nin vec3 t01126 ;\nin vec2 t01127 ;\nin vec2 t01128 ;\nin vec4 t01129 ;\nsmooth out vec2 v0 ;\nsmooth out vec4 v1 ;\nvoid main() {\nv0 = t01128;\nv1 = vec4 ( identityLight,identityLight,identityLight,1.0 );\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( t01125 ).x,( t01125 ).y,( t01125 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler1 ;\nsmooth in vec2 v0 ;\nsmooth in vec4 v1 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v1 ) * ( texture2D ( sampler1,v0 ) );\n}\n"},Program {programUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("t01125",Parameter {name = "position", ty = V3F}),("t01126",Parameter {name = "normal", ty = V3F}),("t01127",Parameter {name = "diffuseUV", ty = V2F}),("t01128",Parameter {name = "lightmapUV", ty = V2F}),("t01129",Parameter {name = "color", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform float identityLight ;\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 t01125 ;\nin vec3 t01126 ;\nin vec2 t01127 ;\nin vec2 t01128 ;\nin vec4 t01129 ;\nsmooth out vec2 v0 ;\nsmooth out vec4 v1 ;\nvoid main() {\nv0 = t01127;\nv1 = vec4 ( identityLight,identityLight,identityLight,1.0 );\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( t01125 ).x,( t01125 ).y,( t01125 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler2 ;\nsmooth in vec2 v0 ;\nsmooth in vec4 v1 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v1 ) * ( texture2D ( sampler2,v0 ) );\n}\n"}], slots = [Slot {slotName = "missing shader", slotStreams = fromList [("color",V4F),("position",V3F)], slotUniforms = fromList [("viewProj",M44F),("worldMat",M44F)], slotPrimitive = Triangles, slotPrograms = [0,1]},Slot {slotName = "models/mapobjects/gratelamp/gratetorch2b", slotStreams = fromList [("color",V4F),("diffuseUV",V2F),("lightmapUV",V2F),("normal",V3F),("position",V3F)], slotUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], slotPrimitive = Triangles, slotPrograms = [2]},Slot {slotName = "models/mapobjects/gratelamp/gratetorch2", slotStreams = fromList [("color",V4F),("diffuseUV",V2F),("lightmapUV",V2F),("normal",V3F),("position",V3F)], slotUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], slotPrimitive = Triangles, slotPrograms = [3,4]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.0 0.0 0.0 0.0)}],SetProgram 4,SetRasterContext (TriangleCtx (CullFront CCW) PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 2,SetProgram 3,SetRasterContext (TriangleCtx (CullFront CCW) PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = DstColor, colorFDst = Zero, alphaFSrc = DstColor, alphaFDst = Zero, color = V4 0.0 0.0 0.0 0.0}) (VV4B (V4 True True True True))]}),RenderSlot 2,SetProgram 2,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 1,SetProgram 1,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = Min, colorFSrc = One, colorFDst = One, alphaFSrc = One, alphaFDst = One, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 0,SetProgram 0,SetRasterContext (TriangleCtx CullNone (PolygonLine 1.0) NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("e14",Parameter {name = "position", ty = V3F}),("k14",Parameter {name = "color", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 e14 ;\nin vec4 k14 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = k14;\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( e14 ).x,( e14 ).y,( e14 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( ( 1.0 ) - ( ( v0 ).x ),( 1.0 ) - ( ( v0 ).y ),( 1.0 ) - ( ( v0 ).z ),1.0 );\n}\n"},Program {programUniforms = fromList [("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("i36",Parameter {name = "position", ty = V3F}),("o36",Parameter {name = "color", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 i36 ;\nin vec4 o36 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = vec4 ( ( o36 ).x,( o36 ).y,( o36 ).z,0.5 );\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( i36 ).x,( i36 ).y,( i36 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"},Program {programUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("d73",Parameter {name = "lightmapUV", ty = V2F}),("i73",Parameter {name = "color", ty = V4F}),("m72",Parameter {name = "position", ty = V3F}),("s72",Parameter {name = "normal", ty = V3F}),("y72",Parameter {name = "diffuseUV", ty = V2F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform float identityLight ;\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 m72 ;\nin vec3 s72 ;\nin vec2 y72 ;\nin vec2 d73 ;\nin vec4 i73 ;\nsmooth out vec2 v0 ;\nsmooth out vec4 v1 ;\nvoid main() {\nv0 = y72;\nv1 = vec4 ( ( ( vec3 ( ( i73 ).x,( i73 ).y,( i73 ).z ) ) * ( identityLight ) ).x,( ( vec3 ( ( i73 ).x,( i73 ).y,( i73 ).z ) ) * ( identityLight ) ).y,( ( vec3 ( ( i73 ).x,( i73 ).y,( i73 ).z ) ) * ( identityLight ) ).z,( i73 ).w );\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( m72 ).x,( m72 ).y,( m72 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler0 ;\nsmooth in vec2 v0 ;\nsmooth in vec4 v1 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v1 ) * ( texture2D ( sampler0,v0 ) );\n}\n"},Program {programUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("a112",Parameter {name = "color", ty = V4F}),("e111",Parameter {name = "position", ty = V3F}),("k111",Parameter {name = "normal", ty = V3F}),("q111",Parameter {name = "diffuseUV", ty = V2F}),("v111",Parameter {name = "lightmapUV", ty = V2F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform float identityLight ;\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 e111 ;\nin vec3 k111 ;\nin vec2 q111 ;\nin vec2 v111 ;\nin vec4 a112 ;\nsmooth out vec2 v0 ;\nsmooth out vec4 v1 ;\nvoid main() {\nv0 = v111;\nv1 = vec4 ( identityLight,identityLight,identityLight,1.0 );\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( e111 ).x,( e111 ).y,( e111 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler1 ;\nsmooth in vec2 v0 ;\nsmooth in vec4 v1 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v1 ) * ( texture2D ( sampler1,v0 ) );\n}\n"},Program {programUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], programStreams = fromList [("d145",Parameter {name = "lightmapUV", ty = V2F}),("i145",Parameter {name = "color", ty = V4F}),("m144",Parameter {name = "position", ty = V3F}),("s144",Parameter {name = "normal", ty = V3F}),("y144",Parameter {name = "diffuseUV", ty = V2F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform float identityLight ;\nuniform mat4 viewProj ;\nuniform mat4 worldMat ;\nin vec3 m144 ;\nin vec3 s144 ;\nin vec2 y144 ;\nin vec2 d145 ;\nin vec4 i145 ;\nsmooth out vec2 v0 ;\nsmooth out vec4 v1 ;\nvoid main() {\nv0 = y144;\nv1 = vec4 ( identityLight,identityLight,identityLight,1.0 );\ngl_Position = ( viewProj ) * ( ( worldMat ) * ( vec4 ( ( m144 ).x,( m144 ).y,( m144 ).z,1.0 ) ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler2 ;\nsmooth in vec2 v0 ;\nsmooth in vec4 v1 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v1 ) * ( texture2D ( sampler2,v0 ) );\n}\n"}], slots = [Slot {slotName = "missing shader", slotStreams = fromList [("color",V4F),("position",V3F)], slotUniforms = fromList [("viewProj",M44F),("worldMat",M44F)], slotPrimitive = Triangles, slotPrograms = [0,1]},Slot {slotName = "models/mapobjects/gratelamp/gratetorch2b", slotStreams = fromList [("color",V4F),("diffuseUV",V2F),("lightmapUV",V2F),("normal",V3F),("position",V3F)], slotUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], slotPrimitive = Triangles, slotPrograms = [2]},Slot {slotName = "models/mapobjects/gratelamp/gratetorch2", slotStreams = fromList [("color",V4F),("diffuseUV",V2F),("lightmapUV",V2F),("normal",V3F),("position",V3F)], slotUniforms = fromList [("identityLight",Float),("viewProj",M44F),("worldMat",M44F)], slotPrimitive = Triangles, slotPrograms = [3,4]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.0 0.0 0.0 0.0)}],SetProgram 4,SetRasterContext (TriangleCtx (CullFront CCW) PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 2,SetProgram 3,SetRasterContext (TriangleCtx (CullFront CCW) PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = DstColor, colorFDst = Zero, alphaFSrc = DstColor, alphaFDst = Zero, color = V4 0.0 0.0 0.0 0.0}) (VV4B (V4 True True True True))]}),RenderSlot 2,SetProgram 2,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 1,SetProgram 1,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = Min, colorFSrc = One, colorFDst = One, alphaFSrc = One, alphaFDst = One, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 0,SetProgram 0,SetRasterContext (TriangleCtx CullNone (PolygonLine 1.0) NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/NewStyle.out b/tests/accept/NewStyle.out
index 682c8c44..f8cba51b 100644
--- a/tests/accept/NewStyle.out
+++ b/tests/accept/NewStyle.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("v",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 v ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = v;\ngl_Position = ( ( MVP ) * ( v ) ) * ( vec4 ( 0.5,0.5,0.5,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.1 0.0 0.2 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("s9",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 s9 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = s9;\ngl_Position = ( ( MVP ) * ( s9 ) ) * ( vec4 ( 0.5,0.5,0.5,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.1 0.0 0.2 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/Prelude.lc b/tests/accept/Prelude.lc
index 3fe241e8..35d27f0a 100644
--- a/tests/accept/Prelude.lc
+++ b/tests/accept/Prelude.lc
@@ -17,13 +17,18 @@ const x y = x
 
 otherwise = True
 
-undefined = undefined
+--undefined = undefined
+
+builtins
+    undefined :: forall (a :: Type) . a
 
 x & f = f x
-($) = \f1 x -> f1 x
-(.) = \f2 g x -> f2 (g 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)
 
 data List a = Nil | Cons a (List a)
@@ -31,9 +36,9 @@ data List a = Nil | Cons a (List a)
 pi = 3.14
 
 zip :: [a] -> [b] -> [(a,b)]
-zip []     _    = []
-zip _    []     = []
-zip (a:as) (b:bs) = (a,b) : zip as bs
+zip []      xs     = []
+zip xs      []     = []
+zip (a: as) (b: bs) = (a,b): zip as bs
 
 unzip :: [(a,b)] -> ([a],[b])
 unzip [] = ([],[])
@@ -41,12 +46,12 @@ unzip ((a,b):xs) = (a:as,b:bs)
   where (as,bs) = unzip xs
 
 filter pred []    = []
-filter pred (x:xs) = case (pred x) of
+filter pred (x:xs) = case pred x of
                        True -> (x : filter pred xs)
                        False -> (filter pred xs)
 
 tail :: [a] -> [a]
-tail (_ : xs) = xs
+tail (_: xs) = xs
 
 pairs :: [a] -> [(a, a)]
 pairs v = zip v (tail v)
@@ -83,7 +88,29 @@ sortBy f xs = uncurry (mergeBy f) ((sortBy f *** sortBy f) (split xs))
 data Maybe a
     = Nothing
     | Just a
-    deriving (Eq, Ord, Show)
+--    deriving (Eq, Ord, Show)
+
+
+snd (Tuple2 a b) = b
+
+-- Row polymorphism
+builtins
+  Split :: Type -> Type -> Type -> Type {- TODO - LATER: Constraint -}
+
+tuptype :: List Type -> Type
+tuptype [] = 'Tuple0
+tuptype (x:xs) = 'Tuple2 x (tuptype xs)
+
+data RecordC (xs :: List (Tuple2 String Type))
+    = RecordCons (tuptype (map snd xs))
+
+builtins
+  record :: List (Tuple2 String Type) -> Type
+--record xs = RecordCons ({- TODO: sortBy fst-} xs)
+
+builtins
+    project :: forall (xs :: List (Tuple2 String Type)) . forall (s :: String) -> Split (RecordC xs) (RecordC ('Cons ('Tuple2 s a) 'Nil)) b => RecordC xs -> a
+
 
 --------------------------------------- HTML colors
 
@@ -112,7 +139,7 @@ colorImage2 = ColorImage @2
 depthImage1 = DepthImage @1
 
 v3FToV4F :: Vec 3 Float -> Vec 4 Float
-v3FToV4F v = V4 v%x v%y v%z 1
+v3FToV4F v = V4 0.0 0.0 0.0 1.0  --- todo! -- V4 v%x v%y v%z 1
 
 ------------
 -- * WebGL 1
@@ -212,6 +239,19 @@ dFdy = PrimDFdy
 
 -- extra
 round = PrimRound
+
+
+-- 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
 ------------------
@@ -264,18 +304,8 @@ lookat pos target up = translateBefore4 (neg pos) (orthogonal $ toOrthoUnsafe r)
     r = transpose $ Mat3 u v w
 -}
 
--- 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
-
 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
+
diff --git a/tests/accept/PrimReduce.out b/tests/accept/PrimReduce.out
index f8c7d247..f235a091 100644
--- a/tests/accept/PrimReduce.out
+++ b/tests/accept/PrimReduce.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("v",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 v ;\nvoid main() {\ngl_Position = ( ( mat4 ( vec4 ( -0.9899924966004454,-0.1411200080598672,0.0,0.0 ),vec4 ( 0.1411200080598672,-0.9899924966004454,0.0,0.0 ),vec4 ( 0.0,0.0,1.0,0.0 ),vec4 ( 0.0,0.0,0.0,1.0 ) ) ) * ( v ) ) * ( vec4 ( 0.1,0.1,0.1,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 0.0,0.0,1.0,1.0 );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 1.0 0.0 0.0 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("g7",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 g7 ;\nvoid main() {\ngl_Position = ( ( mat4 ( vec4 ( cos ( 3.0 ),( 0.0 ) - ( sin ( 3.0 ) ),0.0,0.0 ),vec4 ( sin ( 3.0 ),cos ( 3.0 ),0.0,0.0 ),vec4 ( 0.0,0.0,1.0,0.0 ),vec4 ( 0.0,0.0,0.0,1.0 ) ) ) * ( g7 ) ) * ( vec4 ( 0.1,0.1,0.1,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 0.0,0.0,1.0,1.0 );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 1.0 0.0 0.0 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/prototypes/tests/accept/data.lc b/tests/accept/data.lc
index 60731eb8..60731eb8 100644
--- a/prototypes/tests/accept/data.lc
+++ b/tests/accept/data.lc
diff --git a/prototypes/tests/accept/empty.lc b/tests/accept/empty.lc
index ae71538d..ae71538d 100644
--- a/prototypes/tests/accept/empty.lc
+++ b/tests/accept/empty.lc
diff --git a/tests/accept/gfx02.out b/tests/accept/gfx02.out
index 7d826dea..c408f1cb 100644
--- a/tests/accept/gfx02.out
+++ b/tests/accept/gfx02.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("t00025",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 t00025 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = t00025;\ngl_Position = t00025;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.0 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("u7",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 u7 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = u7;\ngl_Position = u7;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.0 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/gfx03.out b/tests/accept/gfx03.out
index ffa06c69..75f81b2e 100644
--- a/tests/accept/gfx03.out
+++ b/tests/accept/gfx03.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP2",M44F)], programStreams = fromList [("t00022",Parameter {name = "position", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP2 ;\nin vec3 t00022 ;\nvoid main() {\ngl_Position = ( MVP2 ) * ( vec4 ( ( t00022 ).x,( t00022 ).y,( t00022 ).z,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 0.0,0.4,0.0,1.0 );\n}\n"},Program {programUniforms = fromList [("MVP2",M44F)], programStreams = fromList [("t00087",Parameter {name = "position", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP2 ;\nin vec3 t00087 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = vec4 ( ( t00087 ).x,( t00087 ).y,( t00087 ).z,1.0 );\ngl_Position = ( MVP2 ) * ( vec4 ( ( t00087 ).x,( t00087 ).y,( t00087 ).z,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) + ( vec4 ( 1.0,1.4,1.0,0.6 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("t00166",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 t00166 ;\nflat out vec4 v0 ;\nvoid main() {\nv0 = t00166;\ngl_Position = ( MVP ) * ( t00166 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nflat in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) * ( vec4 ( 1.0,1.4,1.0,0.6 ) );\n}\n"}], slots = [Slot {slotName = "stream", slotStreams = fromList [("position",V3F)], slotUniforms = fromList [("MVP2",M44F)], slotPrimitive = Triangles, slotPrograms = [0,1]},Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [2]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 2,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = SrcAlpha, colorFDst = OneMinusSrcAlpha, alphaFSrc = SrcAlpha, alphaFDst = OneMinusSrcAlpha, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 1,SetProgram 1,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False,ColorOp NoBlending (VV4B (V4 True True False False))]}),RenderSlot 0,SetProgram 0,SetRasterContext (TriangleCtx CullNone (PolygonLine 20.0) NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Always False,ColorOp NoBlending (VV4B (V4 True True False False))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP2",M44F)], programStreams = fromList [("e9",Parameter {name = "position", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP2 ;\nin vec3 e9 ;\nvoid main() {\ngl_Position = ( MVP2 ) * ( vec4 ( 0.0,0.0,0.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 0.0,0.4,0.0,1.0 );\n}\n"},Program {programUniforms = fromList [("MVP2",M44F)], programStreams = fromList [("e23",Parameter {name = "position", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP2 ;\nin vec3 e23 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = vec4 ( 0.0,0.0,0.0,1.0 );\ngl_Position = ( MVP2 ) * ( vec4 ( 0.0,0.0,0.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) + ( vec4 ( 1.0,1.4,1.0,0.6 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("q40",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 q40 ;\nflat out vec4 v0 ;\nvoid main() {\nv0 = q40;\ngl_Position = ( MVP ) * ( q40 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nflat in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) * ( vec4 ( 1.0,1.4,1.0,0.6 ) );\n}\n"}], slots = [Slot {slotName = "stream", slotStreams = fromList [("position",V3F)], slotUniforms = fromList [("MVP2",M44F)], slotPrimitive = Triangles, slotPrograms = [0,1]},Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [2]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 2,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = SrcAlpha, colorFDst = OneMinusSrcAlpha, alphaFSrc = SrcAlpha, alphaFDst = OneMinusSrcAlpha, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 1,SetProgram 1,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False,ColorOp NoBlending (VV4B (V4 True True False False))]}),RenderSlot 0,SetProgram 0,SetRasterContext (TriangleCtx CullNone (PolygonLine 20.0) NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Always False,ColorOp NoBlending (VV4B (V4 True True False False))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/gfx04.out b/tests/accept/gfx04.out
index 30e1c9f9..ad9a997d 100644
--- a/tests/accept/gfx04.out
+++ b/tests/accept/gfx04.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("t00022",Parameter {name = "position", ty = V3F}),("t00023",Parameter {name = "normal", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec3 t00022 ;\nin vec3 t00023 ;\nsmooth out vec4 v0 ;\nflat out vec4 v1 ;\nvoid main() {\nv0 = vec4 ( ( t00023 ).x,( t00023 ).y,( t00023 ).z,1.0 );\nv1 = vec4 ( ( t00022 ).x,( t00022 ).y,( t00022 ).z,1.0 );\ngl_Position = ( MVP ) * ( vec4 ( ( t00022 ).x,( t00022 ).y,( t00022 ).z,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nflat in vec4 v1 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) * ( vec4 ( 1.0,1.4,1.0,0.6 ) );\n}\n"}], slots = [Slot {slotName = "stream", slotStreams = fromList [("normal",V3F),("position",V3F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = SrcAlpha, colorFDst = OneMinusSrcAlpha, alphaFSrc = SrcAlpha, alphaFDst = OneMinusSrcAlpha, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("f20",Parameter {name = "normal", ty = V3F}),("z19",Parameter {name = "position", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec3 z19 ;\nin vec3 f20 ;\nsmooth out vec4 v0 ;\nflat out vec4 v1 ;\nvoid main() {\nv0 = vec4 ( 0.0,0.0,0.0,1.0 );\nv1 = vec4 ( 0.0,0.0,0.0,1.0 );\ngl_Position = ( MVP ) * ( vec4 ( 0.0,0.0,0.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nflat in vec4 v1 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) * ( vec4 ( 1.0,1.4,1.0,0.6 ) );\n}\n"}], slots = [Slot {slotName = "stream", slotStreams = fromList [("normal",V3F),("position",V3F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = SrcAlpha, colorFDst = OneMinusSrcAlpha, alphaFSrc = SrcAlpha, alphaFDst = OneMinusSrcAlpha, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/record01.out b/tests/accept/record01.out
index f941f5d5..7824c8a8 100644
--- a/tests/accept/record01.out
+++ b/tests/accept/record01.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("t00031",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 t00031 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = t00031;\ngl_Position = ( MVP ) * ( t00031 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) * ( vec4 ( 1.0,0.4,0.0,0.2 ) );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = SrcAlpha, colorFDst = OneMinusSrcAlpha, alphaFSrc = SrcAlpha, alphaFDst = OneMinusSrcAlpha, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("w12",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 w12 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = w12;\ngl_Position = ( MVP ) * ( w12 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) * ( vec4 ( 1.0,0.4,0.0,0.2 ) );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = SrcAlpha, colorFDst = OneMinusSrcAlpha, alphaFSrc = SrcAlpha, alphaFDst = OneMinusSrcAlpha, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/recursivetexture02.out b/tests/accept/recursivetexture02.out
index 723c6e33..683cd73c 100644
--- a/tests/accept/recursivetexture02.out
+++ b/tests/accept/recursivetexture02.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0}], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 0 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 1 0 Nothing)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 2 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 3 0 Nothing)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 4 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 5 0 Nothing)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 6 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 7 0 Nothing)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 8 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 9 0 Nothing)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("u",Parameter {name = "vertexUV", ty = V2F}),("v",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 v ;\nin vec2 u ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = u;\ngl_Position = ( ( MVP ) * ( v ) ) * ( vec4 ( 0.5,0.5,0.5,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( ( v0 ).x,( v0 ).y,( v0 ).x,( v0 ).y );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("u",Parameter {name = "vertexUV", ty = V2F}),("v",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [("sampler4",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 v ;\nin vec2 u ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = u;\ngl_Position = ( ( MVP ) * ( v ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler4 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler4,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("u",Parameter {name = "vertexUV", ty = V2F}),("v",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [("sampler3",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 v ;\nin vec2 u ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = u;\ngl_Position = ( ( MVP ) * ( v ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler3 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler3,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("u",Parameter {name = "vertexUV", ty = V2F}),("v",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [("sampler2",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 v ;\nin vec2 u ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = u;\ngl_Position = ( ( MVP ) * ( v ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler2 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler2,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("u",Parameter {name = "vertexUV", ty = V2F}),("v",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [("sampler1",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 v ;\nin vec2 u ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = u;\ngl_Position = ( ( MVP ) * ( v ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler1 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler1,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("u",Parameter {name = "vertexUV", ty = V2F}),("v",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [("sampler0",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 v ;\nin vec2 u ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = u;\ngl_Position = ( ( MVP ) * ( v ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler0 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler0,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F),("vertexUV",V2F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0,1,2,3,4,5]}], streams = [], commands = [SetRenderTarget 5,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 4,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 1,SetTexture 0 9,SetSamplerUniform "sampler4" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 3,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 2,SetTexture 0 7,SetSamplerUniform "sampler3" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 2,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 3,SetTexture 0 5,SetSamplerUniform "sampler2" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 1,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 4,SetTexture 0 3,SetSamplerUniform "sampler1" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 5,SetTexture 0 1,SetSamplerUniform "sampler0" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT Red) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Depth, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0},TextureDescriptor {textureType = Texture2D (FloatT RGBA) 1, textureSize = VV2U (V2 1024 768), textureSemantic = Color, textureSampler = SamplerDescriptor {samplerWrapS = Repeat, samplerWrapT = Nothing, samplerWrapR = Nothing, samplerMinFilter = Linear, samplerMagFilter = Linear, samplerBorderColor = VV4F (V4 0.0 0.0 0.0 1.0), samplerMinLod = Nothing, samplerMaxLod = Nothing, samplerLodBias = 0.0, samplerCompareFunc = Nothing}, textureBaseLevel = 0, textureMaxLevel = 0}], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 0 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 1 0 Nothing)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 2 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 3 0 Nothing)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 4 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 5 0 Nothing)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 6 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 7 0 Nothing)}]},RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (TextureImage 8 0 Nothing)},TargetItem {targetSemantic = Color, targetRef = Just (TextureImage 9 0 Nothing)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("d62",Parameter {name = "vertexUV", ty = V2F}),("w61",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 w61 ;\nin vec2 d62 ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = d62;\ngl_Position = ( ( MVP ) * ( w61 ) ) * ( vec4 ( 0.5,0.5,0.5,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ).xyxy;\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("b77",Parameter {name = "position4", ty = V4F}),("i77",Parameter {name = "vertexUV", ty = V2F})], programInTextures = fromList [("sampler4",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 b77 ;\nin vec2 i77 ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = i77;\ngl_Position = ( ( MVP ) * ( b77 ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler4 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler4,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("g92",Parameter {name = "position4", ty = V4F}),("n92",Parameter {name = "vertexUV", ty = V2F})], programInTextures = fromList [("sampler3",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 g92 ;\nin vec2 n92 ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = n92;\ngl_Position = ( ( MVP ) * ( g92 ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler3 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler3,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("l107",Parameter {name = "position4", ty = V4F}),("s107",Parameter {name = "vertexUV", ty = V2F})], programInTextures = fromList [("sampler2",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 l107 ;\nin vec2 s107 ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = s107;\ngl_Position = ( ( MVP ) * ( l107 ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler2 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler2,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("q122",Parameter {name = "position4", ty = V4F}),("x122",Parameter {name = "vertexUV", ty = V2F})], programInTextures = fromList [("sampler1",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 q122 ;\nin vec2 x122 ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = x122;\ngl_Position = ( ( MVP ) * ( q122 ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler1 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler1,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"},Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("c138",Parameter {name = "vertexUV", ty = V2F}),("v137",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [("sampler0",FTexture2D)], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 v137 ;\nin vec2 c138 ;\nsmooth out vec2 v0 ;\nvoid main() {\nv0 = c138;\ngl_Position = ( ( MVP ) * ( v137 ) ) * ( vec4 ( 1.0,1.0,1.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform sampler2D sampler0 ;\nsmooth in vec2 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( texture2D ( sampler0,v0 ) ) * ( vec4 ( 0.7,0.7,0.7,1.0 ) );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F),("vertexUV",V2F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0,1,2,3,4,5]}], streams = [], commands = [SetRenderTarget 5,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 4,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 1,SetTexture 0 9,SetSamplerUniform "sampler4" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 3,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 2,SetTexture 0 7,SetSamplerUniform "sampler3" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 2,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 3,SetTexture 0 5,SetSamplerUniform "sampler2" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 1,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 4,SetTexture 0 3,SetSamplerUniform "sampler1" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.0 1.0)}],SetProgram 5,SetTexture 0 1,SetSamplerUniform "sampler0" 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/reduce01.out b/tests/accept/reduce01.out
index fe31a70c..c408f1cb 100644
--- a/tests/accept/reduce01.out
+++ b/tests/accept/reduce01.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [(Color,Just (Framebuffer Color))]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("t00027",("position4",V4F))], programInTextures = fromList [], programOutput = [("f0",V4F)], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 t00027 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = t00027;\ngl_Position = t00027;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [(Color,VV4F (V4 0.0 0.0 0.4 1.0))],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("u7",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 u7 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = u7;\ngl_Position = u7;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.0 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/reduce05.out b/tests/accept/reduce05.out
index 2d50fe02..6085a9c8 100644
--- a/tests/accept/reduce05.out
+++ b/tests/accept/reduce05.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("t00020",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 t00020 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = t00020;\ngl_Position = t00020;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 1.0,0.0,0.0,1.0 );\n}\n"},Program {programUniforms = fromList [], programStreams = fromList [("t00020",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 t00020 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = t00020;\ngl_Position = t00020;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 0.0,1.0,0.0,1.0 );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Triangles, slotPrograms = [0,1]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.0 0.0 1.0 1.0)}],SetProgram 1,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 False True False False))]}),RenderSlot 0,SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True False False False))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("f8",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 f8 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = f8;\ngl_Position = f8;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 1.0,0.0,0.0,1.0 );\n}\n"},Program {programUniforms = fromList [], programStreams = fromList [("q18",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 q18 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = q18;\ngl_Position = q18;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 0.0,1.0,0.0,1.0 );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Triangles, slotPrograms = [0,1]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.0 0.0 1.0 1.0)}],SetProgram 1,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 False True False False))]}),RenderSlot 0,SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True False False False))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/reduce06.out b/tests/accept/reduce06.out
index 4791ed55..0faab023 100644
--- a/tests/accept/reduce06.out
+++ b/tests/accept/reduce06.out
@@ -1 +1 @@
-True
\ No newline at end of file
+Exp (Con_ ("True",Exp (Con_ ("Bool",Exp TType_) [])) [])
\ No newline at end of file
diff --git a/tests/accept/simple02.out b/tests/accept/simple02.out
index f941f5d5..7824c8a8 100644
--- a/tests/accept/simple02.out
+++ b/tests/accept/simple02.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("t00031",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 t00031 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = t00031;\ngl_Position = ( MVP ) * ( t00031 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) * ( vec4 ( 1.0,0.4,0.0,0.2 ) );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = SrcAlpha, colorFDst = OneMinusSrcAlpha, alphaFSrc = SrcAlpha, alphaFDst = OneMinusSrcAlpha, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("w12",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 w12 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = w12;\ngl_Position = ( MVP ) * ( w12 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = ( v0 ) * ( vec4 ( 1.0,0.4,0.0,0.2 ) );\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Triangles, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp (Blend {colorEqSrc = FuncAdd, alphaEqSrc = FuncAdd, colorFSrc = SrcAlpha, colorFDst = OneMinusSrcAlpha, alphaFSrc = SrcAlpha, alphaFDst = OneMinusSrcAlpha, color = V4 1.0 1.0 1.0 1.0}) (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/simple03.out b/tests/accept/simple03.out
index 2568ce50..3a065c2c 100644
--- a/tests/accept/simple03.out
+++ b/tests/accept/simple03.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("viewProj",M44F)], programStreams = fromList [("t00028",Parameter {name = "position", ty = V3F}),("t00029",Parameter {name = "color", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 viewProj ;\nin vec3 t00028 ;\nin vec3 t00029 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = vec4 ( ( t00029 ).x,( t00029 ).y,( t00029 ).z,1.0 );\ngl_Position = ( viewProj ) * ( vec4 ( ( t00028 ).x,( t00028 ).y,( t00028 ).z,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 1.0,1.0,1.0,1.0 );\n}\n"},Program {programUniforms = fromList [("viewProj",M44F)], programStreams = fromList [("t00088",Parameter {name = "position", ty = V3F}),("t00089",Parameter {name = "color", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 viewProj ;\nin vec3 t00088 ;\nin vec3 t00089 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = vec4 ( ( t00089 ).x,( t00089 ).y,( t00089 ).z,1.0 );\ngl_Position = ( viewProj ) * ( vec4 ( ( t00088 ).x,( t00088 ).y,( t00088 ).z,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "missing shader", slotStreams = fromList [("color",V3F),("position",V3F)], slotUniforms = fromList [("viewProj",M44F)], slotPrimitive = Triangles, slotPrograms = [0,1]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.0 0.0 0.4 1.0)}],SetProgram 1,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetProgram 0,SetRasterContext (TriangleCtx CullNone (PolygonLine 20.0) (Offset (-1.0) 0.0) FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)},TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("viewProj",M44F)], programStreams = fromList [("b13",Parameter {name = "color", ty = V3F}),("v12",Parameter {name = "position", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 viewProj ;\nin vec3 v12 ;\nin vec3 b13 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = vec4 ( 0.0,0.0,0.0,1.0 );\ngl_Position = ( viewProj ) * ( vec4 ( 0.0,0.0,0.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = vec4 ( 1.0,1.0,1.0,1.0 );\n}\n"},Program {programUniforms = fromList [("viewProj",M44F)], programStreams = fromList [("c31",Parameter {name = "position", ty = V3F}),("i31",Parameter {name = "color", ty = V3F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 viewProj ;\nin vec3 c31 ;\nin vec3 i31 ;\nsmooth out vec4 v0 ;\nvoid main() {\nv0 = vec4 ( 0.0,0.0,0.0,1.0 );\ngl_Position = ( viewProj ) * ( vec4 ( 0.0,0.0,0.0,1.0 ) );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nsmooth in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "missing shader", slotStreams = fromList [("color",V3F),("position",V3F)], slotUniforms = fromList [("viewProj",M44F)], slotPrimitive = Triangles, slotPrograms = [0,1]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0},ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.0 0.0 0.4 1.0)}],SetProgram 1,SetRasterContext (TriangleCtx CullNone PolygonFill NoOffset FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0,SetProgram 0,SetRasterContext (TriangleCtx CullNone (PolygonLine 20.0) (Offset (-1.0) 0.0) FirstVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Lequal True,ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/swizzling.out b/tests/accept/swizzling.out
index 4791ed55..0faab023 100644
--- a/tests/accept/swizzling.out
+++ b/tests/accept/swizzling.out
@@ -1 +1 @@
-True
\ No newline at end of file
+Exp (Con_ ("True",Exp (Con_ ("Bool",Exp TType_) [])) [])
\ No newline at end of file
diff --git a/tests/accept/recursivetexture01.lc b/tests/accept/tmp/recursivetexture01.lc
index 681894b9..681894b9 100644
--- a/tests/accept/recursivetexture01.lc
+++ b/tests/accept/tmp/recursivetexture01.lc
diff --git a/tests/accept/uniformparam01.out b/tests/accept/uniformparam01.out
index 7cb89db0..1554cccc 100644
--- a/tests/accept/uniformparam01.out
+++ b/tests/accept/uniformparam01.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("t00027",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 t00027 ;\nflat out vec4 v0 ;\nvoid main() {\nv0 = t00027;\ngl_Position = ( MVP ) * ( t00027 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nflat in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Lines, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (LineCtx 1.0 LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("s7",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 s7 ;\nflat out vec4 v0 ;\nvoid main() {\nv0 = s7;\ngl_Position = ( MVP ) * ( s7 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nflat in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Lines, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (LineCtx 1.0 LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/uniformparam02.out b/tests/accept/uniformparam02.out
index 66801067..efe3326a 100644
--- a/tests/accept/uniformparam02.out
+++ b/tests/accept/uniformparam02.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("t00012",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 t00012 ;\nflat out vec4 v0 ;\nvoid main() {\nv0 = t00012;\ngl_Position = t00012;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nflat in vec4 v0 ;\nvoid main() {\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Lines, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0}],SetProgram 0,SetRasterContext (LineCtx 1.0 LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Depth, targetRef = Just (Framebuffer Depth)}]}], programs = [Program {programUniforms = fromList [], programStreams = fromList [("v4",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nin vec4 v4 ;\nflat out vec4 v0 ;\nvoid main() {\nv0 = v4;\ngl_Position = v4;\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nflat in vec4 v0 ;\nvoid main() {\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [], slotPrimitive = Lines, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Depth, clearValue = VFloat 1000.0}],SetProgram 0,SetRasterContext (LineCtx 1.0 LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [DepthOp Less False]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/uniformparam03.out b/tests/accept/uniformparam03.out
index 0f8a775e..1554cccc 100644
--- a/tests/accept/uniformparam03.out
+++ b/tests/accept/uniformparam03.out
@@ -1 +1 @@
-Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [(Color,Just (Framebuffer Color))]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("t00027",("position4",V4F))], programInTextures = fromList [], programOutput = [("f0",V4F)], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 t00027 ;\nflat out vec4 v0 ;\nvoid main() {\nv0 = t00027;\ngl_Position = ( MVP ) * ( t00027 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nflat in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Lines, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [(Color,VV4F (V4 0.5 0.0 0.4 1.0))],SetProgram 0,SetRasterContext (LineCtx 1.0 LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
+Pipeline {backend = OpenGL33, textures = [], samplers = [], targets = [RenderTarget {renderTargets = [TargetItem {targetSemantic = Color, targetRef = Just (Framebuffer Color)}]}], programs = [Program {programUniforms = fromList [("MVP",M44F)], programStreams = fromList [("s7",Parameter {name = "position4", ty = V4F})], programInTextures = fromList [], programOutput = [Parameter {name = "f0", ty = V4F}], vertexShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nuniform mat4 MVP ;\nin vec4 s7 ;\nflat out vec4 v0 ;\nvoid main() {\nv0 = s7;\ngl_Position = ( MVP ) * ( s7 );\ngl_PointSize = 1.0;\n}\n", geometryShader = Nothing, fragmentShader = "#version 330 core\nvec4 texture2D(sampler2D s, vec2 uv){return texture(s,uv);}\nflat in vec4 v0 ;\nout vec4 f0 ;\nvoid main() {\nf0 = v0;\n}\n"}], slots = [Slot {slotName = "stream4", slotStreams = fromList [("position4",V4F)], slotUniforms = fromList [("MVP",M44F)], slotPrimitive = Lines, slotPrograms = [0]}], streams = [], commands = [SetRenderTarget 0,ClearRenderTarget [ClearImage {imageSemantic = Color, clearValue = VV4F (V4 0.5 0.0 0.4 1.0)}],SetProgram 0,SetRasterContext (LineCtx 1.0 LastVertex),SetAccumulationContext (AccumulationContext {accViewportName = Nothing, accOperations = [ColorOp NoBlending (VV4B (V4 True True True True))]}),RenderSlot 0]}
\ No newline at end of file
diff --git a/tests/accept/where.lc b/tests/accept/where.lc
new file mode 100644
index 00000000..bf9db0f2
--- /dev/null
+++ b/tests/accept/where.lc
@@ -0,0 +1,8 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+f = x
+  where
+    z = y
+      where
+        y = 1.0
+    x = 1.0
diff --git a/tests/demo/fragmenttest.lc b/tests/demo/tmp/fragmenttest.lc
index 47ef3ebe..47ef3ebe 100644
--- a/tests/demo/fragmenttest.lc
+++ b/tests/demo/tmp/fragmenttest.lc
diff --git a/prototypes/tests/reject/data.lc b/tests/reject/data.lc
index 4f609a33..4f609a33 100644
--- a/prototypes/tests/reject/data.lc
+++ b/tests/reject/data.lc
diff --git a/prototypes/tests/reject/empty.lc b/tests/reject/empty.lc
index 5349cc9b..5349cc9b 100644
--- a/prototypes/tests/reject/empty.lc
+++ b/tests/reject/empty.lc
diff --git a/tests/reject/accumulate01.lc b/tests/rejectold/accumulate01.lc
index 7b0e20da..7b0e20da 100644
--- a/tests/reject/accumulate01.lc
+++ b/tests/rejectold/accumulate01.lc
diff --git a/tests/reject/accumulate02.lc b/tests/rejectold/accumulate02.lc
index 3c4767c2..3c4767c2 100644
--- a/tests/reject/accumulate02.lc
+++ b/tests/rejectold/accumulate02.lc
diff --git a/tests/reject/accumulate03.lc b/tests/rejectold/accumulate03.lc
index fa0a8fba..fa0a8fba 100644
--- a/tests/reject/accumulate03.lc
+++ b/tests/rejectold/accumulate03.lc
diff --git a/tests/reject/adhoc.lc b/tests/rejectold/adhoc.lc
index 42e2d968..42e2d968 100644
--- a/tests/reject/adhoc.lc
+++ b/tests/rejectold/adhoc.lc
diff --git a/tests/reject/fragctx01.lc b/tests/rejectold/fragctx01.lc
index 9edefca9..9edefca9 100644
--- a/tests/reject/fragctx01.lc
+++ b/tests/rejectold/fragctx01.lc
diff --git a/tests/reject/fragctx02.lc b/tests/rejectold/fragctx02.lc
index 375b943f..375b943f 100644
--- a/tests/reject/fragctx02.lc
+++ b/tests/rejectold/fragctx02.lc
diff --git a/tests/reject/framebuffer01.lc b/tests/rejectold/framebuffer01.lc
index f39b24ff..f39b24ff 100644
--- a/tests/reject/framebuffer01.lc
+++ b/tests/rejectold/framebuffer01.lc
diff --git a/tests/reject/framebuffer02.lc b/tests/rejectold/framebuffer02.lc
index ab8504f6..ab8504f6 100644
--- a/tests/reject/framebuffer02.lc
+++ b/tests/rejectold/framebuffer02.lc
diff --git a/tests/reject/framebuffer03.lc b/tests/rejectold/framebuffer03.lc
index 0cbfc28a..0cbfc28a 100644
--- a/tests/reject/framebuffer03.lc
+++ b/tests/rejectold/framebuffer03.lc
diff --git a/tests/reject/instantiate.lc b/tests/rejectold/instantiate.lc
index 4e3bcfbb..4e3bcfbb 100644
--- a/tests/reject/instantiate.lc
+++ b/tests/rejectold/instantiate.lc
diff --git a/tests/reject/listcompr01.lc b/tests/rejectold/listcompr01.lc
index 37d01261..37d01261 100644
--- a/tests/reject/listcompr01.lc
+++ b/tests/rejectold/listcompr01.lc
diff --git a/tests/reject/nameclash01.lc b/tests/rejectold/nameclash01.lc
index 18776b15..18776b15 100644
--- a/tests/reject/nameclash01.lc
+++ b/tests/rejectold/nameclash01.lc
diff --git a/tests/reject/rastctx01.lc b/tests/rejectold/rastctx01.lc
index 2a667319..2a667319 100644
--- a/tests/reject/rastctx01.lc
+++ b/tests/rejectold/rastctx01.lc
diff --git a/tests/reject/record01.lc b/tests/rejectold/record01.lc
index 994a55a4..994a55a4 100644
--- a/tests/reject/record01.lc
+++ b/tests/rejectold/record01.lc
diff --git a/tests/reject/scope01.lc b/tests/rejectold/scope01.lc
index 336afac7..336afac7 100644
--- a/tests/reject/scope01.lc
+++ b/tests/rejectold/scope01.lc
diff --git a/tests/reject/syntax01.lc b/tests/rejectold/syntax01.lc
index 87505f14..87505f14 100644
--- a/tests/reject/syntax01.lc
+++ b/tests/rejectold/syntax01.lc
diff --git a/tests/reject/syntax02.lc b/tests/rejectold/syntax02.lc
index 868168a9..868168a9 100644
--- a/tests/reject/syntax02.lc
+++ b/tests/rejectold/syntax02.lc
diff --git a/tests/rejectold/typesig.lc b/tests/rejectold/typesig.lc
new file mode 100644
index 00000000..4c00d33a
--- /dev/null
+++ b/tests/rejectold/typesig.lc
@@ -0,0 +1,8 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+data X = X
+
+x :: x
+x = X
+
+
diff --git a/tests/reject/typesigctx.lc b/tests/rejectold/typesigctx.lc
index 0c5f00fe..0c5f00fe 100644
--- a/tests/reject/typesigctx.lc
+++ b/tests/rejectold/typesigctx.lc