diff --git a/lib/Pinchot.hs b/lib/Pinchot.hs
--- a/lib/Pinchot.hs
+++ b/lib/Pinchot.hs
@@ -83,8 +83,11 @@
   , syntaxTrees
   , allRulesRecord
 
-  -- ** Wrappers and optics
+  -- ** Typeclass instances and optics
   , wrappedInstances
+  , bifunctorInstances
+  , semigroupInstances
+  , monoidInstances
   , rulesToOptics
 
   -- * Creating Earley grammars
@@ -113,6 +116,7 @@
 import Pinchot.NonEmpty
 import Pinchot.Rules
 import Pinchot.SyntaxTree
+import Pinchot.SyntaxTree.Instancer
 import Pinchot.SyntaxTree.Optics
 import Pinchot.SyntaxTree.Wrappers
 import Pinchot.Terminalize
diff --git a/lib/Pinchot/Earley.hs b/lib/Pinchot/Earley.hs
--- a/lib/Pinchot/Earley.hs
+++ b/lib/Pinchot/Earley.hs
@@ -15,6 +15,7 @@
 import Data.Sequence ((<|), viewl, ViewL(EmptyL, (:<)), Seq)
 import qualified Data.Sequence as Seq
 import qualified Language.Haskell.TH as T
+import Pinchot.Internal.TemplateHaskellShim (dataD)
 import qualified Language.Haskell.TH.Syntax as Syntax
 import qualified Text.Earley
 
@@ -164,9 +165,6 @@
   :: Qualifier
   -- ^ Qualifier for data types corresponding to those created from
   -- the 'Rule's
-  -> T.Name
-  -- ^ Name of terminal type.  Typically you will get this through
-  -- the Template Haskell quoting mechanism, such as @''Char@.
   -> Seq (Rule t)
   -- ^ A record is created that holds a value for each 'Rule'
   -- in the 'Seq', as well as for every ancestor of these 'Rule's.
@@ -178,8 +176,8 @@
   --
   -- where @NAME@ is the name of the type.  Don't count on these
   -- records being in any particular order.
