diff --git a/benchmarks/JoiningTypes.hs b/benchmarks/JoiningTypes.hs
--- a/benchmarks/JoiningTypes.hs
+++ b/benchmarks/JoiningTypes.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 module JoiningTypes (main) where
 
 import Criterion.Main
@@ -39,7 +37,8 @@
   renderSym (EEq)   = "EEq"
   renderSym (EIf)   = "EIf"
 
-interpretationInstances ''Expr1
+instance Equality   Expr1
+instance StringTree Expr1
 
 instance Eval Expr1 where
   evalSym (EI n)  = n
@@ -91,8 +90,10 @@
   renderSym (EEqJ)   = "EEq"
   renderSym (EIfJ)   = "EIf"
 
-interpretationInstances ''ExprI
-interpretationInstances ''ExprB
+instance Equality   ExprI
+instance StringTree ExprI
+instance Equality   ExprB
+instance StringTree ExprB
 
 instance Eval ExprI where
   evalSym (EIJ n) = n
@@ -158,11 +159,14 @@
 instance Render Expr4J5 where
   renderSym (E4JIf)   = "EIf"
 
-interpretationInstances ''Expr4J1
-interpretationInstances ''Expr4J2
-interpretationInstances ''Expr4J3
-interpretationInstances ''Expr4J4
-interpretationInstances ''Expr4J5
+instance Equality   Expr4J1
+instance StringTree Expr4J1
+instance Equality   Expr4J2
+instance StringTree Expr4J2
+instance Equality   Expr4J3
+instance StringTree Expr4J3
+instance Equality   Expr4J5
+instance StringTree Expr4J5
 
 instance Eval Expr4J1 where
   evalSym (E4JI n)  = n
diff --git a/benchmarks/Normal.hs b/benchmarks/Normal.hs
--- a/benchmarks/Normal.hs
+++ b/benchmarks/Normal.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 module Normal (main) where
 
 import Criterion.Main
@@ -110,7 +108,8 @@
   renderSym EEq    = "EEq"
   renderSym EIf    = "EIf"
 
-interpretationInstances ''ExprS
+instance Equality   ExprS
+instance StringTree ExprS
 
 instance Eval ExprS where
   evalSym (EI n) = n
diff --git a/benchmarks/WithArity.hs b/benchmarks/WithArity.hs
--- a/benchmarks/WithArity.hs
+++ b/benchmarks/WithArity.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 module WithArity (main) where
 
 import Criterion.Main
@@ -104,7 +102,8 @@
     renderSym T5     = "T5"
     renderSym T10    = "T10"
 
-interpretationInstances ''T
+instance Equality   T
+instance StringTree T
 
 instance Eval T
   where
diff --git a/examples/NanoFeldspar.hs b/examples/NanoFeldspar.hs
--- a/examples/NanoFeldspar.hs
+++ b/examples/NanoFeldspar.hs
@@ -29,6 +29,7 @@
 import Language.Syntactic.Functional.Tuple
 import Language.Syntactic.Sugar.BindingT ()
 import Language.Syntactic.Sugar.TupleT ()
+import Language.Syntactic.TH
 
 
 
@@ -55,12 +56,12 @@
     Sub :: (Type a, Num a) => Arithmetic (a :-> a :-> Full a)
     Mul :: (Type a, Num a) => Arithmetic (a :-> a :-> Full a)
 
-instance Symbol Arithmetic
-  where
-    symSig Add = signature
-    symSig Sub = signature
-    symSig Mul = signature
+deriveSymbol   ''Arithmetic
+deriveEquality ''Arithmetic
 
+instance StringTree Arithmetic
+instance EvalEnv Arithmetic env
+
 instance Render Arithmetic
   where
     renderSym Add = "(+)"
@@ -68,56 +69,42 @@
     renderSym Mul = "(*)"
     renderArgs = renderArgsSmart
 
-interpretationInstances ''Arithmetic
-
 instance Eval Arithmetic
   where
     evalSym Add = (+)
     evalSym Sub = (-)
     evalSym Mul = (*)
 
-instance EvalEnv Arithmetic env
-
 data Parallel sig
   where
     Parallel :: Type a => Parallel (Length :-> (Index -> a) :-> Full [a])
 
-instance Symbol Parallel
-  where
-    symSig Parallel = signature
-
-instance Render Parallel
-  where
-    renderSym Parallel = "parallel"
+deriveSymbol    ''Parallel
+deriveRender id ''Parallel
+deriveEquality  ''Parallel
 
