diff --git a/lib/Pinchot.hs b/lib/Pinchot.hs
--- a/lib/Pinchot.hs
+++ b/lib/Pinchot.hs
@@ -40,15 +40,9 @@
 
 -}
 module Pinchot
-  ( -- * Intervals
-    Intervals
-  , include
-  , exclude
-  , solo
-  , pariah
-
+  (
   -- * Production rules
-  , RuleName
+    RuleName
   , Rule
   , BranchName
   , terminal
@@ -102,7 +96,7 @@
 
 import Pinchot.Earley
 import Pinchot.Locator
-import Pinchot.Intervals
+import Pinchot.Names
 import Pinchot.Rules
 import Pinchot.SyntaxTree
 import Pinchot.SyntaxTree.Instancer
diff --git a/lib/Pinchot/Earley.hs b/lib/Pinchot/Earley.hs
--- a/lib/Pinchot/Earley.hs
+++ b/lib/Pinchot/Earley.hs
@@ -4,137 +4,135 @@
 
 module Pinchot.Earley where
 
+import Pinchot.Names
 import Pinchot.RecursiveDo
 import Pinchot.Rules
 import Pinchot.Types
-import Pinchot.Intervals
 
 import Control.Applicative ((<|>), liftA2)
 import Data.Data (Data)
-import Data.Foldable (toList)
-import Data.Sequence.NonEmpty (NonEmptySeq(NonEmptySeq))
-import qualified Data.Sequence.NonEmpty as NE
-import Data.Sequence ((<|), viewl, ViewL(EmptyL, (:<)), Seq)
-import qualified Data.Sequence as Seq
+import Data.Foldable (foldlM)
+import Data.List.NonEmpty (NonEmpty((:|)))
 import qualified Language.Haskell.TH as T
 import qualified Language.Haskell.TH.Syntax as Syntax
 import qualified Text.Earley
 
 earleyTerm
   :: Eq t
-  => NonEmptySeq t
-  -> Text.Earley.Prod r e (t, a) (NonEmptySeq (t, a))
-earleyTerm sq = NonEmptySeq <$> parseHead <*> parseRest
+  => NonEmpty t
+  -> Text.Earley.Prod r e (t, a) (NonEmpty (t, a))
+earleyTerm (fore :| aft) = (:|) <$> parseHead <*> parseRest
   where
-    parseHead = parse . NE._fore $ sq
-    parseRest = foldr (liftA2 (<|) . parse) (pure Seq.empty) (NE._aft sq)
+    parseHead = parse fore
+    parseRest = foldr (liftA2 (:) . parse) (pure []) aft
     parse t = Text.Earley.satisfy ((== t) . fst)
 
--- | Creates a list of pairs.  Each list represents a statement in
+branchToParser
+  :: Syntax.Lift t
+  => String
+  -- ^ Module prefix
+  -> Branch t
+  -> Namer T.ExpQ
+branchToParser prefix (Branch name rules) = do
+  case rules of
+    [] -> return [| pure $constructor |]
+    (Rule rule1 _ _) : xs -> do
+      rule1Name <- getName rule1
+      let z = [| $constructor <$> $(T.varE rule1Name) |]
+          f soFar (Rule rule2 _ _) = do
+            rule2Name <- getName rule2
+            return [| $soFar <*> $(T.varE rule2Name) |]
+      foldlM f z xs
+  where
+    constructor = do
+      ctorName <- lookupValueName (quald prefix name)
+      T.conE ctorName
+
+-- | Creates a list of pairs.  Each pair represents a statement in
 -- @do@ notation.  The first element of the pair is the name of the
 -- variable to which to bind the result of the expression, which is
 -- the second element of the pair.
+
 ruleToParser
   :: (Syntax.Lift t, Data t)
   => String
   -- ^ Module prefix
   -> Rule t
-  -> [(T.Name, T.ExpQ)]
-ruleToParser prefix (Rule nm mayDescription rt) = case rt of
+  -> Namer [(T.Name, T.ExpQ)]
+ruleToParser prefix (Rule nm mayDescription rt) = do
+  bindName <- getName nm
+  let desc = maybe nm id mayDescription
+      makeRule expression = (bindName,
+        [|Text.Earley.rule ($expression Text.Earley.<?> desc)|])
+      constructor = do
+        ctorName <- lookupValueName (quald prefix nm)
+        T.conE ctorName
+      wrapper wrapRule = [|fmap $constructor $(T.varE wrapRule) |]
+  case rt of
+    Terminal (Predicate pdct) -> return [makeRule expression]
+      where
+        expression = do
+          ctorName <- lookupValueName (quald prefix nm)
+          [| let f (c, a)
+                  | $(fmap T.unType pdct) c = Just
+                      ($(T.conE ctorName) (c, a))
+                  | otherwise = Nothing
+            in Text.Earley.terminal f |]
 
-  Terminal ivls -> [makeRule expression]
-    where
-      expression =
-        [| let f (c, a)
-                | inIntervals ivls c = Just
-                    ($(T.conE (quald prefix nm)) (c, a))
-                | otherwise = Nothing
-           in Text.Earley.terminal f |]
+    NonTerminal (b1 :| bs) -> do
+      let addBranch tree branch = do
+            branchParserExpn <- branchToParser prefix branch
+            return [| $tree <|> $branchParserExpn |]
+      branch1 <- branchToParser prefix b1
+      expression <- foldlM addBranch branch1 bs
+      return [makeRule expression]
 
-  NonTerminal (NE.NonEmptySeq b1 bs) -> [makeRule expression]
-    where
-      expression = foldl addBranch (branchToParser prefix b1) bs
-        where
-          addBranch tree branch =
-            [| $tree <|> $(branchToParser prefix branch) |]
+    Wrap (Rule innerNm _ _) -> do
+      innerName <- getName innerNm
+      let expression = [| fmap $constructor $(T.varE innerName) |]
+      return [makeRule expression]
 
-  Wrap (Rule innerNm _ _) -> [makeRule expression]
-    where
-      expression = [|fmap $constructor $(T.varE (localRuleName innerNm)) |]
+    Record sq -> do
+      expression <- case sq of
+        [] -> return [| pure $constructor |]
+        Rule r1 _ _ : restFields -> do
+          r1Name <- getName r1
+          let fstField = [| $constructor <$> $(T.varE r1Name) |]
+              addField soFar (Rule r _ _) = do
+                rName <- getName r
+                return [| $soFar <*> $(T.varE rName) |]
+          foldlM addField fstField restFields
+      return [makeRule expression]
 
-  Record sq -> [makeRule expression]
-    where
-      expression = case viewl sq of
-        EmptyL -> [| pure $constructor |]
-        Rule r1 _ _ :< restFields -> foldl addField fstField restFields
-          where
-            fstField = [| $constructor <$> $(T.varE (localRuleName r1)) |]
-            addField soFar (Rule r _ _)
-              = [| $soFar <*> $(T.varE (localRuleName r)) |]
-    
-  Opt (Rule innerNm _ _) -> [makeRule expression]
-    where
-      expression = [| fmap $constructor (pure Nothing <|> $(just)) |]
-        where
-          just = [| fmap Just $(T.varE (localRuleName innerNm)) |]
+    Opt (Rule innerNm _ _) -> do
+      innerName <- getName innerNm
+      let just = [| fmap Just $(T.varE innerName) |]
+          expression = [| fmap $constructor (pure Nothing <|> $(just)) |]
+      return [makeRule expression]
 
-  Star (Rule innerNm _ _) -> [nestRule, makeRule (wrapper helper)]
-    where
-      nestRule = (helper, ([|Text.Earley.rule|] `T.appE` parseSeq))
-        where
-          parseSeq = T.uInfixE [|pure Seq.empty|] [|(<|>)|] pSeq
-            where
-              pSeq = [|liftA2 (<|)
-                $(T.varE (localRuleName innerNm)) $(T.varE helper) |]
+    Star (Rule innerNm _ _) -> do
+      innerName <- getName innerNm
+      helperName <- namerNewName
+      let pList = [| liftA2 (:) $(T.varE innerName) $(T.varE helperName) |]
+          pChoose = T.uInfixE [|pure []|] [|(<|>)|] pList
+          nestRule = (helperName, ([|Text.Earley.rule|] `T.appE` pChoose))
+      return [nestRule, makeRule (wrapper helperName)]
 
-  Plus (Rule innerNm _ _) -> [nestRule, makeRule topExpn]
-    where
-      nestRule = (helper, [|Text.Earley.rule $(parseSeq)|])
-        where
-          parseSeq = [| pure Seq.empty <|> $pSeq |]
-            where
-              pSeq = [| (<|) <$> $(T.varE (localRuleName innerNm))
-                             <*> $(T.varE helper) |]
-      topExpn = [| $constructor <$>
-        ( NonEmptySeq <$> $(T.varE (localRuleName innerNm))
-                   <*> $(T.varE helper)) |]
+    Plus (Rule innerNm _ _) -> do
+      innerName <- getName innerNm
+      helperName <- namerNewName
+      let pList = [| (:) <$> $(T.varE innerName) <*> $(T.varE helperName) |]
+          pChoose = [| pure [] <|> $pList |]
+          nestRule = (helperName, [|Text.Earley.rule $pChoose |])
+          topExpn = [| $constructor <$>
+            ( (:|) <$> $(T.varE innerName) <*> $(T.varE helperName)) |]
+      return [nestRule, makeRule topExpn]
 
-  Series neSeq -> [makeRule expression]
-    where
-      expression = [| fmap $constructor $
-        earleyTerm $(Syntax.liftData neSeq) |]
+    Series neSeq -> do
+      let expn = [| fmap $constructor $ earleyTerm $(Syntax.liftData neSeq) |]
+      return [makeRule expn]
 
 
-  where
-    makeRule expression = (localRuleName nm,
-      [|Text.Earley.rule ($expression Text.Earley.<?> $(textToExp desc))|])
-    desc = maybe nm id mayDescription
-    textToExp txt = [| $(Syntax.lift txt) |]
-    constructor = T.conE (quald prefix nm)
-    wrapper wrapRule = [|fmap $constructor $(T.varE wrapRule) |]
-    helper = helperName nm
-
-localRuleName :: String -> T.Name
-localRuleName suffix = T.mkName ("_rule'" ++ suffix)
-
-helperName :: String -> T.Name
-helperName suffix = T.mkName ("_helper'" ++ suffix)
-
-branchToParser
-  :: Syntax.Lift t
-  => String
-  -- ^ Module prefix
-  -> Branch t
-  -> T.ExpQ
-branchToParser prefix (Branch name rules) = case viewl rules of
-  EmptyL -> [| pure $constructor |]
-  (Rule rule1 _ _) :< xs -> foldl f z xs
-    where
-      z = [| $constructor <$> $(T.varE (localRuleName rule1)) |]
-      f soFar (Rule rule2 _ _) = [| $soFar <*> $(T.varE (localRuleName rule2)) |]
-  where
-    constructor = T.conE (quald prefix name)
-
 -- | Creates an expression that has type
 --
 -- 'Text.Earley.Grammar' r (Prod r String (c, a) (p c a))
@@ -153,10 +151,13 @@
   -> Rule t
   -- ^ Create a grammar for this 'Rule'
   -> T.Q T.Exp
-earleyGrammarFromRule prefix r@(Rule top _ _) = recursiveDo binds final
-  where
-    binds = concatMap (ruleToParser prefix) . toList . family $ r
-    final = [| return $(T.varE $ localRuleName top) |]
+earleyGrammarFromRule prefix r@(Rule top _ _) = do
+  (binds, topName) <- runNamer $ do
+    bnds <- fmap concat . sequence . fmap (ruleToParser prefix) . family $ r
+    topN <- getName top
+    return (bnds, topN)
+  let final = [| return $(T.varE topName) |]
+  recursiveDo binds final
 
 -- | Creates a record data type that holds a value of type
 --
@@ -181,7 +182,7 @@
   :: Qualifier
   -- ^ Qualifier for data types corresponding to those created from
   -- the 'Rule's
-  -> Seq (Rule t)
+  -> [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.
   -> T.DecsQ
@@ -193,28 +194,20 @@
   -- where @NAME@ is the name of the type.  Don't count on these
   -- records being in any particular order.
 allRulesRecord prefix ruleSeq
-  = sequence [T.dataD (return []) (T.mkName nameStr)
+  = sequence [T.dataD (return []) productions
                       tys Nothing [con] (return [])]
   where
-    nameStr = "Productions"
-    tys = [T.PlainTV (T.mkName "r"), T.PlainTV (T.mkName "t"),
-      T.PlainTV (T.mkName "a")]
-    con = T.recC (T.mkName nameStr)
-        (fmap mkRecord . toList . families $ ruleSeq)
-    mkRecord (Rule ruleNm _ _) = T.varBangType recName st
+    tys = [tyVarBndrR, tyVarBndrT, tyVarBndrA]
+    con = T.recC productions
+        (fmap mkRecord . families $ ruleSeq)
+    mkRecord (Rule ruleNm _ _) = T.varBangType (recordName ruleNm) st
       where
-        recName = T.mkName ("a'" ++ ruleNm)
         st = T.bangType (T.bang T.noSourceUnpackedness T.noSourceStrictness) ty
           where
-            ty = [t| Text.Earley.Prod $(T.varT (T.mkName "r"))
-                      String
-                      ( $(T.varT (T.mkName "t")), $(T.varT (T.mkName "a")))
-                      ( $(T.conT (T.mkName nameWithPrefix))
-                            $(T.varT (T.mkName "t"))
-                            $(T.varT (T.mkName "a"))) |]
-            nameWithPrefix = case prefix of
-              [] -> ruleNm
-              _ -> prefix ++ '.' : ruleNm
+            ty = do
+              ctorName <- lookupTypeName (quald prefix ruleNm)
+              [t| Text.Earley.Prod $typeR String ($typeT, $typeA)
+                      ( $(T.conT ctorName) $typeT $typeA) |]
 
 -- | Creates a 'Text.Earley.Grammar' that contains a
 -- 'Text.Earley.Prod' for every given 'Rule' and its ancestors.
@@ -229,9 +222,9 @@
   -> Qualifier
   -- ^ Qualifier for the type created with 'allRulesRecord'
 
-  -> Seq (Rule t)
+  -> [Rule t]
   -- ^ Creates an Earley grammar that contains a 'Text.Earley.Prod'
-  -- for each 'Rule' in this 'Seq', as well as all the ancestors of
+  -- for each 'Rule' in this list, as well as all the ancestors of
   -- these 'Rule's.
 
   -> T.ExpQ
@@ -243,21 +236,19 @@
   -- any additional information about each token (often
   -- 'Pinchot.Loc').
 earleyProduct pfxRule pfxRec ruleSeq = do
-  let binds = concatMap (ruleToParser pfxRule)
-        . toList . families $ ruleSeq
-      final = [| return
-        $(T.recConE (T.mkName rulesRecName)
-                    (fmap mkRec . toList . families $ ruleSeq)) |]
-        
-  recursiveDo binds final
-  where
-    rulesRecName
-      | null pfxRec = "Productions"
-      | otherwise = pfxRec ++ ".Productions"
-    mkRec (Rule n _ _) = return (T.mkName recName, recVal)
-      where
-        recName
-          | null pfxRec = "a'" ++ n
-          | otherwise = pfxRec ++ ".a'" ++ n
-        recVal = T.VarE . localRuleName $ n
+  (binds, topName) <- runNamer $ do
+    let fams = families ruleSeq
+    bnds <- fmap concat . sequence . fmap (ruleToParser pfxRule) $ fams
+    let allRuleNames = fmap _ruleName fams
+    allRuleBindNames <- traverse getName allRuleNames
+    let mkRec ruleName bindName = (qualRecordName pfxRec ruleName, T.VarE bindName)
+        ruleBindNamePairs = zipWith mkRec allRuleNames allRuleBindNames
+        convertPair (str, expn) = do
+          nm <- lookupValueName str
+          return (nm, expn)
+        final = do
+          recName <- lookupValueName (quald pfxRec productionsStr)
+          [| return $(T.recConE recName (fmap convertPair ruleBindNamePairs)) |]
+    return (bnds, final)
+  recursiveDo binds topName
 
diff --git a/lib/Pinchot/Examples/Newman.hs b/lib/Pinchot/Examples/Newman.hs
--- a/lib/Pinchot/Examples/Newman.hs
+++ b/lib/Pinchot/Examples/Newman.hs
@@ -13,12 +13,9 @@
 import Pinchot.Examples.RulesToOptics
 
 import qualified Control.Lens as Lens
-import Data.Foldable (toList)
 import Data.List (intersperse)
-import Data.Sequence (Seq)
-import qualified Data.Sequence as Seq
-import Data.Sequence.NonEmpty (NonEmptySeq)
-import qualified Data.Sequence.NonEmpty as NE
+import Data.List.NonEmpty (NonEmpty, toList)
+import qualified Data.List.NonEmpty as NE
 import qualified Text.Earley as Earley
 import qualified Text.Show.Pretty as Pretty
 
@@ -30,9 +27,9 @@
 
 -- | Labels a single field, where the field may or may not appear in
 -- a parsed result.
-labelOpt :: String -> Seq (Char, Loc) -> String
+labelOpt :: String -> [(Char, Loc)] -> String
 labelOpt l sq
-  = l ++ ": " ++ show (toList . fmap fst $ sq)
+  = l ++ ": " ++ show (fmap fst $ sq)
   ++ " " ++ loc ++ "\n"
   where
     loc = case Lens.uncons sq of
@@ -41,12 +38,12 @@
 
 -- | Labels a single field, where the field will always appear in a
 -- parsed result.
-labelNE :: String -> NonEmptySeq (Char, Loc) -> String
+labelNE :: String -> NonEmpty (Char, Loc) -> String
 labelNE l sq
   = l ++ ": " ++ show (toList . fmap fst $ sq)
   ++ " " ++ loc ++ "\n"
   where
-    loc = labelLoc . snd . NE._fore $ sq
+    loc = labelLoc . snd . NE.head $ sq
 
 -- | Formats a single 'Address' for nice on-screen display.
 showAddress :: Address Char Loc -> String
@@ -60,7 +57,7 @@
           . _r'Address'1'StreetLine $ a
 
         pre = labelOpt "Direction prefix"
-          . maybe Seq.empty NE.nonEmptySeqToSeq
+          . maybe [] NE.toList
           . Lens.preview (r'Address'1'StreetLine
                           . r'StreetLine'2'DirectionSpace'Opt
                           . Lens._Wrapped'
@@ -76,7 +73,7 @@
           $ a
 
         suf = labelOpt "Street suffix"
-          . maybe Seq.empty NE.nonEmptySeqToSeq
+          . maybe [] NE.toList
           . Lens.preview (r'Address'1'StreetLine
                           . r'StreetLine'4'SpaceSuffix'Opt
                           . Lens._Wrapped'
@@ -107,7 +104,7 @@
 -- | Formats successful 'Address' parses and the 'Earley.Report' for
 -- nice on-screen display.
 showParseResult
-  :: ([Address Char Loc], Earley.Report String (Seq (Char, Loc)))
+  :: ([Address Char Loc], Earley.Report String [(Char, Loc)])
   -> String
 showParseResult (addresses, report) = addresses' ++ "\n" ++ report'
   where
@@ -115,7 +112,7 @@
       . concat . intersperse "---\n" . map showAddress
       $ addresses
     report' = ("Earley report:\n\n" ++) . show
-      $ report { Earley.unconsumed = toList . fmap fst
+      $ report { Earley.unconsumed = fmap fst
       . Earley.unconsumed $ report }
 
 -- | Parse an address and print the resulting report.  Good for use
diff --git a/lib/Pinchot/Examples/Postal.hs b/lib/Pinchot/Examples/Postal.hs
--- a/lib/Pinchot/Examples/Postal.hs
+++ b/lib/Pinchot/Examples/Postal.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 -- | This module contains a context-free grammar for U.S. postal
@@ -12,22 +13,23 @@
 module Pinchot.Examples.Postal where
 
 import Pinchot
-import Data.Monoid ((<>))
 
-rDigit = terminal "Digit" (include '0' '9') <?> "digit from 0 to 9"
+rDigit = terminal "Digit" [|| \x -> x >= '0' && x <= '9' ||]
+  <?> "digit from 0 to 9"
 
 rDigits = plus rDigit
 
-rLetter = terminal "Letter" (include 'a' 'z' <> include 'A' 'Z')
+rLetter = terminal "Letter" [|| \x -> (x >= 'a' && x <= 'z')
+                                   || (x >= 'A' && x <= 'Z') ||]
   <?> "letter from A to Z"
 
-rNorth = terminal "North" (solo 'N')
+rNorth = terminal "North" [|| (== 'N') ||]
 
-rSouth = terminal "South" (solo 'S')
+rSouth = terminal "South" [|| (== 'S') ||]
 
-rEast = terminal "East" (solo 'E')
+rEast = terminal "East" [|| (== 'E') ||]
 
-rWest = terminal "West" (solo 'W')
+rWest = terminal "West" [|| (== 'W') ||]
 
 rNE = series "NE" "NE"
 
@@ -50,11 +52,11 @@
 
 rSuffix = union "Suffix" [rStreet, rAvenue, rWay, rBoulevard]
 
-rSpace = terminal "Space" (solo ' ')
+rSpace = terminal "Space" [|| (== ' ') ||]
 
-rComma = terminal "Comma" (solo ',')
+rComma = terminal "Comma" [|| (== ',') ||]
 
-rNewline = terminal "Newline" (solo '\n')
+rNewline = terminal "Newline" [|| (== '\n') ||]
 
 rCommaSpace = record "CommaSpace" [rComma, rSpace]
 
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
@@ -1,6 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 -- The following extension is required only for the splice of Lens wrapped
 -- instances in 'wrappedInstances'
@@ -13,13 +14,15 @@
 -- generate them.
 module Pinchot.Examples.SyntaxTrees where
 
+import GHC.Generics (Generic)
+
 import Pinchot
 import Pinchot.Examples.Postal
 
 -- This generates the data types corresponding to the 'rAddress'
 -- 'Rule', as well as all the ancestors of that 'Rule'.
 $(syntaxTrees
-  [''Eq, ''Ord, ''Show, ''Foldable, ''Traversable, ''Functor]
+  [''Eq, ''Ord, ''Show, ''Foldable, ''Traversable, ''Functor, ''Generic]
   [rAddress])
 
 -- This generates intances of the Lens Wrapped typeclass.
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
@@ -6,13 +6,13 @@
 -- that were used to create it.
 module Pinchot.Examples.Terminalize where
 
-import Data.Sequence.NonEmpty (NonEmptySeq)
+import Data.List.NonEmpty (NonEmpty)
 
 import Pinchot
 import Pinchot.Examples.Postal
 import qualified Pinchot.Examples.SyntaxTrees as SyntaxTrees
 
-terminalizeAddress :: SyntaxTrees.Address t a -> NonEmptySeq (t, a)
+terminalizeAddress :: SyntaxTrees.Address t a -> NonEmpty (t, a)
 terminalizeAddress = $(terminalizeRuleExp "SyntaxTrees" rAddress)
 
 $(terminalizers "SyntaxTrees" [rAddress])
diff --git a/lib/Pinchot/Intervals.hs b/lib/Pinchot/Intervals.hs
deleted file mode 100644
--- a/lib/Pinchot/Intervals.hs
+++ /dev/null
@@ -1,258 +0,0 @@
-{-# OPTIONS_HADDOCK not-home #-}
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- | Intervals describe terminal symbols.  Ordinarily you will not
--- need to use this module, as "Pinchot" re-exports the things you
--- usually need.
-module Pinchot.Intervals where
-
-import qualified Control.Lens as Lens
-import Control.Monad (join)
-import Data.Data (Data)
-import Data.Monoid ((<>))
-import Data.Ord (comparing)
-import Data.Sequence (Seq, ViewL(EmptyL, (:<)), viewl, (<|))
-import qualified Data.Sequence as Seq
-import Language.Haskell.TH
-import Language.Haskell.TH.Syntax
-import Text.Show.Pretty (PrettyVal)
-import qualified Text.Show.Pretty as Pretty
-
-import Pinchot.Pretty
-
--- | Groups of terminals.  Create an 'Intervals' using 'include',
--- 'exclude', 'solo' and 'pariah'.  Combine 'Intervals' using
--- 'mappend', which will combine both the included and excluded
--- terminal symbols from each operand.
-data Intervals a = Intervals
-  { _included :: Seq (a, a)
-  -- ^ Each pair @(a, b)@ is an inclusive range of terminal symbols,
-  -- in order.  For instance, @('a', 'c')@ includes the characters
-  -- @'a'@, @'b'@, and @'c'@.  The 'included' sequence contains all
-  -- terminals that are included in the 'Intervals', except for those
-  -- that are 'excluded'.
-  , _excluded :: Seq (a, a)
-  -- ^ Each symbol in 'excluded' is not in the 'Intervals', even if
-  -- the symbol is 'included'.
-  } deriving (Eq, Ord, Show, Data)
-
-Lens.makeLenses ''Intervals
-
-instance PrettyVal a => PrettyVal (Intervals a) where
-  prettyVal (Intervals inc exc)
-    = Pretty.Rec "Pinchot.Intervals.Intervals"
-      [ ("_included", prettySeq Pretty.prettyVal inc)
-      , ("_excluded", prettySeq Pretty.prettyVal exc)
-      ]
-
-instance Functor Intervals where
-  fmap f (Intervals a b) = Intervals (fmap g a) (fmap g b)
-    where
-      g (x, y) = (f x, f y)
-
-instance Monoid (Intervals a) where
-  mempty = Intervals mempty mempty
-  (Intervals x1 y1) `mappend` (Intervals x2 y2)
-    = Intervals (x1 <> x2) (y1 <> y2)
-
--- | Include a range of symbols in the 'Intervals'.  For instance, to
--- include the characters @'a'@, @'b'@, and @'c'@, use @include 'a'
--- 'c'@.  Example: 'Pinchot.Examples.Postal.rLetter'.
-include :: a -> a -> Intervals a
-include l h = Intervals [(l, h)] []
-
--- | Exclude a range of symbols in the 'Intervals'.  Each symbol that
--- is 'exclude'd is not included in the 'Intervals', even if it is
--- also 'include'd.
-exclude :: a -> a -> Intervals a
-exclude l h = Intervals [] [(l, h)]
-
--- | Include a single symbol.  Example:
--- 'Pinchot.Examples.Postal.rNorth'.
-solo :: a -> Intervals a
-solo x = Intervals [(x, x)] []
-
--- | Exclude a single symbol.
-pariah :: a -> Intervals a
-pariah x = Intervals [] [(x, x)]
-
--- | Left endpoint.
-endLeft :: Ord a => (a, a) -> a
-endLeft (a, b) = min a b
-
--- | Right endpoint.
-endRight :: Ord a => (a, a) -> a
-endRight (a, b) = max a b
-
--- | Is this symbol included in the interval?
-inInterval :: Ord a => a -> (a, a) -> Bool
-inInterval x i = x >= endLeft i && x <= endRight i
-
--- | Enumerate all members of an interval.
-members :: (Ord a, Enum a) => (a, a) -> Seq a
-members i = Seq.fromList [endLeft i .. endRight i]
-
--- | Sort a sequence of intervals.
-sortIntervalSeq :: Ord a => Seq (a, a) -> Seq (a, a)
-sortIntervalSeq = Seq.sortBy (comparing endLeft <> comparing endRight)
-
--- | Arrange an interval so the lower bound is first in the pair.
-standardizeInterval :: Ord a => (a, a) -> (a, a)
-standardizeInterval (a, b) = (min a b, max a b)
-
--- | Sorts the intervals using 'sortIntervalSeq' and presents them in a
--- regular order using 'flatten'.  The function @standardizeIntervalSeq a@ has
--- the following properties, where @b@ is the result:
---
--- @
--- 'uniqueMembers' a == 'uniqueMembers' b
---
--- let go [] = True
---     go (_:[]) = True
---     go (x:y:xs)
---          | 'endRight' x < 'endLeft' y
---              && 'endRight' x < pred ('endLeft' x)
---              = go (y:xs)
---          | otherwise = False
--- in go b
--- @
---
--- The second property means that adjacent intervals in the list must
--- be separated by at least one point on the number line.
-
-standardizeIntervalSeq :: (Ord a, Enum a) => Seq (a, a) -> Seq (a, a)
-standardizeIntervalSeq = flattenIntervalSeq . sortIntervalSeq
-
--- | Presents the intervals in a standard order, as described in
--- 'standardizeIntervalSeq'.  If the input has already been sorted with
--- 'sortIntervalSeq', the same properties for 'standardizeIntervalSeq' hold for
--- this function.  Otherwise, its properties are undefined.
-flattenIntervalSeq :: (Ord a, Enum a) => Seq (a, a) -> Seq (a, a)
-flattenIntervalSeq = fmap standardizeInterval . go Nothing
-  where
-    go mayCurr sq = case (mayCurr, viewl sq) of
-      (Nothing, EmptyL) -> []
-      (Just i, EmptyL) -> [i]
-      (Nothing, x :< xs) -> go (Just x) xs
-      (Just curr, x :< xs)
-        | endRight curr < endLeft x
-            && endRight curr < pred (endLeft x) -> curr <| go (Just x) xs
-        | otherwise -> go (Just (endLeft curr,
-            max (endRight curr) (endRight x))) xs
-
-
-{- |
-Removes excluded members from a list of 'Interval'.  The
-following properties hold:
-
-@
-
-removeProperties
-  :: (Ord a, Enum a)
-  => Seq (a, a)
-  -> Seq (a, a)
-  -> [Bool]
-removeProperties inc exc =
-
- let r = removeExcludes inc exc
-     allExcluded = concatMap members exc
-     allIncluded = concatMap members inc
-     allResults = concatMap members r
- in [
-   -- intervals remain in original order
-   allResults == filter (not . (\`elem\` allExcluded)) allIncluded
-
- -- Every resulting member was a member of the original include list
- , all (\`elem\` allIncluded) allResults
-
- -- No resulting member is in the exclude list
- , all (not . (\`elem\` allExcluded)) allResults
-
- -- Every included member that is not in the exclude list is
- -- in the result
- , all (\x -> x \`elem\` allExcluded || x \`elem\` allResults)
-       allIncluded
-
- ]
-@
-
--}
-removeExcludes
-  :: (Ord a, Enum a)
-  => Seq (a, a)
-  -- ^ Included intervals (not necessarily sorted)
-  -> Seq (a, a)
-  -- ^ Excluded intervals (not necessarily sorted)
-  -> Seq (a, a)
-removeExcludes inc = foldr remover inc
-
-remover
-  :: (Ord a, Enum a)
-  => (a, a)
-  -- ^ Remove this interval
-  -> Seq (a, a)
-  -- ^ From this sequence of intervals
-  -> Seq (a, a)
-remover ivl = join . fmap squash . fmap (removeInterval ivl)
-  where
-    squash (Nothing, Nothing) = Seq.empty
-    squash (Just x, Nothing) = Seq.singleton x
-    squash (Nothing, Just x) = Seq.singleton x
-    squash (Just x, Just y) = x <| y <| Seq.empty
-
--- | Removes a single interval from a single other interval.  Returns
--- a sequence of intervals, which always
-removeInterval
-  :: (Ord a, Enum a)
-  => (a, a)
-  -- ^ Remove this interval
-  -> (a, a)
-  -- ^ From this interval
-  -> (Maybe (a, a), Maybe (a, a))
-removeInterval ivl oldIvl = (onLeft, onRight)
-  where
-    onLeft
-      | endLeft ivl > endLeft oldIvl =
-          Just ( endLeft oldIvl
-               , min (pred (endLeft ivl)) (endRight oldIvl))
-      | otherwise = Nothing
-    onRight
-      | endRight ivl < endRight oldIvl =
-          Just ( max (succ (endRight ivl)) (endLeft oldIvl)
-               , endRight oldIvl)
-      | otherwise = Nothing
-
--- | Runs 'standardizeIntervalSeq' on the 'included' and 'excluded'
--- intervals.
-standardizeIntervals
-  :: (Ord a, Enum a)
-  => Intervals a
-  -> Intervals a
-standardizeIntervals (Intervals i e)
-  = Intervals (standardizeIntervalSeq i) (standardizeIntervalSeq e)
-
--- | Sorts the intervals using 'standardizeIntervalSeq', and then removes the
--- excludes with 'removeExcludes'.
-splitIntervals
-  :: (Ord a, Enum a)
-  => Intervals a
-  -> Seq (a, a)
-splitIntervals (Intervals is es)
-  = removeExcludes (standardizeIntervalSeq is) es
-
--- | 'True' if the given element is a member of the 'Intervals'.
-inIntervals :: (Enum a, Ord a) => Intervals a -> a -> Bool
-inIntervals ivls a = any (inInterval a) . splitIntervals $ ivls
-
-liftSeq :: Lift a => Seq a -> ExpQ
-liftSeq sq = case viewl sq of
-  EmptyL -> varE 'Seq.empty
-  x :< xs -> uInfixE (lift x) (varE '(<|)) (liftSeq xs)
-
-instance Lift a => Lift (Intervals a) where
-  lift (Intervals inc exc) = [| Intervals $sqInc $sqExc |]
-    where
-      sqInc = liftSeq inc
-      sqExc = liftSeq exc
diff --git a/lib/Pinchot/Locator.hs b/lib/Pinchot/Locator.hs
--- a/lib/Pinchot/Locator.hs
+++ b/lib/Pinchot/Locator.hs
@@ -6,9 +6,7 @@
 
 import Pinchot.Types
 
-import qualified Data.ListLike as ListLike
-import Data.Sequence (Seq, (|>))
-import qualified Data.Sequence as Seq
+import Data.List (mapAccumL)
 import qualified Text.Earley as Earley
 
 -- | Advances the location for 'Char' values.  Tabs advance to the
@@ -21,36 +19,25 @@
   | c == '\t' = Loc lin (col + 8 - ((col - 1) `mod` 8)) (pos + 1)
   | otherwise = Loc lin (col + 1) (pos + 1)
 
--- | Takes any ListLike value based on 'Char' (@Seq@, @Text@,
--- @String@, etc.) and creates a 'Seq' which pairs each 'Char' with
--- its location.  Example: 'locatedFullParses'.
-locations
-  :: ListLike.FoldableLL full Char
-  => full
-  -> Seq (Char, Loc)
-locations = fst . ListLike.foldl' f (Seq.empty, Loc 1 1 1)
+-- | Adds locations to a list of characters.
+locations :: Traversable t => t Char -> t (Char, Loc)
+locations = snd . mapAccumL f (Loc 1 1 1)
   where
-    f (!sq, !loc) c = (sq |> (c, loc), advanceChar c loc)
+    f loc char = (advanceChar char loc, (char, loc))
 
--- | Breaks a ListLike into a 'Seq' but does not assign locations.
-noLocations
-  :: ListLike.FoldableLL full item
-  => full
-  -> Seq (item, ())
-noLocations = ListLike.foldl' f Seq.empty
-  where
-    f !sq c = sq |> (c, ())
+-- | Takes a list of tokens and assigns empty locations.
+noLocations :: Functor f => f a -> f (a, ())
+noLocations = fmap (\a -> (a, ()))
 
 -- | Obtains all full Earley parses from a given input string, after
 -- assigning a location to every 'Char'.  Example:
 -- 'Pinchot.Examples.Newman.address'.
 locatedFullParses
-  :: ListLike.FoldableLL full Char
-  => (forall r. Earley.Grammar r (Earley.Prod r String (Char, Loc) (p Char Loc)))
+  :: (forall r. Earley.Grammar r (Earley.Prod r String (Char, Loc) (p Char Loc)))
   -- ^ Earley grammar with production that you want to parse.
-  -> full
-  -- ^ Source text, e.g. 'String', 'Data.Text', etc.
-  -> ([p Char Loc], Earley.Report String (Seq (Char, Loc)))
+  -> [Char]
+  -- ^ Source text
+  -> ([p Char Loc], Earley.Report String [(Char, Loc)])
   -- ^ A list of successful parses that when to the end of the
   -- source string, along with the Earley report showing possible
   -- errors.
diff --git a/lib/Pinchot/Names.hs b/lib/Pinchot/Names.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pinchot/Names.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+-- | Template Haskell names and values.
+module Pinchot.Names where
+
+import Control.Monad.Trans.Class (lift)
+import qualified Control.Monad.Trans.State as St
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Language.Haskell.TH as T
+
+-- | @t@
+nameT :: T.Name
+nameT = T.mkName "t"
+
+-- | @a@
+nameA :: T.Name
+nameA = T.mkName "a"
+
+-- | @r@
+nameR :: T.Name
+nameR = T.mkName "r"
+
+-- | @t@ as a type
+typeT :: T.TypeQ
+typeT = T.varT nameT
+
+-- | @a@ as a type
+typeA :: T.TypeQ
+typeA = T.varT nameA
+
+-- | @r@ as a type
+typeR :: T.TypeQ
+typeR = T.varT nameR
+
+-- | @t@ as a TyVarBndr
+tyVarBndrT :: T.TyVarBndr
+tyVarBndrT = T.PlainTV nameT
+
+-- | @a@ as a TyVarBndr
+tyVarBndrA :: T.TyVarBndr
+tyVarBndrA = T.PlainTV nameA
+
+-- | @r@ as a TyVarBndr
+tyVarBndrR :: T.TyVarBndr
+tyVarBndrR = T.PlainTV nameR
+
+productionsStr :: String
+productionsStr = "Productions"
+
+-- | @Productions@
+productions :: T.Name
+productions = T.mkName productionsStr
+
+-- | @a'@ followed by the given string.
+recordName :: String -> T.Name
+recordName n = T.mkName $ "a'" ++ n
+
+-- | Qualified record name.
+qualRecordName :: Qualifier -> String -> String
+qualRecordName q s = quald q ("a'" ++ s)
+
+-- | Environment for the creation of new names.  Each name is
+-- associated with an arbitrary String.  Useful for assigning a new
+-- unique name to match a particular Pinchot identifier.  Use
+-- 'getName' to get the name associated with a particular identifier,
+-- creating it if necessary.
+newtype Namer a = Namer (St.StateT (Map String T.Name) T.Q a)
+  deriving (Functor, Applicative, Monad)
+
+liftQ :: T.Q a -> Namer a
+liftQ = Namer . lift
+
+namerNewName :: Namer T.Name
+namerNewName = Namer $ lift (T.newName "_namerNewName")
+
+runNamer :: Namer a -> T.Q a
+runNamer (Namer n) = fmap fst $ (St.runStateT n) Map.empty
+
+-- | Get th Name that corresponds to a particular string.  If
+-- necessary, creates the name.
+getName :: String -> Namer T.Name
+getName str = Namer $ do
+  names <- St.get
+  case Map.lookup str names of
+    Just n -> return n
+    Nothing -> do
+      new <- lift $ T.newName ("_getName_" ++ str)
+      let newMap = Map.insert str new names
+      St.put newMap
+      return new
+
+lookupValueName :: String -> T.Q T.Name
+lookupValueName str = do
+  mayName <- T.lookupValueName str
+  case mayName of
+    Nothing -> fail $ "name not found: " ++ str
+    Just r -> return r
+
+lookupTypeName :: String -> T.Q T.Name
+lookupTypeName str = do
+  mayName <- T.lookupTypeName str
+  case mayName of
+    Nothing -> fail $ "name not found: " ++ str
+    Just r -> return r
+
+-- | Many functions take an argument that holds the name qualifier
+-- for the module that contains the data types created by applying a
+-- function such as 'Pinchot.SyntaxTree.syntaxTrees' or
+-- 'Pinchot.Earley.earleyProduct'.
+--
+-- You will have to make sure that these data types are in scope.
+-- The spliced Template Haskell code has to know where to
+-- look for these data types.  If you did an unqualified @import@ or
+-- if the types are in the same module as the function that takes a
+-- 'Qualifier' argument, just pass the empty string here.  If you did a
+-- qualified import, use the appropriate qualifier here.
+--
+-- For example, if you used @import qualified MyAst@, pass
+-- @\"MyAst\"@ here.  If you used @import qualified
+-- Data.MyLibrary.MyAst as MyLibrary.MyAst@, pass
+-- @\"MyLibrary.MyAst\"@ here.
+type Qualifier = String
+
+
+-- | Prepends a qualifier to a string, and returns the resulting
+-- Name.
+quald
+  :: Qualifier
+  -> String
+  -- ^ Item to be named - constructor, value, etc.
+  -> String
+quald qual suf
+  | null qual = suf
+  | otherwise = (qual ++ '.':suf)
diff --git a/lib/Pinchot/Pretty.hs b/lib/Pinchot/Pretty.hs
--- a/lib/Pinchot/Pretty.hs
+++ b/lib/Pinchot/Pretty.hs
@@ -2,27 +2,18 @@
 
 module Pinchot.Pretty where
 
-import Data.Foldable (toList)
-import Data.Sequence (Seq)
-import Data.Sequence.NonEmpty (NonEmptySeq(NonEmptySeq))
+import Data.List.NonEmpty (NonEmpty((:|)))
 import Text.Show.Pretty (Value)
 import qualified Text.Show.Pretty as Pretty
 import qualified Text.Earley as Earley
 
--- | Prettify a 'Seq'.
-prettySeq :: (a -> Value) -> Seq a -> Value
-prettySeq f
-  = Pretty.Con "Seq"
-  . (:[])
-  . Pretty.List
-  . fmap f
-  . toList
+prettyList :: (a -> Value) -> [a] -> Value
+prettyList f = Pretty.List . fmap f
 
--- | Prettify a 'NonEmptySeq'.
-prettyNonEmptySeq :: (a -> Value) -> NonEmptySeq a -> Value
-prettyNonEmptySeq f (NonEmptySeq a1 as)
-  = Pretty.Rec "NonEmptySeq"
-               [("_fore", f a1), ("_aft", prettySeq f as)]
+-- | Prettify a 'NonEmpty'.
+prettyNonEmpty :: (a -> Value) -> NonEmpty a -> Value
+prettyNonEmpty f (a1 :| as)
+  = Pretty.Con ":|" [(f a1), (Pretty.List (fmap f as))]
 
 -- | Prettify a 'Maybe'.
 prettyMaybe
@@ -47,10 +38,10 @@
 -- | Prettify the output of 'Pinchot.Locator.locatedFullParses'.
 prettyFullParses
   :: (Pretty.PrettyVal p, Pretty.PrettyVal v)
-  => ([p], Earley.Report String (Seq v))
+  => ([p], Earley.Report String [v])
   -> Value
 prettyFullParses x = Pretty.Tuple
   [ Pretty.prettyVal . fst $ x
-  , prettyReport Pretty.prettyVal (prettySeq Pretty.prettyVal)
+  , prettyReport Pretty.prettyVal (prettyList Pretty.prettyVal)
       . snd $ x
   ]
diff --git a/lib/Pinchot/RecursiveDo.hs b/lib/Pinchot/RecursiveDo.hs
--- a/lib/Pinchot/RecursiveDo.hs
+++ b/lib/Pinchot/RecursiveDo.hs
@@ -57,20 +57,18 @@
   -> T.ExpQ
   -- ^ Returns an expression whose value is the final return value
   -- from the @do@ block.
-recursiveDo binds final = [| fmap fst $ mfix $(fn) |]
-  where
-    fn = [| \ $(lazyPattern (fmap fst binds)) -> $doBlock |]
-    doBlock = T.doE (bindStmts ++ returnStmts)
-    bindStmts = map mkBind binds
-      where
-        mkBind (name, exp)
-          = T.bindS (T.varP name) exp
-    returnStmts = [bindRtnVal, returner]
-      where
-        rtnValName = T.mkName "_returner"
-        bindRtnVal = T.bindS (T.varP rtnValName) final
-        returner
-          = T.noBindS
-            [| return $(bigTuple (T.varE rtnValName) 
-                                 (fmap (T.varE . fst) binds)) |]
-
+recursiveDo binds final = do
+  rtnValName <- T.newName "_returner"
+  let bindStmts = map mkBind binds
+        where
+          mkBind (name, exp) = T.bindS (T.varP name) exp
+      fn = [| \ $(lazyPattern (fmap fst binds)) -> $doBlock |]
+      returnStmts = [bindRtnVal, returner]
+        where
+          bindRtnVal = T.bindS (T.varP rtnValName) final
+          returner
+            = T.noBindS
+              [| return $(bigTuple (T.varE rtnValName) 
+                                  (fmap (T.varE . fst) binds)) |]
+      doBlock = T.doE (bindStmts ++ returnStmts)
+  [| fmap fst $ mfix $(fn) |]
diff --git a/lib/Pinchot/Rules.hs b/lib/Pinchot/Rules.hs
--- a/lib/Pinchot/Rules.hs
+++ b/lib/Pinchot/Rules.hs
@@ -1,18 +1,15 @@
 {-# OPTIONS_HADDOCK not-home #-}
-{-# LANGUAGE OverloadedLists #-}
 module Pinchot.Rules where
 
 import Control.Monad (join)
 import Control.Monad.Trans.State (get, put, State)
 import qualified Control.Monad.Trans.State as State
-import Data.Sequence (Seq, (<|))
-import qualified Data.Sequence as Seq
-import qualified Data.Sequence.NonEmpty as NE
+import qualified Data.List.NonEmpty as NE
 import Data.Set (Set)
 import qualified Data.Set as Set
+import qualified Language.Haskell.TH as T
 
 import Pinchot.Types
-import Pinchot.Intervals
 
 -- | Name a 'Rule' for use in error messages.  If you do not name a
 -- rule using this combinator, the rule's type name will be used in
@@ -34,10 +31,18 @@
 -- 'Pinchot.Examples.Postal.rLetter'.
 terminal
   :: RuleName
-  -> Intervals t
-  -- ^ Valid terminal symbols
+  -> T.Q (T.TExp (t -> Bool))
+  -- ^ Valid terminal symbols.  This is a typed Template Haskell
+  -- expression.  To use it, make sure you have
+  --
+  -- > {-# LANGUAGE TemplateHaskell #-}
+  --
+  -- at the top of your module, and then use the Template Haskell
+  -- quotes, like this:
+  --
+  -- > terminal "AtoZ" [|| (\c -> c >= 'A' && c <= 'Z') ||]
   -> Rule t
-terminal n i = rule n (Terminal i)
+terminal n i = rule n (Terminal (Predicate i))
 
 -- | Creates a non-terminal production rule.  This is the most
 -- flexible way to create non-terminals.  You can even create a
@@ -47,12 +52,12 @@
 nonTerminal
   :: RuleName
   -- ^ Will be used for the name of the resulting type
-  -> Seq (BranchName, Seq (Rule t))
-  -- ^ Branches of the non-terminal production rule.  This 'Seq'
+  -> [(BranchName, [Rule t])]
+  -- ^ Branches of the non-terminal production rule.  This list
   -- must have at least one element; otherwise, an error will
   -- result.
   -> Rule t
-nonTerminal n branches = case NE.seqToNonEmptySeq branches of
+nonTerminal n branches = case NE.nonEmpty branches of
   Nothing -> error $ "nonTerminal: rule has no branches: " ++ n
   Just bs -> rule n . NonTerminal . fmap (uncurry Branch) $ bs
 
@@ -69,18 +74,18 @@
 union
   :: RuleName
   -- ^ Will be used for the name of the resulting type
-  -> Seq (Rule t)
+  -> [Rule t]
   -- ^ List of branches.  There must be at least one branch;
   -- otherwise a compile-time error will occur.
   -> Rule t
 union n rs = nonTerminal n (fmap f rs)
   where
     f rule@(Rule branchName _ _)
-      = (n ++ '\'' : branchName, Seq.singleton rule)
+      = (n ++ '\'' : branchName, [rule])
 
 -- | Creates a production for a sequence of terminals.  Useful for
 -- parsing specific words.  When used with 'Pinchot.syntaxTrees', the
--- resulting data type is a @newtype@ that wraps a @'NE.NonEmptySeq'
+-- resulting data type is a @newtype@ that wraps a @'NE.NonEmpty'
 -- (t, a)@, where @t@ is the type of the token (often 'Char') and @a@
 -- is an arbitrary metadata type.
 --
@@ -95,7 +100,7 @@
   -- otherwise this function will apply 'error'.  This list must be
   -- finite.
   -> Rule t
-series n = rule n . Series . get . NE.seqToNonEmptySeq . Seq.fromList
+series n = rule n . Series . get . NE.nonEmpty
   where
     get Nothing = error $ "term function used with empty list for rule: " ++ n
     get (Just a) = a
@@ -130,7 +135,7 @@
   -- ^ The name of this rule, which is used both as the type name
   -- and for the name of the sole data constructor
 
-  -> Seq (Rule t)
+  -> [Rule t]
   -- ^ The right-hand side of this rule.  This sequence can be empty,
   -- which results in an epsilon production.
   -> Rule t
@@ -170,34 +175,34 @@
 
 -- | Gets all ancestor rules to this 'Rule'.  Includes the current
 -- rule if it has not already been seen.
-getAncestors :: Rule t -> State (Set RuleName) (Seq (Rule t))
+getAncestors :: Rule t -> State (Set RuleName) [Rule t]
 getAncestors r@(Rule name _ ty) = do
   set <- get
   if Set.member name set
-    then return Seq.empty
+    then return []
     else do
       put (Set.insert name set)
       case ty of
-        Terminal _ -> return (Seq.singleton r)
+        Terminal _ -> return [r]
         NonTerminal bs -> do
-          ass <- fmap join . traverse branchAncestors . NE.nonEmptySeqToSeq $ bs
-          return $ r <| ass
+          ass <- fmap join . traverse branchAncestors . NE.toList $ bs
+          return $ r : ass
         Wrap c -> do
           cs <- getAncestors c
-          return $ r <| cs
+          return $ r : cs
         Record ls -> do
           cs <- fmap join . traverse getAncestors $ ls
-          return $ r <| cs
+          return $ r : cs
         Opt c -> do
           cs <- getAncestors c
-          return $ r <| cs
+          return $ r : cs
         Star c -> do
           cs <- getAncestors c
-          return $ r <| cs
+          return $ r : cs
         Plus c -> do
           cs <- getAncestors c
-          return $ r <| cs
-        Series _ -> return (Seq.singleton r)
+          return $ r : cs
+        Series _ -> return [r]
   where
     branchAncestors (Branch _ rs) = fmap join . traverse getAncestors $ rs
 
@@ -205,14 +210,14 @@
 -- duplicates.
 family
   :: Rule t
-  -> Seq (Rule t)
+  -> [Rule t]
 family rule = State.evalState (getAncestors rule) Set.empty
 
 -- | Gets all the ancestor 'Rule's of a sequence of 'Rule'.  Includes
 -- each 'Rule' that is in the sequence.  Skips duplicates.
 families
-  :: Seq (Rule t)
-  -> Seq (Rule t)
+  :: [Rule t]
+  -> [Rule t]
 families
   = join
   . flip State.evalState Set.empty
diff --git a/lib/Pinchot/SyntaxTree.hs b/lib/Pinchot/SyntaxTree.hs
--- a/lib/Pinchot/SyntaxTree.hs
+++ b/lib/Pinchot/SyntaxTree.hs
@@ -1,14 +1,13 @@
 {-# OPTIONS_HADDOCK not-home #-}
 {-# LANGUAGE TemplateHaskell #-}
--- | Grower - grows the types to hold a syntax tree
+-- | Grows the types to hold a syntax tree.
 
 module Pinchot.SyntaxTree where
 
-import Data.Foldable (toList)
-import Data.Sequence (Seq)
-import Data.Sequence.NonEmpty (NonEmptySeq)
+import Data.List.NonEmpty (NonEmpty, toList)
 import qualified Language.Haskell.TH as T
 
+import Pinchot.Names
 import Pinchot.Rules
 import Pinchot.Types
 
@@ -20,11 +19,10 @@
 syntaxTrees
   :: [T.Name]
   -- ^ What to derive, e.g. @[''Eq, ''Ord, ''Show]@
-  -> Seq (Rule t)
+  -> [Rule t]
   -> T.DecsQ
 syntaxTrees derives
   = traverse (ruleToType derives)
-  . toList
   . families
 
 branchConstructor :: Branch t -> T.ConQ
@@ -32,13 +30,11 @@
   where
     name = T.mkName nm
     mkField (Rule n _ _) = notStrict
-      [t| $(T.conT (T.mkName n)) $(charTypeVar) $(anyTypeVar) |]
+      [t| $(T.conT (T.mkName n)) $(typeT) $(typeA) |]
       where
         notStrict = T.bangType
           (T.bang T.noSourceUnpackedness T.noSourceStrictness)
-    fields = toList . fmap mkField $ rules
-    anyTypeVar = T.varT (T.mkName "a")
-    charTypeVar = T.varT (T.mkName "t")
+    fields = fmap mkField $ rules
 
 -- | Makes the top-level declaration for a given rule.
 ruleToType
@@ -48,71 +44,66 @@
   -> T.Q T.Dec
 ruleToType deriveNames (Rule nm _ ruleType) = case ruleType of
   Terminal _ ->
-    T.newtypeD (T.cxt []) name [charType, anyType] Nothing newtypeCon derives
+    T.newtypeD (T.cxt []) name [tyVarBndrT, tyVarBndrA] Nothing newtypeCon derives
     where
       newtypeCon = T.normalC name
         [notStrict
-          [t| ( $(charTypeVar), $(anyTypeVar) ) |] ]
+          [t| ( $(typeT), $(typeA) ) |] ]
 
-  NonTerminal bs -> T.dataD (T.cxt []) name [charType, anyType] Nothing cons derives
+  NonTerminal bs -> T.dataD (T.cxt []) name [tyVarBndrT, tyVarBndrA] Nothing cons derives
     where
       cons = toList (fmap branchConstructor bs)
 
   Wrap (Rule inner _ _) ->
-    T.newtypeD (T.cxt []) name [charType, anyType] Nothing newtypeCon derives
+    T.newtypeD (T.cxt []) name [tyVarBndrT, tyVarBndrA] Nothing newtypeCon derives
     where
       newtypeCon = T.normalC name
         [ notStrict
-            [t| $(T.conT (T.mkName inner)) $(charTypeVar) $(anyTypeVar) |] ]
+            [t| $(T.conT (T.mkName inner)) $(typeT) $(typeA) |] ]
 
-  Record sq -> T.dataD (T.cxt []) name [charType, anyType] Nothing [ctor] derives
+  Record sq -> T.dataD (T.cxt []) name [tyVarBndrT, tyVarBndrA] Nothing [ctor] derives
     where
-      ctor = T.recC name . zipWith mkField [(0 :: Int) ..] . toList $ sq
+      ctor = T.recC name . zipWith mkField [(0 :: Int) ..] $ sq
       mkField num (Rule rn _ _) = T.varBangType (T.mkName fldNm)
         (notStrict
-          [t| $(T.conT (T.mkName rn)) $(charTypeVar) $(anyTypeVar) |])
+          [t| $(T.conT (T.mkName rn)) $(typeT) $(typeA) |])
         where
           fldNm = '_' : recordFieldName num nm rn
 
   Opt (Rule inner _ _) ->
-    T.newtypeD (T.cxt []) name [charType, anyType] Nothing newtypeCon derives
+    T.newtypeD (T.cxt []) name [tyVarBndrT, tyVarBndrA] Nothing newtypeCon derives
     where
       newtypeCon = T.normalC name
         [notStrict
-          [t| Maybe ( $(T.conT (T.mkName inner)) $(charTypeVar)
-                                                 $(anyTypeVar)) |]]
+          [t| Maybe ( $(T.conT (T.mkName inner)) $(typeT)
+                                                 $(typeA)) |]]
 
   Star (Rule inner _ _) ->
-    T.newtypeD (T.cxt []) name [charType, anyType] Nothing newtypeCon derives
+    T.newtypeD (T.cxt []) name [tyVarBndrT, tyVarBndrA] Nothing newtypeCon derives
     where
       newtypeCon = T.normalC name [sq]
         where
           sq = notStrict
-            [t| Seq ( $(T.conT (T.mkName inner)) $(charTypeVar)
-                                                 $(anyTypeVar) ) |]
+            [t| [$(T.conT (T.mkName inner)) $(typeT) $(typeA)]  |]
 
   Plus (Rule inner _ _) ->
-    T.newtypeD (T.cxt []) name [charType, anyType] Nothing cons derives
+    T.newtypeD (T.cxt []) name [tyVarBndrT, tyVarBndrA] Nothing cons derives
     where
       cons = T.normalC name [ne]
         where
-          ne = notStrict [t| NonEmptySeq $(ins) |]
+          ne = notStrict [t| NonEmpty $(ins) |]
             where
               ins = [t| $(T.conT (T.mkName inner))
-                $(charTypeVar) $(anyTypeVar) |]
+                $(typeT) $(typeA) |]
 
   Series _ ->
-    T.newtypeD (T.cxt []) name [charType, anyType] Nothing cons derives
+    T.newtypeD (T.cxt []) name [tyVarBndrT, tyVarBndrA] Nothing cons derives
     where
       cons = T.normalC name [sq]
-      sq = notStrict [t| NonEmptySeq ( $(charTypeVar), $(anyTypeVar) ) |]
+      sq = notStrict [t| NonEmpty ( $(typeT), $(typeA) ) |]
 
   where
     name = T.mkName nm
-    anyType = T.PlainTV (T.mkName "a")
-    anyTypeVar = T.varT (T.mkName "a")
-    charType = T.PlainTV (T.mkName "t")
-    charTypeVar = T.varT (T.mkName "t")
     derives = mapM T.conT deriveNames
     notStrict = T.bangType
       (T.bang T.noSourceUnpackedness T.noSourceStrictness)
diff --git a/lib/Pinchot/SyntaxTree/Instancer.hs b/lib/Pinchot/SyntaxTree/Instancer.hs
--- a/lib/Pinchot/SyntaxTree/Instancer.hs
+++ b/lib/Pinchot/SyntaxTree/Instancer.hs
@@ -12,12 +12,11 @@
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Semigroup ((<>))
-import Data.Sequence (Seq)
-import qualified Data.Sequence as Seq
-import Data.Sequence.NonEmpty (NonEmptySeq)
+import Data.List.NonEmpty (NonEmpty)
 import qualified Language.Haskell.TH as T
 import qualified Text.Show.Pretty as Pretty
 
+import Pinchot.Names
 import Pinchot.Types
 import Pinchot.Pretty
 import Pinchot.Rules
@@ -35,9 +34,9 @@
 -- Example: "Pinchot.Examples.SyntaxTrees".
 
 bifunctorInstances
-  :: Seq (Rule t)
+  :: [Rule t]
   -> T.DecsQ
-bifunctorInstances = traverse f . toList . families
+bifunctorInstances = traverse f . families
   where
     f rule@(Rule ruleName _ _) = T.instanceD (T.cxt [])
       [t| Bifunctor.Bifunctor $(T.conT (T.mkName ruleName)) |]
@@ -60,18 +59,16 @@
 -- Example: "Pinchot.Examples.SyntaxTrees".
 
 semigroupInstances
-  :: Seq (Rule t)
+  :: [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.conT (T.mkName ruleName)) $(typeT) $(typeA)) |]
           [T.valD (T.varP '(Semigroup.<>))
                   (T.normalB expn) []]
 
@@ -90,17 +87,15 @@
 --
 -- Example: "Pinchot.Examples.SyntaxTrees".
 monoidInstances
-  :: Seq (Rule t)
+  :: [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| Monoid ( $( T.conT (T.mkName ruleName) ) $(typeT) $(typeA) ) |]
           [ T.valD (T.varP 'mappend)
                    (T.normalB expAppend) []
           , T.valD (T.varP 'mempty)
@@ -171,8 +166,9 @@
   -> 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))
+  ctorName <- lookupValueName (quald qual name)
+  let body = T.lamE [T.conP ctorName [T.varP val]]
+        [| $(T.conE ctorName)
               ( $(T.varE fa) . fst $ $(T.varE val)
               , $(T.varE fb) . snd $ $(T.varE val)
               )
@@ -199,8 +195,9 @@
   -> 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))
+  ctorName <- lookupValueName (quald qual name)
+  let expn = T.lamE [T.conP ctorName [T.varP val]]
+        [| $(T.conE ctorName)
             ( $(T.varE (errLookup inner lkp)) $(T.varE val) ) |]
   return $ T.valD (T.varP (errLookup name lkp)) (T.normalB expn) []
 
@@ -208,7 +205,7 @@
   :: Qualifier
   -> Map RuleName T.Name
   -> RuleName
-  -> Seq (Rule t)
+  -> [Rule t]
   -> T.Q T.DecQ
 recordBimapLetBind qual lkp name sq = do
   let clause = recordBimapClause qual lkp name sq
@@ -218,15 +215,16 @@
   :: Qualifier
   -> Map RuleName T.Name
   -> RuleName
-  -> Seq (Rule t)
+  -> [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
+  ctorName <- lookupValueName (quald qual name)
+  let body = foldl f (T.conE ctorName) . 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) []
+  T.clause [T.conP ctorName pats] (T.normalB body) []
 
 recordBimapLetBindField
   :: Map RuleName T.Name
@@ -247,11 +245,12 @@
   -> 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
+  ctorName <- lookupValueName (quald qual name)
+  let body = [| $(T.conE ctorName) $ 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]]
+  let clause = T.clause [T.conP ctorName [T.varP val]]
         (T.normalB body) []
   return $ T.funD (errLookup name lkp) [clause]
 
@@ -265,9 +264,10 @@
   -> T.Q T.DecQ
 starBimapLetBind qual lkp name inner = do
   val <- T.newName $ "starBimapLetBind" ++ name
-  let body = [| $(T.conE (quald qual name))
+  ctorName <- lookupValueName (quald qual name)
+  let body = [| $(T.conE ctorName)
                 $ fmap $(T.varE (errLookup inner lkp)) $(T.varE val) |]
-  let clause = T.clause [T.conP (quald qual name) [T.varP val]]
+  let clause = T.clause [T.conP ctorName [T.varP val]]
         (T.normalB body) []
   return $ T.funD (errLookup name lkp) [clause]
 
@@ -281,9 +281,10 @@
   -> T.Q T.DecQ
 plusBimapLetBind qual lkp name inner = do
   val <- T.newName $ "plusBimapLetBind" ++ name
-  let body = [| $(T.conE (quald qual name))
+  ctorName <- lookupValueName (quald qual name)
+  let body = [| $(T.conE ctorName)
                 $ fmap $(T.varE (errLookup inner lkp)) $(T.varE val) |]
-  let clause = T.clause [T.conP (quald qual name) [T.varP val]]
+  let clause = T.clause [T.conP ctorName [T.varP val]]
         (T.normalB body) []
   return $ T.funD (errLookup name lkp) [clause]
 
@@ -296,8 +297,9 @@
   -> T.Q T.DecQ
 seriesBimapLetBind qual fa fb lkp name = do
   val <- T.newName $ "termBimapLetBind" ++ name
-  let body = T.lamE [T.conP (quald qual name) [T.varP val]]
-        [| $(T.conE (quald qual name))
+  ctorName <- lookupValueName (quald qual name)
+  let body = T.lamE [T.conP ctorName [T.varP val]]
+        [| $(T.conE ctorName)
               (fmap ( Bifunctor.bimap $(T.varE fa) $(T.varE fb) )
                     $(T.varE val) ) |]
   return $ T.valD (T.varP (errLookup name lkp)) (T.normalB body) []
@@ -338,11 +340,13 @@
 
 wrappedMemptyExpression
   :: Qualifier
-  -> Seq RuleName
+  -> [RuleName]
   -> T.ExpQ
 wrappedMemptyExpression qual rules = foldr f [| mempty |] rules
   where
-    f name acc = [| $(T.conE (quald qual name)) $(acc) |]
+    f name acc = do
+      ctorName <- lookupValueName (quald qual name)
+      [| $(T.conE ctorName) $(acc) |]
 
 -- | If possible, creates an expression of type
 --
@@ -359,12 +363,12 @@
 
 monoidCtors
   :: Rule t
-  -> Maybe (Seq RuleName)
+  -> Maybe ([RuleName])
 monoidCtors (Rule ruleName _ ty) = case ty of
   Wrap r -> do
     rest <- monoidCtors r
     return $ ruleName `Lens.cons` rest
-  Star _ -> Just (Seq.singleton ruleName)
+  Star _ -> Just [ruleName]
   _ -> Nothing
 
 -- | If possible, creates an expression of type
@@ -384,20 +388,20 @@
 
 semigroupCtors
   :: Rule t
-  -> Maybe (Seq RuleName)
+  -> Maybe ([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)
+  Plus _ -> Just [ruleName]
+  Star _ -> Just [ruleName]
   _ -> Nothing
 
 wrappedSemigroupExpression
   :: T.Name
   -- ^ mappend operator
   -> Qualifier
-  -> Seq RuleName
+  -> [RuleName]
   -- ^ Rule names, with the outermost name on the left side of the
   -- 'Seq'.
   -> T.ExpQ
@@ -414,11 +418,15 @@
       where
         mkPat name = foldr f (T.varP name) rules
           where
-            f rule acc = T.conP (quald qual rule) [acc]
+            f rule acc = do
+              ctorName <- lookupValueName (quald qual rule)
+              T.conP ctorName [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
+            f rule acc = do
+              ctorName <- lookupValueName (quald qual rule)
+              T.appE (T.conE ctorName) acc
 
 -- | Creates an expression of type
 --
@@ -444,13 +452,11 @@
   :: Rule t
   -> T.DecQ
 prettyInstance rule = do
-  let a = T.varT $ T.mkName "a"
-      t = T.varT $ T.mkName "t"
-      ruleTypeName = T.conT . T.mkName . _ruleName $ rule
-      cxt = [ [t| Pretty.PrettyVal $t |]
-            , [t| Pretty.PrettyVal $a |]
+  let ruleTypeName = T.conT . T.mkName . _ruleName $ rule
+      cxt = [ [t| Pretty.PrettyVal $typeT |]
+            , [t| Pretty.PrettyVal $typeA |]
             ]
-      ty = [t| Pretty.PrettyVal ( $ruleTypeName $t $a ) |]
+      ty = [t| Pretty.PrettyVal ( $ruleTypeName $typeT $typeA ) |]
       dec = T.funD 'Pretty.prettyVal [clause]
         where
           clause = T.clause [] (T.normalB (prettyExpression "" rule)) []
@@ -477,7 +483,7 @@
 --
 -- Example: "Pinchot.Examples.SyntaxTrees".
 prettyInstances
-  :: Seq (Rule t)
+  :: [Rule t]
   -> T.DecsQ
 prettyInstances
   = fmap toList . sequence . fmap prettyInstance . families
@@ -494,13 +500,15 @@
 prettyExpressionInEnv qual lkp (Rule name _ ty) = case ty of
   Terminal _ -> do
     x <- T.newName "x"
-    [| \ $(T.conP (quald qual name) [T.varP x])
+    ctorName <- lookupValueName (quald qual name)
+    [| \ $(T.conP ctorName [T.varP x])
           -> Pretty.Con name [Pretty.prettyVal $(T.varE x)] |]
   NonTerminal sq -> prettyBranches qual lkp sq
   Wrap (Rule inner _ _) -> do
     x <- T.newName "x"
+    ctorName <- lookupValueName (quald qual name)
     fVal <- lookupRule lkp inner
-    [| \ $(T.conP (quald qual name) [T.varP x])
+    [| \ $(T.conP ctorName [T.varP x])
          -> Pretty.Con name [$(T.varE fVal) $(T.varE x)] |]
   Record rules -> do
     (pat, expn) <- prettyConstructor qual lkp name rules
@@ -508,28 +516,32 @@
   Opt (Rule inner _ _) -> do
     x <- T.newName "x"
     fVal <- lookupRule lkp inner
-    [| \ $(T.conP (quald qual name) [T.varP x]) ->
+    ctorName <- lookupValueName (quald qual name)
+    [| \ $(T.conP ctorName [T.varP x]) ->
       Pretty.Con name [prettyMaybe $(T.varE fVal) $(T.varE x)] |]
   Star (Rule inner _ _) -> do
     x <- T.newName "x"
     fVal <- lookupRule lkp inner
-    [| \ $(T.conP (quald qual name) [T.varP x]) ->
-       Pretty.Con name [prettySeq $(T.varE fVal) $(T.varE x)] |]
+    ctorName <- lookupValueName (quald qual name)
+    [| \ $(T.conP ctorName [T.varP x]) ->
+       Pretty.Con name [prettyList $(T.varE fVal) $(T.varE x)] |]
   Plus (Rule inner _ _) -> do
     x <- T.newName "x"
     fVal <- lookupRule lkp inner
-    [| \ $(T.conP (quald qual name) [T.varP x]) ->
-       Pretty.Con name [prettyNonEmptySeq $(T.varE fVal) $(T.varE x)] |]
+    ctorName <- lookupValueName (quald qual name)
+    [| \ $(T.conP ctorName [T.varP x]) ->
+       Pretty.Con name [prettyNonEmpty $(T.varE fVal) $(T.varE x)] |]
   Series _ -> do
     x <- T.newName "x"
-    [| \ $(T.conP (quald qual name) [T.varP x])
+    ctorName <- lookupValueName (quald qual name)
+    [| \ $(T.conP ctorName [T.varP x])
          -> Pretty.Con name
-            [prettyNonEmptySeq Pretty.prettyVal $(T.varE x)] |]
+            [prettyNonEmpty Pretty.prettyVal $(T.varE x)] |]
 
 prettyBranches
   :: Qualifier
   -> Map RuleName T.Name
-  -> NonEmptySeq (Branch t)
+  -> NonEmpty (Branch t)
   -> T.ExpQ
 prettyBranches qual lkp branches = do
   x <- T.newName "x"
@@ -576,11 +588,11 @@
   -> Map RuleName T.Name
   -> String
   -- ^ Name of branch, or name of data constructor
-  -> Seq (Rule t)
+  -> [Rule t]
   -> T.Q (T.PatQ, T.ExpQ)
-prettyConstructor qual lkp branchName branches
-  = deconstruct (quald qual branchName) (length fieldNames)
-      getFinal
+prettyConstructor qual lkp branchName branches = do
+  ctorName <- lookupValueName (quald qual branchName)
+  deconstruct ctorName (length fieldNames) getFinal
   where
     fieldNames = toList . fmap _ruleName $ branches
     getFinal fields = [| Pretty.Con branchName $(values) |]
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,16 +1,15 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Pinchot.SyntaxTree.Optics where
 
-import Data.Foldable (toList)
-import Data.Sequence (Seq)
-import Data.Sequence.NonEmpty (NonEmptySeq)
+import Data.Data (Data)
+import Data.List.NonEmpty (NonEmpty, toList)
 import qualified Control.Lens as Lens
 import qualified Language.Haskell.TH as T
 import qualified Language.Haskell.TH.Syntax as Syntax
 
+import Pinchot.Names
 import Pinchot.Rules
 import Pinchot.Types
-import Pinchot.Intervals
 
 -- | Creates optics declarations for a 'Rule', if optics can
 -- be made for the 'Rule':
@@ -21,21 +20,22 @@
 --
 -- * 'Pinchot.record' gets a single 'Lens.Lens'
 --
--- * 'Pinchot.wrap', 'Pinchot.opt', 'Pinchot.star',
--- and 'Pinchot.plus' do not get optics.
+-- * 'Pinchot.wrap', 'Pinchot.opt', 'Pinchot.star', and 'Pinchot.plus'
+-- do not get optics.  For those, you will typically want to use
+-- 'Pinchot.wrappedInstances'.
 --
 -- Each rule in the sequence of 'Rule', as well as all ancestors of
 -- those 'Rule's, will be handled.
 --
 -- Example: "Pinchot.Examples.RulesToOptics".
 rulesToOptics
-  :: Syntax.Lift t
+  :: (Syntax.Lift t, Data t)
   => Qualifier
   -- ^ Qualifier for module containing the data types that will get
   -- optics
   -> T.Name
   -- ^ Type name for the terminal
-  -> Seq (Rule t)
+  -> [Rule t]
   -> T.Q [T.Dec]
 rulesToOptics qual termName
   = fmap concat
@@ -49,13 +49,13 @@
 --
 -- * 'NonTerminal' gets a 'Lens.Prism' for each constructor
 --
--- * 'Terminals' gets a single 'Lens.Prism'
+-- * 'Series' gets a single 'Lens.Prism'
 --
 -- * 'Record' gets a single 'Lens.Lens'
 --
 -- * 'Wrap', 'Opt', 'Star', and 'Plus' do not get optics.
 ruleToOptics
-  :: Syntax.Lift t
+  :: (Syntax.Lift t, Data t)
   => Qualifier
   -- ^ Qualifier for module containing the data type that will get
   -- optics
@@ -64,9 +64,10 @@
   -> Rule t
   -> T.Q [T.Dec]
 ruleToOptics qual termName (Rule nm _ ty) = case ty of
-  Terminal ivls -> terminalToOptics qual termName nm ivls
+  Terminal pdct -> terminalToOptics qual termName nm pdct
   NonTerminal bs -> sequence $ nonTerminalToOptics qual nm bs
   Record sq -> sequence $ recordsToOptics qual nm sq
+  Series ne -> seriesToOptics qual termName nm ne
   _ -> return []
   
 
@@ -84,30 +85,175 @@
   -- ^ Terminal type name
   -> String
   -- ^ Rule name
-  -> Intervals t
+  -> Predicate t
   -> T.Q [T.Dec]
-terminalToOptics qual termName nm ivls = do
+terminalToOptics qual termName nm (Predicate pdct) = do
+  ctorName <- lookupTypeName (quald qual nm)
   e1 <- T.sigD (T.mkName ('_':nm))
-    $ T.forallT [ T.PlainTV (T.mkName "a")] (return [])
-    [t| Lens.Prism' ( $(T.conT termName), $(anyType) )
-                    ($(T.conT (quald qual nm)) $(T.conT termName) $(anyType))
+    $ T.forallT [ tyVarBndrA] (return [])
+    [t| Lens.Prism' ( $(T.conT termName), $(typeA) )
+                    ( $(T.conT ctorName) $(T.conT termName) $(typeA))
     |]
   
   e2 <- T.valD prismName (T.normalB expn) []
   return [e1, e2]
   where
-    anyType = T.varT (T.mkName "a")
     prismName = T.varP (T.mkName ('_' : nm))
-    fetchPat = T.conP (quald qual nm) [T.varP (T.mkName "_x")]
-    fetchName = T.varE (T.mkName "_x")
-    ctor = T.conE (quald qual nm)
-    expn = [| let fetch $fetchPat = $fetchName
-                  store (term, a)
-                    | inIntervals ivls term = Just ($(ctor) (term, a))
-                    | otherwise = Nothing
-              in Lens.prism' fetch store
-           |]
+    expn = do
+      x <- T.newName "_x"
+      ctorName <- lookupValueName (quald qual nm)
+      let fetchPat = T.conP ctorName [T.varP x]
+          fetchName = T.varE x
+      [| let fetch $fetchPat = $fetchName
+             store (term, a)
+                 | $(fmap T.unType pdct) term
+                    = Just ($(T.conE ctorName) (term, a))
+                 | otherwise = Nothing
+               in Lens.prism' fetch store
+        |]
 
+
+seriesToOptics
+  :: (Data t, Syntax.Lift t)
+  => Qualifier
+  -- ^ Qualifier for module containing the data type that will get
+  -- optics
+  -> T.Name
+  -- ^ Terminal type name
+  -> String
+  -- ^ Rule name
+  -> NonEmpty t
+  -> T.Q [T.Dec]
+seriesToOptics qual termName nm terminals = do
+  ctorName <- lookupTypeName (quald qual nm)
+  e1 <- T.sigD (T.mkName ('_':nm))
+    $ T.forallT [ tyVarBndrA] (return [])
+    [t| Lens.Prism' (NonEmpty ( $(T.conT termName), $(typeA) ))
+                    ( $(T.conT ctorName) $(T.conT termName) $(typeA))
+    |]
+  
+  e2 <- T.valD prismName (T.normalB expn) []
+  return [e1, e2]
+  where
+    prismName = T.varP (T.mkName ('_' : nm))
+    expn = do
+      x <- T.newName "_x"
+      ctorName <- lookupValueName (quald qual nm)
+      let fetchPat = T.conP ctorName [T.varP x]
+          fetchName = T.varE x
+      [| let fetch $fetchPat = $fetchName
+             store terms
+                 | fmap fst terms == $(Syntax.liftData terminals)
+                    = Just ($(T.conE ctorName) terms )
+                 | otherwise = Nothing
+               in Lens.prism' fetch store
+        |]
+
+
+prismSignature
+  :: Qualifier
+  -> String
+  -- ^ Rule name
+  -> Branch t
+  -> T.DecQ
+prismSignature qual nm (Branch inner rules) = do
+  ctorName <- lookupTypeName (quald qual nm)
+  T.sigD prismName
+    (forallA [t| Lens.Prism'
+        ($(T.conT ctorName) $(typeT) $(typeA))
+        $(fieldsType) |])
+  where
+    prismName = T.mkName ('_' : inner)
+    fieldsType = case rules of
+      [] -> T.tupleT 0
+      Rule r1 _ _ : [] -> do
+        ctorName <- lookupTypeName (quald qual r1)
+        [t| $(T.conT ctorName) $(typeT) $(typeA) |]
+      rs -> foldl addType (T.tupleT (length rs)) rs
+        where
+          addType soFar (Rule r _ _) = do
+            ctorName <- lookupTypeName (quald qual r)
+            soFar `T.appT`
+              [t| $(T.conT ctorName) $(typeT) $(typeA) |]
+
+setterPatAndExpn
+  :: Qualifier
+  -> BranchName
+  -> [a]
+  -- ^ List of rules
+  -> T.Q (T.PatQ, T.ExpQ)
+setterPatAndExpn qual inner rules = do
+  names <- sequence . flip replicate (T.newName "_setterPatAndExpn")
+    . length $ rules
+  let pat = T.tupP . fmap T.varP $ names
+      expn = foldl addVar start names
+        where
+          start = do
+            ctorName <- lookupValueName (quald qual inner)
+            T.conE ctorName
+          addVar acc nm = acc `T.appE` (T.varE nm)
+  return (pat, expn)
+
+prismSetter
+  :: Qualifier
+  -> Branch t
+  -> T.ExpQ
+prismSetter qual (Branch inner rules) = do
+  (pat, expn) <- setterPatAndExpn qual inner rules
+  T.lamE [pat] expn
+
+-- | Returns a pattern and expression to match a particular branch; if
+-- there is a match, the expression will return each field, in a tuple
+-- in a Right.
+rightPatternAndExpression
+  :: Qualifier
+  -> BranchName
+  -> Int
+  -- ^ Number of fields
+  -> T.Q (T.PatQ, T.ExpQ)
+rightPatternAndExpression qual inner n = do
+  names <- sequence . replicate n $ T.newName "_patternAndExpression"
+  ctorName <- lookupValueName (quald qual inner)
+  let pat = T.conP ctorName . fmap T.varP $ names
+      expn = T.appE (T.conE 'Right)
+        . T.tupE
+        . fmap T.varE
+        $ names
+  return (pat, expn)
+
+-- | Returns a pattern and expression for branches that did not match.
+-- Does not return anything if there are no other branches.
+leftPatternAndExpression
+  :: [a]
+  -- ^ List of all other branches
+  -> Maybe (T.Q (T.PatQ, T.ExpQ))
+leftPatternAndExpression ls
+  | null ls = Nothing
+  | otherwise = Just $ do
+      local <- T.newName "_leftPatternAndExpression"
+      return (T.varP local, T.appE (T.conE 'Left) (T.varE local))
+  
+
+prismGetter
+  :: Qualifier
+  -> Branch t
+  -- ^ Make prism for this branch
+  -> [Branch t] 
+  -- ^ List of all branches
+  -> T.ExpQ
+prismGetter qual (Branch inner rules) bs = do
+  local <- T.newName "_prismGetter"
+  (patCtor, bodyCtor) <- rightPatternAndExpression qual inner (length rules)
+  let firstElem = T.match patCtor (T.normalB bodyCtor) []
+  lastElem <- case leftPatternAndExpression bs of
+    Nothing -> return []
+    Just computation -> do
+      (patLeft, expLeft) <- computation
+      return [T.match patLeft (T.normalB expLeft) []]
+  T.lamE [T.varP local]
+    (T.caseE (T.varE local) $ firstElem : lastElem)
+
+
 -- | Creates prisms for each 'Branch'.
 nonTerminalToOptics
   :: Qualifier
@@ -115,128 +261,101 @@
   -- optics
   -> String
   -- ^ Rule name
-  -> NonEmptySeq (Branch t)
+  -> NonEmpty (Branch t)
   -> [T.Q T.Dec]
 nonTerminalToOptics qual nm bsSeq = concat $ fmap makePrism bs
   where
     bs = toList bsSeq
-    makePrism (Branch inner rulesSeq) = [ signature, binding ]
+    makePrism branch@(Branch inner _) =
+      [ prismSignature qual nm branch, binding ]
       where
-        charType = T.varT (T.mkName "t")
-        anyType = T.varT (T.mkName "a")
-        rules = toList rulesSeq
         prismName = T.mkName ('_' : inner)
-        signature = T.sigD prismName
-          (forallA [t| Lens.Prism'
-              ($(T.conT (quald qual nm)) $(charType) $(anyType))
-              $(fieldsType) |])
-          where
-            fieldsType = case rules of
-              [] -> T.tupleT 0
-              Rule r1 _ _ : [] -> [t| $(T.conT (quald qual r1))
-                $(charType) $(anyType) |]
-              rs -> foldl addType (T.tupleT (length rs)) rs
-                where
-                  addType soFar (Rule r _ _) = soFar `T.appT`
-                    [t| $(T.conT (quald qual r)) $(charType) $(anyType) |]
         binding = T.valD (T.varP prismName) body []
           where
             body = T.normalB
               $ (T.varE 'Lens.prism)
-              `T.appE` setter
-              `T.appE` getter
-              where
-                setter = T.lamE [pat] expn
-                  where
-                    (pat, expn) = case rules of
-                      [] -> (T.tupP [], T.conE (quald qual inner))
-                      _ : [] -> (T.varP local,
-                        T.conE (quald qual inner)
-                        `T.appE` T.varE local)
-                        where
-                          local = T.mkName "_x"
-                      ls -> (T.tupP pats, set)
-                        where
-                          pats = fmap (\i -> T.varP (T.mkName ("_x" ++ show i)))
-                            . take (length ls) $ [(0 :: Int) ..]
-                          set = foldl addVar start . take (length ls)
-                            $ [(0 :: Int) ..]
-                            where
-                              addVar acc i = acc `T.appE`
-                                (T.varE (T.mkName ("_x" ++ show i)))
-                              start = T.conE (quald qual inner)
+              `T.appE` (prismSetter qual branch)
+              `T.appE` (prismGetter qual branch bs)
 
-                getter = T.lamE [pat] expn
-                  where
-                    local = T.mkName "_x"
-                    pat = T.varP local
-                    expn = T.caseE (T.varE (T.mkName "_x")) $
-                      T.match patCtor bodyCtor []
-                      : rest
-                      where
-                        patCtor = T.conP (quald qual inner)
-                          . fmap (\i -> T.varP (T.mkName $ "_y" ++ show i))
-                          . take (length rules)
-                          $ [(0 :: Int) ..]
-                        bodyCtor = T.normalB . (T.conE 'Right `T.appE`)
-                          $ case rules of
-                          [] -> T.tupE []
-                          _:[] -> T.varE (T.mkName "_y0")
-                          _ -> T.tupE
-                            . fmap (\i -> T.varE (T.mkName $ "_y" ++ show i))
-                            . take (length rules)
-                            $ [(0 :: Int) ..]
-                        rest = case bs of
-                          [] -> []
-                          _ -> [T.match patBlank bodyBlank []]
-                          where
-                            patBlank = T.varP (T.mkName "_z")
-                            bodyBlank = T.normalB
-                              $ T.conE ('Left)
-                              `T.appE` T.varE (T.mkName "_z")
+recordLensSignature
+  :: Qualifier
+  -> RuleName
+  -- ^ Name of the main rule
+  -> RuleName
+  -- ^ Name of the rule for this lens
+  -> Int
+  -- ^ Index for this lens
+  -> T.DecQ
+recordLensSignature qual nm inner idx = do
+  ctorOuter <- lookupTypeName (quald qual nm)
+  ctorInner <- lookupTypeName (quald qual inner)
+  T.sigD lensName (forallA
+    [t| Lens.Lens' ($(T.conT ctorOuter) $(typeT) $(typeA))
+                  ($(T.conT ctorInner) $(typeT) $(typeA))
+    |])
+  where
+    lensName = T.mkName $ recordFieldName idx nm inner
 
+recordLensGetter
+  :: Qualifier
+  -> String
+  -- ^ Record field name
+  -> T.ExpQ
+recordLensGetter qual fieldNm = do
+  namedRec <- T.newName "_namedRec"
+  fieldNm <- lookupValueName $ quald qual ('_' : fieldNm)
+  let pat = T.varP namedRec
+      expn = (T.varE fieldNm)
+        `T.appE` (T.varE namedRec)
+  T.lamE [pat] expn
+
+recordLensSetter
+  :: Qualifier
+  -> String
+  -- ^ Record field name
+  -> T.ExpQ
+recordLensSetter qual fieldNm = do
+  namedRec <- T.newName "_namedRec"
+  namedNewVal <- T.newName "_namedNewVal"
+  fieldName <- lookupValueName (quald qual ('_' : fieldNm))
+  let patRec = T.varP namedRec
+      patNewVal = T.varP namedNewVal
+      expn = T.recUpdE (T.varE namedRec)
+        [ return (fieldName , T.VarE namedNewVal) ]
+  T.lamE [patRec, patNewVal] expn
+
+recordLensFunction
+  :: Qualifier
+  -> RuleName
+  -- ^ Name of the main rule
+  -> RuleName
+  -- ^ Name of the rule for this lens
+  -> Int
+  -- ^ Index for this lens
+  -> T.DecQ
+recordLensFunction qual nm inner idx =
+  let fieldNm = recordFieldName idx nm inner
+      lensName = T.mkName $ recordFieldName idx nm inner
+      getter = recordLensGetter qual fieldNm
+      setter = recordLensSetter qual fieldNm
+      body = (T.varE 'Lens.lens) `T.appE` getter `T.appE` setter
+  in T.funD lensName [T.clause [] (T.normalB body) []]
+
+
 recordsToOptics
   :: Qualifier
   -- ^ Qualifier for module containing the data type that will get
   -- optics
   -> String
   -- ^ Rule name
-  -> Seq (Rule t)
+  -> [Rule t]
   -> [T.Q T.Dec]
-recordsToOptics qual nm
-  = concat . zipWith makeLens [(0 :: Int) ..] . toList
-  where
-    makeLens index (Rule inner _ _) = [ signature, function ]
-      where
-        charType = T.varT (T.mkName "t")
-        anyType = T.varT (T.mkName "a")
-        fieldNm = recordFieldName index nm inner
-        lensName = T.mkName fieldNm
-        signature = T.sigD lensName (forallA
-          [t| Lens.Lens' ($(T.conT (quald qual nm)) $(charType) $(anyType))
-                         ($(T.conT (quald qual inner)) $(charType) $(anyType))
-          |])
-
-        function = T.funD lensName [T.clause [] (T.normalB body) []]
-          where
-            namedRec = T.mkName "_namedRec"
-            namedNewVal = T.mkName "_namedNewVal"
-            body = (T.varE 'Lens.lens) `T.appE` getter `T.appE` setter
-              where
-                getter = T.lamE [pat] expn
-                  where
-                    pat = T.varP namedRec
-                    expn = (T.varE (quald qual ('_' : fieldNm)))
-                      `T.appE` (T.varE namedRec)
-
-                setter = T.lamE [patRec, patNewVal] expn
-                  where
-                    patRec = T.varP namedRec
-                    patNewVal = T.varP namedNewVal
-                    expn = T.recUpdE (T.varE namedRec)
-                      [ return ( quald qual ('_' : fieldNm)
-                               , T.VarE namedNewVal) ]
+recordsToOptics qual nm rules = do
+  let makeLens index (Rule inner _ _) = [ signature, function ]
+        where
+          signature = recordLensSignature qual nm inner index
+          function = recordLensFunction qual nm inner index
+  concat . zipWith makeLens [(0 :: Int) ..] $ rules
 
 forallA :: T.TypeQ -> T.TypeQ
-forallA = T.forallT [ T.PlainTV (T.mkName "t")
-                    , T.PlainTV (T.mkName "a")] (return [])
+forallA = T.forallT [ tyVarBndrT, tyVarBndrA ] (return [])
diff --git a/lib/Pinchot/SyntaxTree/Wrappers.hs b/lib/Pinchot/SyntaxTree/Wrappers.hs
--- a/lib/Pinchot/SyntaxTree/Wrappers.hs
+++ b/lib/Pinchot/SyntaxTree/Wrappers.hs
@@ -1,13 +1,12 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Pinchot.SyntaxTree.Wrappers where
 
-import Data.Foldable (toList)
-import Data.Maybe (catMaybes)
-import Data.Sequence (Seq)
-import Data.Sequence.NonEmpty (NonEmptySeq)
 import qualified Control.Lens as Lens
+import Data.List.NonEmpty (NonEmpty)
+import Data.Maybe (catMaybes)
 import qualified Language.Haskell.TH as T
 
+import Pinchot.Names
 import Pinchot.Rules
 import Pinchot.Types
 
@@ -28,12 +27,11 @@
 -- Example: "Pinchot.Examples.SyntaxTrees".
 
 wrappedInstances
-  :: Seq (Rule t)
+  :: [Rule t]
   -> T.DecsQ
 wrappedInstances
   = sequence
   . catMaybes
-  . toList
   . fmap singleWrappedInstance
   . families
 
@@ -65,17 +63,16 @@
 makeWrapped wrappedType nm = T.instanceD (return []) typ decs
   where
     name = T.mkName nm
-    local = T.mkName "_x"
     typ = (T.conT ''Lens.Wrapped) `T.appT`
       ((T.conT name)
-        `T.appT` (T.varT (T.mkName "t"))
-        `T.appT` (T.varT (T.mkName "a")))
+        `T.appT` (typeT)
+        `T.appT` (typeA))
     decs = [assocType, wrapper]
       where
         assocType = T.tySynInstD ''Lens.Unwrapped
           (T.tySynEqn [T.conT name
-            `T.appT` (T.varT (T.mkName "t"))
-            `T.appT` (T.varT (T.mkName "a"))]
+            `T.appT` (typeT)
+            `T.appT` (typeA)]
                       wrappedType)
         wrapper = T.funD 'Lens._Wrapped'
           [T.clause [] (T.normalB body) []]
@@ -84,15 +81,18 @@
               `T.appE` unwrap
               `T.appE` doWrap
               where
-                unwrap = T.lamE [lambPat] (T.varE local)
-                  where
-                    lambPat = T.conP name [T.varP local]
-                doWrap = T.lamE [lambPat] expn
-                  where
-                    expn = (T.conE name)
-                      `T.appE` (T.varE local)
-                    lambPat = T.varP local
+                unwrap = do
+                  local <- T.newName "_local"
+                  let lambPat = T.conP name [T.varP local]
+                  T.lamE [lambPat] (T.varE local)
+                    
+                doWrap = do
+                  local <- T.newName "_local"
+                  let expn = (T.conE name) `T.appE` (T.varE local)
+                      lambPat = T.varP local
+                  T.lamE [lambPat] expn
 
+
 wrappedOpt
   :: String
   -- ^ Wrapped rule name
@@ -104,22 +104,22 @@
     maybeName = (T.conT ''Maybe)
       `T.appT`
       ((T.conT (T.mkName wrappedName))
-        `T.appT` (T.varT (T.mkName "t"))
-        `T.appT` (T.varT (T.mkName "a")))
+        `T.appT` (typeT)
+        `T.appT` (typeA))
 
 wrappedTerminal
   :: String
   -- ^ Wrapper Rule name
   -> T.Q T.Dec
 wrappedTerminal = makeWrapped
-  [t| ( $(T.varT (T.mkName "t")), $(T.varT (T.mkName "a")) ) |]
+  [t| ( $(typeT), $(typeA) ) |]
 
 wrappedTerminals
   :: String
   -- ^ Wrapper Rule name
   -> T.Q T.Dec
 wrappedTerminals = makeWrapped
-  [t| Seq ( $(T.varT (T.mkName "t")), $(T.varT (T.mkName "a")) ) |]
+  [t| [ ($(typeT), $(typeA)) ] |]
 
 wrappedStar
   :: String
@@ -129,10 +129,9 @@
   -> T.Q T.Dec
 wrappedStar wrappedName = makeWrapped innerName
   where
-    innerName = (T.conT ''Seq) `T.appT`
-      ((T.conT (T.mkName wrappedName))
-        `T.appT` (T.varT (T.mkName "t"))
-        `T.appT` (T.varT (T.mkName "a")))
+    innerName =
+      [t| [ $(T.conT (T.mkName wrappedName)) $(typeT)
+                                             $(typeA) ] |]
 
 wrappedPlus
   :: String
@@ -142,11 +141,11 @@
   -> T.Q T.Dec
 wrappedPlus wrappedName = makeWrapped tupName
   where
-    tupName = T.conT ''NonEmptySeq
-      `T.appT` ((T.conT (T.mkName wrappedName))
-                  `T.appT` (T.varT (T.mkName "t"))
-                  `T.appT` (T.varT (T.mkName "a")))
+    tupName = [t| NonEmpty ( $(T.conT (T.mkName wrappedName))
+                             $(typeT)
+                             $(typeA)) |]
 
+
 wrappedWrap
   :: String
   -- ^ Wrapped rule name
@@ -157,5 +156,5 @@
   where
     innerName =
       ((T.conT (T.mkName wrappedName))
-        `T.appT` (T.varT (T.mkName "t"))
-        `T.appT` (T.varT (T.mkName "a")))
+        `T.appT` (typeT)
+        `T.appT` (typeA))
diff --git a/lib/Pinchot/Terminalize.hs b/lib/Pinchot/Terminalize.hs
--- a/lib/Pinchot/Terminalize.hs
+++ b/lib/Pinchot/Terminalize.hs
@@ -3,15 +3,14 @@
 module Pinchot.Terminalize where
 
 import Control.Monad (join)
-import Data.Sequence (Seq)
-import Data.Sequence.NonEmpty (NonEmptySeq)
-import qualified Data.Sequence.NonEmpty as NonEmpty
-import qualified Data.Sequence as Seq
-import Data.Foldable (foldlM, toList)
+import Data.List.NonEmpty (NonEmpty((:|)), toList)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Foldable (foldlM)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Language.Haskell.TH as T
 
+import Pinchot.Names
 import Pinchot.Types
 import Pinchot.Rules
 
@@ -21,7 +20,7 @@
 -- @t'RULE_NAME@ where @RULE_NAME@ is the name of the rule.  The
 -- type of the declaration is either
 --
--- Production a -> Seq (t, a)
+-- Production a -> [(t, a)]
 --
 -- or
 --
@@ -39,13 +38,12 @@
   -- ^ Qualifier for the module containing the data types created
   -- from the 'Rule's
  
-  -> Seq (Rule t)
+  -> [Rule t]
   -> T.Q [T.Dec]
 
 terminalizers qual
   = fmap concat
   . traverse (terminalizer qual)
-  . toList
   . families
 
 -- | For the given rule, creates declarations that reduce the rule
@@ -54,7 +52,7 @@
 -- the rule.  The
 -- type of the declaration is either
 --
--- Production a -> Seq (t, a)
+-- Production a -> [(t, a)]
 --
 -- or
 --
@@ -80,23 +78,25 @@
     anyType = T.varT (T.mkName "a")
     charType = T.varT (T.mkName "t")
     sig
-      | atLeastOne rule = T.sigD (T.mkName declName)
-          . T.forallT [T.PlainTV (T.mkName "t")
-                      , T.PlainTV (T.mkName "a")] (return [])
-          $ [t| $(T.conT (quald qual nm)) $(charType) $(anyType)
-            -> NonEmptySeq ($(charType), $(anyType)) |]
-      | otherwise = T.sigD (T.mkName declName)
-          . T.forallT [ T.PlainTV (T.mkName "t")
-                      , T.PlainTV (T.mkName "a")] (return [])
-          $ [t| $(T.conT (quald qual nm)) $(charType) $(anyType)
-              -> Seq ($(charType), $(anyType)) |]
+      | atLeastOne rule = do
+          ctorName <- lookupTypeName (quald qual nm)
+          T.sigD (T.mkName declName)
+            . T.forallT [tyVarBndrT , tyVarBndrA ] (return [])
+            $ [t| $(T.conT ctorName) $(charType) $(anyType)
+              -> NonEmpty ($(charType), $(anyType)) |]
+      | otherwise = do
+          ctorName <- lookupTypeName (quald qual nm)
+          T.sigD (T.mkName declName)
+            . T.forallT [ tyVarBndrT , tyVarBndrA ] (return [])
+            $ [t| $(T.conT ctorName) $(charType) $(anyType)
+                -> [($(charType), $(anyType))] |]
     expn = T.valD (T.varP $ T.mkName declName)
       (T.normalB (terminalizeRuleExp qual rule)) []
 
 -- | For the given rule, returns an expression that has type of
 -- either
 --
--- Production a -> Seq (t, a)
+-- Production a -> [(t, a)]
 --
 -- or
 --
@@ -119,7 +119,7 @@
         let expn = terminalizeSingleRule qual lkp r
             decName = lookupName lkp rn
         in T.valD (T.varP decName) (T.normalB expn) []
-  T.letE (fmap mkDec . toList $ allRules) (T.varE (lookupName lkp nm))
+  T.letE (fmap mkDec $ allRules) (T.varE (lookupName lkp nm))
 
 -- | Creates a 'Map' where each key is the name of the 'Rule' and
 -- each value is a name corresponding to that 'Rule'.  No
@@ -145,7 +145,7 @@
 -- | For the given rule, returns an expression that has type
 -- of either
 --
--- Production a -> Seq (t, a)
+-- Production a -> [(t, a)]
 --
 -- or
 --
@@ -168,8 +168,9 @@
 terminalizeSingleRule qual lkp rule@(Rule nm _ ty) = case ty of
   Terminal _ -> do
     x <- T.newName "x"
-    let pat = T.conP (quald qual nm) [T.varP x]
-    [| \ $(pat) -> NonEmpty.singleton $(T.varE x) |]
+    ctorName <- lookupValueName (quald qual nm)
+    let pat = T.conP ctorName [T.varP x]
+    [| \ $(pat) -> ( $(T.varE x) :| [] ) |]
 
   NonTerminal bs -> do
     x <- T.newName "x"
@@ -183,7 +184,8 @@
 
   Wrap (Rule inner _ _) -> do
     x <- T.newName "x"
-    let pat = T.conP (quald qual nm) [T.varP x]
+    ctorName <- lookupValueName (quald qual nm)
+    let pat = T.conP ctorName [T.varP x]
     [| \ $(pat) -> $(T.varE (lookupName lkp inner)) $(T.varE x) |]
 
   Record rs -> do
@@ -195,17 +197,19 @@
 
   Opt r@(Rule inner _ _) -> do
     x <- T.newName "x"
-    let pat = T.conP (quald qual nm) [T.varP x]
-    [| \ $(pat) -> maybe Seq.empty
+    ctorName <- lookupValueName (quald qual nm)
+    let pat = T.conP ctorName [T.varP x]
+    [| \ $(pat) -> maybe [] 
           $(convert (T.varE (lookupName lkp inner))) $(T.varE x) |]
     where
-      convert expn | atLeastOne r = [| NonEmpty.nonEmptySeqToSeq . $(expn) |]
+      convert expn | atLeastOne r = [| NonEmpty.toList . $(expn) |]
                    | otherwise = expn
 
   Star r@(Rule inner _ _) -> do
     x <- T.newName "x"
-    let pat = T.conP (quald qual nm) [T.varP x]
-        convert e | atLeastOne r = [| NonEmpty.nonEmptySeqToSeq . $(e) |]
+    ctorName <- lookupValueName (quald qual nm)
+    let pat = T.conP ctorName [T.varP x]
+        convert e | atLeastOne r = [| NonEmpty.toList . $(e) |]
                   | otherwise = e
     [| \ $(pat) -> join . fmap $(convert (T.varE (lookupName lkp inner)))
           $ $(T.varE x) |]
@@ -213,26 +217,28 @@
   Plus r@(Rule inner _ _)
     | atLeastOne r -> do
         x <- T.newName "x"
-        let pat = T.conP (quald qual nm) [T.varP x]
+        ctorName <- lookupValueName (quald qual nm)
+        let pat = T.conP ctorName [T.varP x]
         [| \ $(pat) ->
             let getTermNonEmpty = $(T.varE (lookupName lkp inner))
-                getTerms (NonEmpty.NonEmptySeq e1 es)
+                getTerms (e1 :| es)
                   = join . fmap getTermNonEmpty
-                  $ NonEmpty.NonEmptySeq e1 es
+                  $ (e1 :| es)
            in getTerms $(T.varE x)
           |]
 
     | otherwise -> do
         x <- T.newName "x"
         [| let getTermSeq = $(T.varE (lookupName lkp inner))
-               getTerms (NonEmpty.NonEmptySeq e1 es) = getTermSeq e1
+               getTerms (e1 :| es) = getTermSeq e1
                 `mappend` (join (fmap getTermSeq es))
            in getTerms $(T.varE x)
           |]
 
   Series _ -> do
     x <- T.newName "x"
-    let pat = T.conP (quald qual nm) [T.varP x]
+    ctorName <- lookupValueName (quald qual nm)
+    let pat = T.conP ctorName [T.varP x]
     [| \ $(pat) -> $(T.varE x) |]
 
 terminalizeProductAllowsZero
@@ -240,51 +246,60 @@
   -> Map RuleName T.Name
   -> String
   -- ^ Rule name or branch name, as applicable
-  -> Seq (Rule t)
+  -> [Rule t]
   -> T.Q (T.PatQ, T.ExpQ)
 terminalizeProductAllowsZero qual lkp name bs = do
-  pairs <- fmap toList . traverse (terminalizeProductRule lkp) $ bs
-  let pat = T.conP (quald qual name) (fmap (fst . snd) pairs)
+  pairs <- traverse (terminalizeProductRule lkp) $ bs
+  ctorName <- lookupValueName (quald qual name)
+  let pat = T.conP ctorName (fmap (fst . snd) pairs)
       body = case pairs of
-        [] -> [| Seq.empty |]
+        [] -> [| [] |]
         x:xs -> foldl f start xs
           where
             f acc trip = [| $(acc) `mappend` $(procTrip trip) |]
             start = procTrip x
             procTrip (rule, (_, expn))
-              | atLeastOne rule = [| NonEmpty.nonEmptySeqToSeq $(expn) |]
+              | atLeastOne rule = [| NonEmpty.toList $(expn) |]
               | otherwise = expn
   return (pat, body)
 
+prependList :: [a] -> NonEmpty a -> NonEmpty a
+prependList [] ne = ne
+prependList (x:xs) (a :| as) = (x :| (xs ++ (a : as)))
+
+appendList :: NonEmpty a -> [a] -> NonEmpty a
+appendList (a :| as) xs = a :| (as ++ xs)
+
 terminalizeProductAtLeastOne
   :: Qualifier
   -> Map RuleName T.Name
   -> String
   -- ^ Rule name or branch name, as applicable
-  -> Seq (Rule t)
+  -> [Rule t]
   -> T.Q (T.PatQ, T.ExpQ)
 terminalizeProductAtLeastOne qual lkp name bs = do
-  pairs <- fmap toList . traverse (terminalizeProductRule lkp) $ bs
-  let pat = T.conP (quald qual name) (fmap (fst . snd) pairs)
-      body = [| ( $(leadSeq) `NonEmpty.prependSeq` $(firstNonEmpty))
-                `NonEmpty.appendSeq` $(trailSeq) |]
+  pairs <- traverse (terminalizeProductRule lkp) $ bs
+  ctorName <- lookupValueName (quald qual name)
+  let pat = T.conP ctorName (fmap (fst . snd) pairs)
+      body = [| ( $(leadSeq) `prependList` $(firstNonEmpty))
+                `appendList` $(trailSeq) |]
         where
           (leadRules, lastRules) = span (not . atLeastOne . fst) pairs
           (firstNonEmptyRule, trailRules) = case lastRules of
             [] -> error $ "terminalizeProductAtLeastOne: failure 1: " ++ name
             x:xs -> (x, xs)
           leadSeq = case fmap (snd . snd) leadRules of
-            [] -> [| Seq.empty |]
+            [] -> [| [] |]
             x:xs -> foldl f x xs
               where
                 f acc expn = [| $(acc) `mappend` $(expn) |]
           firstNonEmpty = [| $(snd . snd $ firstNonEmptyRule) |]
 
-          trailSeq = foldl f [| Seq.empty |] trailRules
+          trailSeq = foldl f [| [] |] trailRules
             where
               f acc (rule, (_, expn))
                 | atLeastOne rule =
-                    [| $(acc) `mappend` NonEmpty.nonEmptySeqToSeq $(expn) |]
+                    [| $(acc) `mappend` NonEmpty.toList $(expn) |]
                 | otherwise =
                     [| $(acc) `mappend` $(expn) |]
   return (pat, body)
diff --git a/lib/Pinchot/Types.hs b/lib/Pinchot/Types.hs
--- a/lib/Pinchot/Types.hs
+++ b/lib/Pinchot/Types.hs
@@ -4,13 +4,10 @@
 {-# LANGUAGE DeriveAnyClass #-}
 module Pinchot.Types where
 
-import Pinchot.Intervals
-
 import qualified Control.Lens as Lens
 import Data.Data (Data)
+import Data.List.NonEmpty (NonEmpty)
 import GHC.Generics (Generic)
-import Data.Sequence (Seq)
-import Data.Sequence.NonEmpty (NonEmptySeq)
 import qualified Language.Haskell.TH as T
 import Text.Show.Pretty (PrettyVal(prettyVal))
 import qualified Text.Show.Pretty as Pretty
@@ -50,7 +47,7 @@
   { _ruleName :: RuleName
   , _ruleDescription :: Maybe String
   , _ruleType :: RuleType t
-  } deriving (Eq, Ord, Show, Data, Generic, PrettyVal)
+  } deriving (Show, Generic, PrettyVal)
 
 -- Can't use Template Haskell in this module due to corecursive
 -- types
@@ -72,40 +69,50 @@
 -- produces.
 data Branch t = Branch
   { _branchName :: BranchName
-  , _branches :: Seq (Rule t)
-  } deriving (Eq, Ord, Show, Data)
+  , _branches :: [Rule t]
+  } deriving (Show, Generic, PrettyVal)
 
 branchName :: Lens.Lens' (Branch t) BranchName
 branchName
   = Lens.lens _branchName (\b n -> b { _branchName = n })
 
-branches :: Lens.Lens' (Branch t) (Seq (Rule t))
+branches :: Lens.Lens' (Branch t) [Rule t]
 branches
   = Lens.lens _branches (\b s -> b { _branches = s})
 
-instance PrettyVal t => PrettyVal (Branch t) where
-  prettyVal (Branch b1 bs) = Pretty.Rec "Branch"
-    [ ("_branchName", prettyVal b1)
-    , ("_branches", prettySeq prettyVal bs)
-    ]
+newtype Predicate a = Predicate { unPredicate :: T.Q (T.TExp (a -> Bool)) }
 
+instance Show (Predicate a) where show _ = "<predicate>"
+instance PrettyVal (Predicate a) where prettyVal _ = Pretty.Con "Predicate" []
+
 -- | The type of a particular rule.
 data RuleType t
-  = Terminal (Intervals t)
-  | NonTerminal (NonEmptySeq (Branch t))
+  = Terminal (Predicate t)
+  | NonTerminal (NonEmpty (Branch t))
   | Wrap (Rule t)
-  | Record (Seq (Rule t))
+  | Record [Rule t]
   | Opt (Rule t)
   | Star (Rule t)
   | Plus (Rule t)
-  | Series (NonEmptySeq t)
-  deriving (Eq, Ord, Show, Data)
+  | Series (NonEmpty t)
+  deriving (Show, Generic)
 
-_Terminal :: Lens.Prism' (RuleType t) (Intervals t)
-_Terminal = Lens.prism' Terminal
-  (\r -> case r of { Terminal i -> Just i; _ -> Nothing })
+instance PrettyVal t => PrettyVal (RuleType t) where
+  prettyVal r = case r of
+    Terminal t -> Pretty.Con "Terminal" [prettyVal t]
+    NonTerminal ne -> Pretty.Con "NonTerminal" [prettyNonEmpty prettyVal ne]
+    Wrap r -> Pretty.Con "Wrap" [prettyVal r]
+    Record rs -> Pretty.Con "Record" [Pretty.List $ fmap prettyVal rs]
+    Opt r -> Pretty.Con "Opt" [prettyVal r]
+    Star r -> Pretty.Con "Star" [prettyVal r]
+    Plus r -> Pretty.Con "Plus" [prettyVal r]
+    Series ne -> Pretty.Con "Series" [prettyNonEmpty prettyVal ne]
 
-_NonTerminal :: Lens.Prism' (RuleType t) (NonEmptySeq (Branch t))
+_Terminal :: Lens.Prism' (RuleType t) (T.Q (T.TExp (t -> Bool)))
+_Terminal = Lens.prism' (Terminal . Predicate)
+  (\r -> case r of { Terminal (Predicate i) -> Just i; _ -> Nothing })
+
+_NonTerminal :: Lens.Prism' (RuleType t) (NonEmpty (Branch t))
 _NonTerminal = Lens.prism' NonTerminal
   (\r -> case r of { NonTerminal b -> Just b; _ -> Nothing })
 
@@ -113,7 +120,7 @@
 _Wrap = Lens.prism' Wrap
   (\r -> case r of { Wrap x -> Just x; _ -> Nothing })
 
-_Record :: Lens.Prism' (RuleType t) (Seq (Rule t))
+_Record :: Lens.Prism' (RuleType t) [Rule t]
 _Record = Lens.prism' Record
   (\r -> case r of { Record x -> Just x; _ -> Nothing })
 
@@ -129,22 +136,10 @@
 _Plus = Lens.prism' Plus
   (\r -> case r of { Plus x -> Just x; _ -> Nothing })
 
-_Series :: Lens.Prism' (RuleType t) (NonEmptySeq t)
+_Series :: Lens.Prism' (RuleType t) (NonEmpty t)
 _Series = Lens.prism' Series
   (\r -> case r of { Series s -> Just s; _ -> Nothing })
 
-instance PrettyVal t => PrettyVal (RuleType t) where
-  prettyVal x = case x of
-    Terminal ivl -> Pretty.Con "Terminal" [(prettyVal ivl)]
-    NonTerminal ne -> Pretty.Con "NonTerminal"
-      [prettyNonEmptySeq prettyVal ne]
-    Wrap r -> Pretty.Con "Wrap" [prettyVal r]
-    Record rs -> Pretty.Con "Record" [prettySeq prettyVal rs]
-    Opt rs -> Pretty.Con "Opt" [prettyVal rs]
-    Star rs -> Pretty.Con "Star" [prettyVal rs]
-    Plus rs -> Pretty.Con "Plus" [prettyVal rs]
-    Series sq -> Pretty.Con "Series" [prettyNonEmptySeq prettyVal sq]
-
 -- | The name of a field in a record, without the leading
 -- underscore.
 recordFieldName
@@ -156,44 +151,6 @@
   -- ^ Inner type name
   -> String
 recordFieldName idx par inn = "r'" ++ par ++ "'" ++ show idx ++ "'" ++ inn
-
--- | Many functions take an argument that holds the name qualifier
--- for the module that contains the data types created by applying a
--- function such as 'Pinchot.SyntaxTree.syntaxTrees' or
--- 'Pinchot.Earley.earleyProduct'.
---
--- You will have to make sure that these data types are in scope.
--- The spliced Template Haskell code has to know where to
--- look for these data types.  If you did an unqualified @import@ or
--- if the types are in the same module as the function that takes a
--- 'Qualifier' argument, just pass the empty string here.  If you did a
--- qualified import, use the appropriate qualifier here.
---
--- For example, if you used @import qualified MyAst@, pass
--- @\"MyAst\"@ here.  If you used @import qualified
--- Data.MyLibrary.MyAst as MyLibrary.MyAst@, pass
--- @\"MyLibrary.MyAst\"@ here.
---
--- I recommend that you always create a new module and that all you
--- do in that module is apply 'Pinchot.SyntaxTree.syntaxTrees' or
--- 'Pinchot.Earley.earleyProduct', and that you then perform an @import
--- qualified@ to bring those names into scope in the module in which
--- you use a function that takes a 'Qualifier' argument.  This
--- avoids unlikely, but possible, issues that could otherwise arise
--- due to naming conflicts.
-type Qualifier = String
-
-
--- | Prepends a qualifier to a string, and returns the resulting
--- Name.
-quald
-  :: Qualifier
-  -> String
-  -- ^ Item to be named - constructor, value, etc.
-  -> T.Name
-quald qual suf
-  | null qual = T.mkName suf
-  | otherwise = T.mkName (qual ++ '.':suf)
 
 -- | A location.
 
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: gen-pinchot-cabal
--- Generated on: 2016-08-21 08:12:40.469343 EDT
+-- Generated on: 2017-02-03 16:36:31.080916 EST
 -- Cartel library version: 0.16.0.0
 
 name: pinchot
-version: 0.22.0.0
+version: 0.24.0.0
 cabal-version: >= 1.10
 license: BSD3
 license-file: LICENSE
 build-type: Simple
-copyright: Copyright (c) 2015 - 2016 Omari Norman
+copyright: Copyright (c) 2015 - 2017 Omari Norman
 author: Omari Norman
 maintainer: omari@smileystation.com
 stability: Experimental
@@ -34,9 +34,7 @@
     , Earley >= 0.11.0.1
     , pretty-show >= 1.6.9
     , lens >= 4.13
-    , ListLike >= 4.2.1
     , semigroups >= 0.18.1
-    , non-empty-sequence >= 0.2
   exposed-modules:
     Pinchot
     Pinchot.Earley
@@ -48,8 +46,8 @@
     Pinchot.Examples.RulesToOptics
     Pinchot.Examples.SyntaxTrees
     Pinchot.Examples.Terminalize
-    Pinchot.Intervals
     Pinchot.Locator
+    Pinchot.Names
     Pinchot.Pretty
     Pinchot.RecursiveDo
     Pinchot.Rules
@@ -86,9 +84,7 @@
       , Earley >= 0.11.0.1
       , pretty-show >= 1.6.9
       , lens >= 4.13
-      , ListLike >= 4.2.1
       , semigroups >= 0.18.1
-      , non-empty-sequence >= 0.2
     other-modules:
       Pinchot
       Pinchot.Earley
@@ -100,8 +96,8 @@
       Pinchot.Examples.RulesToOptics
       Pinchot.Examples.SyntaxTrees
       Pinchot.Examples.Terminalize
-      Pinchot.Intervals
       Pinchot.Locator
+      Pinchot.Names
       Pinchot.Pretty
       Pinchot.RecursiveDo
       Pinchot.Rules
@@ -135,9 +131,7 @@
       , Earley >= 0.11.0.1
       , pretty-show >= 1.6.9
       , lens >= 4.13
-      , ListLike >= 4.2.1
       , semigroups >= 0.18.1
-      , non-empty-sequence >= 0.2
     other-modules:
       Pinchot
       Pinchot.Earley
@@ -149,8 +143,8 @@
       Pinchot.Examples.RulesToOptics
       Pinchot.Examples.SyntaxTrees
       Pinchot.Examples.Terminalize
-      Pinchot.Intervals
       Pinchot.Locator
+      Pinchot.Names
       Pinchot.Pretty
       Pinchot.RecursiveDo
       Pinchot.Rules