-allRulesRecord prefix termName ruleSeq
-  = sequence [T.dataD (return []) (T.mkName nameStr) tys [con] []]
+allRulesRecord prefix ruleSeq
+  = sequence [dataD (return []) (T.mkName nameStr) tys [con] []]
   where
     nameStr = "Productions"
     tys = [T.PlainTV (T.mkName "r"), T.PlainTV (T.mkName "t"),
diff --git a/lib/Pinchot/Examples/AllRulesRecord.hs b/lib/Pinchot/Examples/AllRulesRecord.hs
--- a/lib/Pinchot/Examples/AllRulesRecord.hs
+++ b/lib/Pinchot/Examples/AllRulesRecord.hs
@@ -11,4 +11,4 @@
 import Pinchot.Examples.Postal
 import qualified Pinchot.Examples.SyntaxTrees as SyntaxTrees
 
-$(allRulesRecord "SyntaxTrees" ''Char [rAddress])
+$(allRulesRecord "SyntaxTrees" [rAddress])
diff --git a/lib/Pinchot/Examples/SyntaxTrees.hs b/lib/Pinchot/Examples/SyntaxTrees.hs
--- a/lib/Pinchot/Examples/SyntaxTrees.hs
+++ b/lib/Pinchot/Examples/SyntaxTrees.hs
@@ -14,16 +14,22 @@
 module Pinchot.Examples.SyntaxTrees where
 
 import Pinchot
-import Pinchot.SyntaxTree.Wrappers
 import Pinchot.Examples.Postal
 
-import qualified Control.Lens as Lens
-
 -- This generates the data types corresponding to the 'rAddress'
 -- 'Rule', as well as all the ancestors of that 'Rule'.
-$(syntaxTrees ''Char
+$(syntaxTrees
   [''Eq, ''Ord, ''Show, ''Foldable, ''Traversable, ''Functor]
   [rAddress])
 
 -- This generates intances of the Lens Wrapped typeclass.
 $(wrappedInstances [rAddress])
+
+-- This generates instances of the Bifunctor typeclass.
+$(bifunctorInstances [rAddress])
+
+-- This generates instances of the Semigroup typeclass.
+$(semigroupInstances [rAddress])
+
+-- This generates instances of the Monoid typeclass.
+$(monoidInstances [rAddress])
diff --git a/lib/Pinchot/Examples/Terminalize.hs b/lib/Pinchot/Examples/Terminalize.hs
--- a/lib/Pinchot/Examples/Terminalize.hs
+++ b/lib/Pinchot/Examples/Terminalize.hs
@@ -13,4 +13,4 @@
 terminalizeAddress :: SyntaxTrees.Address t a -> NonEmpty (t, a)
 terminalizeAddress = $(terminalizeRuleExp "SyntaxTrees" rAddress)
 
-$(terminalizers "SyntaxTrees" ''Char [rAddress])
+$(terminalizers "SyntaxTrees" [rAddress])
diff --git a/lib/Pinchot/NonEmpty.hs b/lib/Pinchot/NonEmpty.hs
--- a/lib/Pinchot/NonEmpty.hs
+++ b/lib/Pinchot/NonEmpty.hs
@@ -6,6 +6,7 @@
 module Pinchot.NonEmpty where
 
 import Control.Monad (join, ap)
+import Data.Semigroup (Semigroup((<>)))
 import Data.Sequence (Seq, (<|))
 import qualified Data.Sequence as Seq
 import qualified Control.Lens as Lens
@@ -17,6 +18,10 @@
   , _rest :: Seq a
   -- ^ All remaining items
   } deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
+
+instance Semigroup (NonEmpty a) where
+  (NonEmpty a1 as) <> (NonEmpty b1 bs)
+    = NonEmpty a1 (as <> (b1 <| bs))
 
 Lens.makeLenses ''NonEmpty
 
diff --git a/lib/Pinchot/SyntaxTree.hs b/lib/Pinchot/SyntaxTree.hs
--- a/lib/Pinchot/SyntaxTree.hs
+++ b/lib/Pinchot/SyntaxTree.hs
@@ -7,6 +7,7 @@
 import Data.Foldable (toList)
 import Data.Sequence (Seq)
 import qualified Language.Haskell.TH as T
+import Pinchot.Internal.TemplateHaskellShim (newtypeD, dataD)
 
 import Pinchot.NonEmpty
 import Pinchot.Rules
@@ -18,15 +19,12 @@
 -- applying this function to a single start symbol.  Example:
 -- "Pinchot.Examples.SyntaxTrees".
 syntaxTrees
-  :: T.Name
-  -- ^ Name of terminal type.  Typically you will get this from the
-  -- Template Haskell quoting mechanism, e.g. @''Char@.
-  -> [T.Name]
+  :: [T.Name]
   -- ^ What to derive, e.g. @[''Eq, ''Ord, ''Show]@
   -> Seq (Rule t)
   -> T.DecsQ
-syntaxTrees term derives
-  = traverse (ruleToType term derives)
+syntaxTrees derives
+  = traverse (ruleToType derives)
   . toList
   . families
 
@@ -42,32 +40,30 @@
 
 -- | Makes the top-level declaration for a given rule.
 ruleToType
-  :: T.Name
-  -- ^ Name of terminal type
-  -> [T.Name]
+  :: [T.Name]
   -- ^ What to derive
   -> Rule t
   -> T.Q T.Dec
-ruleToType typeName derives (Rule nm _ ruleType) = case ruleType of
+ruleToType derives (Rule nm _ ruleType) = case ruleType of
   Terminal _ ->
-    T.newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
+    newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
     where
       newtypeCon = T.normalC name
         [T.strictType T.notStrict
           [t| ( $(charTypeVar), $(anyTypeVar) ) |] ]
 
-  NonTerminal b1 bs -> T.dataD (T.cxt []) name [charType, anyType] cons derives
+  NonTerminal b1 bs -> dataD (T.cxt []) name [charType, anyType] cons derives
     where
       cons = branchConstructor b1 : toList (fmap branchConstructor bs)
 
   Wrap (Rule inner _ _) ->
-    T.newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
+    newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
     where
       newtypeCon = T.normalC name
         [ T.strictType T.notStrict
             [t| $(T.conT (T.mkName inner)) $(charTypeVar) $(anyTypeVar) |] ]
 
-  Record sq -> T.dataD (T.cxt []) name [charType, anyType] [ctor] derives
+  Record sq -> dataD (T.cxt []) name [charType, anyType] [ctor] derives
     where
       ctor = T.recC name . zipWith mkField [(0 :: Int) ..] . toList $ sq
       mkField num (Rule rn _ _) = T.varStrictType (T.mkName fldNm)
@@ -77,7 +73,7 @@
           fldNm = '_' : recordFieldName num nm rn
 
   Opt (Rule inner _ _) ->
-    T.newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
+    newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
     where
       newtypeCon = T.normalC name
         [T.strictType T.notStrict
@@ -85,7 +81,7 @@
                                                  $(anyTypeVar)) |]]
 
   Star (Rule inner _ _) ->