-interpretationInstances ''Parallel
+instance StringTree Parallel
+instance EvalEnv Parallel env
 
 instance Eval Parallel
   where
     evalSym Parallel = \len ixf -> Prelude.map ixf [0 .. len-1]
 
-instance EvalEnv Parallel env
-
 data ForLoop sig
   where
     ForLoop :: Type st => ForLoop (Length :-> st :-> (Index -> st -> st) :-> Full st)
 
-instance Symbol ForLoop
-  where
-    symSig ForLoop = signature
-
-instance Render ForLoop
-  where
-    renderSym ForLoop = "forLoop"
+deriveSymbol    ''ForLoop
+deriveRender id ''ForLoop
+deriveEquality  ''ForLoop
 
-interpretationInstances ''ForLoop
+instance StringTree ForLoop
+instance EvalEnv ForLoop env
 
 instance Eval ForLoop
   where
     evalSym ForLoop = \len init body -> foldl (flip body) init [0 .. len-1]
 
-instance EvalEnv ForLoop env
-
 type FeldDomain = Typed
     (   BindingT
     :+: Let
@@ -157,6 +144,7 @@
 -- * "Backends"
 --------------------------------------------------------------------------------
 
+-- | Interface for controlling code motion
 cmInterface :: CodeMotionInterface FeldDomain
 cmInterface = defaultInterfaceT sharable (const True)
   where
diff --git a/examples/NanoFeldsparComp.hs b/examples/NanoFeldsparComp.hs
new file mode 100644
--- /dev/null
+++ b/examples/NanoFeldsparComp.hs
@@ -0,0 +1,205 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+
+-- Note GADTs needed by GHC 7.6. In later GHCs is works with just TypeFamilies.
+
+-- | A simple compiler for NanoFeldspar
+
+module NanoFeldsparComp where
+
+
+
+import Control.Monad.State
+import Control.Monad.Writer
+
+import Language.Syntactic
+import Language.Syntactic.Functional
+import Language.Syntactic.Functional.Sharing
+import Language.Syntactic.Functional.Tuple
+
+import NanoFeldspar hiding ((==))
+
+
+
+--------------------------------------------------------------------------------
+-- * Imperative programs
+--------------------------------------------------------------------------------
+
+type Var = String
+
+varName :: Name -> Var
+varName v = 'v' : show v
+
+varNameE :: Name -> Exp
+varNameE v = App (varName v) []
+
+data Exp = App String [Exp]
+  deriving (Eq, Show)
+
+data Stmt
+    = Assign Exp Exp
+    | If Exp Prog Prog
+    | For Exp Var Prog
+  deriving (Eq, Show)
+
+type Prog = [Stmt]
+
+viewOp :: String -> Maybe String
+viewOp op@(_:_:_)
+    | head op == '(' && last op == ')' = Just $ tail $ init op
+    | otherwise = Nothing
+
+renderExp :: Exp -> String
+renderExp (App f []) = f
+renderExp (App f@(_:_) [a,b])
+    | Just op <- viewOp f = concat ["(", renderExp a, " ", op, " ", renderExp b, ")"]
+renderExp (App f args) = "(" ++ unwords (f : Prelude.map renderExp args) ++ ")"
+
+indent :: [String] -> [String]
+indent = Prelude.map ("    " ++)
+
+renderProg :: Prog -> String
+renderProg = unlines . concatMap render
+  where
+    render (Assign l r) = [unwords [renderExp l, "=", renderExp r]]
+    render (If c t f) = concat
+        [ [unwords ["if", renderExp c]]
+        , indent (concatMap render t)
+        , ["else"]
+        , indent (concatMap render f)
+        ]
+    render (For l v body) = concat
+        [ [unwords ["for",v,"<", renderExp l]]
+        , indent (concatMap render body)
+        ]
+
+
+
+--------------------------------------------------------------------------------
+-- * Code generation
+--------------------------------------------------------------------------------
+
+type CodeGen = WriterT Prog (State Name)
+
+type Dom = BindingT
+       :+: Let
+       :+: Tuple
+       :+: Arithmetic
+       :+: Parallel
+       :+: ForLoop
+       :+: Construct
+
+fresh :: CodeGen Exp
+fresh = do
+    v <- get; put (v+1)
+    return (varNameE v)
+
+confiscate :: CodeGen Exp -> CodeGen (Exp,Prog)
+confiscate = censor (const mempty) . listen
+
+compileExp :: ASTF Dom a -> CodeGen Exp
+compileExp var
+    | Just (Var v) <- prj var = return (varNameE v)
+compileExp (lett :$ a :$ (lam :$ body))
+    | Just Let      <- prj lett
+    , Just (LamT v) <- prj lam
+    = do
+        a' <- compileExp a
+        tell [Assign (varNameE v) a']
+        compileExp body
+compileExp (par :$ len :$ (lam :$ body))
+    | Just Parallel <- prj par
+    , Just (LamT v) <- prj lam
+    = do
+        len' <- compileExp len
+        (e,body') <- confiscate $ compileExp body
+        arr <- fresh
+        let arrPos = App "(!)" [arr, varNameE v]
+        tell
+            [ For len' (varName v)
+                (  body'
+                ++ [Assign arrPos e]
+                )
+            ]
+        return arr
+compileExp (for :$ len :$ init :$ (lam1 :$ (lam2 :$ body)))
+    | Just ForLoop  <- prj for
+    , Just (LamT i) <- prj lam1
+    , Just (LamT s) <- prj lam2
+    = do
+        len'  <- compileExp len
+        init' <- compileExp init
+        (e,body') <- confiscate $ compileExp body
+        next <- fresh
+        tell
+            [ Assign (varNameE s) init'
+            , For len' (varName i)
+                (  body'
+                ++ [ Assign next e
+                   , Assign (varNameE s) next
+                   ]
+                )
+            ]
+        return next
+compileExp (cond :$ c :$ t :$ f)
+    | Just (Construct "cond" _) <- prj cond
+    = do
+        c' <- compileExp c
+        (t',tProg) <- confiscate $ compileExp t
+        (f',fProg) <- confiscate $ compileExp f
+        res <- fresh
+        tell
+            [ If c'
+                (  tProg
+                ++ [Assign res  t']
+                )
+                (  fProg
+                ++ [Assign res  f']
+                )
+            ]
+        return res
+compileExp (arrIx :$ arr :$ ix)
+    | Just (Construct "arrIx" _) <- prj arrIx = do
+        arr' <- compileExp arr
+        ix'  <- compileExp ix
+        return $ App "(!)" [arr',ix']
+-- Generic case for all other constructs
+compileExp a = simpleMatch
+  (\s as -> fmap (App (renderSym s)) $ sequence (listArgs compileExp as)) a
+
+compileTop :: ASTF Dom a -> CodeGen ()
+compileTop = go 0
+  where
+    go :: Int -> ASTF Dom a -> CodeGen ()
+    go n (lam :$ body)
+        | Just (LamT v) <- prj lam = do
+            tell [Assign (varNameE v) (App ("inp" ++ show n) [])]
+            go (n+1) body
+    go _ a = do
+        a' <- compileExp a
+        tell [Assign (App "out" []) a']
+
+
+
+compile :: (Syntactic a, Domain a ~ Typed Dom) => a -> String
+compile
+    = renderProg
+    . fst
+    . flip runState 0
+    . execWriterT
+    . compileTop
+    . mapAST (\(Typed s) -> s)
+    . codeMotion cmInterface
+    . desugar
+
+icompile :: (Syntactic a, Domain a ~ Typed Dom) => a -> IO ()
+icompile = putStrLn . compile
+
+
+
+--------------------------------------------------------------------------------
+-- * Code generation
+--------------------------------------------------------------------------------
+
+test_matMul = icompile matMul
+
diff --git a/src/Language/Syntactic/Decoration.hs b/src/Language/Syntactic/Decoration.hs
--- a/src/Language/Syntactic/Decoration.hs
+++ b/src/Language/Syntactic/Decoration.hs
@@ -34,8 +34,11 @@
 
 instance Symbol sym => Symbol (sym :&: info)
   where
-    rnfSym = rnfSym . decorExpr
     symSig = symSig . decorExpr
+
+instance (NFData1 sym, NFData1 info) => NFData1 (sym :&: info)
+  where
+    rnf1 (s :&: i) = rnf1 s `seq` rnf1 i `seq` ()
 
 instance Project sub sup => Project sub (sup :&: info)
   where
diff --git a/src/Language/Syntactic/Functional.hs b/src/Language/Syntactic/Functional.hs
--- a/src/Language/Syntactic/Functional.hs
+++ b/src/Language/Syntactic/Functional.hs
@@ -92,11 +92,13 @@
 data Construct sig
   where
     Construct :: Signature sig => String -> Denotation sig -> Construct sig
+  -- There is no `NFData1` instance for `Construct` because that would give rise
+  -- to a constraint `NFData (Denotation sig)`, which easily spreads to other
+  -- functions.
 
 instance Symbol Construct
   where
-    rnfSym (Construct name den) = rnf name `seq` den `seq` ()
-    symSig (Construct _ _)      = signature
+    symSig (Construct _ _) = signature
 
 instance Render Construct
   where
@@ -126,11 +128,14 @@
 
 instance Symbol Binding
   where
-    rnfSym (Var v) = rnf v
-    rnfSym (Lam v) = rnf v
     symSig (Var _) = signature
     symSig (Lam _) = signature
 
+instance NFData1 Binding
+  where
+    rnf1 (Var v) = rnf v
+    rnf1 (Lam v) = rnf v
+
 -- | 'equal' does strict identifier comparison; i.e. no alpha equivalence.
 --
 -- 'hash' assigns the same hash to all variables and binders. This is a valid over-approximation
@@ -211,11 +216,14 @@
 
 instance Symbol BindingT
   where
-    rnfSym (VarT v) = rnf v
-    rnfSym (LamT v) = rnf v
     symSig (VarT _) = signature
     symSig (LamT _) = signature
 
+instance NFData1 BindingT
+  where
+    rnf1 (VarT v) = rnf v
+    rnf1 (LamT v) = rnf v
+
 -- | 'equal' does strict identifier comparison; i.e. no alpha equivalence.
 --
 -- 'hash' assigns the same hash to all variables and binders. This is a valid over-approximation
@@ -284,8 +292,7 @@
     prVar :: sym sig -> Maybe Name
     prLam :: sym sig -> Maybe Name
   -- It is in principle possible to replace a constraint `BindingDomain s` by
-  -- `(Project Binding s, Project BindingT s)`. However, the problem is that one then has to
-  -- specify the type `t` through a `Proxy`. The `BindingDomain` class gets around this problem.
+  -- `(Project Binding s, Project BindingT s)`
 
 instance {-# OVERLAPPING #-}
          (BindingDomain sym1, BindingDomain sym2) => BindingDomain (sym1 :+: sym2)
diff --git a/src/Language/Syntactic/Functional/Tuple.hs b/src/Language/Syntactic/Functional/Tuple.hs
--- a/src/Language/Syntactic/Functional/Tuple.hs
+++ b/src/Language/Syntactic/Functional/Tuple.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 -- | Construction and elimination of tuples
 
 module Language.Syntactic.Functional.Tuple where
@@ -118,7 +116,8 @@
     renderSym Sel4 = "sel4"
     renderArgs = renderArgsSmart
 
-interpretationInstances ''Tuple
+instance Equality   Tuple
+instance StringTree Tuple
 
 instance Eval Tuple
   where
diff --git a/src/Language/Syntactic/Functional/WellScoped.hs b/src/Language/Syntactic/Functional/WellScoped.hs
--- a/src/Language/Syntactic/Functional/WellScoped.hs
+++ b/src/Language/Syntactic/Functional/WellScoped.hs
@@ -63,10 +63,13 @@
 
 instance Symbol BindingWS
   where
-    rnfSym (VarWS Proxy) = ()
-    rnfSym LamWS         = ()
-    symSig (VarWS _)     = signature
-    symSig LamWS         = signature
+    symSig (VarWS _) = signature
+    symSig LamWS     = signature
+
+instance NFData1 BindingWS
+  where
+    rnf1 (VarWS Proxy) = ()
+    rnf1 LamWS         = ()
 
 instance Eval BindingWS
   where
diff --git a/src/Language/Syntactic/Interpretation.hs b/src/Language/Syntactic/Interpretation.hs
--- a/src/Language/Syntactic/Interpretation.hs
+++ b/src/Language/Syntactic/Interpretation.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DefaultSignatures #-}
 
 -- | Equality and rendering of 'AST's
 
@@ -17,13 +17,11 @@
       -- * Default interpretation
     , equalDefault
     , hashDefault
-    , interpretationInstances
     ) where
 
 
 
 import Data.Tree (Tree (..))
-import Language.Haskell.TH
 
 import Data.Hash (Hash, combine, hashInt)
 import qualified Data.Hash as Hash
@@ -45,12 +43,16 @@
     -- Comparing elements of different types is often needed when dealing with expressions with
     -- existentially quantified sub-terms.
     equal :: e a -> e b -> Bool
+    default equal :: Render e => e a -> e b -> Bool
+    equal = equalDefault
 
     -- | Higher-kinded hashing. Elements that are equal according to 'equal' must result in the same
     -- hash:
     --
     -- @equal a b  ==>  hash a == hash b@
     hash :: e a -> Hash
+    default hash :: Render e => e a -> Hash
+    hash = hashDefault
 
 instance Equality sym => Equality (AST sym)
   where
@@ -204,16 +206,3 @@
 -- | Default implementation of 'hash'
 hashDefault :: Render sym => sym a -> Hash
 hashDefault = Hash.hash . renderSym
-
--- | Derive instances for 'Equality' and 'StringTree'
-interpretationInstances :: Name -> DecsQ
-interpretationInstances n =
-    [d|
-        instance Equality $(typ) where
-          equal = equalDefault
-          hash  = hashDefault
-        instance StringTree $(typ)
-    |]
-  where
-    typ = conT n
-
diff --git a/src/Language/Syntactic/Syntax.hs b/src/Language/Syntactic/Syntax.hs
--- a/src/Language/Syntactic/Syntax.hs
+++ b/src/Language/Syntactic/Syntax.hs
@@ -50,7 +50,8 @@
     , Typed (..)
     , injT
     , castExpr
-      -- * Type inference
+      -- * Misc.
+    , NFData1 (..)
     , symType
     , prjP
     ) where
@@ -129,16 +130,12 @@
 -- | Valid symbols to use in an 'AST'
 class Symbol sym
   where
-    -- | Force a symbol to normal form
-    rnfSym :: sym sig -> ()
-    rnfSym s = s `seq` ()
-
     -- | Reify the signature of a symbol
     symSig :: sym sig -> SigRep sig
 
-instance Symbol sym => NFData (AST sym sig)
+instance NFData1 sym => NFData (AST sym sig)
   where
-    rnf (Sym s)  = rnfSym s
+    rnf (Sym s)  = rnf1 s
     rnf (s :$ a) = rnf s `seq` rnf a
 
 -- | Count the number of symbols in an 'AST'
@@ -206,11 +203,14 @@
 
 instance (Symbol sym1, Symbol sym2) => Symbol (sym1 :+: sym2)
   where
-    rnfSym (InjL s) = rnfSym s
-    rnfSym (InjR s) = rnfSym s
     symSig (InjL s) = symSig s
     symSig (InjR s) = symSig s
 
+instance (NFData1 sym1, NFData1 sym2) => NFData1 (sym1 :+: sym2)
+  where
+    rnf1 (InjL s) = rnf1 s
+    rnf1 (InjR s) = rnf1 s
+
 -- | Symbol projection
 --
 -- The class is defined for /all pairs of types/, but 'prj' can only succeed if @sup@ is of the form
@@ -387,8 +387,15 @@
 
 
 --------------------------------------------------------------------------------
--- * Type inference
+-- * Misc.
 --------------------------------------------------------------------------------
+
+-- | Higher-kinded version of 'NFData'
+class NFData1 c
+  where
+    -- | Force a symbol to normal form
+    rnf1 :: c a -> ()
+    rnf1 s = s `seq` ()
 
 -- | Constrain a symbol to a specific type
 symType :: Proxy sym -> sym sig -> sym sig
diff --git a/src/Language/Syntactic/TH.hs b/src/Language/Syntactic/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Syntactic/TH.hs
@@ -0,0 +1,173 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Language.Syntactic.TH where
+
+
+
+import Language.Haskell.TH
+
+import Data.Hash (hashInt, combine)
+import qualified Data.Hash as Hash
+
+import Language.Syntactic
+
+
+
+-- | Get the name and arity of a constructor
+conName :: Con -> (Name, Int)
+conName (NormalC name args) = (name, length args)
+conName (RecC name args)    = (name, length args)
+conName (InfixC _ name _)   = (name, 2)
+conName (ForallC _ _ c)     = conName c
+
+-- | Description of class methods
+data Method
+    = DefaultMethod Name Name
+        -- ^ rhs = lhs
+    | MatchingMethod Name (Con -> Int -> Name -> Int -> Clause) [Clause]
+        -- ^ @MatchingMethod methodName mkClause extraClauses@
+        --
+        -- @mkClause@ takes as arguments (1) a description of the constructor,
+        -- (2) the constructor's index, (3) the constructor's name, and (4) its
+        -- arity.
+
+-- | General method for class deriving
+deriveClass
+    :: Cxt       -- ^ Instance context
+    -> Name      -- ^ Type constructor name
+    -> Type      -- ^ Class head (e.g. @Render Con@)
+    -> [Method]  -- ^ Methods
+    -> DecsQ
+deriveClass cxt ty clHead methods = do
+    t@(TyConI (DataD _ _ _ cs _)) <- reify ty
+    return
+      [ InstanceD cxt clHead $
+          [ FunD method (clauses ++ extra)
+            | MatchingMethod method mkClause extra <- methods
+            , let clauses = [ mkClause c i nm ar | (i,c) <- zip [0..] cs
+                            , let (nm,ar) = conName c
+                            ]
+          ] ++
+          [ FunD rhs [Clause [] (NormalB (VarE lhs)) []]
+            | DefaultMethod rhs lhs <- methods
+          ]
+      ]
+
+-- | General method for class deriving
+deriveClassSimple
+    :: Name      -- ^ Class name
+    -> Name      -- ^ Type constructor name
+    -> [Method]  -- ^ Methods
+    -> DecsQ
+deriveClassSimple cl ty = deriveClass [] ty (AppT (ConT cl) (ConT ty))
+
+varSupply :: [Name]
+varSupply = map mkName $ tail $ concat $ iterate step [[]]
+  where
+    step :: [String] -> [String]
+    step vars = concatMap (\c -> map (c:) vars) ['a' .. 'z']
+
+-- | Derive 'Symbol' instance for a type
+deriveSymbol
+    :: Name  -- ^ Type name
+    -> DecsQ
+deriveSymbol ty =
+    deriveClassSimple ''Symbol ty [MatchingMethod 'symSig  symSigClause []]
+  where
+    symSigClause _ _ con arity =
+      Clause [ConP con (replicate arity WildP)] (NormalB (VarE 'signature)) []
+
+-- | Derive 'Equality' instance for a type
+--
+-- > equal Con1 Con1 = True
+-- > equal (Con2 a1 ... x1) (Con2 a2 ... x2) = and [a1==a2, ... x1==x2]
+-- > equal _ _ = False
+--
+-- > hash Con1           = hashInt 0
+-- > hash (Con2 a ... x) = foldr1 combine [hashInt 1, hash a, ... hash x]
+deriveEquality
+    :: Name  -- ^ Type name
+    -> DecsQ
+deriveEquality ty = do
+    TyConI (DataD _ _ _ cs _) <- reify ty
+    let equalFallThrough = if length cs > 1
+          then [Clause [WildP, WildP] (NormalB $ ConE 'False) []]
+          else []
+    deriveClassSimple ''Equality ty
+      [ MatchingMethod 'equal equalClause equalFallThrough
+      , MatchingMethod 'hash hashClause []
+      ]
+  where
+    equalClause _ _ con arity = Clause
+        [ ConP con [VarP v | v <- vs1]
+        , ConP con [VarP v | v <- vs2]
+        ]
+        (NormalB body)
+        []
+      where
+        vs1 = take arity varSupply
+        vs2 = take arity $ drop arity varSupply
+
+        body = case arity of
+          0 -> ConE 'True
+          _ -> AppE (VarE 'and)
+                 ( ListE
+                     [ InfixE (Just (VarE v1)) (VarE '(==)) (Just (VarE v2))
+                       | (v1,v2) <- zip vs1 vs2
+                     ]
+                 )
+
+    hashClause _ i con arity = Clause
+        [ConP con [VarP v | v <- vs]]
+        (NormalB body)
+        []
+      where
+        vs = take arity varSupply
+        body = case arity of
+          0 -> AppE (VarE 'hashInt) (LitE (IntegerL (toInteger i)))
+          _ -> foldl1 AppE
+                [ VarE 'foldr1
+                , VarE 'combine
+                , ListE
+                    $ AppE (VarE 'hashInt) (LitE (IntegerL (toInteger i)))
+                    : [ AppE (VarE 'Hash.hash) (VarE v)
+                        | v <- vs
+                      ]
+                ]
+
+-- | Derive 'Render' instance for a type
+--
+-- > renderSym Con1           = "Con1"
+-- > renderSym (Con2 a ... x) = concat ["(", unwords ["Con2", show a, ... show x], ")"]
+deriveRender
+    :: (String -> String)  -- ^ Constructor name modifier
+    -> Name                -- ^ Type name
+    -> DecsQ
+deriveRender modify ty =
+    deriveClassSimple ''Render ty [MatchingMethod 'renderSym renderClause []]
+  where
+    conName = modify . nameBase
+
+    renderClause _ _ con arity = Clause
+        [ConP con [VarP v | v <- take arity varSupply]]
+        (NormalB body)
+        []
+      where
+        body = case arity of
+            0 -> LitE $ StringL $ conName con
+            _ -> renderRHS con $ take arity varSupply
+
+    renderRHS :: Name -> [Name] -> Exp
+    renderRHS con args =
+      AppE (VarE 'concat)
+        ( ListE
+            [ LitE (StringL "(")
+            , AppE (VarE 'unwords)
+                (ListE (LitE (StringL (conName con)) : map showArg args))
+            , LitE (StringL ")")
+            ]
+        )
+
+    showArg :: Name -> Exp
+    showArg arg = AppE (VarE 'show) (VarE arg)
+
diff --git a/syntactic.cabal b/syntactic.cabal
--- a/syntactic.cabal
+++ b/syntactic.cabal
@@ -1,5 +1,5 @@
 Name:           syntactic
-Version:        3.0
+Version:        3.1
 Synopsis:       Generic representation and manipulation of abstract syntax
 Description:    The library provides a generic representation of type-indexed abstract syntax trees
                 (or indexed data types in general). It also permits the definition of open syntax
@@ -46,6 +46,11 @@
   type:     git
   location: https://github.com/emilaxelsson/syntactic
 
+flag th
+  description: Include the module Language.Syntactic.TH, which uses Template
+               Haskell
+  default:     True
+
 library
   exposed-modules:
     Language.Syntactic
@@ -64,6 +69,9 @@
     Language.Syntactic.Sugar.MonadT
     Language.Syntactic.Sugar.Tuple
     Language.Syntactic.Sugar.TupleT
+  if flag(th)
+    exposed-modules:
+      Language.Syntactic.TH
 
   build-depends:
     base >= 4 && < 5,
@@ -71,9 +79,11 @@
     data-hash,
     deepseq,
     mtl >= 2 && < 3,
-    tagged,
-    template-haskell,
     tree-view
+  if impl(ghc < 7.8)
+    build-depends: tagged
+  if flag(th)
+    build-depends: template-haskell
 
   hs-source-dirs: src
 
@@ -97,7 +107,6 @@
 
   other-extensions:
     OverlappingInstances
-    TemplateHaskell
     UndecidableInstances
 
 test-suite examples
@@ -111,21 +120,11 @@
 
   default-extensions:
 
-  other-extensions:
-    FlexibleContexts
-    FlexibleInstances
-    GADTs
-    MultiParamTypeClasses
-    ScopedTypeVariables
-    TemplateHaskell
-    TypeFamilies
-    TypeOperators
-    UndecidableInstances
-
   build-depends:
     syntactic,
     base,
     containers,
+    mtl,
     QuickCheck,
     tagged,
     tasty,
diff --git a/tests/MonadTests.hs b/tests/MonadTests.hs
--- a/tests/MonadTests.hs
+++ b/tests/MonadTests.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 module MonadTests where
 
diff --git a/tests/NanoFeldsparTests.hs b/tests/NanoFeldsparTests.hs
--- a/tests/NanoFeldsparTests.hs
+++ b/tests/NanoFeldsparTests.hs
@@ -19,6 +19,7 @@
 import Language.Syntactic.Functional
 import Language.Syntactic.Functional.Sharing
 import qualified NanoFeldspar as Nano
+import qualified NanoFeldsparComp as Nano
 
 
 
@@ -70,9 +71,6 @@
       forAll genMat $ \b ->
         matMul a b == evalCM Nano.matMul a b
 
-mkGold_scProd = writeFile "tests/gold/scProd.txt" $ Nano.showAST Nano.scProd
-mkGold_matMul = writeFile "tests/gold/matMul.txt" $ Nano.showAST Nano.matMul
-
 alphaRename :: ASTF Nano.FeldDomain a -> ASTF Nano.FeldDomain a
 alphaRename = mapAST rename
   where
@@ -100,6 +98,11 @@
     , goldenVsString "spanVec tree" "tests/gold/spanVec.txt" $ return $ fromString $ Nano.showAST Nano.spanVec
     , goldenVsString "scProd tree"  "tests/gold/scProd.txt"  $ return $ fromString $ Nano.showAST Nano.scProd
     , goldenVsString "matMul tree"  "tests/gold/matMul.txt"  $ return $ fromString $ Nano.showAST Nano.matMul
+
+    , goldenVsString "fib comp"     "tests/gold/fib.comp"     $ return $ fromString $ Nano.compile Nano.fib
+    , goldenVsString "spanVec comp" "tests/gold/spanVec.comp" $ return $ fromString $ Nano.compile Nano.spanVec
+    , goldenVsString "scProd comp"  "tests/gold/scProd.comp"  $ return $ fromString $ Nano.compile Nano.scProd
+    , goldenVsString "matMul comp"  "tests/gold/matMul.comp"  $ return $ fromString $ Nano.compile Nano.matMul
 
     , testProperty "fib eval"     prop_fib
     , testProperty "spanVec eval" prop_spanVec
diff --git a/tests/TH.hs b/tests/TH.hs
new file mode 100644
--- /dev/null
+++ b/tests/TH.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
+
+module TH where
+
+
+
+import Data.List (nub)
+
+import Language.Syntactic
+import Language.Syntactic.TH
+
+
+
+data Sym sig
+  where
+    A :: Int -> Bool -> Sym (a :-> a :-> Full a)
+    B :: Sym (Full Bool)
+    C :: String -> Sym (a :-> Int :-> Full a)
+
+deriveSymbol    ''Sym
+deriveEquality  ''Sym
+deriveRender id ''Sym
+
+tests =
+    [ equal B B
+    , equal (A 5 True) (A 5 True)
+    , equal (C "syntactic") (C "syntactic")
+    , not $ equal (A 5 True) (A 6 True)
+    , not $ equal (A 5 True) (C "c")
+    , hashes == nub hashes
+    , renderSym (A 5 True) == "(A 5 True)"
+    ]
+  where
+    hashes =
+        [ hash $ A 5 True
+        , hash $ B
+        , hash $ C "a"
+        , hash $ A 6 True
+        , hash $ C "b"
+        ]
+
+main :: IO ()
+main = if and tests
+    then return ()
+    else error "TH tests failed"
+
diff --git a/tests/Tests.hs b/tests/Tests.hs
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -3,6 +3,7 @@
 import qualified NanoFeldsparTests
 import qualified WellScopedTests
 import qualified MonadTests
+import qualified TH
 
 tests = testGroup "AllTests"
     [ NanoFeldsparTests.tests
@@ -10,5 +11,7 @@
     , MonadTests.tests
     ]
 
-main = defaultMain tests
+main = do
+    TH.main
+    defaultMain tests
 
diff --git a/tests/WellScopedTests.hs b/tests/WellScopedTests.hs
--- a/tests/WellScopedTests.hs
+++ b/tests/WellScopedTests.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 module WellScopedTests where
 
diff --git a/tests/gold/fib.txt b/tests/gold/fib.txt
--- a/tests/gold/fib.txt
+++ b/tests/gold/fib.txt
@@ -1,6 +1,6 @@
 Lam v3
  └╴sel1
-    └╴forLoop
+    └╴ForLoop
        ├╴v3
        ├╴tup2
        │  ├╴0
diff --git a/tests/gold/matMul.txt b/tests/gold/matMul.txt
--- a/tests/gold/matMul.txt
+++ b/tests/gold/matMul.txt
@@ -1,6 +1,6 @@
 Lam v6
  └╴Lam v5
-    └╴parallel
+    └╴Parallel
        ├╴arrLen
        │  └╴v6
        └╴Lam v4
@@ -12,13 +12,13 @@
              │  │     └╴v4
              │  └╴arrLen
              │     └╴v5
-             └╴parallel
+             └╴Parallel
                 ├╴arrLen
                 │  └╴arrIx
                 │     ├╴v5
                 │     └╴0
                 └╴Lam v3
-                   └╴forLoop
+                   └╴ForLoop
                       ├╴v7
                       ├╴0.0
                       └╴Lam v2
diff --git a/tests/gold/scProd.txt b/tests/gold/scProd.txt
--- a/tests/gold/scProd.txt
+++ b/tests/gold/scProd.txt
@@ -1,6 +1,6 @@
 Lam v4
  └╴Lam v3
-    └╴forLoop
+    └╴ForLoop
        ├╴min
        │  ├╴arrLen
        │  │  └╴v4
diff --git a/tests/gold/spanVec.txt b/tests/gold/spanVec.txt
--- a/tests/gold/spanVec.txt
+++ b/tests/gold/spanVec.txt
@@ -1,6 +1,6 @@
 Lam v3
  └╴Let v4
-    ├╴forLoop
+    ├╴ForLoop
     │  ├╴arrLen
     │  │  └╴v3
     │  ├╴tup2