diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+### 0.0.0.1
+
+- Initial release. Comes with parser and interpreter. Optimizer not done yet.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2021, Pippijn van Steenhoven
+ All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification, are 
+permitted provided that the following conditions are met:
+
+Redistributions of source code must retain the above copyright notice, this list of 
+conditions and the following disclaimer.
+
+Redistributions in binary form must reproduce the above copyright notice, this list of 
+conditions and the following disclaimer in the documentation and/or other materials 
+provided with the distribution.
+
+Neither the name of Mark Peter Wassell nor the names of its contributors may be used 
+to endorse or promote products derived from this software without specific prior written 
+permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY 
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 
+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR 
+TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/glsl.cabal b/glsl.cabal
new file mode 100644
--- /dev/null
+++ b/glsl.cabal
@@ -0,0 +1,93 @@
+name:           glsl
+version:        0.0.0.1
+cabal-version:  >= 1.10
+build-type:     Simple
+author:         Pippijn van Steenhoven
+license:        BSD3
+license-file:   LICENSE
+copyright:      2021 Pippijn van Steenhoven
+category:       Graphics
+stability:      Experimental
+homepage:       https://github.com/homectl/glsl
+synopsis:       Parser and optimizer for a small subset of GLSL
+description:
+                Parser and optimizer for a small subset of GLSL.
+
+                This package can parse a very small subset of GLSL, namely
+                exactly the subset emitted by GPipe-Core. It can evaluate the
+                code and return the computed result. This is useful for
+                debugging shaders generated by GPipe-Core.
+maintainer:     Pippijn van Steenhoven
+data-files:     CHANGELOG.md
+
+source-repository head
+  type:     git
+  location: https://github.com/homectl/workspace
+  subdir:   glsl
+
+library
+  default-language: Haskell2010
+  hs-source-dirs: src
+  exposed-modules:
+      Language.GLSL.ConstExpr
+      Language.GLSL.Decls
+      Language.GLSL.Optimizer.Deinline
+      Language.GLSL.Optimizer.DFG
+      Language.GLSL.Optimizer.FunctionGenerator
+      Language.GLSL.Optimizer.Liveness
+      Language.GLSL.Optimizer
+      Language.GLSL.Runtime.Eval
+      Language.GLSL.Runtime.Math
+      Language.GLSL.Runtime.PrimFuns
+      Language.GLSL.Runtime.Value
+      Language.GLSL.StructuralEquality
+      Language.GLSL.Types
+  build-depends:
+      base                          >= 4.9 && < 5
+    , attoparsec                    >= 0.10 && < 0.15
+    , containers                    >= 0.5 && < 0.7
+    , fgl                           >= 5.3 && < 6
+    , graphviz                      >= 2999.10 && < 2999.21
+    , lens                          >= 4.15.2 && < 6
+    , linear                        >= 1.18 && < 1.22
+    , scientific                    >= 0.3.1 && < 0.4
+    , text                          >= 0.10 && < 1.3
+    , transformers                  >= 0.5.2 && < 0.6
+  ghc-options:
+      -Wall
+
+test-suite testsuite
+  default-language: Haskell2010
+  hs-source-dirs:   test
+  type: exitcode-stdio-1.0
+  main-is:          testsuite.hs
+  other-modules:
+      Language.GLSL.Optimizer.DeinlineSpec
+      Language.GLSL.GLSLSpec
+      Test.GLSL
+  ghc-options:
+      -Wall
+      -threaded
+  build-tool-depends:
+      hspec-discover:hspec-discover
+  build-depends:
+      base
+    , attoparsec
+    , bytestring
+    , glsl
+    , hspec
+    , text
+
+executable optshader
+  default-language: Haskell2010
+  hs-source-dirs:   tools
+  main-is:          optshader.hs
+  ghc-options:
+      -Wall
+      -rtsopts
+      -threaded
+  build-depends:
+      base < 5
+    , glsl
+    , text
+    , time
diff --git a/src/Language/GLSL/ConstExpr.hs b/src/Language/GLSL/ConstExpr.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/ConstExpr.hs
@@ -0,0 +1,45 @@
+module Language.GLSL.ConstExpr
+  ( ConstExprs
+  , collectConstExprs
+  , isConstExpr
+  ) where
+
+import qualified Data.IntSet         as S
+import           Language.GLSL.Types
+
+
+newtype ConstExprs = ConstExprs S.IntSet
+
+collectConstExprs :: [StmtAnnot a] -> ConstExprs
+collectConstExprs = ConstExprs . foldr (add . unAnnot) S.empty
+  where
+    add :: Stmt a -> S.IntSet -> S.IntSet
+    add (AssignStmt (Name NsT (NameId n)) e) s
+      | isConstExpr (ConstExprs s) e = S.insert n s
+    add _ s = s
+
+
+isConstExpr :: ConstExprs -> Expr -> Bool
+isConstExpr ce (BinaryExpr l BOpMul r) =
+  any isZero [l, r] || all (isConstExprAtom ce) [l, r]
+
+isConstExpr ce (AtomExpr e)         = isConstExprAtom ce e
+isConstExpr ce (UnaryExpr _ e)      = isConstExprAtom ce e
+isConstExpr ce (BinaryExpr l _ r)   = all (isConstExprAtom ce) [l, r]
+isConstExpr ce (FunCallExpr _ args) = all (isConstExprAtom ce) args
+isConstExpr _ TextureExpr{}         = False
+
+
+isConstExprAtom :: ConstExprs -> ExprAtom -> Bool
+isConstExprAtom (ConstExprs ce) (IdentifierExpr (NameExpr (Name NsT (NameId n)))) =
+  S.member n ce
+
+isConstExprAtom _ LitIntExpr{}   = True
+isConstExprAtom _ LitFloatExpr{} = True
+isConstExprAtom _ _              = False
+
+
+isZero :: ExprAtom -> Bool
+isZero (LitIntExpr _ 0)   = True
+isZero (LitFloatExpr _ 0) = True
+isZero _                  = False
diff --git a/src/Language/GLSL/Decls.hs b/src/Language/GLSL/Decls.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Decls.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StrictData      #-}
+module Language.GLSL.Decls where
+
+import qualified Data.IntMap.Strict  as M
+import           Language.GLSL.Types (Name (..), NameExpr (..), NameId (..),
+                                      Namespace (..))
+
+
+data Decls a = Decls
+  { declsS   :: M.IntMap a
+  , declsT   :: M.IntMap a
+  , declsU   :: M.IntMap a
+  , declsVF  :: M.IntMap a
+  , declsIn  :: M.IntMap a
+  , declsOut :: M.IntMap a
+  }
+
+emptyDecls :: Decls a
+emptyDecls = Decls M.empty M.empty M.empty M.empty M.empty M.empty
+
+addDecl :: Namespace -> NameId -> a -> Decls a -> Decls a
+addDecl NsT (NameId n) v decls@Decls{..} = decls{declsT = M.insert n v declsT}
+addDecl NsS (NameId n) v decls@Decls{..} = decls{declsS = M.insert n v declsS}
+addDecl NsU (NameId n) v decls@Decls{..} = decls{declsU = M.insert n v declsU}
+addDecl NsVF (NameId n) v decls@Decls{..} = decls{declsVF = M.insert n v declsVF}
+addDecl NsIn (NameId n) v decls@Decls{..} = decls{declsIn = M.insert n v declsIn}
+addDecl NsOut (NameId n) v decls@Decls{..} = decls{declsOut = M.insert n v declsOut}
+
+addDeclN :: Name -> a -> Decls a -> Decls a
+addDeclN (Name ns n) = addDecl ns n
+
+addDeclNE :: NameExpr -> a -> Decls a -> Decls a
+addDeclNE (NameExpr n)      = addDeclN n
+addDeclNE (UniformExpr n m) = addDecl NsU (toUniformId (n, m))
+
+getDecls :: Namespace -> Decls a -> M.IntMap a
+getDecls NsT Decls{..}   = declsT
+getDecls NsS Decls{..}   = declsS
+getDecls NsU Decls{..}   = declsU
+getDecls NsVF Decls{..}  = declsVF
+getDecls NsIn Decls{..}  = declsIn
+getDecls NsOut Decls{..} = declsOut
+
+getDecl :: Namespace -> NameId -> Decls a -> Maybe a
+getDecl ns (NameId n) decls = M.lookup n (getDecls ns decls)
+
+getDeclN :: Name -> Decls a -> Maybe a
+getDeclN (Name ns n) = getDecl ns n
+
+getDeclNE :: NameExpr -> Decls a -> Maybe a
+getDeclNE (NameExpr n)      = getDeclN n
+getDeclNE (UniformExpr n m) = getDecl NsU (toUniformId (n, m))
+
+toUniformId :: (NameId, NameId) -> NameId
+toUniformId (NameId n, NameId m) = NameId $ n * 1000 + m
+
+fromUniformId :: NameId -> (NameId, NameId)
+fromUniformId (NameId i) = let (n, m) = i `divMod` 1000 in (NameId n, NameId m)
+
+showUniformId :: NameId -> String
+showUniformId i =
+  let (n, m) = fromUniformId i in
+  "u" <> show n <> ".u" <> show m
diff --git a/src/Language/GLSL/Optimizer.hs b/src/Language/GLSL/Optimizer.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Optimizer.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData        #-}
+module Language.GLSL.Optimizer where
+
+import           Control.Monad                    (when)
+import           Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Text.Lazy                   as LT
+import qualified Data.Text.Lazy.IO                as IO
+import qualified Language.GLSL.Optimizer.Deinline as Deinline
+import qualified Language.GLSL.Optimizer.Liveness as Liveness
+import           Language.GLSL.Types              (Annot, GLSL, parseGLSL,
+                                                   parseShader, parseTest,
+                                                   printShader)
+
+
+optimizeShader :: LT.Text -> Either String LT.Text
+-- optimizeShader = fmap printShader . parse
+optimizeShader = fmap (printShader . optimize) . parse
+
+
+parse :: LT.Text -> Either String (GLSL ())
+parse = parseShader
+
+optimize :: Annot a => GLSL a -> GLSL a
+optimize = (`const` id)
+  -- . foldr (.) id (replicate 20 $ Deinline.pass Deinline.defaultConfig{Deinline.windowSize=5})
+  -- . foldr (.) id (replicate 30 $ Deinline.pass Deinline.defaultConfig{Deinline.windowSize=10})
+  . Deinline.pass Deinline.defaultConfig{Deinline.windowSize=10}
+
+
+main :: IO ()
+main = do
+  putStrLn "Loading shader source..."
+  -- inText <- IO.readFile "../large-shaders/lambdacnc.frag"
+  -- inText <- IO.readFile "../large-shaders/lambdacnc.vert"
+  -- inText <- IO.readFile "../large-shaders/lambdaray.frag"
+  -- inText <- IO.readFile "../large-shaders/xax.frag"
+  inText <- IO.readFile "../large-shaders/xax.vert"
+  -- inText <- IO.readFile "../large-shaders/small.vert"
+  when False $ parseTest (parseGLSL :: Parser (GLSL ())) inText
+  putStrLn "Parsing shader source..."
+  case parse inText of
+    Left err -> writeFile "../opt.glsl" $ "// Error\n" <> err
+    Right ok -> do
+      putStrLn "Computing liveness..."
+      let ls = Liveness.computeLiveness ok
+      putStrLn "Optimizing shader..."
+      IO.writeFile "../opt.glsl" $ printShader $ optimize ls
diff --git a/src/Language/GLSL/Optimizer/DFG.hs b/src/Language/GLSL/Optimizer/DFG.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Optimizer/DFG.hs
@@ -0,0 +1,156 @@
+{-# LANGUAGE NamedFieldPuns  #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StrictData      #-}
+module Language.GLSL.Optimizer.DFG where
+
+import           Control.Monad.Trans.State (StateT, execState, get, modify',
+                                            put)
+import           Data.Foldable             (forM_)
+import           Data.Functor              (void)
+import           Data.Functor.Identity     (Identity)
+import           Data.Graph.Inductive      (Node)
+import qualified Data.Graph.Inductive      as G
+import qualified Data.GraphViz             as GV
+import qualified Data.GraphViz.Printing    as GV
+import qualified Data.Text.Lazy.IO         as IO
+import           Language.GLSL.Decls
+import           Language.GLSL.Types       hiding (t)
+
+--------------------------------------------------------------------------------
+
+data DFG = DFG
+  { gr         :: G.Gr DFGNode DFGEdge
+  , decls      :: Decls Node
+  , nextNodeId :: Node
+  , ifCond     :: Maybe Node
+  }
+
+emptyDFG :: DFG
+emptyDFG = DFG
+  { gr = G.empty
+  , decls = emptyDecls
+  , nextNodeId = 0
+  , ifCond = Nothing
+  }
+
+data DFGEdge = DFGEdge
+  deriving (Show)
+
+data DFGNode
+  = DFGNode Namespace NameId
+  deriving (Show)
+
+type DFGState = StateT DFG Identity
+
+genDFG :: GLSL a -> DFG
+genDFG prog = execState (dfgGLSL prog) emptyDFG
+
+dfgGLSL :: GLSL a -> DFGState ()
+dfgGLSL (GLSL _ decls) = mapM_ dfgTopDecl decls
+
+dfgTopDecl :: TopDecl a -> DFGState ()
+dfgTopDecl (LayoutDecl _ d)     = dfgGlobalDecl d
+dfgTopDecl (GlobalDecl d)       = dfgGlobalDecl d
+dfgTopDecl (ProcDecl _ _ stmts) = mapM_ dfgStmtAnnot stmts
+
+dfgGlobalDecl :: GlobalDecl -> DFGState ()
+dfgGlobalDecl (GDecl _ (TyStruct _ ms) (Name NsU n)) =
+  mapM_ (dfgStructMember n) ms
+dfgGlobalDecl (GDecl _ _ (Name ns n)) =
+  void $ addNode ns n
+
+dfgStructMember :: NameId -> (Type, NameId) -> DFGState ()
+dfgStructMember n (_, m) = void $ addNode NsU (toUniformId (n, m))
+
+dfgStmt :: Stmt a -> DFGState ()
+dfgStmt (DeclStmt d)     = dfgLocalDecl d
+dfgStmt (AssignStmt n e) = do
+  targetId <- nodeForName n
+  DFG{ifCond} <- get
+  forM_ ifCond (addEdge targetId)
+  dfgExpr e targetId
+dfgStmt (IfStmt c t e) = do
+  ifCond <- Just <$> nodeFor NsT c
+  modify' $ \dfg -> dfg{ifCond}
+  mapM_ dfgStmtAnnot (t ++ e)
+  modify' $ \dfg -> dfg{ifCond=Nothing}
+dfgStmt _                = return ()
+
+dfgStmtAnnot :: StmtAnnot a -> DFGState ()
+dfgStmtAnnot (SA _ s) = dfgStmt s
+
+dfgLocalDecl :: LocalDecl -> DFGState ()
+dfgLocalDecl (LDecl _ n e) = do
+  nodeId <- addNode NsT n
+  maybe (return ()) (`dfgExpr` nodeId) e
+
+dfgExpr :: Expr -> Node -> DFGState ()
+dfgExpr (FunCallExpr _ args) declNode = mapM_ (`dfgExprAtom` declNode) args
+dfgExpr (TextureExpr t x y) declNode  = mapM_ (`dfgExprAtom` declNode) [t, x, y]
+dfgExpr (UnaryExpr _ e) declNode      = dfgExprAtom e declNode
+dfgExpr (AtomExpr e) declNode         = dfgExprAtom e declNode
+dfgExpr (BinaryExpr l _ r) declNode   = mapM_ (`dfgExprAtom` declNode) [l, r]
+
+dfgExprAtom :: ExprAtom -> Node -> DFGState ()
+dfgExprAtom LitIntExpr{} _                = return ()
+dfgExprAtom LitFloatExpr{} _              = return ()
+dfgExprAtom (IdentifierExpr n) declNode   = nodeForNameExpr n >>= addEdge declNode
+dfgExprAtom (SwizzleExpr n _)  declNode   = nodeFor NsT n >>= addEdge declNode
+dfgExprAtom (VecIndexExpr n _) declNode   = nodeForNameExpr n >>= addEdge declNode
+dfgExprAtom (MatIndexExpr n _ _) declNode = nodeForNameExpr n >>= addEdge declNode
+
+
+nodeForUniform :: NameId -> NameId -> DFGState Node
+nodeForUniform n m = do
+  DFG{..} <- get
+  let i = toUniformId (n, m)
+  case getDecl NsU i decls of
+    Nothing -> error $ "no node for " <> showUniformId i
+    Just ok -> return ok
+
+nodeForNameExpr :: NameExpr -> DFGState Node
+nodeForNameExpr (NameExpr n)      = nodeForName n
+nodeForNameExpr (UniformExpr n m) = nodeForUniform n m
+
+nodeForName :: Name -> DFGState Node
+nodeForName (Name ns n) = nodeFor ns n
+
+nodeFor :: Namespace -> NameId -> DFGState Node
+nodeFor ns n = do
+  DFG{..} <- get
+  case getDecl ns n decls of
+    Nothing -> error $ "no node for " <> pp ppName (Name ns n)
+    Just ok -> return ok
+
+addEdge :: Node -> Node -> DFGState ()
+addEdge declNode idNode =
+  modify' $ \g@DFG{gr} -> g { gr = G.insEdge (declNode, idNode, DFGEdge) gr }
+
+addNode :: Namespace -> NameId -> DFGState Node
+addNode ns n = do
+  g@DFG{..} <- get
+  let nodeId = nextNodeId
+  put g { gr = G.insNode (nodeId, DFGNode ns n) gr
+        , decls = addDecl ns n nodeId decls
+        , nextNodeId = nextNodeId + 1
+        }
+  return nodeId
+
+--------------------------------------------------------------------------------
+-- Visualisation
+--------------------------------------------------------------------------------
+
+instance GV.Labellable DFGNode where
+  toLabelValue (DFGNode NsU i) = GV.toLabelValue $ showUniformId i
+  toLabelValue (DFGNode ns n) = GV.toLabelValue $
+    pp ppNamespace ns <> show n
+
+instance GV.Labellable DFGEdge where
+  toLabelValue DFGEdge = GV.toLabelValue ""
+
+toDot :: FilePath -> DFG -> IO ()
+toDot path =
+  IO.writeFile path . GV.printIt . GV.graphToDot GV.quickParams . gr
+
+toSvg :: DFG -> FilePath -> IO FilePath
+toSvg DFG{gr} = GV.runGraphviz (GV.graphToDot GV.quickParams gr) GV.Svg
diff --git a/src/Language/GLSL/Optimizer/Deinline.hs b/src/Language/GLSL/Optimizer/Deinline.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Optimizer/Deinline.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections   #-}
+module Language.GLSL.Optimizer.Deinline where
+
+import           Control.Applicative                       (ZipList (..))
+import           Control.Arrow                             ((&&&))
+import qualified Data.List                                 as List
+import           Data.Maybe                                (listToMaybe)
+import           Debug.Trace                               (trace)
+import           Language.GLSL.ConstExpr                   (ConstExprs,
+                                                            collectConstExprs)
+import qualified Language.GLSL.Optimizer.FunctionGenerator as FunctionGenerator
+import qualified Language.GLSL.StructuralEquality          as StructuralEquality
+import           Language.GLSL.Types
+
+
+data Config = Config
+  { maxLookahead :: Int
+  -- ^ Maximum number of statements to look ahead for equality.
+  --
+  --   Increasing this potentially finds more de-inlining opportunities but also
+  --   drastically increases the cost of not finding any. This number does not
+  --   matter if we always find an opportunity quickly.
+
+  , minRepeats   :: Int
+  -- ^ Minimum number of times a piece of code needs to appear for it to be
+  --   worth extracting into a function.
+
+  , maxRepeats   :: Int
+  -- ^ Maximum number of initial repeats to use for maximization. If we find
+  --   enough, we're happy and stop looking. Most of the time we'll find fewer
+  --   than 10, but sometimes a bit of code is repeated a lot which would slow
+  --   down the algorithm significantly.
+
+  , windowSize   :: Int
+  -- ^ Number of statements in the sliding window.
+  }
+
+
+defaultConfig :: Config
+defaultConfig = Config
+  { maxLookahead = 200
+  , minRepeats = 3
+  , maxRepeats = 10
+  , windowSize = 10
+  }
+
+
+pass :: Annot a => Config -> GLSL a -> GLSL a
+pass config (GLSL v d) = GLSL v (map (diTopDecl config) d)
+
+diTopDecl :: Annot a => Config -> TopDecl a -> TopDecl a
+diTopDecl config (ProcDecl fn params body) =
+  ProcDecl fn params $ diStmts config body
+diTopDecl _ d = d
+
+
+diStmts :: Annot a => Config -> [StmtAnnot a] -> [StmtAnnot a]
+diStmts config ss =
+  let ce = collectConstExprs ss in
+  case findBody config ce ss of
+    Nothing -> ss
+    Just body ->
+      let _newProc = pp ppTopDecl (FunctionGenerator.makeFunction body) in
+      trace (
+        "found one! length = " <> show (length body)
+        -- <> "\n" <> ppl ppStmtAnnot body <> "\n\n"
+        -- <> newProc
+      ) $ deleteBody ce body ss
+
+
+-- | Remove all occurrences of 'body' from 'ss'.
+deleteBody :: ConstExprs -> [StmtAnnot a] -> [StmtAnnot a] -> [StmtAnnot a]
+deleteBody ce body = go []
+  where
+    go acc [] = reverse acc
+    go acc (s:ss) =
+      if StructuralEquality.eqStmtAnnots ce (zip body ss)
+        then go (s:acc) (drop (length body) ss)
+        else go (s:acc) ss
+
+
+findBody :: Config -> ConstExprs -> [StmtAnnot a] -> Maybe [StmtAnnot a]
+findBody _ _ [] = Nothing
+findBody Config{..} _ (_:ss) | length ss < windowSize = Nothing
+findBody config@Config{..} ce (_:ss) =
+  let
+    -- Get a peep hole window of statements.
+    window = take windowSize ss
+
+    -- We'll iterate over all possible sub-programs from the current position.
+    tails = List.tails ss
+
+    -- We want to find similar statements and filter out the empty sub-program
+    -- since the empty list is trivially equal to another empty list.
+    isSimilar l = not (null l) && StructuralEquality.eqStmtAnnots ce l
+
+    -- Try to find a similar set of statements to the window somewhere in the
+    -- lookahead range.
+    firstRepeat =
+      List.find isSimilar
+      . map (zip window)
+      . take maxLookahead
+      $ tails
+
+    -- If we found one, see how many more we find in the code.
+    --
+    -- If we find enough, we're happy and stop looking. Most of the time we'll
+    -- find fewer than 10, but sometimes a bit of code is repeated a lot which would
+    -- slow down the algorithm.
+    allRepeats =
+      take maxRepeats
+      . map fst
+      . filter (isSimilar . snd)
+      . map (id &&& zip window)
+      $ tails
+
+    -- If there are enough repeats to be worth extracting, try to maximise
+    -- the amount of code extracted.
+    maximised =
+      transpose
+      . takeWhile (allEqual ce)
+      . transpose
+      $ ss : allRepeats
+  in
+  case firstRepeat of
+    -- No matches, continue looking.
+    Nothing -> findBody config ce ss
+    -- Found one, but the number of repeats doesn't make it worth
+    -- extracting into a function (minRepeats counts the first occurrence
+    -- which is in the window and not in allRepeats).
+    Just _ | length (take (minRepeats - 1) allRepeats) < minRepeats - 1 ->
+      findBody config ce ss
+    -- Found one with several repeats, we'll extract this one.
+    Just _ -> listToMaybe maximised
+
+
+transpose :: [[a]] -> [[a]]
+transpose = getZipList . traverse ZipList
+
+-- | Check for each statement whether it's structurally equal to the first one.
+allEqual :: ConstExprs -> [StmtAnnot a] -> Bool
+allEqual _ []      = True
+allEqual ce (x:xs) = all (StructuralEquality.eqStmtAnnot ce x) xs
diff --git a/src/Language/GLSL/Optimizer/FunctionGenerator.hs b/src/Language/GLSL/Optimizer/FunctionGenerator.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Optimizer/FunctionGenerator.hs
@@ -0,0 +1,7 @@
+module Language.GLSL.Optimizer.FunctionGenerator where
+
+import           Language.GLSL.Types
+
+
+makeFunction :: [StmtAnnot a] -> TopDecl a
+makeFunction _ = ProcDecl ProcMain [] []
diff --git a/src/Language/GLSL/Optimizer/Liveness.hs b/src/Language/GLSL/Optimizer/Liveness.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Optimizer/Liveness.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GLSL.Optimizer.Liveness where
+
+import qualified Data.IntSet            as S
+import qualified Data.Text.Lazy.Builder as LTB
+import           Language.GLSL.Types    hiding (t)
+
+
+newtype Liveness = Liveness { unLiveness :: S.IntSet }
+
+empty :: Liveness
+empty = Liveness S.empty
+
+instance Annot Liveness where
+  parseAnnot = pure empty
+  ppAnnot = Just . LTB.fromString . show . S.toList . unLiveness
+
+
+computeLiveness :: GLSL a -> GLSL Liveness
+computeLiveness (GLSL v d) = GLSL v (map clTopDecl d)
+
+clTopDecl :: TopDecl a -> TopDecl Liveness
+clTopDecl (LayoutDecl s d) = LayoutDecl s d
+clTopDecl (GlobalDecl d) = GlobalDecl d
+clTopDecl (ProcDecl name params ss) =
+  ProcDecl name params . fst . clStmtAnnots empty $ ss
+
+clStmtAnnots :: Liveness -> [StmtAnnot a] -> ([StmtAnnot Liveness], Liveness)
+clStmtAnnots ls = foldr clStmtAnnot ([], ls)
+
+clStmtAnnot
+  :: StmtAnnot a
+  -> ([StmtAnnot Liveness], Liveness)
+  -> ([StmtAnnot Liveness], Liveness)
+clStmtAnnot (SA _ s) (ss, ls) =
+  let (s', ls') = clStmt s ls in
+  (SA ls' s':ss, ls')
+
+clStmt :: Stmt a -> Liveness -> (Stmt Liveness, Liveness)
+clStmt (AssignStmt n e) ls =
+  (AssignStmt n e, clExpr e ls)
+clStmt (DeclStmt d@(LDecl _ (NameId n) e)) ls =
+  (DeclStmt d, delete n . maybe id clExpr e $ ls)
+clStmt (EmitStmt e) ls =
+  (EmitStmt e, clEmit e ls)
+clStmt (IfStmt (NameId c) t e) ls =
+  let (t', lsT) = clStmtAnnots ls t
+      (e', lsE) = clStmtAnnots ls e
+  in
+  (IfStmt (NameId c) t' e', insert c $ lsT `union` lsE)
+
+
+clEmit :: Emit -> Liveness -> Liveness
+clEmit EmitFragDepth    = id
+clEmit (EmitPosition e) = clExpr e
+
+clExpr :: Expr -> Liveness -> Liveness
+clExpr (UnaryExpr _ e) ls      = clExprAtom e ls
+clExpr (BinaryExpr l _ r) ls   = clExprAtom l . clExprAtom r $ ls
+clExpr (FunCallExpr _ args) ls = foldr clExprAtom ls args
+clExpr (TextureExpr t x y) ls  = foldr clExprAtom ls [t, x, y]
+clExpr (AtomExpr e) ls         = clExprAtom e ls
+
+clExprAtom :: ExprAtom -> Liveness -> Liveness
+clExprAtom (IdentifierExpr n) ls         = clNameExpr n ls
+clExprAtom (SwizzleExpr (NameId n) _) ls = insert n ls
+clExprAtom _ ls                          = ls
+
+clNameExpr :: NameExpr -> Liveness -> Liveness
+clNameExpr (NameExpr (Name NsT (NameId n))) ls = insert n ls
+clNameExpr _ ls                                = ls
+
+insert :: Int -> Liveness -> Liveness
+insert n = Liveness . S.insert n . unLiveness
+
+delete :: Int -> Liveness -> Liveness
+delete n = Liveness . S.delete n . unLiveness
+
+union :: Liveness -> Liveness -> Liveness
+union a b = Liveness $ S.union (unLiveness a) (unLiveness b)
diff --git a/src/Language/GLSL/Runtime/Eval.hs b/src/Language/GLSL/Runtime/Eval.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Runtime/Eval.hs
@@ -0,0 +1,210 @@
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE StrictData                 #-}
+{-# LANGUAGE ViewPatterns               #-}
+module Language.GLSL.Runtime.Eval where
+
+import           Control.Lens                     ((^.))
+import           Control.Monad                    (foldM, foldM_)
+import           Control.Monad.Trans.State.Strict (evalStateT, get, modify')
+import qualified Data.IntMap                      as M
+import qualified Data.Text.Lazy                   as LT
+import qualified Data.Text.Lazy.IO                as IO
+import qualified Debug.Trace                      as Trace
+import           Language.GLSL.Decls              (addDecl, addDeclN, addDeclNE,
+                                                   emptyDecls, getDeclNE,
+                                                   toUniformId)
+import qualified Language.GLSL.Runtime.PrimFuns   as PrimFuns
+import           Language.GLSL.Runtime.Value      (Eval, EvalResult (..),
+                                                   EvalState (..), Proc (..),
+                                                   Value (..), defaultValue,
+                                                   evalBinaryOp, evalCoerce,
+                                                   evalUnaryOp, isNaNValue,
+                                                   roundValue)
+import           Language.GLSL.Types
+import           Linear                           (R1 (..), R2 (..), R3 (..),
+                                                   R4 (..))
+
+
+traceAssignments :: Bool
+traceAssignments = False
+
+trace :: String -> a -> a
+trace = if traceAssignments then Trace.trace else const id
+
+
+eval :: LT.Text -> Either String Value
+eval code = do
+  glsl <- parseShader code
+  fromResult $ evalStateT (evalGLSL glsl) startState
+
+
+startState :: EvalState
+startState = EvalState
+  { stProcs = M.empty
+  , stMainProc = Nothing
+
+  , globals = emptyDecls
+  , gl_Position = Nothing
+  }
+
+
+evalGLSL :: GLSL () -> Eval Value
+evalGLSL (GLSL _ d) = do
+  mapM_ discoverTopDecl d
+  evalMain
+  -- maybe (FloatValue 0) id . gl_Position <$> get
+  roundValue <$> getValue emptyLocals (NameExpr (Name NsOut (NameId 0)))
+
+discoverTopDecl :: TopDecl () -> Eval ()
+discoverTopDecl (LayoutDecl _ d) = discoverGlobalDecl d
+discoverTopDecl (GlobalDecl d) = discoverGlobalDecl d
+discoverTopDecl (ProcDecl ProcMain params body) =
+  modify' $ \st -> st{stMainProc = Just $ Proc params body}
+discoverTopDecl (ProcDecl (ProcName (NameId n)) params body) =
+  modify' $ \st@EvalState{..} -> st{stProcs = M.insert n (Proc params body) stProcs}
+
+discoverGlobalDecl :: GlobalDecl -> Eval ()
+discoverGlobalDecl (GDecl GkUniform (TyStruct _ fields) (Name NsU n)) =
+  modify' $ \st@EvalState{..} ->
+    st{globals = foldr (\(ty, m) -> addDecl NsU (toUniformId (n, m)) (defaultValue ty)) globals fields}
+discoverGlobalDecl (GDecl GkOut ty n) =
+  modify' $ \st@EvalState{..} -> st{globals = addDeclN n (defaultValue ty) globals}
+discoverGlobalDecl (GDecl GkIn ty n) =
+  modify' $ \st@EvalState{..} -> st{globals = addDeclN n (defaultValue ty) globals}
+discoverGlobalDecl d@(GDecl GkUniform _ _) =
+  fail $ "unsupported uniform type in decl: " <> pp ppGlobalDecl d
+
+
+evalMain :: Eval ()
+evalMain = do
+  Just mainProc <- stMainProc <$> get
+  evalProc mainProc []
+  return ()
+
+newtype LocalState = LocalState
+  { temps :: M.IntMap Value
+  }
+
+emptyLocals :: LocalState
+emptyLocals = LocalState
+  { temps = M.empty
+  }
+
+evalProc :: Proc -> [Value] -> Eval ()
+evalProc (Proc _params ss) _args =
+  foldM_ evalStmtAnnot emptyLocals ss
+
+evalStmtAnnot :: LocalState -> StmtAnnot () -> Eval LocalState
+evalStmtAnnot lst (SA () s) = evalStmt lst s
+
+evalStmt :: LocalState -> Stmt () -> Eval LocalState
+evalStmt lst (AssignStmt n e) = do
+  v <- evalExpr lst e
+  setValue lst (NameExpr n) v
+evalStmt lst (DeclStmt d) = evalLocalDecl lst d
+evalStmt lst (EmitStmt e) = evalEmit lst e
+evalStmt lst (IfStmt cond thens elses) = do
+  BoolValue v <- getValue lst (NameExpr (Name NsT cond))
+  if v
+    then foldM evalStmtAnnot lst thens
+    else foldM evalStmtAnnot lst elses
+
+evalEmit :: LocalState -> Emit -> Eval LocalState
+evalEmit lst EmitFragDepth = return lst
+evalEmit lst (EmitPosition e) = do
+  v <- evalExpr lst e
+  modify' $ \st -> st{gl_Position = Just v}
+  return lst
+
+evalLocalDecl :: LocalState -> LocalDecl -> Eval LocalState
+evalLocalDecl lst (LDecl ty (NameExpr . Name NsT -> n) Nothing) =
+  let v = defaultValue ty in
+  setValue lst n v
+evalLocalDecl lst (LDecl ty (NameExpr . Name NsT -> n) (Just e)) = do
+  v <- evalExpr lst e >>= evalCoerce ty
+  setValue lst n v
+
+evalExpr :: LocalState -> Expr -> Eval Value
+evalExpr lst = \case
+  BinaryExpr l op r -> do
+    lv <- evalExprAtom lst l
+    rv <- evalExprAtom lst r
+    return $ evalBinaryOp lv op rv
+  UnaryExpr op e -> do
+    v <- evalExprAtom lst e
+    return $ evalUnaryOp op v
+  AtomExpr e -> evalExprAtom lst e
+  FunCallExpr fun args -> do
+    vals <- mapM (evalExprAtom lst) args
+    PrimFuns.eval fun vals
+  e@TextureExpr{} ->
+    fail $ "texture() not implemented: " <> pp ppExpr e
+
+evalExprAtom :: LocalState -> ExprAtom -> Eval Value
+evalExprAtom lst = \case
+  LitFloatExpr _ f   -> return $ FloatValue f
+  LitIntExpr _ i     -> return $ IntValue i
+  IdentifierExpr n   -> getValue lst n
+  SwizzleExpr n s    -> getValue lst (NameExpr (Name NsT n)) >>= evalVecIndex s
+  VecIndexExpr n i   -> getValue lst n >>= evalVecIndex i
+  MatIndexExpr n i j -> getValue lst n >>= evalMatIndex i j
+
+evalVecIndex :: Swizzle -> Value -> Eval Value
+evalVecIndex X (Vec2Value v) = return $ FloatValue $ v ^. _x
+evalVecIndex Y (Vec2Value v) = return $ FloatValue $ v ^. _y
+evalVecIndex X (Vec3Value v) = return $ FloatValue $ v ^. _x
+evalVecIndex Y (Vec3Value v) = return $ FloatValue $ v ^. _y
+evalVecIndex Z (Vec3Value v) = return $ FloatValue $ v ^. _z
+evalVecIndex X (Vec4Value v) = return $ FloatValue $ v ^. _x
+evalVecIndex Y (Vec4Value v) = return $ FloatValue $ v ^. _y
+evalVecIndex Z (Vec4Value v) = return $ FloatValue $ v ^. _z
+evalVecIndex W (Vec4Value v) = return $ FloatValue $ v ^. _w
+evalVecIndex s v = fail $ "cannot access " <> pp ppSwizzle s <> " on " <> show v
+
+evalMatIndex :: Swizzle -> Swizzle -> Value -> Eval Value
+evalMatIndex i j (Mat4x4Value v) =
+  return $ FloatValue $ v ^. (swizzle i . swizzle j)
+  where
+    swizzle X = _x
+    swizzle Y = _y
+    swizzle Z = _z
+    swizzle W = _w
+evalMatIndex i j v =
+  fail $ "cannot access [" <> pp ppVecIndex i <> "][" <> pp ppVecIndex j <> "]"
+      <> " on " <> show v
+
+
+setValue :: LocalState -> NameExpr -> Value -> Eval LocalState
+setValue lst@LocalState{..} n@(NameExpr (Name NsT (NameId nId))) v =
+  trace (pp ppNameExpr n <> " = " <> show v) $
+  if isNaNValue v
+    then fail $ pp ppNameExpr n <> " = " <> show v
+    else return lst{temps = M.insert nId v temps}
+setValue lst n v = do
+  modify' $ \st@EvalState{..} -> st{globals = addDeclNE n v globals}
+  trace (pp ppNameExpr n <> " = " <> show v) $
+    if isNaNValue v
+      then fail $ pp ppNameExpr n <> " = " <> show v
+      else return lst
+
+
+getValue :: LocalState -> NameExpr -> Eval Value
+getValue LocalState{..} (NameExpr (Name NsT (NameId n))) = do
+  let Just v = M.lookup n temps
+  return v
+getValue _ n = do
+  v <- getDeclNE n . globals <$> get
+  case v of
+    Nothing -> fail $ "undefined global: " <> pp ppNameExpr n
+    Just ok -> return ok
+
+
+main :: IO ()
+main = do
+  txt <- IO.readFile "../large-shaders/xax.vert"
+  print $ eval txt
diff --git a/src/Language/GLSL/Runtime/Math.hs b/src/Language/GLSL/Runtime/Math.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Runtime/Math.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -Wno-type-defaults #-}
+module Language.GLSL.Runtime.Math where
+
+import           Prelude (Float, fromIntegral, max, min, (*), (-), (.), (/),
+                          (<))
+import qualified Prelude
+
+floor :: Float -> Float
+floor = fromIntegral . Prelude.floor
+
+fract :: Float -> Float
+fract x = x - floor x
+
+mod :: Float -> Float -> Float
+mod x y = x - y * floor (x/y)
+
+clamp :: Float -> Float -> Float -> Float
+clamp x a = min (max x a)
+
+saturate :: Float -> Float
+saturate x = clamp x 0 1
+
+step :: Float -> Float -> Float
+step a x = if x < a then 0 else 1
+
+smoothstep :: Float -> Float -> Float -> Float
+smoothstep a b x = let t = saturate ((x-a) / (b-a)) in t*t*(3-2*t)
diff --git a/src/Language/GLSL/Runtime/PrimFuns.hs b/src/Language/GLSL/Runtime/PrimFuns.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Runtime/PrimFuns.hs
@@ -0,0 +1,71 @@
+module Language.GLSL.Runtime.PrimFuns where
+
+import           Control.Monad               ((>=>))
+import           Language.GLSL.Runtime.Math  (floor, fract, mod, smoothstep,
+                                              step)
+import           Language.GLSL.Runtime.Value (Eval, Value (..), evalCoerce)
+import           Language.GLSL.Types         (FunName (..), Type (..), pp,
+                                              ppFunName)
+import           Linear
+import           Prelude                     hiding (floor, mod)
+
+flt :: Value -> Eval Float
+flt = evalCoerce TyFloat >=> convert
+  where
+    convert (FloatValue v) = pure v
+    convert v              = fail $ "not a Float value: " <> show v
+
+v4 :: Value -> Eval (V4 Float)
+v4 = evalCoerce (TyVec 4) >=> convert
+  where
+    convert (Vec4Value v) = pure v
+    convert v             = fail $ "not a V4 value: " <> show v
+
+
+eval :: FunName -> [Value] -> Eval Value
+eval PrimVec2 [x, y] =
+  fmap Vec2Value $ V2
+    <$> flt x
+    <*> flt y
+eval PrimVec3 [x, y, z] =
+  fmap Vec3Value $ V3
+    <$> flt x
+    <*> flt y
+    <*> flt z
+eval PrimVec4 [x, y, z, w] =
+  fmap Vec4Value $ V4
+    <$> flt x
+    <*> flt y
+    <*> flt z
+    <*> flt w
+
+eval PrimMat4x4 [x, y, z, w] =
+  fmap Mat4x4Value $ V4
+    <$> v4 x
+    <*> v4 y
+    <*> v4 z
+    <*> v4 w
+
+eval PrimLength [Vec2Value a] = pure $ FloatValue $ norm a
+eval PrimLength [Vec3Value a] = pure $ FloatValue $ norm a
+eval PrimLength [Vec4Value a] = pure $ FloatValue $ norm a
+
+eval PrimNormalize [Vec2Value a] = pure $ Vec2Value $ signorm a
+eval PrimNormalize [Vec3Value a] = pure $ Vec3Value $ signorm a
+eval PrimNormalize [Vec4Value a] = pure $ Vec4Value $ signorm a
+
+eval PrimSqrt   [a] = FloatValue      . sqrt   <$> flt a
+eval PrimSin    [a] = FloatValue      . sin    <$> flt a
+eval PrimAsin   [a] = FloatValue      . asin   <$> flt a
+eval PrimCos    [a] = FloatValue      . cos    <$> flt a
+eval PrimAbs    [a] = FloatValue      . abs    <$> flt a
+eval PrimFloor  [a] = FloatValue      . floor  <$> flt a
+eval PrimFract  [a] = FloatValue      . fract  <$> flt a
+eval PrimMod  [a,b] = fmap FloatValue $ mod    <$> flt a <*> flt b
+eval PrimAtan [a,b] = fmap FloatValue $ atan2  <$> flt a <*> flt b
+
+eval PrimSmoothstep [a,b,c] = fmap FloatValue $ smoothstep <$> flt a <*> flt b <*> flt c
+eval PrimStep         [a,b] = fmap FloatValue $ step <$> flt a <*> flt b
+
+-- eval _ (a:_) = pure a
+eval fun _ = fail $ "primfun not implemented: " <> pp ppFunName fun
diff --git a/src/Language/GLSL/Runtime/Value.hs b/src/Language/GLSL/Runtime/Value.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Runtime/Value.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StrictData                 #-}
+module Language.GLSL.Runtime.Value where
+
+import           Control.Monad.Trans.State.Strict (StateT)
+import qualified Data.IntMap                      as M
+import           Language.GLSL.Decls              (Decls)
+import           Language.GLSL.Types
+import           Linear                           (M44, V2, V3, V4, (!*!), (!*))
+
+data Proc
+  = Proc [ParamDecl] [StmtAnnot ()]
+
+data EvalState = EvalState
+  { stProcs     :: M.IntMap Proc
+  , stMainProc  :: Maybe Proc
+
+  , globals     :: Decls Value
+  , gl_Position :: Maybe Value
+  }
+
+newtype EvalResult a = EvalResult { fromResult :: Either String a }
+  deriving (Functor, Applicative, Monad)
+
+instance MonadFail EvalResult where
+  fail = EvalResult . Left
+
+type Eval = StateT EvalState EvalResult
+
+data Value
+  = FloatValue Float
+  | IntValue Int
+  | BoolValue Bool
+  | Vec2Value (V2 Float)
+  | Vec3Value (V3 Float)
+  | Vec4Value (V4 Float)
+  | Mat4x4Value (M44 Float)
+  deriving (Show, Eq)
+
+
+defaultValue :: Type -> Value
+defaultValue TyFloat   = FloatValue 0
+defaultValue (TyVec 2) = Vec2Value 0
+defaultValue (TyVec 3) = Vec3Value 0
+defaultValue (TyVec 4) = Vec4Value 0
+defaultValue ty        = error $ "defaultValue not implemented: " <> pp ppType ty
+
+
+isNaNValue :: Value -> Bool
+isNaNValue (FloatValue v) = isNaN v
+isNaNValue _              = False
+
+
+roundValue :: Value -> Value
+roundValue (FloatValue v) =
+  FloatValue $ fromIntegral (round (v * 100000) :: Integer) / 100000
+roundValue v = v
+
+
+evalCoerce :: Type -> Value -> Eval Value
+evalCoerce TyFloat v@FloatValue{} = return v
+evalCoerce TyBool v@BoolValue{} = return v
+evalCoerce TyFloat (IntValue i)   = return $ FloatValue (fromIntegral i)
+evalCoerce (TyVec 2) v@Vec2Value{}     = return v
+evalCoerce (TyVec 3) v@Vec3Value{}     = return v
+evalCoerce (TyVec 4) v@Vec4Value{}     = return v
+evalCoerce (TyMat 4 4) v@Mat4x4Value{} = return v
+evalCoerce ty v                        = fail $ "coerce failed: " <> show (ty, v)
+
+
+evalBinaryOp :: Value -> BinaryOp -> Value -> Value
+evalBinaryOp (FloatValue l) BOpPlus (FloatValue r)  = FloatValue (l + r)
+evalBinaryOp (FloatValue l) BOpMinus (FloatValue r) = FloatValue (l - r)
+evalBinaryOp (FloatValue l) BOpMul (FloatValue r)   = FloatValue (l + r)
+evalBinaryOp (FloatValue l) BOpDiv (FloatValue r)   = FloatValue (l / r)
+evalBinaryOp (FloatValue l) BOpLE (FloatValue r)    = BoolValue (l <= r)
+evalBinaryOp (FloatValue l) BOpGE (FloatValue r)    = BoolValue (l >= r)
+evalBinaryOp (FloatValue l) BOpLT (FloatValue r)    = BoolValue (l < r)
+evalBinaryOp (FloatValue l) BOpGT (FloatValue r)    = BoolValue (l > r)
+
+evalBinaryOp (IntValue l) BOpPlus (IntValue r)      = IntValue (l + r)
+evalBinaryOp (IntValue l) BOpMinus (IntValue r)     = IntValue (l - r)
+evalBinaryOp (IntValue l) BOpMul (IntValue r)       = IntValue (l * r)
+
+evalBinaryOp (Vec4Value l) BOpMul (Mat4x4Value r)   = Vec4Value (r !* l)
+evalBinaryOp (Mat4x4Value l) BOpMul (Mat4x4Value r) = Mat4x4Value (r !*! l)
+
+evalBinaryOp l@FloatValue{} o (IntValue r) = evalBinaryOp l o (FloatValue $ fromIntegral r)
+evalBinaryOp (IntValue l) o r@FloatValue{} = evalBinaryOp (FloatValue $ fromIntegral l) o r
+
+evalBinaryOp l o r =
+  error $ "not implemented: " <> show (l, o, r)
+
+
+evalUnaryOp :: UnaryOp -> Value -> Value
+evalUnaryOp UOpMinus (FloatValue v) = FloatValue (-v)
+evalUnaryOp UOpMinus (IntValue v) = IntValue (-v)
+
+evalUnaryOp o e =
+  error $ "not implemented: " <> show (o, e)
diff --git a/src/Language/GLSL/StructuralEquality.hs b/src/Language/GLSL/StructuralEquality.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/StructuralEquality.hs
@@ -0,0 +1,90 @@
+-- | Structural equality, ignoring the variable names.
+module Language.GLSL.StructuralEquality where
+
+import           Language.GLSL.ConstExpr (ConstExprs, isConstExpr)
+import           Language.GLSL.Types
+
+
+eqStmtAnnots :: ConstExprs -> [(StmtAnnot a, StmtAnnot a)] -> Bool
+eqStmtAnnots ce = all (uncurry (eqStmtAnnot ce))
+
+eqStmtAnnot :: ConstExprs -> StmtAnnot a -> StmtAnnot a -> Bool
+eqStmtAnnot ce (SA _ a) (SA _ b) = eqStmt ce a b
+
+
+eqStmt :: ConstExprs -> Stmt a -> Stmt a -> Bool
+eqStmt ce (AssignStmt _ ea) (AssignStmt _ eb) =
+  -- We consider constant expressions to be equal, since we can just pass that
+  -- constant into the function as an argument. Most of the time, it's small
+  -- things like 1.0 or (-1.0) (possibly in a t-var, hence the ConstExprs set).
+  isConstExpr ce ea && isConstExpr ce eb ||
+  eqExpr ea eb
+eqStmt _ (DeclStmt da) (DeclStmt db) =
+  eqLocalDecl da db
+eqStmt _ (EmitStmt ea) (EmitStmt eb) =
+  eqEmit ea eb
+eqStmt ce (IfStmt _ ta ea) (IfStmt _ tb eb) =
+  eqStmtAnnots ce (zip ta tb) &&
+  eqStmtAnnots ce (zip ea eb)
+eqStmt _ _ _ = False
+
+
+eqExpr :: Expr -> Expr -> Bool
+eqExpr (AtomExpr ea) (AtomExpr eb) =
+  eqExprAtom ea eb
+eqExpr (UnaryExpr ua ea) (UnaryExpr ub eb) =
+  ua == ub && eqExprAtom ea eb
+eqExpr (FunCallExpr fa aa) (FunCallExpr fb ab) =
+  fa == fb && all (uncurry eqExprAtom) (zip aa ab)
+eqExpr (TextureExpr ta xa ya) (TextureExpr tb xb yb) =
+  all (uncurry eqExprAtom) [(ta, tb), (xa, xb), (ya, yb)]
+eqExpr (BinaryExpr la oa ra) (BinaryExpr lb ob rb) =
+  oa == ob && eqExprAtom la lb && eqExprAtom ra rb
+eqExpr _ _ =
+  False
+
+
+eqExprAtom :: ExprAtom -> ExprAtom -> Bool
+eqExprAtom (LitIntExpr _ _) (LitIntExpr _ _)             = True
+eqExprAtom (LitIntExpr _ _) (LitFloatExpr _ _)           = True
+eqExprAtom (LitFloatExpr _ _) (LitFloatExpr _ _)         = True
+eqExprAtom (LitFloatExpr _ _) (LitIntExpr _ _)           = True
+eqExprAtom (IdentifierExpr a) (IdentifierExpr b)         = eqNameExpr a b
+eqExprAtom (SwizzleExpr _ a) (SwizzleExpr _ b)           = a == b
+eqExprAtom (VecIndexExpr _ ia) (VecIndexExpr _ ib)       = ia == ib
+eqExprAtom (MatIndexExpr _ ia ja) (MatIndexExpr _ ib jb) = ia == ib && ja == jb
+eqExprAtom _ _                                           = False
+
+-- | All variable names are equal.
+--
+--   We used to ignore temporary names only, considering all other names as
+--   globals and a fixed part of the code. This check is quite expensive and it
+--   turns out that most of the time the global variables *are* the same. If
+--   they are not, we'll need to pass them as arguments to our new function, but
+--   this is rare enough so it won't increase the average function parameter
+--   list length too much.
+eqNameExpr :: NameExpr -> NameExpr -> Bool
+eqNameExpr (UniformExpr na ma) (UniformExpr nb mb) = na == nb && ma == mb
+-- eqName (Name NsT _) (Name NsT _)   = True
+-- eqName (Name nsa na) (Name nsb nb) = nsa == nsb && na == nb
+eqNameExpr _ _                                     = True
+
+eqLocalDecl :: LocalDecl -> LocalDecl -> Bool
+eqLocalDecl (LDecl tya _ ea) (LDecl tyb _ eb) =
+  eqType tya tyb && eqMaybe eqExpr ea eb
+
+
+eqType :: Type -> Type -> Bool
+eqType = (==)
+
+
+eqEmit :: Emit -> Emit -> Bool
+eqEmit (EmitPosition a) (EmitPosition b) = eqExpr a b
+eqEmit EmitFragDepth EmitFragDepth       = True
+eqEmit _ _                               = False
+
+
+eqMaybe :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
+eqMaybe f (Just a) (Just b) = f a b
+eqMaybe _ Nothing Nothing   = True
+eqMaybe _ _ _               = False
diff --git a/src/Language/GLSL/Types.hs b/src/Language/GLSL/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/GLSL/Types.hs
@@ -0,0 +1,650 @@
+{-# LANGUAGE DeriveFunctor     #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData        #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+module Language.GLSL.Types where
+
+import           Control.Applicative              (Applicative (..), (<|>))
+import           Data.Attoparsec.ByteString.Char8 (IResult (Partial), Parser,
+                                                   char, decimal, endOfInput,
+                                                   many1, option, parse,
+                                                   parseOnly, rational,
+                                                   scientific, sepBy1)
+import           Data.List                        (intersperse)
+import qualified Data.Scientific                  as Sci
+import qualified Data.Text.Encoding               as T
+import qualified Data.Text.Lazy                   as LT
+import qualified Data.Text.Lazy.Builder           as LTB
+import qualified Data.Text.Lazy.Builder.Int       as LTB
+import qualified Data.Text.Lazy.Builder.RealFloat as LTB
+
+
+parseShader :: Annot a => LT.Text -> Either String (GLSL a)
+parseShader = parseOnly parseGLSL . T.encodeUtf8 . LT.toStrict
+
+printShader :: Annot a => GLSL a -> LT.Text
+printShader = LTB.toLazyText . ppGLSL
+
+
+data GLSL a = GLSL Version [TopDecl a]
+  deriving (Show, Functor, Foldable, Traversable)
+
+parseGLSL :: Annot a => Parser (GLSL a)
+parseGLSL = GLSL
+  <$> parseVersion
+  <*> ("\n" >> many1 parseTopDecl >>= (endOfInput >>) . pure)
+
+ppGLSL :: Annot a => GLSL a -> LTB.Builder
+ppGLSL (GLSL v decls) =
+  ppVersion v
+  <> "\n" <> ppL ppTopDecl decls
+
+newtype Version = Version Int
+  deriving (Show)
+
+parseVersion :: Parser Version
+parseVersion = Version <$> ("#version " >> decimal)
+
+ppVersion :: Version -> LTB.Builder
+ppVersion (Version v) = "#version " <> ppInt v
+
+data TopDecl a
+  = LayoutDecl LayoutSpec GlobalDecl
+  | GlobalDecl GlobalDecl
+  | ProcDecl ProcName [ParamDecl] [StmtAnnot a]
+  deriving (Show, Functor, Foldable, Traversable)
+
+parseTopDecl :: Annot a => Parser (TopDecl a)
+parseTopDecl = layoutDecl <|> globalDecl <|> procDecl
+  where
+    layoutDecl = LayoutDecl
+      <$> ("layout(" >> parseLayoutSpec)
+      <*> (") " >> parseGlobalDecl)
+
+    globalDecl = GlobalDecl
+      <$> parseGlobalDecl
+
+    procDecl = ProcDecl
+      <$> ("void " >> parseProcName)
+      <*> ("() " >> pure [])
+      -- <*> ("{\n" >> many1 parseStmtAnnot)
+      <*> ("{\n" >> many1 parseStmtAnnot >>= ("}\n" >>) . pure)
+
+ppTopDecl :: Annot a => TopDecl a -> LTB.Builder
+ppTopDecl (LayoutDecl e d) = "layout(" <> ppLayoutSpec e <> ") " <> ppGlobalDecl d
+ppTopDecl (GlobalDecl d) = ppGlobalDecl d
+ppTopDecl (ProcDecl n a b) =
+  "void " <> ppProcName n
+  <> "(" <> ppS "," ppParamDecl a <> ") {\n"
+  <> ppL ppStmtAnnot b
+  <> "}\n"
+
+data ProcName
+  = ProcMain
+  | ProcName NameId
+  deriving (Show)
+
+parseProcName :: Parser ProcName
+parseProcName =
+  ("main" >> pure ProcMain)
+  <|> ("p" >> ProcName <$> parseNameId)
+
+ppProcName :: ProcName -> LTB.Builder
+ppProcName ProcMain     = "main"
+ppProcName (ProcName n) = "p" <> ppNameId n
+
+data LayoutSpec
+  = LayoutStd140
+  | LayoutLocation Int
+  deriving (Show)
+
+parseLayoutSpec :: Parser LayoutSpec
+parseLayoutSpec =
+  ("std140" >> pure LayoutStd140)
+  <|> ("location = " >> LayoutLocation <$> decimal)
+
+ppLayoutSpec :: LayoutSpec -> LTB.Builder
+ppLayoutSpec LayoutStd140       = "std140"
+ppLayoutSpec (LayoutLocation l) = "location = " <> ppInt l
+
+data ParamDecl
+  = Param ParamKind LocalDecl
+  deriving (Show)
+
+parseParamDecl :: Parser ParamDecl
+parseParamDecl = Param
+  <$> parseParamKind
+  <*> (" " >> parseLocalDecl)
+
+ppParamDecl :: ParamDecl -> LTB.Builder
+ppParamDecl (Param k d) =
+  ppParamKind k <> " " <> ppLocalDecl d
+
+data ParamKind
+  = PkIn
+  | PkOut
+  | PkInout
+  deriving (Show)
+
+parseParamKind :: Parser ParamKind
+parseParamKind = (char ' ' <|> pure ' ') >>
+  ("in" >> return PkIn) <|>
+  ("out" >> return PkOut) <|>
+  ("inout" >> return PkInout)
+
+ppParamKind :: ParamKind -> LTB.Builder
+ppParamKind PkIn    = "in"
+ppParamKind PkOut   = "out"
+ppParamKind PkInout = "inout"
+
+data LocalDecl
+  = LDecl Type NameId (Maybe Expr)
+  deriving (Show)
+
+parseLocalDecl :: Parser LocalDecl
+parseLocalDecl = LDecl
+  <$> parseType
+  <*> (" t" >> parseNameId)
+  <*> (option Nothing (" = " >> Just <$> parseExpr) >>= (";\n" >>) . pure)
+
+ppLocalDecl :: LocalDecl -> LTB.Builder
+ppLocalDecl (LDecl t n Nothing) =
+  ppType t
+  <> " t" <> ppNameId n <> ";\n"
+ppLocalDecl (LDecl t n (Just e)) =
+  ppType t
+  <> " t" <> ppNameId n
+  <> " = " <> ppExpr e <> ";\n"
+
+data GlobalDecl
+  = GDecl GDeclKind Type Name
+  deriving (Show)
+
+parseGlobalDecl :: Parser GlobalDecl
+parseGlobalDecl = GDecl
+  <$> parseGDeclKind
+  <*> (" " >> parseType)
+  <*> (" " >> parseName >>= (";\n" >>) . pure)
+
+ppGlobalDecl :: GlobalDecl -> LTB.Builder
+ppGlobalDecl (GDecl k t n) =
+  ppGDeclKind k
+  <> " " <> ppType t
+  <> " " <> ppName n <> ";\n"
+
+data GDeclKind
+  = GkIn
+  | GkOut
+  | GkUniform
+  deriving (Show)
+
+parseGDeclKind :: Parser GDeclKind
+parseGDeclKind =
+  ("in" >> return GkIn) <|>
+  ("out" >> return GkOut) <|>
+  ("uniform" >> return GkUniform)
+
+ppGDeclKind :: GDeclKind -> LTB.Builder
+ppGDeclKind GkIn      = "in"
+ppGDeclKind GkOut     = "out"
+ppGDeclKind GkUniform = "uniform"
+
+data Type
+  = TyBool
+  | TyFloat
+  | TySampler2D
+  | TyVec Int
+  | TyMat Int Int
+  | TyStruct NameId [(Type, NameId)]
+  deriving (Show, Eq)
+
+parseType :: Parser Type
+parseType =
+  ("bool" >> return TyBool)
+  <|> ("float" >> return TyFloat)
+  <|> ("sampler2D" >> return TySampler2D)
+  <|> ("vec" >> TyVec <$> decimal)
+  <|> ("mat" >> TyMat <$> decimal <*> ("x" >> decimal))
+  <|> tyStruct
+  where
+    tyStruct = TyStruct
+      <$> ("uBlock" >> parseNameId)
+      <*> (" {\n" >> many1 parseStructMember >>= ("}" >>) . pure)
+
+    parseStructMember :: Parser (Type, NameId)
+    parseStructMember = (,)
+      <$> parseType
+      <*> (" u" >> parseNameId >>= (";\n" >>) . pure)
+
+ppType :: Type -> LTB.Builder
+ppType TyBool = "bool"
+ppType TyFloat = "float"
+ppType TySampler2D = "sampler2D"
+ppType (TyVec n) = "vec" <> ppInt n
+ppType (TyMat n m) = "mat" <> ppInt n <> "x" <> ppInt m
+ppType (TyStruct n ms) =
+  "uBlock" <> ppNameId n
+  <> " {\n" <> ppL ppStructMember ms <> "}"
+  where ppStructMember (t, n) = ppType t <> " u" <> ppNameId n <> ";\n"
+
+newtype NameId = NameId Int
+  deriving (Show, Eq)
+
+parseNameId :: Parser NameId
+parseNameId = NameId
+  <$> decimal
+
+ppNameId :: NameId -> LTB.Builder
+ppNameId (NameId n) = ppInt n
+
+data Name
+  = Name Namespace NameId
+  deriving (Show)
+
+parseName :: Parser Name
+parseName = Name
+  <$> parseNamespace
+  <*> parseNameId
+
+ppName :: Name -> LTB.Builder
+ppName (Name ns n) = ppNamespace ns <> ppNameId n
+
+data Namespace
+  = NsT
+  | NsS
+  | NsU
+  | NsVF
+  | NsIn
+  | NsOut
+  deriving (Show, Eq)
+
+parseNamespace :: Parser Namespace
+parseNamespace =
+  ("in" >> pure NsIn)
+  <|> ("out" >> pure NsOut)
+  <|> ("vf" >> pure NsVF)
+  <|> (char 't' >> pure NsT)
+  <|> (char 'u' >> pure NsU)
+  <|> (char 's' >> pure NsS)
+
+ppNamespace :: Namespace -> LTB.Builder
+ppNamespace NsT   = "t"
+ppNamespace NsS   = "s"
+ppNamespace NsU   = "u"
+ppNamespace NsVF  = "vf"
+ppNamespace NsIn  = "in"
+ppNamespace NsOut = "out"
+
+data FunName
+  = PrimMain
+  | PrimMat3x3
+  | PrimMat4x4
+  | PrimVec2
+  | PrimVec3
+  | PrimVec4
+  | PrimPow
+  | PrimDot
+  | PrimCos
+  | PrimAtan
+  | PrimMod
+  | PrimAbs
+  | PrimCross
+  | PrimLength
+  | PrimAsin
+  | PrimSmoothstep
+  | PrimStep
+  | PrimFract
+  | PrimFloor
+  | PrimSin
+  | PrimTan
+  | PrimSqrt
+  | PrimNormalize
+  deriving (Show, Eq)
+
+parseFunName :: Parser FunName
+parseFunName =
+  ("main" >> pure PrimMain)
+  <|> ("mat3x3" >> pure PrimMat3x3)
+  <|> ("mat4x4" >> pure PrimMat4x4)
+  <|> ("vec2" >> pure PrimVec2)
+  <|> ("vec3" >> pure PrimVec3)
+  <|> ("vec4" >> pure PrimVec4)
+  <|> ("pow" >> pure PrimPow)
+  <|> ("dot" >> pure PrimDot)
+  <|> ("cos" >> pure PrimCos)
+  <|> ("atan" >> pure PrimAtan)
+  <|> ("mod" >> pure PrimMod)
+  <|> ("abs" >> pure PrimAbs)
+  <|> ("cross" >> pure PrimCross)
+  <|> ("length" >> pure PrimLength)
+  <|> ("asin" >> pure PrimAsin)
+  <|> ("smoothstep" >> pure PrimSmoothstep)
+  <|> ("step" >> pure PrimStep)
+  <|> ("fract" >> pure PrimFract)
+  <|> ("floor" >> pure PrimFloor)
+  <|> ("sin" >> pure PrimSin)
+  <|> ("tan" >> pure PrimTan)
+  <|> ("sqrt" >> pure PrimSqrt)
+  <|> ("normalize" >> pure PrimNormalize)
+
+ppFunName :: FunName -> LTB.Builder
+ppFunName PrimMain       = "main"
+ppFunName PrimMat3x3     = "mat3x3"
+ppFunName PrimMat4x4     = "mat4x4"
+ppFunName PrimVec2       = "vec2"
+ppFunName PrimVec3       = "vec3"
+ppFunName PrimVec4       = "vec4"
+ppFunName PrimPow        = "pow"
+ppFunName PrimDot        = "dot"
+ppFunName PrimCos        = "cos"
+ppFunName PrimAtan       = "atan"
+ppFunName PrimMod        = "mod"
+ppFunName PrimAbs        = "abs"
+ppFunName PrimCross      = "cross"
+ppFunName PrimLength     = "length"
+ppFunName PrimAsin       = "asin"
+ppFunName PrimSmoothstep = "smoothstep"
+ppFunName PrimStep       = "step"
+ppFunName PrimFract      = "fract"
+ppFunName PrimFloor      = "floor"
+ppFunName PrimSin        = "sin"
+ppFunName PrimTan        = "tan"
+ppFunName PrimSqrt       = "sqrt"
+ppFunName PrimNormalize  = "normalize"
+
+data Swizzle
+  = X | Y | Z | W
+  deriving (Show, Eq)
+
+parseSwizzle :: Parser Swizzle
+parseSwizzle =
+  (char 'x' >> pure X)
+  <|> (char 'y' >> pure Y)
+  <|> (char 'z' >> pure Z)
+  <|> (char 'w' >> pure W)
+
+ppSwizzle :: Swizzle -> LTB.Builder
+ppSwizzle X = "x"
+ppSwizzle Y = "y"
+ppSwizzle Z = "z"
+ppSwizzle W = "w"
+
+parseVecIndex :: Parser Swizzle
+parseVecIndex =
+  (char '0' >> pure X)
+  <|> (char '1' >> pure Y)
+  <|> (char '2' >> pure Z)
+  <|> (char '3' >> pure W)
+
+ppVecIndex :: Swizzle -> LTB.Builder
+ppVecIndex X = "0"
+ppVecIndex Y = "1"
+ppVecIndex Z = "2"
+ppVecIndex W = "3"
+
+data NameExpr
+  = NameExpr Name
+  | UniformExpr NameId NameId
+  deriving (Show)
+
+parseNameExpr :: Parser NameExpr
+parseNameExpr =
+  UniformExpr <$> (char 'u' >> parseNameId) <*> (".u" >> parseNameId)
+  <|> NameExpr <$> parseName
+
+ppNameExpr :: NameExpr -> LTB.Builder
+ppNameExpr (NameExpr n) = ppName n
+ppNameExpr (UniformExpr n m) = "u" <> ppNameId n <> ".u" <> ppNameId m
+
+data Cast
+  = Cast
+  | NoCast
+  deriving (Show)
+
+data ExprAtom
+  = LitIntExpr Cast Int
+  | LitFloatExpr Cast Float
+  | IdentifierExpr NameExpr
+  | SwizzleExpr NameId Swizzle
+  | VecIndexExpr NameExpr Swizzle
+  | MatIndexExpr NameExpr Swizzle Swizzle
+  deriving (Show)
+
+parseExprAtom :: Parser ExprAtom
+parseExprAtom =
+  litNumber <$> scientific
+  <|> LitIntExpr Cast <$> ("int(" >> decimal >>= (")" >>) . pure)
+  <|> LitFloatExpr Cast <$> ("float(" >> rational >>= (")" >>) . pure)
+  <|> SwizzleExpr <$> (char 't' >> parseNameId) <*> (char '.' >> parseSwizzle)
+  <|> MatIndexExpr <$> parseNameExpr <*> ("[" >> parseVecIndex) <*> ("][" >> parseVecIndex >>= ("]" >>) . pure)
+  <|> VecIndexExpr <$> parseNameExpr <*> ("[" >> parseVecIndex >>= ("]" >>) . pure)
+  <|> IdentifierExpr <$> parseNameExpr
+  where
+    litNumber s =
+      let e = Sci.base10Exponent s
+          c = Sci.coefficient s
+      in if e >= 0
+          then LitIntExpr NoCast (fromInteger (c * 10 ^ e))
+          else LitFloatExpr NoCast (Sci.toRealFloat s)
+
+ppExprAtom :: ExprAtom -> LTB.Builder
+ppExprAtom (LitIntExpr Cast i)     = "int(" <> ppInt i <> ")"
+ppExprAtom (LitIntExpr NoCast i)   = ppInt i
+ppExprAtom (LitFloatExpr Cast n)   = "float(" <> ppFloat n <> ")"
+ppExprAtom (LitFloatExpr NoCast r) = ppFloat r
+ppExprAtom (IdentifierExpr n)      = ppNameExpr n
+ppExprAtom (SwizzleExpr n m)       = "t" <> ppNameId n <> "." <> ppSwizzle m
+ppExprAtom (VecIndexExpr n i)      = ppNameExpr n <> "[" <> ppVecIndex i <> "]"
+ppExprAtom (MatIndexExpr n i j)    = ppNameExpr n <> "[" <> ppVecIndex i <> "]" <> "[" <> ppVecIndex j <> "]"
+
+data Expr
+  = UnaryExpr UnaryOp ExprAtom
+  | BinaryExpr ExprAtom BinaryOp ExprAtom
+  | FunCallExpr FunName [ExprAtom]
+  | TextureExpr ExprAtom ExprAtom ExprAtom
+  | AtomExpr ExprAtom
+  deriving (Show)
+
+parseExpr :: Parser Expr
+parseExpr =
+  (char '(' >> operatorExpr >>= (char ')' >>) . pure)
+  <|> textureExpr
+  <|> funCallExpr
+  <|> AtomExpr <$> parseExprAtom
+
+  where
+    operatorExpr =
+      BinaryExpr <$> parseExprAtom <*> parseBinaryOp <*> parseExprAtom
+      <|> UnaryExpr <$> parseUnaryOp <*> parseExprAtom
+
+    textureExpr = TextureExpr
+      <$> ("texture(" >> parseExprAtom)
+      <*> (",vec2(" >> parseExprAtom)
+      <*> ("," >> parseExprAtom >>= ("))" >>) . pure)
+
+    funCallExpr = FunCallExpr
+      <$> parseFunName
+      <*> (char '(' >> sepBy1 parseExprAtom (char ',') >>= (char ')' >>) . pure)
+
+ppExpr :: Expr -> LTB.Builder
+ppExpr (AtomExpr e) = ppExprAtom e
+ppExpr (UnaryExpr o e) = "(" <> ppUnaryOp o <> ppExprAtom e <> ")"
+ppExpr (BinaryExpr l o r) = "(" <> ppExprAtom l <> ppBinaryOp o <> ppExprAtom r <> ")"
+ppExpr (FunCallExpr n args) = ppFunName n <> "(" <> ppS "," ppExprAtom args <> ")"
+ppExpr (TextureExpr t x y) = "texture(" <> ppExprAtom t <> ",vec2(" <> ppExprAtom x <> "," <> ppExprAtom y <> "))"
+
+data BinaryOp
+  = BOpPlus
+  | BOpMinus
+  | BOpMul
+  | BOpDiv
+  | BOpGE
+  | BOpGT
+  | BOpLE
+  | BOpLT
+  | BOpAnd
+  | BOpOr
+  deriving (Show, Eq)
+
+parseBinaryOp :: Parser BinaryOp
+parseBinaryOp =
+  (char '+' >> pure BOpPlus)
+  <|> (char '-' >> pure BOpMinus)
+  <|> (char '*' >> pure BOpMul)
+  <|> (char '/' >> pure BOpDiv)
+  <|> (">=" >> pure BOpGE)
+  <|> (">" >> pure BOpGT)
+  <|> ("<=" >> pure BOpLE)
+  <|> ("<" >> pure BOpLT)
+  <|> ("&&" >> pure BOpAnd)
+  <|> ("||" >> pure BOpOr)
+
+ppBinaryOp :: BinaryOp -> LTB.Builder
+ppBinaryOp BOpPlus  = "+"
+ppBinaryOp BOpMinus = "-"
+ppBinaryOp BOpMul   = "*"
+ppBinaryOp BOpDiv   = "/"
+ppBinaryOp BOpGE    = ">="
+ppBinaryOp BOpGT    = ">"
+ppBinaryOp BOpLE    = "<="
+ppBinaryOp BOpLT    = "<"
+ppBinaryOp BOpAnd   = "&&"
+ppBinaryOp BOpOr    = "||"
+
+data UnaryOp
+  = UOpMinus
+  | UOpNot
+  deriving (Show, Eq)
+
+parseUnaryOp :: Parser UnaryOp
+parseUnaryOp =
+  (char '-' >> pure UOpMinus)
+  <|> (char '!' >> pure UOpMinus)
+
+ppUnaryOp :: UnaryOp -> LTB.Builder
+ppUnaryOp UOpMinus = "-"
+ppUnaryOp UOpNot   = "!"
+
+data StmtAnnot a = SA
+  { annot   :: a
+  , unAnnot :: Stmt a
+  }
+  deriving (Show, Functor, Foldable, Traversable)
+
+instance Applicative StmtAnnot where
+  pure a = SA a (pure a)
+  liftA2 f a b = SA (f (annot a) (annot b)) $ liftA2 f (unAnnot a) (unAnnot b)
+
+parseStmtAnnot :: Annot a => Parser (StmtAnnot a)
+parseStmtAnnot = SA <$> parseAnnot <*> parseStmt
+
+ppStmtAnnot :: Annot a => StmtAnnot a -> LTB.Builder
+ppStmtAnnot (SA a s) =
+  maybe "" (\ltb -> "// " <> ltb <> "\n") (ppAnnot a) <> ppStmt s
+
+data Stmt a
+  = AssignStmt Name Expr
+  | DeclStmt LocalDecl
+  | EmitStmt Emit
+  | IfStmt NameId [StmtAnnot a] [StmtAnnot a]
+  deriving (Show, Functor, Foldable, Traversable)
+
+instance Applicative Stmt where
+  -- Arbitrary decision because "pure" doesn't really make sense.
+  pure _ = EmitStmt EmitFragDepth
+
+  liftA2 f (IfStmt n t1 e1) (IfStmt _ t2 e2) = IfStmt n
+    ((zipWith . liftA2) f t1 t2)
+    ((zipWith . liftA2) f e1 e2)
+  liftA2 _ (AssignStmt n e) _ = AssignStmt n e
+  liftA2 _ (DeclStmt d) _ = DeclStmt d
+  liftA2 _ (EmitStmt e) _ = EmitStmt e
+  liftA2 _ (IfStmt n _ _) _ = IfStmt n [] []
+
+
+parseStmt :: Annot a => Parser (Stmt a)
+parseStmt =
+  IfStmt <$> ("if(t" >> parseNameId >>= ("){\n" >>) . pure)
+         <*> many1 parseStmtAnnot
+         <*> ("} else {\n" >> many1 parseStmtAnnot >>= ("}\n" >>) . pure)
+  <|> AssignStmt <$> parseName <*> (" = " >> parseExpr >>= (";\n" >>) . pure)
+  <|> DeclStmt <$> parseLocalDecl
+  <|> EmitStmt <$> parseEmit
+
+ppStmt :: Annot a => Stmt a -> LTB.Builder
+ppStmt (AssignStmt n e) = ppName n <> " = " <> ppExpr e <> ";\n"
+ppStmt (DeclStmt d) = ppLocalDecl d
+ppStmt (EmitStmt e) = ppEmit e
+ppStmt (IfStmt c t e) =
+  "if(t" <> ppNameId c <> "){\n"
+  <> ppL ppStmtAnnot t
+  <> "} else {\n"
+  <> ppL ppStmtAnnot e
+  <> "}\n"
+
+data Emit
+  = EmitPosition Expr
+  | EmitFragDepth
+  deriving (Show)
+
+parseEmit :: Parser Emit
+parseEmit =
+  EmitPosition <$> ("gl_Position = " >> parseExpr >>= (";\n" >>) . pure)
+  <|> ("gl_FragDepth = gl_FragCoord[2];\n" >> pure EmitFragDepth)
+
+ppEmit :: Emit -> LTB.Builder
+ppEmit (EmitPosition e) = "gl_Position = " <> ppExpr e <> ";\n"
+ppEmit EmitFragDepth    = "gl_FragDepth = gl_FragCoord[2];\n"
+
+ppInt :: Int -> LTB.Builder
+ppInt = LTB.decimal
+
+ppFloat :: Float -> LTB.Builder
+ppFloat = LTB.realFloat
+
+ppL :: (a -> LTB.Builder) -> [a] -> LTB.Builder
+ppL printer = mconcat . map printer
+
+ppS :: LTB.Builder -> (a -> LTB.Builder) -> [a] -> LTB.Builder
+ppS sep printer = mconcat . intersperse sep . map printer
+
+class Annot a where
+  parseAnnot :: Parser a
+  ppAnnot :: a -> Maybe LTB.Builder
+
+instance Annot () where
+  parseAnnot = pure ()
+  ppAnnot = const Nothing
+
+instance (Annot a, Annot b) => Annot (a, b) where
+  parseAnnot = error "not implemented"
+  ppAnnot (a, b) = do
+    ppA <- ppAnnot a
+    ppB <- ppAnnot b
+    return $ "(" <> ppA <> ", " <> ppB <> ")"
+
+----------------------------------
+
+parseTest :: Show a => Parser a -> LT.Text -> IO ()
+parseTest p input =
+  let r = show . fromPartial . parse p . T.encodeUtf8 . LT.toStrict $ input in
+  if length r > 600
+    then
+      let start = take 500 r
+          end = reverse $ take 100 $ reverse r
+      in
+      putStrLn $ start <> " ... " <> end
+    else putStrLn r
+  where
+    fromPartial (Partial cont) = cont mempty
+    fromPartial r              = r
+
+t :: Show a => Parser a -> String -> IO ()
+t p = parseTest p . LT.pack
+
+pp :: (a -> LTB.Builder) -> a -> String
+pp printer = LT.unpack . LTB.toLazyText . printer
+
+ppl :: (a -> LTB.Builder) -> [a] -> String
+ppl printer = LT.unpack . LTB.toLazyText . ppL printer
diff --git a/test/Language/GLSL/GLSLSpec.hs b/test/Language/GLSL/GLSLSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Language/GLSL/GLSLSpec.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GLSL.GLSLSpec where
+
+import           Test.Hspec                       (Spec, describe, it)
+
+import           Control.Applicative              (liftA2)
+import           Data.Attoparsec.ByteString.Char8 (decimal)
+import qualified Language.GLSL.Types    as GLSL
+import           Test.GLSL                        (Transform, shouldTransformTo,
+                                                   with)
+
+
+newtype TestAnnot = TestAnnot Int
+
+instance GLSL.Annot TestAnnot where
+  parseAnnot = "// " >> TestAnnot <$> decimal >>= ("\n" >>) . pure
+  ppAnnot (TestAnnot n) = Just $ GLSL.ppInt n
+
+
+testAddAnnot :: [Int] -> Transform () TestAnnot
+testAddAnnot = zipWith (fmap . setAnnot)
+  where
+    setAnnot i () = TestAnnot i
+
+
+testJoinAnnot :: Transform () (TestAnnot, TestAnnot)
+testJoinAnnot ss =
+    let ss1 = testAddAnnot [0..3] ss
+        ss2 = testAddAnnot (reverse [0..3]) ss
+    in (zipWith . liftA2) (,) ss1 ss2
+
+
+spec :: Spec
+spec = do
+    describe "fmap" $ do
+        it "should add annotations" $
+            [ "float t1 = 0;"
+            , "float t2 = 0.0;"
+            , "float t3 = (t2+1.1);"
+            , "float t4 = (t3+vf1);"
+            ] `with` testAddAnnot [0..3]
+            `shouldTransformTo`
+            [ "// 0"
+            , "float t1 = 0;"
+            , "// 1"
+            , "float t2 = 0.0;"
+            , "// 2"
+            , "float t3 = (t2+1.1);"
+            , "// 3"
+            , "float t4 = (t3+vf1);"
+            ]
+
+    describe "liftA2" $ do
+        it "should join annotations" $
+            [ "float t1 = 0;"
+            , "float t2 = 0.0;"
+            , "float t3 = (t2+1.1);"
+            , "float t4 = (t3+vf1);"
+            ] `with` testJoinAnnot
+            `shouldTransformTo`
+            [ "// (0, 3)"
+            , "float t1 = 0;"
+            , "// (1, 2)"
+            , "float t2 = 0.0;"
+            , "// (2, 1)"
+            , "float t3 = (t2+1.1);"
+            , "// (3, 0)"
+            , "float t4 = (t3+vf1);"
+            ]
diff --git a/test/Language/GLSL/Optimizer/DeinlineSpec.hs b/test/Language/GLSL/Optimizer/DeinlineSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Language/GLSL/Optimizer/DeinlineSpec.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GLSL.Optimizer.DeinlineSpec where
+
+import           Test.Hspec                        (Spec, describe, it)
+
+import           Language.GLSL.Optimizer.Deinline (Config (..), defaultConfig,
+                                                    diStmts)
+import           Test.GLSL                         (Transform,
+                                                    shouldNotTransform,
+                                                    shouldTransformTo, with)
+
+
+-- | Test config has smaller window size so we don't need to write as many
+--   lines in our tests.
+testConfig :: Config
+testConfig = defaultConfig{windowSize=3}
+
+testDI :: Transform () ()
+testDI = diStmts testConfig
+
+
+spec :: Spec
+spec = do
+    describe "diStmts" $ do
+        it "should leave non-repetitive code alone" $
+            shouldNotTransform $
+            [ "float t1 = 0;"
+            , "float t2 = 0.0;"
+            , "float t3 = (t2+1.1);"
+            , "float t4 = (t3+vf1);"
+            ] `with` testDI
+
+        it "should remove repeated code" $
+            [ "float t1 = 0;"
+            , "float t2 = 0.0;"
+            , "float t3 = (t2+1.1);" -- start of same code
+            , "float t4 = (t3+vf1);"
+            , "float t5 = (t4*vf1);"
+            , "float t6 = (t5/vf1);"
+            , "float t7 = (t5-vf1);" -- end of same code
+            , "float t8 = (t2+1.1);" -- different code
+            , "float t9 = sin(t3);" -- also different
+            , "float t10 = (t9+1.1);" -- start of same code
+            , "float t11 = (t10+vf1);"
+            , "float t12 = (t11*vf1);"
+            , "float t13 = (t12/vf1);"
+            , "float t14 = (t13-vf1);" -- end of same code
+            , "float t15 = cos(t14);" -- different code
+            , "float t16 = tan(t15);" -- also different
+            ] `with` testDI
+            `shouldTransformTo`
+            [ "float t1 = 0;"
+            , "float t2 = 0.0;"
+            , "float t8 = (t2+1.1);" -- different code
+            , "float t9 = sin(t3);" -- also different
+            , "float t15 = cos(t14);" -- different code
+            , "float t16 = tan(t15);" -- also different
+            ]
diff --git a/test/Test/GLSL.hs b/test/Test/GLSL.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/GLSL.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Test.GLSL where
+
+import           Test.Hspec                        (Expectation, shouldBe)
+
+import           Data.Attoparsec.ByteString.Char8  (many1, parseOnly)
+import qualified Data.ByteString.Char8             as BS
+import           Data.String                       (fromString)
+import qualified Data.Text.Lazy                    as LT
+import qualified Data.Text.Lazy.Builder            as LTB
+import qualified Language.GLSL.Types     as GLSL
+
+
+type Transform a b = [GLSL.StmtAnnot a] -> [GLSL.StmtAnnot b]
+type TransformExpectation a b
+    = (Transform a b, [BS.ByteString])
+    -> [LT.Text]
+    -> Expectation
+
+with :: [s] -> Transform a b -> (Transform a b, [s])
+with = flip (,)
+
+shouldTransformTo :: (GLSL.Annot a, GLSL.Annot b) => TransformExpectation a b
+shouldTransformTo (f, code) expected =
+    let Right glsl = parseOnly (many1 GLSL.parseStmtAnnot) $ BS.unlines code
+        res = f glsl
+    in
+    concatMap (LT.lines . LTB.toLazyText . GLSL.ppStmtAnnot) res
+    `shouldBe`
+    expected
+
+shouldNotTransform
+    :: (GLSL.Annot a, GLSL.Annot b)
+    => (Transform a b, [String])
+    -> Expectation
+shouldNotTransform (f, a) =
+    shouldTransformTo (f, map fromString a) (map fromString a)
diff --git a/test/testsuite.hs b/test/testsuite.hs
new file mode 100644
--- /dev/null
+++ b/test/testsuite.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/tools/optshader.hs b/tools/optshader.hs
new file mode 100644
--- /dev/null
+++ b/tools/optshader.hs
@@ -0,0 +1,49 @@
+module Main (main) where
+
+import qualified Data.Text.Lazy              as LT
+import qualified Data.Text.Lazy.IO           as IO
+import           Data.Time.Clock             as Time (diffUTCTime,
+                                                      getCurrentTime,
+                                                      nominalDiffTimeToSeconds)
+import qualified Language.GLSL.Optimizer     as Opt
+import qualified Language.GLSL.Optimizer.DFG as DFG
+import qualified Language.GLSL.Types         as GLSL
+import qualified System.Environment          as Env
+
+main :: IO ()
+main = Env.getArgs >>= mapM_ process
+
+parseShader :: LT.Text -> Either String (GLSL.GLSL ())
+parseShader = GLSL.parseShader
+
+process :: FilePath -> IO ()
+process inFile = do
+  putStrLn "Loading file..."
+  inText <- IO.readFile inFile
+  putStrLn "Parsing file..."
+  case parseShader inText of
+    Left err -> fail err
+    Right ok -> do
+      putStrLn "Generating data flow graph (opt.dot)..."
+      let dfg = DFG.genDFG ok
+      DFG.toDot "opt.dot" dfg
+      -- DFG.toSvg dfg "../opt.svg"
+      putStrLn "Optimizing shader (opt.glsl)..."
+      s <- Time.getCurrentTime
+      let outText = GLSL.printShader $ Opt.optimize ok
+      IO.writeFile "opt.glsl" outText
+      e <- Time.getCurrentTime
+      let elapsed = Time.nominalDiffTimeToSeconds $ Time.diffUTCTime e s
+      putStrLn $ "Optimizer took " <> show elapsed <> "s"
+      let inLen = LT.length inText
+          outLen = LT.length outText
+          factor :: Float
+          factor = fromIntegral inLen / fromIntegral outLen
+      putStrLn $ "Size: " <> showKB inLen <> " -> "
+                  <> showKB outLen <> ", " <> show factor <> "x reduction"
+
+
+showKB :: (Show a, Integral a) => a -> String
+showKB x | x > 1024 * 1024 = show (x `div` (1024 * 1024)) <> "MiB"
+showKB x | x > 1024 = show (x `div` 1024) <> "KiB"
+showKB x = show x <> "B"