-    T.newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
+    newtypeD (T.cxt []) name [charType, anyType] newtypeCon derives
     where
       newtypeCon = T.normalC name [sq]
         where
@@ -94,7 +90,7 @@
                                                  $(anyTypeVar) ) |]
 
   Plus (Rule inner _ _) ->
-    T.newtypeD (T.cxt []) name [charType, anyType] cons derives
+    newtypeD (T.cxt []) name [charType, anyType] cons derives
     where
       cons = T.normalC name [ne]
         where
diff --git a/lib/Pinchot/SyntaxTree/Instancer.hs b/lib/Pinchot/SyntaxTree/Instancer.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/SyntaxTree/Instancer.hs
@@ -0,0 +1,402 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Pinchot.SyntaxTree.Instancer where
+
+import qualified Data.Bifunctor as Bifunctor
+import Data.Maybe (catMaybes)
+import qualified Data.Semigroup as Semigroup
+import qualified Control.Lens as Lens
+import Data.Foldable (foldlM, toList)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Semigroup ((<>))
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+import qualified Language.Haskell.TH as T
+
+import Pinchot.Types
+import Pinchot.Rules
+
+-- | Creates an instance of 'Bifunctor.Bifunctor' for every 'Rule'
+-- in the 'Seq' as well as their ancestors.
+--
+-- This function must be
+-- spliced in the same module as the module in which the syntax tree
+-- types are created.  This avoids problems with orphan instances.
+-- Since ancestors are included, you can get the entire tree of
+-- instances that you need by applying this function to a single
+-- start symbol.
+--
+-- Example: "Pinchot.Examples.SyntaxTrees".
+
+bifunctorInstances
+  :: Seq (Rule t)
+  -> T.DecsQ
+bifunctorInstances = traverse f . toList . families
+  where
+    f rule@(Rule ruleName _ _) = T.instanceD (T.cxt [])
+      [t| Bifunctor.Bifunctor $(T.conT (T.mkName ruleName)) |]
+      [T.valD (T.varP 'Bifunctor.bimap)
+              (T.normalB (bimapExpression "" rule)) []]
+
+-- | Where possible, creates an instance of 'Semigroup.Semigroup'
+-- for every 'Rule' in the 'Seq' as well as their ancestors.  Only
+-- 'star' and 'plus' rules, as well as rules that through one or
+-- more layers of 'wrap' ultimately wrap a 'star' or 'plus' rule,
+-- get a 'Semigroup.Semigroup' instance.
+--
+-- This function must be
+-- spliced in the same module as the module in which the syntax tree
+-- types are created.  This avoids problems with orphan instances.
+-- Since ancestors are included, you can get the entire tree of
+-- instances that you need by applying this function to a single
+-- start symbol.
+--
+-- Example: "Pinchot.Examples.SyntaxTrees".
+
+semigroupInstances
+  :: Seq (Rule t)
+  -> T.DecsQ
+semigroupInstances = fmap catMaybes . traverse f . toList . families
+  where
+    nameT = T.varT $ T.mkName "t"
+    nameA = T.varT $ T.mkName "a"
+    f rule@(Rule ruleName _ _) = case semigroupExpression "" rule of
+      Nothing -> return Nothing
+      Just expn -> fmap Just
+        $ T.instanceD (T.cxt [])
+          [t| Semigroup.Semigroup
+            ( $(T.conT (T.mkName ruleName)) $(nameT) $(nameA)) |]
+          [T.valD (T.varP '(Semigroup.<>))
+                  (T.normalB expn) []]
+
+-- | Where possible, creates an instance of 'Monoid'
+-- for every 'Rule' in the 'Seq' as well as their ancestors.  Only
+-- 'star' rules, as well as rules that through one or
+-- more layers of 'wrap' ultimately wrap a 'star' rule,
+-- get a 'Monoid' instance.
+--
+-- This function must be
+-- spliced in the same module as the module in which the syntax tree
+-- types are created.  This avoids problems with orphan instances.
+-- Since ancestors are included, you can get the entire tree of
+-- instances that you need by applying this function to a single
+-- start symbol.
+--
+-- Example: "Pinchot.Examples.SyntaxTrees".
+monoidInstances
+  :: Seq (Rule t)
+  -> T.DecsQ
+monoidInstances = fmap catMaybes . traverse f . toList . families
+  where
+    nameT = T.varT $ T.mkName "t"
+    nameA = T.varT $ T.mkName "a"
+    f rule@(Rule ruleName _ _)
+      = case (semigroupExpression "" rule, memptyExpression "" rule) of
+      (Just expAppend, Just expMempty) -> fmap Just
+        $ T.instanceD (T.cxt [])
+          [t| Monoid ( $( T.conT (T.mkName ruleName) ) $(nameT) $(nameA) ) |]
+          [ T.valD (T.varP 'mappend)
+                   (T.normalB expAppend) []
+          , T.valD (T.varP 'mempty)
+                   (T.normalB expMempty) [] ]
+      _ -> return Nothing
+
+
+
+-- Creates an expression of type
+--
+-- (a -> b) -> (c -> d) -> RuleData a c -> RuleData b d
+bimapExpression
+  :: Qualifier
+  -> Rule t
+  -> T.ExpQ
+bimapExpression qual rule@(Rule ruleName _ _) = do
+  fa <- T.newName "fa"
+  fb <- T.newName "fb"
+  val <- T.newName "val"
+  lkpName <- nameMap rule
+  letBinds <- bimapLetBinds qual fa fb lkpName rule
+  let resultExpn =
+        [| $(T.varE $ errLookup ruleName lkpName) $(T.varE val) |]
+  T.lamE [T.varP fa, T.varP fb, T.varP val]
+    (T.letE letBinds resultExpn)
+
+
+bimapLetBinds
+  :: Qualifier
+  -> T.Name
+  -- ^ @(a -> b)@
+  -> T.Name
+  -- ^ @(c -> d)@
+  -> Map RuleName T.Name
+  -- ^ Looks up names for other let binds
+  -> Rule t
+  -> T.Q [T.DecQ]
+bimapLetBinds qual fa fb lkp rule
+  = traverse (bimapLetBind qual fa fb lkp) . toList . family $ rule
+
+bimapLetBind
+  :: Qualifier
+  -> T.Name
+  -- ^ @(a -> b)@
+  -> T.Name
+  -- ^ @(c -> d)@
+  -> Map RuleName T.Name
+  -> Rule t
+  -> T.Q T.DecQ
+bimapLetBind qual fa fb lkp (Rule name _ ty) = case ty of
+  Terminal _ -> terminalBimapLetBind qual fa fb lkp name
+  NonTerminal b1 bs -> return $ nonTerminalBimapLetBind qual lkp name
+    (b1 : toList bs)
+  Wrap (Rule inner _ _) -> wrapBimapLetBind qual lkp name inner
+  Record sq -> recordBimapLetBind qual lkp name sq
+  Opt (Rule inner _ _) -> optBimapLetBind qual lkp name inner
+  Star (Rule inner _ _) -> starBimapLetBind qual lkp name inner
+  Plus (Rule inner _ _) -> plusBimapLetBind qual lkp name inner
+
+
+terminalBimapLetBind
+  :: Qualifier
+  -> T.Name
+  -> T.Name
+  -> Map RuleName T.Name
+  -> RuleName
+  -> T.Q T.DecQ
+terminalBimapLetBind qual fa fb lkp name = do
+  val <- T.newName $ "terminalBimapLetBind" ++ name
+  let body = T.lamE [T.conP (quald qual name) [T.varP val]]
+        [| $(T.conE (quald qual name))
+              ( $(T.varE fa) . fst $ $(T.varE val)
+              , $(T.varE fb) . snd $ $(T.varE val)
+              )
+        |]
+  return $ T.valD (T.varP (errLookup name lkp)) (T.normalB body) []
+
+nonTerminalBimapLetBind
+  :: Qualifier
+  -> Map RuleName T.Name
+  -> RuleName
+  -> [Branch a]
+  -> T.DecQ
+nonTerminalBimapLetBind qual lkp name branches =
+  let mkClause (Branch branchName branches)
+        = recordBimapClause qual lkp branchName branches
+      clauses = fmap mkClause branches
+  in T.funD (errLookup name lkp) clauses
+
+wrapBimapLetBind
+  :: Qualifier
+  -> Map RuleName T.Name
+  -> RuleName
+  -> RuleName
+  -> T.Q T.DecQ
+wrapBimapLetBind qual lkp name inner = do
+  val <- T.newName "wrapLetBind"
+  let expn = T.lamE [T.conP (quald qual name) [T.varP val]]
+        [| $(T.conE (quald qual name))
+            ( $(T.varE (errLookup inner lkp)) $(T.varE val) ) |]
+  return $ T.valD (T.varP (errLookup name lkp)) (T.normalB expn) []
+
+recordBimapLetBind
+  :: Qualifier
+  -> Map RuleName T.Name
+  -> RuleName
+  -> Seq (Rule t)
+  -> T.Q T.DecQ
+recordBimapLetBind qual lkp name sq = do
+  let clause = recordBimapClause qual lkp name sq
+  return $ T.funD (errLookup name lkp) [clause]
+
+recordBimapClause
+  :: Qualifier
+  -> Map RuleName T.Name
+  -> RuleName
+  -> Seq (Rule t)
+  -> T.ClauseQ
+recordBimapClause qual lkp name sq = do
+  pairs <- traverse (recordBimapLetBindField lkp) . toList $ sq
+  let body = foldl f (T.conE (quald qual name)) . fmap snd $ pairs
+        where
+          f acc expn = [| $(acc) $(expn) |]
+  let pats = fmap fst pairs
+  T.clause [T.conP (quald qual name) pats] (T.normalB body) []
+
+recordBimapLetBindField
+  :: Map RuleName T.Name
+  -> Rule t
+  -> T.Q (T.PatQ, T.ExpQ)
+recordBimapLetBindField lkp (Rule name _ _) = do
+  tName <- T.newName $ "recordField" ++ name
+  let expn = [| $(T.varE (errLookup name lkp)) $(T.varE tName) |]
+  return (T.varP tName, expn)
+
+optBimapLetBind
+  :: Qualifier
+  -> Map RuleName T.Name
+  -> RuleName
+  -- ^ Name of this rule
+  -> RuleName
+  -- ^ Name of inner rule
+  -> T.Q T.DecQ
+optBimapLetBind qual lkp name inner = do
+  val <- T.newName $ "optBimapLetBind" ++ name
+  let body = [| $(T.conE (quald qual name)) $ case $(T.varE val) of
+                  Nothing -> Nothing
+                  Just v -> Just $ $(T.varE (errLookup inner lkp)) v
+             |]
+  let clause = T.clause [T.conP (quald qual name) [T.varP val]]
+        (T.normalB body) []
+  return $ T.funD (errLookup name lkp) [clause]
+
+starBimapLetBind
+  :: Qualifier
+  -> Map RuleName T.Name
+  -> RuleName
+  -- ^ Name of this rule
+  -> RuleName
+  -- ^ Name of inner rule
+  -> T.Q T.DecQ
+starBimapLetBind qual lkp name inner = do
+  val <- T.newName $ "starBimapLetBind" ++ name
+  let body = [| $(T.conE (quald qual name))
+                $ fmap $(T.varE (errLookup inner lkp)) $(T.varE val) |]
+  let clause = T.clause [T.conP (quald qual name) [T.varP val]]
+        (T.normalB body) []
+  return $ T.funD (errLookup name lkp) [clause]
+
+plusBimapLetBind
+  :: Qualifier
+  -> Map RuleName T.Name
+  -> RuleName
+  -- ^ Name of this rule
+  -> RuleName
+  -- ^ Name of inner rule
+  -> T.Q T.DecQ
+plusBimapLetBind qual lkp name inner = do
+  val <- T.newName $ "plusBimapLetBind" ++ name
+  let body = [| $(T.conE (quald qual name))
+                $ fmap $(T.varE (errLookup inner lkp)) $(T.varE val) |]
+  let clause = T.clause [T.conP (quald qual name) [T.varP val]]
+        (T.normalB body) []
+  return $ T.funD (errLookup name lkp) [clause]
+
+
+errLookup
+  :: (Ord a, Show a)
+  => a
+  -> Map a b
+  -> b
+errLookup k m = case Map.lookup k m of
+  Nothing -> error $ "lookup: key not found: " ++ show k
+  Just v -> v
+
+-- | Creates a map of all ancestor rule names and a corresponding TH
+-- name.
+nameMap
+  :: Rule t
+  -> T.Q (Map RuleName T.Name)
+nameMap = foldlM f Map.empty . family
+  where
+    f acc (Rule ruleName _ _) = do
+      thName <- T.newName $ "bindName" ++ ruleName
+      return $ Map.insert ruleName thName acc
+
+
+-- | If possible, creates an expression of type
+--
+-- RuleData
+--
+-- which is a Monoid 'mempty'.
+memptyExpression
+  :: Qualifier
+  -> Rule t
+  -> Maybe T.ExpQ
+memptyExpression qual rule = do
+  ctors <- monoidCtors rule
+  return $ wrappedMemptyExpression qual ctors
+
+wrappedMemptyExpression
+  :: Qualifier
+  -> Seq RuleName
+  -> T.ExpQ
+wrappedMemptyExpression qual rules = foldr f [| mempty |] rules
+  where
+    f name acc = [| $(T.conE (quald qual name)) $(acc) |]
+
+-- | If possible, creates an expression of type
+--
+-- RuleData -> RuleData -> RuleData
+--
+-- which is a Monoid 'mappend'.
+mappendExpression
+  :: Qualifier
+  -> Rule t
+  -> Maybe T.ExpQ
+mappendExpression qual rule = do
+  ctors <- monoidCtors rule
+  return $ wrappedSemigroupExpression 'mappend qual ctors
+
+monoidCtors
+  :: Rule t
+  -> Maybe (Seq RuleName)
+monoidCtors (Rule ruleName _ ty) = case ty of
+  Wrap r -> do
+    rest <- monoidCtors r
+    return $ ruleName `Lens.cons` rest
+  Star _ -> Just (Seq.singleton ruleName)
+  _ -> Nothing
+
+-- | If possible, creates an expression of type
+--
+-- RuleData -> RuleData -> RuleData
+--
+-- which is a Semigroup '<>'.
+
+semigroupExpression
+  :: Qualifier
+  -> Rule t
+  -> Maybe T.ExpQ
+semigroupExpression qual rule = do
+  ctors <- semigroupCtors rule
+  return $ wrappedSemigroupExpression '(<>) qual ctors
+
+
+semigroupCtors
+  :: Rule t
+  -> Maybe (Seq RuleName)
+semigroupCtors (Rule ruleName _ ty) = case ty of
+  Wrap r -> do
+    rest <- semigroupCtors r
+    return $ ruleName `Lens.cons` rest
+  Plus _ -> Just (Seq.singleton ruleName)
+  Star _ -> Just (Seq.singleton ruleName)
+  _ -> Nothing
+
+wrappedSemigroupExpression
+  :: T.Name
+  -- ^ mappend operator
+  -> Qualifier
+  -> Seq RuleName
+  -- ^ Rule names, with the outermost name on the left side of the
+  -- 'Seq'.
+  -> T.ExpQ
+  -- ^ An expression of type
+  --
+  -- RuleData -> RuleData -> RuleData
+  --
+  -- It unwraps the two argument types, uses the Semigroup @<>@
+  -- operator to combine them, and rewraps the result.
+wrappedSemigroupExpression append qual rules = names >>= makeExp
+  where
+    names = (,) <$> T.newName "x1" <*> T.newName "x2"
+    makeExp (x1, x2) = [| \ $(mkPat x1) $(mkPat x2) -> $(mkRes) |]
+      where
+        mkPat name = foldr f (T.varP name) rules
+          where
+            f rule acc = T.conP (quald qual rule) [acc]
+        mkRes = foldr f
+          [| $(T.varE append) $(T.varE x1) $(T.varE x2) |] rules
+          where
+            f rule acc = T.appE (T.conE (quald qual rule)) acc
diff --git a/lib/Pinchot/SyntaxTree/Optics.hs b/lib/Pinchot/SyntaxTree/Optics.hs
--- a/lib/Pinchot/SyntaxTree/Optics.hs
+++ b/lib/Pinchot/SyntaxTree/Optics.hs
@@ -1,9 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Pinchot.SyntaxTree.Optics where
 
-import Data.Coerce (coerce)
 import Data.Foldable (toList)
-import Data.Maybe (catMaybes)
 import Data.Sequence (Seq)
 import qualified Control.Lens as Lens
 import qualified Language.Haskell.TH as T
@@ -98,7 +96,6 @@
   return [e1, e2]
   where
     anyType = T.varT (T.mkName "a")
-    charType = T.varT (T.mkName "t")
     prismName = T.varP (T.mkName ('_' : nm))
     fetchPat = T.conP (quald qual nm) [T.varP (T.mkName "_x")]
     fetchName = T.varE (T.mkName "_x")
diff --git a/lib/Pinchot/Terminalize.hs b/lib/Pinchot/Terminalize.hs
--- a/lib/Pinchot/Terminalize.hs
+++ b/lib/Pinchot/Terminalize.hs
@@ -9,7 +9,6 @@
 import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Language.Haskell.TH as T
-import qualified Language.Haskell.TH.Syntax as Syntax
 
 import Pinchot.NonEmpty (NonEmpty(NonEmpty))
 import qualified Pinchot.NonEmpty as NonEmpty
@@ -40,16 +39,12 @@
   -- ^ Qualifier for the module containing the data types created
   -- from the 'Rule's
  
-  -> T.Name
-  -- ^ Name of terminal type.  Typically you will get this through
-  -- the Template Haskell quoting mechanism, such as @''Char@.
-
   -> Seq (Rule t)
   -> T.Q [T.Dec]
 
-terminalizers qual termType
+terminalizers qual
   = fmap concat
-  . traverse (terminalizer qual termType)
+  . traverse (terminalizer qual)
   . toList
   . families
 
@@ -76,14 +71,10 @@
   -- ^ Qualifier for the module containing the data types created
   -- from the 'Rule's
  
-  -> T.Name
-  -- ^ Name of terminal type.  Typically you will get this through
-  -- the Template Haskell quoting mechanism, such as @''Char@.
-
   -> Rule t
   -> T.Q [T.Dec]
 
-terminalizer qual termType rule@(Rule nm _ _) = sequence [sig, expn]
+terminalizer qual rule@(Rule nm _ _) = sequence [sig, expn]
   where
     declName = "t'" ++ nm
     anyType = T.varT (T.mkName "a")
@@ -233,7 +224,6 @@
 
     | otherwise -> do
         x <- T.newName "x"
-        let pat = T.conP (quald qual nm) [T.varP x]
         [| let getTermSeq = $(T.varE (lookupName lkp inner))
                getTerms (NonEmpty e1 es) = getTermSeq e1
                 `mappend` (join (fmap getTermSeq es))
diff --git a/oldTemplateHaskell/Pinchot/Internal/TemplateHaskellShim.hs b/oldTemplateHaskell/Pinchot/Internal/TemplateHaskellShim.hs
new file mode 100644
--- /dev/null
+++ b/oldTemplateHaskell/Pinchot/Internal/TemplateHaskellShim.hs
@@ -0,0 +1,15 @@
+-- | A compatibility shim so Pinchot can work with versions of the
+-- template-haskell library both before and after version 2.11.
+-- The .cabal file is set up so this version of this module is used
+-- for 2.10 versions of template-haskell.
+module Pinchot.Internal.TemplateHaskellShim where
+
+import qualified Language.Haskell.TH as T
+
+newtypeD
+  :: T.CxtQ -> T.Name -> [T.TyVarBndr] -> T.ConQ -> [T.Name] -> T.DecQ
+newtypeD = T.newtypeD
+
+dataD
+  :: T.CxtQ -> T.Name -> [T.TyVarBndr] -> [T.ConQ] -> [T.Name] -> T.DecQ
+dataD = T.dataD
diff --git a/pinchot.cabal b/pinchot.cabal
--- a/pinchot.cabal
+++ b/pinchot.cabal
@@ -3,16 +3,16 @@
 -- http://www.github.com/massysett/cartel
 --
 -- Script name used to generate: genCabal.hs
--- Generated on: 2016-04-10 09:37:56.35801 EDT
--- Cartel library version: 0.14.2.8
+-- Generated on: 2016-04-30 09:55:17.798604 EDT
+-- Cartel library version: 0.16.0.0
 
 name: pinchot
-version: 0.16.0.0
+version: 0.18.0.0
 cabal-version: >= 1.14
 license: BSD3
 license-file: LICENSE
 build-type: Simple
-copyright: 2015 Omari Norman
+copyright: 2015-2016 Omari Norman
 author: Omari Norman
 maintainer: omari@smileystation.com
 stability: Experimental
@@ -48,6 +48,7 @@
     Pinchot.RecursiveDo
     Pinchot.Rules
     Pinchot.SyntaxTree
+    Pinchot.SyntaxTree.Instancer
     Pinchot.SyntaxTree.Optics
     Pinchot.SyntaxTree.Wrappers
     Pinchot.Terminalize
@@ -56,10 +57,22 @@
       base >= 4.8.0.0 && < 5
     , containers >= 0.5.6.2
     , transformers >= 0.4.2.0
-    , template-haskell >= 2.10
     , Earley >= 0.11.0.1
     , lens >= 4.13
     , ListLike >= 4.2.1
+    , semigroups >= 0.18.1
+  if flag(oldTemplateHaskell)
+    build-depends:
+        template-haskell >= 2.10 && < 2.11
+    hs-source-dirs:
+      oldTemplateHaskell
+  else
+    build-depends:
+        template-haskell >= 2.11
+    hs-source-dirs:
+      newTemplateHaskell
+  other-modules:
+    Pinchot.Internal.TemplateHaskellShim
   other-extensions:
     TemplateHaskell
   default-language: Haskell2010
@@ -91,6 +104,7 @@
       Pinchot.RecursiveDo
       Pinchot.Rules
       Pinchot.SyntaxTree
+      Pinchot.SyntaxTree.Instancer
       Pinchot.SyntaxTree.Optics
       Pinchot.SyntaxTree.Wrappers
       Pinchot.Terminalize
@@ -101,10 +115,22 @@
         base >= 4.8.0.0 && < 5
       , containers >= 0.5.6.2
       , transformers >= 0.4.2.0
-      , template-haskell >= 2.10
       , Earley >= 0.11.0.1
       , lens >= 4.13
       , ListLike >= 4.2.1
+      , semigroups >= 0.18.1
+    if flag(oldTemplateHaskell)
+      build-depends:
+          template-haskell >= 2.10 && < 2.11
+      hs-source-dirs:
+        oldTemplateHaskell
+    else
+      build-depends:
+          template-haskell >= 2.11
+      hs-source-dirs:
+        newTemplateHaskell
+    other-modules:
+      Pinchot.Internal.TemplateHaskellShim
     other-extensions:
       TemplateHaskell
     default-language: Haskell2010
@@ -112,6 +138,11 @@
       lib
   else
     buildable: False
+
+Flag oldTemplateHaskell
+  description: Use version of Template Haskell before 2.11
+  default: False
+  manual: False
 
 Flag executables
   description: Build executables