diff --git a/examples/Arithmetic.hs b/examples/Arithmetic.hs
--- a/examples/Arithmetic.hs
+++ b/examples/Arithmetic.hs
@@ -5,10 +5,11 @@
 import Data.Char (isDigit)
 import Data.Functor.Compose (Compose(..))
 import Data.Monoid ((<>))
+import Text.Parser.Token (symbol)
 
 import Text.Grampa
 import Text.Grampa.ContextFree.LeftRecursive (Parser)
-import Utilities (infixJoin, symbol)
+import Utilities (infixJoin)
 
 import qualified Rank2
 import Prelude hiding (negate, product, subtract, sum)
@@ -87,7 +88,10 @@
                   <*> f (factor a)
                   <*> f (primary a)
 
-arithmetic :: ArithmeticDomain e => GrammarBuilder (Arithmetic e) g Parser String
+instance Lexical (Arithmetic e)
+
+arithmetic :: (Lexical g, LexicalConstraint Parser g String, ArithmeticDomain e) =>
+              GrammarBuilder (Arithmetic e) g Parser String
 arithmetic Arithmetic{..} = Arithmetic{
    expr= sum,
    sum= product
@@ -99,7 +103,7 @@
          <|> divide <$> product <* symbol "/" <*> factor,
    factor= primary
            <|> symbol "(" *> expr <* symbol ")",
-   primary= whiteSpace *> ((number . read) <$> takeCharsWhile1 isDigit <?> "digits")}
+   primary= lexicalToken ((number . read) <$> takeCharsWhile1 isDigit) <?> "digits"}
 
 main :: IO ()
 main = getContents >>=
diff --git a/examples/Boolean.hs b/examples/Boolean.hs
--- a/examples/Boolean.hs
+++ b/examples/Boolean.hs
@@ -1,15 +1,17 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, KindSignatures, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, KindSignatures, RecordWildCards, ScopedTypeVariables,
+             TypeFamilies, TemplateHaskell #-}
 module Boolean where
 
 import Control.Applicative
 import qualified Data.Bool
 import Data.Char (isSpace)
 import Data.Monoid ((<>))
+import Text.Parser.Token (TokenParsing, symbol)
 
 import qualified Rank2.TH
 
 import Text.Grampa
-import Utilities (infixJoin, keyword, symbol)
+import Utilities (infixJoin)
 
 import Prelude hiding (and, or, not)
 
@@ -41,10 +43,13 @@
       factor :: f e}
    deriving Show
 
+instance Lexical (Boolean e)
+
 $(Rank2.TH.deriveAll ''Boolean)
 
 boolean :: forall e p (g :: (* -> *) -> *).
-           (BooleanDomain e, Alternative (p g String), Parsing (p g String), MonoidParsing (p g)) =>
+           (Lexical g, LexicalConstraint p g String,
+            BooleanDomain e, TokenParsing (p g String), MonoidParsing (p g)) =>
            p g String e -> Boolean e (p g String) -> Boolean e (p g String)
 boolean p Boolean{..} = Boolean{
    expr= term
diff --git a/examples/Combined.hs b/examples/Combined.hs
--- a/examples/Combined.hs
+++ b/examples/Combined.hs
@@ -7,7 +7,7 @@
 import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Rank2.TH
-import Text.Grampa (GrammarBuilder)
+import Text.Grampa (Lexical, LexicalConstraint, GrammarBuilder)
 import Text.Grampa.ContextFree.LeftRecursive (Parser)
 import qualified Arithmetic
 import qualified Boolean
@@ -117,6 +117,8 @@
                            (", conditionalGrammar=" ++ showsPrec prec (conditionalGrammar g)
                            (", lambdaGrammar=" ++ showsPrec prec (lambdaGrammar g) ("}" ++ rest))))))
 
+instance Lexical Expression
+
 $(Rank2.TH.deriveAll ''Expression)
 
 {-
@@ -186,7 +188,7 @@
                   <*> Rank2.traverse f (lambdaGrammar g)
 -}
 
-expression :: GrammarBuilder Expression g Parser String
+expression :: (Lexical g, LexicalConstraint Parser g String) => GrammarBuilder Expression g Parser String
 expression Expression{..} =
    let combinedExpr = Arithmetic.expr arithmeticGrammar
                       <|> Boolean.expr booleanGrammar
diff --git a/examples/Comparisons.hs b/examples/Comparisons.hs
--- a/examples/Comparisons.hs
+++ b/examples/Comparisons.hs
@@ -3,10 +3,10 @@
 
 import Control.Applicative
 import Data.Monoid ((<>))
+import Text.Parser.Token (TokenParsing, symbol)
 
 import qualified Rank2
 import Text.Grampa
-import Utilities (symbol)
 
 class ComparisonDomain c e where
    greaterThan :: c -> c -> e
@@ -62,7 +62,8 @@
                   <$> f (test g)
                   <*> f (term g)
 
-comparisons :: (ComparisonDomain c e, Alternative (p g String), MonoidParsing (p g)) =>
+comparisons :: (Lexical g, LexicalConstraint p g String,
+                ComparisonDomain c e, TokenParsing (p g String), MonoidParsing (p g)) =>
                GrammarBuilder (Comparisons c e) g p String
 comparisons Comparisons{..} =
    Comparisons{
diff --git a/examples/Conditionals.hs b/examples/Conditionals.hs
--- a/examples/Conditionals.hs
+++ b/examples/Conditionals.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RecordWildCards, TemplateHaskell #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RecordWildCards,
+             TypeFamilies, TemplateHaskell #-}
 module Conditionals where
 
 import Control.Applicative
@@ -8,7 +9,6 @@
 
 import Text.Grampa
 import Text.Grampa.ContextFree.LeftRecursive (Parser)
-import Utilities (keyword)
 
 class ConditionalDomain c e where
    ifThenElse :: c -> e -> e -> e
@@ -29,9 +29,13 @@
                            (", test= " ++ showsPrec prec (test a)
                             (", term= " ++ showsPrec prec (term a) ("}" ++ rest)))
 
+instance Lexical (Conditionals t e) where
+   type LexicalConstraint p (Conditionals t e) s = (p ~ Parser, s ~ String)
+
 $(Rank2.TH.deriveAll ''Conditionals)
 
-conditionals :: ConditionalDomain t e => GrammarBuilder (Conditionals t e) g Parser String
+conditionals :: (ConditionalDomain t e, Lexical g, LexicalConstraint Parser g String)
+             => GrammarBuilder (Conditionals t e) g Parser String
 conditionals Conditionals{..} =
    Conditionals{expr= ifThenElse <$> (keyword "if" *> test) <*> (keyword "then" *> term) <*> (keyword "else" *> term),
                 test= empty,
diff --git a/examples/Lambda.hs b/examples/Lambda.hs
--- a/examples/Lambda.hs
+++ b/examples/Lambda.hs
@@ -6,13 +6,13 @@
 import Data.Char (isAlphaNum, isLetter)
 import Data.Map (Map, insert, (!))
 import Data.Monoid ((<>))
+import Text.Parser.Token (symbol, whiteSpace)
 
 import qualified Rank2
 import qualified Rank2.TH
 
 import Text.Grampa
 import Text.Grampa.ContextFree.LeftRecursive (Parser)
-import Utilities (symbol)
 
 class LambdaDomain e where
    apply :: e -> e -> e
@@ -96,7 +96,8 @@
 
 $(Rank2.TH.deriveAll ''Lambda)
 
-lambdaCalculus :: LambdaDomain e => GrammarBuilder (Lambda e) g Parser String
+lambdaCalculus :: (Lexical g, LexicalConstraint Parser g String, LambdaDomain e)
+               => GrammarBuilder (Lambda e) g Parser String
 lambdaCalculus Lambda{..} = Lambda{
    expr= abstraction,
    abstraction= lambda <$> (symbol "\\" *> varName <* symbol "->") <*> abstraction
diff --git a/examples/Main.hs b/examples/Main.hs
--- a/examples/Main.hs
+++ b/examples/Main.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, RankNTypes, KindSignatures, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances, RankNTypes, KindSignatures, UndecidableInstances #-}
 module Main (main, arithmetic, comparisons, boolean, conditionals) where
 
 import System.Environment (getArgs)
 import Data.Functor.Compose (Compose(..))
 import Data.Map (Map)
 import qualified Rank2
-import Text.Grampa (GrammarBuilder, ParseResults, fixGrammar, parseComplete)
+import Text.Grampa (Lexical, LexicalConstraint, GrammarBuilder, ParseResults, fixGrammar, parseComplete)
 import Text.Grampa.ContextFree.LeftRecursive (Parser)
 import Arithmetic (Arithmetic, arithmetic)
 import qualified Arithmetic
@@ -37,17 +37,22 @@
                  <$> (getCompose . Combined.expr $ parseComplete (fixGrammar Combined.expression) args)
                  :: ParseResults [Combined.Tagged])
 
-comparisons :: GrammarBuilder (Rank2.Product (Arithmetic.Arithmetic Int) (Comparisons.Comparisons Int Bool))
-                              g Parser String
+comparisons :: (Lexical g, LexicalConstraint Parser g String) => GrammarBuilder ArithmeticComparisons g Parser String
 comparisons (Rank2.Pair a c) =
    Rank2.Pair (Arithmetic.arithmetic a) (Comparisons.comparisons c{Comparisons.term= Arithmetic.expr a})
 
-boolean :: GrammarBuilder ArithmeticComparisonsBoolean g Parser String
+boolean :: (Lexical g, LexicalConstraint Parser g String) => GrammarBuilder ArithmeticComparisonsBoolean g Parser String
 boolean (Rank2.Pair ac b) = Rank2.Pair (comparisons ac) (Boolean.boolean (Comparisons.test $ Rank2.snd ac) b)
 
-conditionals :: GrammarBuilder ACBC g Parser String
+conditionals :: (Lexical g, LexicalConstraint Parser g String) => GrammarBuilder ACBC g Parser String
 conditionals (Rank2.Pair acb c) =
    Rank2.Pair
       (boolean acb)
       (Conditionals.conditionals c{Conditionals.test= Boolean.expr (Rank2.snd acb),
                                    Conditionals.term= Arithmetic.expr (Rank2.fst $ Rank2.fst acb)})
+
+instance Lexical ArithmeticComparisons
+instance Lexical ArithmeticComparisonsBoolean
+instance Lexical ACBC
+instance Lexical (Lambda.Lambda Lambda.LambdaInitial)
+
diff --git a/examples/Utilities.hs b/examples/Utilities.hs
--- a/examples/Utilities.hs
+++ b/examples/Utilities.hs
@@ -21,11 +21,3 @@
 
 infixJoin :: String -> String -> String -> String
 infixJoin op a b = "(" <> a <> op <> b <> ")"
-
-keyword :: forall s (g :: (* -> *) -> *) p.
-           (Show s, TextualMonoid s, Parsing (p g s), MonoidParsing (p g)) => s -> p g s s
-keyword kwd = whiteSpace *> string kwd <* notFollowedBy (satisfyChar isAlphaNum)
-
-symbol :: forall s (g :: (* -> *) -> *) p.
-          (Show s, TextualMonoid s, Applicative (p g s), MonoidParsing (p g)) => s -> p g s s
-symbol s = whiteSpace *> string s
diff --git a/grammatical-parsers.cabal b/grammatical-parsers.cabal
--- a/grammatical-parsers.cabal
+++ b/grammatical-parsers.cabal
@@ -1,5 +1,5 @@
 name:                grammatical-parsers
-version:             0.2.2
+version:             0.3
 synopsis:            parsers that can combine into grammars
 description:
   /Gram/matical-/pa/rsers, or Grampa for short, is a library of parser types whose values are meant to be assigned
@@ -26,7 +26,8 @@
   exposed-modules:     Text.Grampa,
                        Text.Grampa.PEG.Backtrack, Text.Grampa.PEG.Packrat,
                        Text.Grampa.ContextFree.Continued, Text.Grampa.ContextFree.Parallel,
-                       Text.Grampa.ContextFree.Memoizing, Text.Grampa.ContextFree.LeftRecursive
+                       Text.Grampa.ContextFree.Memoizing, Text.Grampa.ContextFree.SortedMemoizing,
+                       Text.Grampa.ContextFree.LeftRecursive
   other-modules:       Text.Grampa.Class, Text.Grampa.Internal,
                        Text.Grampa.PEG.Backtrack.Measured,
                        Text.Grampa.PEG.Continued, Text.Grampa.PEG.Continued.Measured,
@@ -34,35 +35,34 @@
   default-language:    Haskell2010
   -- other-modules:
   ghc-options:         -Wall
-  build-depends:       base >=4.7 && <5,
+  build-depends:       base >=4.9 && <5,
                        containers >= 0.4 && < 0.6,
                        transformers >= 0.5 && < 0.6,
                        monoid-subclasses >=0.4 && <0.5,
                        parsers < 0.13,
-                       rank2classes == 1.0.*
-  -- hs-source-dirs:      
-  default-language:    Haskell2010
+                       rank2classes >= 1.0.2 && < 1.2
 
 executable             arithmetic
   hs-source-dirs:      examples
   main-is:             Main.hs
   other-modules:       Arithmetic, Boolean, Combined, Comparisons, Conditionals, Lambda, Utilities
   default-language:    Haskell2010
-  build-depends:       base >=4.7 && <5, containers >= 0.5.7.0 && < 0.6,
+  build-depends:       base >=4.9 && <5, containers >= 0.5.7.0 && < 0.6,
                        parsers < 0.13,
-                       rank2classes == 1.0.*, grammatical-parsers,
+                       rank2classes >= 1.0.2 && < 1.2, grammatical-parsers,
                        monoid-subclasses >=0.4 && <0.5
 
 test-suite           quicktests
   type:              exitcode-stdio-1.0
   hs-source-dirs:    test, examples
   x-uses-tf:         true
-  build-depends:     base >=4.7 && < 5, monoid-subclasses < 0.5, parsers < 0.13,
-                     rank2classes == 1.0.*, grammatical-parsers,
+  build-depends:     base >=4.9 && < 5, containers >= 0.5.7.0 && < 0.6,
+                     monoid-subclasses < 0.5, parsers < 0.13,
+                     rank2classes >= 1.0.2 && < 1.2, grammatical-parsers,
                      QuickCheck >= 2 && < 3, checkers >= 0.4.6 && < 0.5, testing-feat < 0.5,
                      tasty >= 0.7, tasty-quickcheck >= 0.7
   main-is:           Test.hs
-  other-modules:     Test.Examples, Arithmetic, Boolean, Combined, Comparisons, Conditionals, Utilities
+  other-modules:     Test.Examples, Arithmetic, Boolean, Combined, Comparisons, Conditionals, Lambda, Utilities
   default-language:  Haskell2010
 
 test-suite           doctests
@@ -77,8 +77,9 @@
   type:              exitcode-stdio-1.0
   hs-source-dirs:    test, examples
   ghc-options:       -O2 -Wall -rtsopts -main-is Benchmark.main
-  Build-Depends:     base >=4.7 && < 5, rank2classes == 1.0.*, grammatical-parsers, monoid-subclasses >=0.4 && <0.5,
+  Build-Depends:     base >=4.9 && < 5, rank2classes >= 1.0.2 && < 1.2, grammatical-parsers,
+                     monoid-subclasses >=0.4 && <0.5,
                      criterion >= 1.0, deepseq >= 1.1, containers >= 0.5.7.0 && < 0.6, text >= 1.1
   main-is:           Benchmark.hs
-  other-modules:     Arithmetic
+  other-modules:     Main, Arithmetic, Boolean, Combined, Comparisons, Conditionals, Lambda, Utilities
   default-language:  Haskell2010
diff --git a/src/Text/Grampa.hs b/src/Text/Grampa.hs
--- a/src/Text/Grampa.hs
+++ b/src/Text/Grampa.hs
@@ -6,9 +6,9 @@
    MultiParsing(..),
    simply,
    -- * Types
-   Grammar, GrammarBuilder, ParseResults, ParseFailure(..),
+   Grammar, GrammarBuilder, ParseResults, ParseFailure(..), Ambiguous(..),
    -- * Parser combinators and primitives
-   GrammarParsing(..), MonoidParsing(..),
+   GrammarParsing(..), MonoidParsing(..), AmbiguousParsing(..), Lexical(..),
    module Text.Parser.Char,
    module Text.Parser.Combinators,
    module Text.Parser.LookAhead)
@@ -19,7 +19,8 @@
 import Text.Parser.LookAhead (LookAheadParsing(lookAhead))
 
 import qualified Rank2
-import Text.Grampa.Class (MultiParsing(..), GrammarParsing(..), MonoidParsing(..), ParseResults, ParseFailure(..))
+import Text.Grampa.Class (Lexical(..), MultiParsing(..), GrammarParsing(..), MonoidParsing(..), AmbiguousParsing(..),
+                          Ambiguous(..), ParseResults, ParseFailure(..))
 
 -- | A type synonym for a fixed grammar record type @g@ with a given parser type @p@ on input streams of type @s@
 type Grammar (g  :: (* -> *) -> *) p s = g (p g s)
diff --git a/src/Text/Grampa/Class.hs b/src/Text/Grampa/Class.hs
--- a/src/Text/Grampa/Class.hs
+++ b/src/Text/Grampa/Class.hs
@@ -1,14 +1,25 @@
-{-# LANGUAGE ConstraintKinds, RankNTypes, TypeFamilies #-}
-module Text.Grampa.Class (MultiParsing(..), GrammarParsing(..), MonoidParsing(..),
-                          ParseResults, ParseFailure(..), completeParser) where
+{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DefaultSignatures, RankNTypes, ScopedTypeVariables,
+             TypeApplications, TypeFamilies, DeriveDataTypeable, DeriveFunctor #-}
+module Text.Grampa.Class (MultiParsing(..), AmbiguousParsing(..), GrammarParsing(..), MonoidParsing(..), Lexical(..),
+                          ParseResults, ParseFailure(..), Ambiguous(..), completeParser) where
 
+import Control.Applicative (Alternative(empty), liftA2, (<|>))
+import Control.Monad (guard)
+import Data.Char (isAlphaNum, isLetter, isSpace)
+import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
-import Data.Monoid (Monoid)
+import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.Data (Data)
+import Data.Typeable (Typeable)
+import Data.Monoid (Monoid, (<>))
 import Data.Monoid.Cancellative (LeftReductiveMonoid)
 import qualified Data.Monoid.Null as Null
 import Data.Monoid.Null (MonoidNull)
 import Data.Monoid.Factorial (FactorialMonoid)
 import Data.Monoid.Textual (TextualMonoid)
+import Text.Parser.Combinators (Parsing(notFollowedBy), skipMany, skipSome)
+import Text.Parser.Char (CharParsing(char))
+import Text.Parser.Token (TokenParsing, IdentifierStyle)
 import GHC.Exts (Constraint)
 
 import qualified Rank2
@@ -18,6 +29,15 @@
 -- | A 'ParseFailure' contains the offset of the parse failure and the list of things expected at that offset. 
 data ParseFailure = ParseFailure Int [String] deriving (Eq, Show)
 
+-- | An 'Ambiguous' parse result, produced by the 'ambiguous' combinator, contains a 'NonEmpty' list of alternative
+-- results.
+newtype Ambiguous a = Ambiguous (NonEmpty a) deriving (Data, Eq, Functor, Ord, Show, Typeable)
+
+instance Show1 Ambiguous where
+   liftShowsPrec sp sl d (Ambiguous (h :| l)) t
+      | d > 5 = "(Ambiguous $ " <> sp 0 h (" :| " <> sl l (')' : t))
+      | otherwise = "Ambiguous (" <> sp 0 h (" :| " <> sl l (')' : t))
+
 completeParser :: MonoidNull s => Compose ParseResults (Compose [] ((,) s)) r -> Compose ParseResults [] r
 completeParser (Compose (Left failure)) = Compose (Left failure)
 completeParser (Compose (Right (Compose results))) =
@@ -38,7 +58,7 @@
    parsePrefix :: (GrammarConstraint m g, FactorialMonoid s) =>
                   g (m g s) -> s -> g (Compose (ResultFunctor m) ((,) s))
 
--- | Parsers that belong to this class memoize the parse results to avoid exponential performance complexity.
+-- | Parsers that belong to this class can memoize the parse results to avoid exponential performance complexity.
 class MultiParsing m => GrammarParsing m where
    type GrammarFunctor m :: ((* -> *) -> *) -> * -> * -> *
    -- | Used to reference a grammar production, only necessary from outside the grammar itself
@@ -63,8 +83,6 @@
 
    -- | A parser that accepts any single input atom.
    anyToken :: FactorialMonoid s => m s s
-   -- | A parser that accepts a specific input atom.
-   token :: (Eq s, FactorialMonoid s) => s -> m s s
    -- | A parser that accepts an input atom only if it satisfies the given predicate.
    satisfy :: FactorialMonoid s => (s -> Bool) -> m s s
    -- | Specialization of 'satisfy' on 'TextualMonoid' inputs, accepting and returning an input character only if it
@@ -111,9 +129,70 @@
    -- | Specialization of 'takeWhile1' on 'TextualMonoid' inputs, accepting the longest sequence of input characters
    -- that match the given predicate; an optimized version of 'fmap fromString  . some . satisfyChar'.
    takeCharsWhile1 :: TextualMonoid s => (Char -> Bool) -> m s s
-   -- | Consume all whitespace characters.
-   whiteSpace :: TextualMonoid s => m s ()
    -- | Zero or more argument occurrences like 'many', with concatenated monoidal results.
    concatMany :: Monoid a => m s a -> m s a
 
-   token x = satisfy (== x)
+-- | Parsers that can produce alternative parses and collect them into an 'Ambiguous' node
+class AmbiguousParsing m where
+   -- | Collect all alternative parses of the same length into a 'NonEmpty' list of results.
+   ambiguous :: m a -> m (Ambiguous a)
+
+-- | If a grammar is 'Lexical', its parsers can instantiate the 'TokenParsing' class.
+class Lexical (g :: (* -> *) -> *) where
+   type LexicalConstraint (m :: ((* -> *) -> *) -> * -> * -> *) g s :: Constraint
+   -- | Always succeeds, consuming all white space and comments
+   lexicalWhiteSpace :: LexicalConstraint m g s => m g s ()
+   -- | Consumes all whitespace and comments, failing if there are none
+   someLexicalSpace :: LexicalConstraint m g s => m g s ()
+   -- | Consumes a single comment, defaults to 'empty'
+   lexicalComment :: LexicalConstraint m g s => m g s ()
+   -- | Consumes a single semicolon and any trailing whitespace, returning the character |';'|. The method can be
+   -- overridden for automatic semicolon insertion, but if it succeeds on semicolon or white space input it must
+   -- consume it.
+   lexicalSemicolon :: LexicalConstraint m g s => m g s Char
+   -- | Applies the argument parser and consumes the trailing 'lexicalWhitespace'
+   lexicalToken :: LexicalConstraint m g s => m g s a -> m g s a
+   -- | Applies the argument parser, determines whether its result is a legal identifier, and consumes the trailing
+   -- 'lexicalWhitespace'
+   identifierToken :: LexicalConstraint m g s => m g s s -> m g s s
+   -- | Determines whether the given character can start an identifier token, allows only a letter or underscore by
+   -- default
+   isIdentifierStartChar :: Char -> Bool
+   -- | Determines whether the given character can be any part of an identifier token, also allows numbers
+   isIdentifierFollowChar :: Char -> Bool
+   -- | Parses a valid identifier and consumes the trailing 'lexicalWhitespace'
+   identifier :: LexicalConstraint m g s => m g s s
+   -- | Parses the argument word whole, not followed by any identifier character, and consumes the trailing
+   -- 'lexicalWhitespace'
+   keyword :: LexicalConstraint m g s => s -> m g s ()
+
+   type instance LexicalConstraint m g s = (Applicative (m g ()), Monad (m g s),
+                                            CharParsing (m g s), MonoidParsing (m g),
+                                            Show s, TextualMonoid s)
+   default lexicalComment :: Alternative (m g s) => m g s ()
+   default lexicalWhiteSpace :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), TextualMonoid s)
+                             => m g s ()
+   default someLexicalSpace :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), TextualMonoid s)
+                            => m g s ()
+   default lexicalSemicolon :: (LexicalConstraint m g s, CharParsing (m g s), MonoidParsing (m g), TextualMonoid s)
+                            => m g s Char
+   default lexicalToken :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), TextualMonoid s)
+                        => m g s a -> m g s a
+   default identifierToken :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), TextualMonoid s)
+                           => m g s s -> m g s s
+   default identifier :: (LexicalConstraint m g s, Monad (m g s), Alternative (m g s),
+                          MonoidParsing (m g), TextualMonoid s) => m g s s
+   default keyword :: (LexicalConstraint m g s, Parsing (m g s), MonoidParsing (m g), Show s, TextualMonoid s)
+                   => s -> m g s ()
+   lexicalWhiteSpace = takeCharsWhile isSpace *> skipMany (lexicalComment *> takeCharsWhile isSpace)
+   someLexicalSpace = takeCharsWhile1 isSpace *> skipMany (lexicalComment *> takeCharsWhile isSpace)
+                      <|> lexicalComment *> skipMany (takeCharsWhile isSpace *> lexicalComment)
+   lexicalComment = empty
+   lexicalSemicolon = lexicalToken (char ';')
+   lexicalToken p = p <* lexicalWhiteSpace
+   isIdentifierStartChar c = isLetter c || c == '_'
+   isIdentifierFollowChar c = isAlphaNum c || c == '_'
+   identifier = identifierToken (liftA2 (<>) (satisfyCharInput (isIdentifierStartChar @g))
+                                             (takeCharsWhile (isIdentifierFollowChar @g)))
+   identifierToken = lexicalToken
+   keyword s = lexicalToken (string s *> notSatisfyChar (isIdentifierFollowChar @g))
diff --git a/src/Text/Grampa/ContextFree/Continued.hs b/src/Text/Grampa/ContextFree/Continued.hs
--- a/src/Text/Grampa/ContextFree/Continued.hs
+++ b/src/Text/Grampa/ContextFree/Continued.hs
@@ -1,15 +1,15 @@
-{-# LANGUAGE InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies #-}
+{-# LANGUAGE InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 -- | Continuation-passing parser for context-free grammars
 module Text.Grampa.ContextFree.Continued (Parser(..), Result(..), alt) where
 
 import Control.Applicative (Applicative(..), Alternative(..), liftA2)
 import Control.Monad (Monad(..), MonadPlus(..))
 
-import Data.Char (isSpace)
 import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
 import Data.List (nub)
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
 import Data.Monoid.Factorial(FactorialMonoid)
 import Data.Monoid.Textual(TextualMonoid)
 import Data.String (fromString)
@@ -25,8 +25,9 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
-import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
+import Text.Grampa.Class (Lexical(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
 import Text.Grampa.Internal (FailureInfo(..))
 
 data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,
@@ -81,6 +82,9 @@
    mzero = empty
    mplus = (<|>)
 
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
 instance Monoid x => Monoid (Parser g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -112,8 +116,10 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where
-   someSpace = () <$ takeCharsWhile1 isSpace
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
 instance MonoidParsing (Parser g) where
    endOfInput = Parser p
@@ -204,13 +210,12 @@
       p s' success failure
          | Just suffix <- Cancellative.stripPrefix s s' = success s suffix failure
          | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])
-   whiteSpace = () <$ takeCharsWhile isSpace
    concatMany :: forall s a. Monoid a => Parser g s a -> Parser g s a
    concatMany (Parser p) = Parser q
       where q :: forall x. s -> (a -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x
             q rest success failure = p rest success' (const $ success mempty rest failure)
                where success' prefix suffix failure' =
-                        q suffix (success . (prefix <>)) (const $ success prefix suffix failure')
+                        q suffix (success . mappend prefix) (const $ success prefix suffix failure')
    {-# INLINABLE string #-}
 
 -- | Continuation-passing context-free parser
diff --git a/src/Text/Grampa/ContextFree/Continued/Measured.hs b/src/Text/Grampa/ContextFree/Continued/Measured.hs
--- a/src/Text/Grampa/ContextFree/Continued/Measured.hs
+++ b/src/Text/Grampa/ContextFree/Continued/Measured.hs
@@ -1,15 +1,15 @@
-{-# LANGUAGE BangPatterns, InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies #-}
+{-# LANGUAGE BangPatterns, InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 -- | Continuation-passing parser for context-free grammars that keeps track of the parsed prefix length
 module Text.Grampa.ContextFree.Continued.Measured (Parser(..), Result(..), alt) where
 
 import Control.Applicative (Applicative(..), Alternative(..), liftA2)
 import Control.Monad (Monad(..), MonadPlus(..))
 
-import Data.Char (isSpace)
 import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
 import Data.List (nub)
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
 import Data.Monoid.Factorial(FactorialMonoid)
 import Data.Monoid.Textual(TextualMonoid)
 import Data.String (fromString)
@@ -25,8 +25,9 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
-import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
+import Text.Grampa.Class (Lexical(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
 import Text.Grampa.Internal (FailureInfo(..))
 
 data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,
@@ -83,6 +84,9 @@
    mzero = empty
    mplus = (<|>)
 
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
 instance Monoid x => Monoid (Parser g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -115,8 +119,10 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where
-   someSpace = () <$ takeCharsWhile1 isSpace
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
 instance MonoidParsing (Parser g) where
    endOfInput = Parser p
@@ -216,14 +222,13 @@
       p s' success failure
          | Just suffix <- Cancellative.stripPrefix s s', !len <- Factorial.length s = success s len suffix failure
          | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])
-   whiteSpace = () <$ takeCharsWhile isSpace
    concatMany :: forall s a. Monoid a => Parser g s a -> Parser g s a
    concatMany (Parser p) = Parser q
       where q :: forall x. s -> (a -> Int -> s -> (FailureInfo -> x) -> x) -> (FailureInfo -> x) -> x
             q rest success failure = p rest success' (const $ success mempty 0 rest failure)
                where success' prefix !len suffix failure' =
                         q suffix 
-                          (\prefix' !len'-> success (prefix <> prefix') (len + len')) 
+                          (\prefix' !len'-> success (mappend prefix prefix') (len + len')) 
                           (const $ success prefix len suffix failure')
    {-# INLINABLE string #-}
 
diff --git a/src/Text/Grampa/ContextFree/LeftRecursive.hs b/src/Text/Grampa/ContextFree/LeftRecursive.hs
--- a/src/Text/Grampa/ContextFree/LeftRecursive.hs
+++ b/src/Text/Grampa/ContextFree/LeftRecursive.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, InstanceSigs,
-             RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, UndecidableInstances #-}
+             RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS -fno-full-laziness #-}
-module Text.Grampa.ContextFree.LeftRecursive (Fixed, Parser, SeparatedParser(..), longest, peg, terminalPEG, 
+module Text.Grampa.ContextFree.LeftRecursive (Fixed, Parser, SeparatedParser(..),
+                                              longest, peg, terminalPEG,
                                               parseSeparated, separated, (<<|>))
 where
 
@@ -9,11 +10,12 @@
 import Control.Monad (Monad(..), MonadPlus(..))
 import Control.Monad.Trans.State.Lazy (State, evalState, get, put)
 
-import Data.Char (isSpace)
 import Data.Functor.Compose (Compose(..))
+import Data.List.NonEmpty (NonEmpty((:|)))
 import Data.Maybe (isJust)
 
-import Data.Monoid (Monoid(mempty), All(..), Any(..), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mempty), All(..), Any(..))
 import Data.Monoid.Null (MonoidNull(null))
 import Data.Monoid.Factorial (FactorialMonoid)
 import Data.Monoid.Textual (TextualMonoid)
@@ -25,22 +27,26 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token as Token
 
 import qualified Rank2
-import Text.Grampa.Class (GrammarParsing(..), MonoidParsing(..), MultiParsing(..), ParseResults)
-import Text.Grampa.Internal (BinTree(EmptyTree))
-import Text.Grampa.ContextFree.Memoizing (ResultList(..), fromResultList)
-import qualified Text.Grampa.ContextFree.Memoizing as Memoizing
+import Text.Grampa.Class (GrammarParsing(..), MonoidParsing(..), MultiParsing(..), AmbiguousParsing(..),
+                          Lexical(..), Ambiguous(..), ParseResults)
+import Text.Grampa.Internal (ResultList(..), ResultsOfLength(..), fromResultList)
+import qualified Text.Grampa.ContextFree.SortedMemoizing as Memoizing
 import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack
 
 import Prelude hiding (cycle, null, span, takeWhile)
 
 type Parser = Fixed Memoizing.Parser
 
+type ResultAppend g s = ResultList g s Rank2.~> ResultList g s Rank2.~> ResultList g s
+
 data Fixed p g s a =
    Parser {
       complete, direct, direct0, direct1, indirect :: p g s a,
+      appendResults :: ResultList g s a -> ResultList g s a -> ResultList g s a,
       cyclicDescendants :: Rank2.Apply g => g (Const (ParserFlags g)) -> ParserFlags g}
    | DirectParser {
       complete, direct0, direct1 :: p g s a}
@@ -51,6 +57,7 @@
                              | CycleParser {
                                   cycleParser  :: p g s a,
                                   backParser   :: p g s a,
+                                  appendResultsArrow :: ResultAppend g s a,
                                   dependencies :: g (Const Bool)}
                              | BackParser {
                                   backParser :: p g s a}
@@ -69,6 +76,9 @@
 --instance Rank2.Applicative g => Monoid (Union g) where
 --   mempty = Union (Rank2.pure $ Const False)
 
+instance (Rank2.Apply g, Rank2.Distributive g) => Semigroup (Union g) where
+   Union g1 <> Union g2 = Union (Rank2.liftA2 union g1 g2)
+
 instance (Rank2.Apply g, Rank2.Distributive g) => Monoid (Union g) where
    mempty = Union (Rank2.cotraverse (Const . getConst) (Const False))
    mappend (Union g1) (Union g2) = Union (Rank2.liftA2 union g1 g2)
@@ -81,6 +91,7 @@
    direct0= direct0 p',
    direct1= direct1 p',
    indirect= indirect p',
+   appendResults= appendResults p',
    cyclicDescendants= cyclicDescendants p'}
    where p' = general' p
 
@@ -90,6 +101,7 @@
    direct0= empty,
    direct1= complete p,
    indirect= empty,
+   appendResults= (<>),
    cyclicDescendants= \cd-> ParserFlags False (const (Const False) Rank2.<$> cd)}
 general' p@DirectParser{} = Parser{
    complete= complete p,
@@ -97,6 +109,7 @@
    direct0= direct0 p,
    direct1= direct1 p,
    indirect= empty,
+   appendResults= (<>),
    cyclicDescendants= \cd-> ParserFlags True (const (Const False) Rank2.<$> cd)}
 general' p@Parser{} = p
 
@@ -129,6 +142,7 @@
       direct0= empty,
       direct1= empty,
       indirect= ind,
+      appendResults= (<>),
       cyclicDescendants= parserFlags . f . Rank2.fmap (ParserFlagsFunctor . getConst) . addSelf}
       where ind = nonTerminal (parserResults . f . Rank2.fmap ParserResultsFunctor)
             addSelf g = Rank2.liftA2 adjust bits g
@@ -159,7 +173,8 @@
       direct= fmap f (direct p),
       direct0= fmap f (direct0 p),
       direct1= fmap f (direct1 p),
-      indirect= fmap f (indirect p)}
+      indirect= fmap f (indirect p),
+      appendResults= (<>)}
    {-# INLINABLE fmap #-}
 
 instance Alternative (p g s) => Applicative (Fixed p g s) where
@@ -180,6 +195,7 @@
       direct0= direct0 p' <*> direct0 q,
       direct1= direct0 p' <*> direct1 q <|> direct1 p' <*> complete q,
       indirect= direct0 p' <*> indirect q <|> indirect p' <*> complete q,
+      appendResults= (<>),
       cyclicDescendants= \deps-> let
            pcd@(ParserFlags pn pd) = cyclicDescendants p' deps
            ParserFlags qn qd = cyclicDescendants q deps
@@ -193,6 +209,7 @@
       direct0= direct0 p' <*> direct0 q',
       direct1= direct0 p' <*> direct1 q' <|> direct1 p' <*> complete q',
       indirect= indirect p' <*> complete q',
+      appendResults= (<>),
       cyclicDescendants= \deps-> let
            pcd@(ParserFlags pn pd) = cyclicDescendants p' deps
            ParserFlags qn qd = cyclicDescendants q' deps
@@ -224,6 +241,7 @@
                     direct0= direct0 p' <|> direct0 q',
                     direct1= direct1 p' <|> direct1 q',
                     indirect= indirect p' <|> indirect q',
+                    appendResults= (<>),
                     cyclicDescendants= \deps-> let
                          ParserFlags pn pd = cyclicDescendants p' deps
                          ParserFlags qn qd = cyclicDescendants q' deps
@@ -244,6 +262,7 @@
       direct0= d0,
       direct1= d1,
       indirect= (:) <$> indirect p <*> mcp,
+      appendResults= (<>),
       cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}
       where d0 = pure [] <|> (:[]) <$> direct0 p
             d1 = (:) <$> direct1 p <*> mcp
@@ -259,6 +278,7 @@
       direct0= d0,
       direct1= d1,
       indirect= (:) <$> indirect p <*> many (complete p),
+      appendResults= (<>),
       cyclicDescendants= cyclicDescendants p}
       where d0 = (:[]) <$> direct0 p
             d1= (:) <$> direct1 p <*> many (complete p)
@@ -281,6 +301,7 @@
                  direct0= direct0 p' Memoizing.<<|> direct0 q',
                  direct1= direct1 p' Memoizing.<<|> direct1 q',
                  indirect= indirect p' Memoizing.<<|> indirect q',
+                 appendResults= (<>),
                  cyclicDescendants= \deps-> let
                          ParserFlags pn pd = cyclicDescendants p' deps
                          ParserFlags qn qd = cyclicDescendants q' deps
@@ -302,6 +323,7 @@
       direct0= d0,
       direct1= d1,
       indirect= direct0 p >>= indirect . general' . cont,
+      appendResults= (<>),
       cyclicDescendants= \cd-> (ParserFlags True $ Rank2.fmap (const $ Const True) cd)}
       where d0 = direct0 p >>= direct0 . general' . cont
             d1 = (direct0 p >>= direct1 . general' . cont) <|> (direct1 p >>= complete . cont)
@@ -311,14 +333,23 @@
       direct0= d0,
       direct1= d1,
       indirect= (indirect p >>= complete . cont) <|> (direct0 p >>= indirect . general' . cont),
-      cyclicDescendants= \cd-> (ParserFlags True $ Rank2.fmap (const $ Const True) cd)}
+      appendResults= (<>),
+      cyclicDescendants= \cd->
+         let pcd@(ParserFlags pn _) = cyclicDescendants p' cd
+         in if pn
+            then ParserFlags True (Rank2.fmap (const $ Const True) cd)
+            else pcd}
       where d0 = direct0 p >>= direct0 . general' . cont
             d1 = (direct0 p >>= direct1 . general' . cont) <|> (direct1 p >>= complete . cont)
+            p'@Parser{} = general' p
 
 instance MonadPlus (p g s) => MonadPlus (Fixed p g s) where
    mzero = empty
    mplus = (<|>)
 
+instance (Alternative (p g s), Semigroup x) => Semigroup (Fixed p g s x) where
+   (<>) = liftA2 (<>)
+
 instance (Alternative (p g s), Monoid x) => Monoid (Fixed p g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -331,7 +362,7 @@
 positivePrimitive :: String -> p g s a -> Fixed p g s a
 positivePrimitive _name p = PositiveDirectParser{complete= p}
 
-instance (LookAheadParsing (p g s), MonoidParsing (Fixed p g)) => Parsing (Fixed p g s) where
+instance (Parsing (p g s), MonoidParsing (Fixed p g)) => Parsing (Fixed p g s) where
    eof = primitive "eof" eof empty eof
    try (PositiveDirectParser p) = PositiveDirectParser (try p)
    try p@DirectParser{} = DirectParser{
@@ -368,6 +399,7 @@
       direct= notFollowedBy (direct p),
       direct0= notFollowedBy (direct p),
       direct1= empty,
+      appendResults= (<>),
       indirect= notFollowedBy (indirect p),
       cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}
    unexpected msg = positivePrimitive "unexpected" (unexpected msg)
@@ -387,6 +419,7 @@
       direct= lookAhead (direct p),
       direct0= lookAhead (direct p),
       direct1= empty,
+      appendResults= appendResults p,
       indirect= lookAhead (indirect p),
       cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}
 
@@ -394,7 +427,6 @@
    endOfInput = primitive "endOfInput" endOfInput empty endOfInput
    getInput = primitive "getInput" (endOfInput *> getInput) (notFollowedBy endOfInput *> getInput) getInput
    anyToken = positivePrimitive "anyToken" anyToken
-   token x = positivePrimitive "token" (token x)
    satisfy predicate = positivePrimitive "satisfy" (satisfy predicate)
    satisfyChar predicate = positivePrimitive "satisfyChar" (satisfyChar predicate)
    satisfyCharInput predicate = positivePrimitive "satisfyCharInput" (satisfyCharInput predicate)
@@ -415,30 +447,30 @@
    takeCharsWhile predicate = primitive "takeCharsWhile" (mempty <$ notSatisfyChar predicate)
                                                          (takeCharsWhile1 predicate) (takeCharsWhile predicate)
    takeCharsWhile1 predicate = positivePrimitive "takeCharsWhile1" (takeCharsWhile1 predicate)
-   whiteSpace = primitive "whiteSpace" (notSatisfyChar isSpace) (satisfyChar isSpace *> whiteSpace) whiteSpace
    concatMany p@PositiveDirectParser{} = DirectParser{
       complete= cmp,
       direct0= d0,
       direct1= d1}
       where d0 = pure mempty
-            d1 = (<>) <$> complete p <*> cmp
+            d1 = mappend <$> complete p <*> cmp
             cmp = concatMany (complete p)
    concatMany p@DirectParser{} = DirectParser{
       complete= cmp,
       direct0= d0,
       direct1= d1}
       where d0 = pure mempty <|> direct0 p
-            d1 = (<>) <$> direct1 p <*> cmp
+            d1 = mappend <$> direct1 p <*> cmp
             cmp = concatMany (complete p)
    concatMany p@Parser{} = Parser{
       complete= cmp,
       direct= d0 <|> d1,
       direct0= d0,
       direct1= d1,
-      indirect= (<>) <$> indirect p <*> cmp,
+      indirect= mappend <$> indirect p <*> cmp,
+      appendResults= mappend,
       cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}
       where d0 = pure mempty <|> direct0 p
-            d1 = (<>) <$> direct1 p <*> cmp
+            d1 = mappend <$> direct1 p <*> cmp
             cmp = concatMany (complete p)
    {-# INLINABLE string #-}
 
@@ -446,7 +478,6 @@
    endOfInput = primitive "endOfInput" endOfInput empty endOfInput
    getInput = primitive "getInput" (endOfInput *> getInput) (notFollowedBy endOfInput *> getInput) getInput
    anyToken = positivePrimitive "anyToken" anyToken
-   token x = positivePrimitive "token" (token x)
    satisfy predicate = positivePrimitive "satisfy" (satisfy predicate)
    satisfyChar predicate = positivePrimitive "satisfyChar" (satisfyChar predicate)
    satisfyCharInput predicate = positivePrimitive "satisfyCharInput" (satisfyCharInput predicate)
@@ -467,35 +498,34 @@
    takeCharsWhile predicate = primitive "takeCharsWhile" (mempty <$ notSatisfyChar predicate)
                                                          (takeCharsWhile1 predicate) (takeCharsWhile predicate)
    takeCharsWhile1 predicate = positivePrimitive "takeCharsWhile1" (takeCharsWhile1 predicate)
-   whiteSpace = primitive "whiteSpace" (notSatisfyChar isSpace) (satisfyChar isSpace *> whiteSpace) whiteSpace
    concatMany p@PositiveDirectParser{} = DirectParser{
       complete= cmp,
       direct0= d0,
       direct1= d1}
       where d0 = pure mempty
-            d1 = (<>) <$> complete p <*> cmp
+            d1 = mappend <$> complete p <*> cmp
             cmp = concatMany (complete p)
    concatMany p@DirectParser{} = DirectParser{
       complete= cmp,
       direct0= d0,
       direct1= d1}
       where d0 = pure mempty `Backtrack.alt` direct0 p
-            d1 = (<>) <$> direct1 p <*> cmp
+            d1 = mappend <$> direct1 p <*> cmp
             cmp = concatMany (complete p)
    concatMany p@Parser{} = Parser{
       complete= cmp,
       direct= d0 `Backtrack.alt` d1,
       direct0= d0,
       direct1= d1,
-      indirect= (<>) <$> indirect p <*> cmp,
+      indirect= mappend <$> indirect p <*> cmp,
+      appendResults= mappend,
       cyclicDescendants= \deps-> (cyclicDescendants p deps){nullable= True}}
       where d0 = pure mempty `Backtrack.alt` direct0 p
-            d1 = (<>) <$> direct1 p <*> cmp
+            d1 = mappend <$> direct1 p <*> cmp
             cmp = concatMany (complete p)
    {-# INLINABLE string #-}
 
-instance (LookAheadParsing (p g s), MonoidParsing (Fixed p g), Show s, TextualMonoid s) =>
-         CharParsing (Fixed p g s) where
+instance (Parsing (p g s), MonoidParsing (Fixed p g), Show s, TextualMonoid s) => CharParsing (Fixed p g s) where
    satisfy = satisfyChar
    string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)
    char = satisfyChar . (==)
@@ -503,10 +533,41 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (LookAheadParsing (p g s), TokenParsing (p g s), MonoidParsing (Fixed p g), Show s, TextualMonoid s) => 
-         TokenParsing (Fixed p g s) where
-   someSpace = positivePrimitive "someSpace" someSpace
+instance (Lexical g, LexicalConstraint (Fixed Backtrack.Parser) g s, Show s, TextualMonoid s) =>
+         TokenParsing (Fixed Backtrack.Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
+instance (Lexical g, LexicalConstraint (Fixed Memoizing.Parser) g s, Show s, TextualMonoid s) =>
+         TokenParsing (Fixed Memoizing.Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
+
+instance AmbiguousParsing (Fixed Memoizing.Parser g s) where
+   ambiguous (PositiveDirectParser p) = PositiveDirectParser (ambiguous p)
+   ambiguous p@DirectParser{} = DirectParser{complete= ambiguous (complete p),
+                                             direct0=  ambiguous (direct0 p),
+                                             direct1=  ambiguous (direct1 p)}
+   ambiguous p@Parser{} = Parser{complete= ambiguous (complete p),
+                                 direct=   ambiguous (direct p),
+                                 direct0=  ambiguous (direct0 p),
+                                 direct1=  ambiguous (direct1 p),
+                                 indirect= ambiguous (indirect p),
+                                 appendResults= appendAmbiguous,
+                                 cyclicDescendants= cyclicDescendants p}
+      where appendAmbiguous (ResultList rl1 f1) (ResultList rl2 f2) = ResultList (join rl1 rl2) (f1 <> f2)
+            join [] rl = rl
+            join rl [] = rl
+            join rl1'@(rol1@(ResultsOfLength l1 s1 r1) : rest1) rl2'@(rol2@(ResultsOfLength l2 _ r2) : rest2)
+               | l1 < l2 = rol1 : join rest1 rl2'
+               | l1 > l2 = rol2 : join rl1' rest2
+               | Ambiguous ar1 :| [] <- r1,
+                 Ambiguous ar2 :| [] <- r2 =
+                    ResultsOfLength l1 s1 (Ambiguous (ar1 <> ar2) :| []) : join rest1 rest2
+               | otherwise = error "Ambiguous results should be grouped as a single value"
+
 -- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list
 -- of input tails, opposite of 'peg'
 longest :: Fixed Memoizing.Parser g s a -> Fixed Backtrack.Parser g [(s, g (ResultList g s))] a
@@ -519,6 +580,7 @@
                             direct0=  Memoizing.longest (direct0 p),
                             direct1=  Memoizing.longest (direct1 p),
                             indirect=  Memoizing.longest (indirect p),
+                            appendResults= (<>),
                             cyclicDescendants= cyclicDescendants p}
 
 -- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'
@@ -532,6 +594,7 @@
                         direct0=  Memoizing.peg (direct0 p),
                         direct1=  Memoizing.peg (direct1 p),
                         indirect=  Memoizing.peg (indirect p),
+                        appendResults= (<>),
                         cyclicDescendants= cyclicDescendants p}
 
 -- | Turns a backtracking PEG parser into a context-free parser
@@ -545,6 +608,7 @@
                                 direct0=  Memoizing.terminalPEG (direct0 p),
                                 direct1=  Memoizing.terminalPEG (direct1 p),
                                 indirect=  Memoizing.terminalPEG (indirect p),
+                                appendResults= (<>),
                                 cyclicDescendants= cyclicDescendants p}
 
 parseRecursive :: forall g s. (Rank2.Apply g, Rank2.Distributive g, Rank2.Traversable g, FactorialMonoid s) =>
@@ -562,7 +626,8 @@
          reseparate :: forall a. Const Bool a -> Const Bool a -> Const (g (Const Bool)) a -> Parser g s a
                     -> SeparatedParser Memoizing.Parser g s a
          reseparate (Const circular) (Const follower) (Const deps) p
-            | circular || leader && follower = CycleParser (indirect p) (direct p) deps
+            | circular || leader && follower =
+              CycleParser (indirect p) (direct p) (Rank2.Arrow (Rank2.Arrow . appendResults p)) deps
             | follower = BackParser (complete p)
             | otherwise = FrontParser (complete p)
             where leader = getAny (Rank2.foldMap (Any . getConst) $ Rank2.liftA2 intersection circulars deps)
@@ -621,27 +686,30 @@
          fixRecursive :: s -> [(s, g (ResultList g s))] -> g (ResultList g s) -> g (ResultList g s)
          whileAnyContinues :: g (ResultList g s) -> g (ResultList g s) -> g (ResultList g s)
          recurseOnce :: s -> [(s, g (ResultList g s))] -> g (ResultList g s) -> g (ResultList g s)
-         maybeDependencies :: g (Const (Maybe (g (Const Bool))))
+         maybeDependencies :: g (Rank2.Product (Const (Maybe (g (Const Bool)))) (ResultAppend g s))
+         maybeDependency :: SeparatedParser Memoizing.Parser g s r
+                         -> Rank2.Product (Const (Maybe (g (Const Bool)))) (ResultAppend g s) r
 
          directs = Rank2.fmap backParser parsers
          indirects = Rank2.fmap (\p-> case p of {CycleParser{}-> cycleParser p; _ -> empty}) parsers
-         maybeDependencies = Rank2.fmap (Const . maybeDependency) parsers
-         maybeDependency p@CycleParser{} = Just (dependencies p)
-         maybeDependency _ = Nothing
-                                                                   
+         maybeDependencies = Rank2.fmap maybeDependency parsers
+         maybeDependency p@CycleParser{} = Rank2.Pair (Const $ Just $ dependencies p) (appendResultsArrow p)
+         maybeDependency _ = Rank2.Pair (Const Nothing) (Rank2.Arrow (Rank2.Arrow . (<>)))
+
          fixRecursive s parsedTail initial =
             foldr1 whileAnyContinues (iterate (recurseOnce s parsedTail) initial)
 
          whileAnyContinues g1 g2 = Rank2.liftA3 choiceWhile maybeDependencies g1 g2
-            where choiceWhile :: Const (Maybe (g (Const Bool))) x -> ResultList g i x -> ResultList g i x 
-                                 -> ResultList g i x
-                  combine :: Const Bool x -> ResultList g i x -> Const Bool x
-                  choiceWhile (Const Nothing) r1 _ = r1
-                  choiceWhile (Const (Just deps)) r1 r2
-                     | getAny (Rank2.foldMap (Any . getConst) (Rank2.liftA2 combine deps g1)) = r1 <> r2
+            where choiceWhile :: Rank2.Product (Const (Maybe (g (Const Bool)))) (ResultAppend g s) x
+                              -> ResultList g s x -> ResultList g s x -> ResultList g s x
+                  combine :: Const Bool x -> ResultList g s x -> Const Bool x
+                  choiceWhile (Rank2.Pair (Const Nothing) _) r1 _ = r1
+                  choiceWhile (Rank2.Pair (Const (Just deps)) append) r1 r2
+                     | getAny (Rank2.foldMap (Any . getConst) (Rank2.liftA2 combine deps g1)) =
+                       append `Rank2.apply` r1 `Rank2.apply` r2
                      | otherwise = r1
                   combine (Const False) _ = Const False
-                  combine (Const True) (ResultList EmptyTree _) = Const False
+                  combine (Const True) (ResultList [] _) = Const False
                   combine (Const True) _ = Const True
 
          recurseOnce s parsedTail initial = Rank2.fmap (($ parsed) . Memoizing.applyParser) indirects
diff --git a/src/Text/Grampa/ContextFree/Memoizing.hs b/src/Text/Grampa/ContextFree/Memoizing.hs
--- a/src/Text/Grampa/ContextFree/Memoizing.hs
+++ b/src/Text/Grampa/ContextFree/Memoizing.hs
@@ -1,18 +1,18 @@
 {-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,
-             RankNTypes, ScopedTypeVariables, TypeFamilies #-}
+             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 module Text.Grampa.ContextFree.Memoizing (FailureInfo(..), ResultList(..), Parser(..), BinTree(..), (<<|>),
                                           fromResultList, reparseTails, longest, peg, terminalPEG)
 where
 
 import Control.Applicative
 import Control.Monad (Monad(..), MonadPlus(..))
-import Data.Char (isSpace)
 import Data.Function (on)
 import Data.Foldable (toList)
 import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
 import Data.List (genericLength, maximumBy, nub)
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
 import Data.Monoid.Cancellative (LeftReductiveMonoid (isPrefixOf))
 import Data.Monoid.Null (MonoidNull(null))
 import Data.Monoid.Factorial (FactorialMonoid(length, splitPrimePrefix))
@@ -25,11 +25,13 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
 
 import qualified Rank2
 
-import Text.Grampa.Class (GrammarParsing(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
+import Text.Grampa.Class (Lexical(..), GrammarParsing(..), MonoidParsing(..), MultiParsing(..), 
+                          ParseResults, ParseFailure(..))
 import Text.Grampa.Internal (BinTree(..), FailureInfo(..))
 import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack
 
@@ -58,9 +60,12 @@
 instance Functor (ResultList g s) where
    fmap f (ResultList l failure) = ResultList ((f <$>) <$> l) failure
 
+instance Semigroup (ResultList g s r) where
+   ResultList rl1 f1 <> ResultList rl2 f2 = ResultList (rl1 <> rl2) (f1 <> f2)
+
 instance Monoid (ResultList g s r) where
    mempty = ResultList mempty mempty
-   ResultList rl1 f1 `mappend` ResultList rl2 f2 = ResultList (rl1 <> rl2) (f1 <> f2)
+   mappend = (<>)
 
 instance Functor (Parser g i) where
    fmap f (Parser p) = Parser (fmap f . p)
@@ -103,6 +108,9 @@
    mzero = empty
    mplus = (<|>)
 
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
 instance Monoid x => Monoid (Parser g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -205,9 +213,8 @@
          | s `isPrefixOf` s' = ResultList (Leaf $ ResultInfo l (Factorial.drop l rest) s) mempty
       p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["string " ++ show s])
       l = Factorial.length s
-   whiteSpace = () <$ takeCharsWhile isSpace
    concatMany p = go
-      where go = mempty <|> (<>) <$> p <*> go
+      where go = mempty <|> mappend <$> p <*> go
    notSatisfy predicate = Parser p
       where p rest@((s, _):_)
                | Just (first, _) <- splitPrimePrefix s, 
@@ -250,8 +257,10 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where
-   someSpace = () <$ takeCharsWhile1 isSpace
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
 fromResultList :: FactorialMonoid s => s -> ResultList g s r -> ParseResults [(s, r)]
 fromResultList s (ResultList EmptyTree (FailureInfo _ pos msgs)) =
diff --git a/src/Text/Grampa/ContextFree/Parallel.hs b/src/Text/Grampa/ContextFree/Parallel.hs
--- a/src/Text/Grampa/ContextFree/Parallel.hs
+++ b/src/Text/Grampa/ContextFree/Parallel.hs
@@ -1,16 +1,16 @@
 {-# LANGUAGE FlexibleContexts, InstanceSigs, GeneralizedNewtypeDeriving,
-             RankNTypes, ScopedTypeVariables, TypeFamilies #-}
+             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 module Text.Grampa.ContextFree.Parallel (FailureInfo(..), ResultList(..), Parser, fromResultList)
 where
 
 import Control.Applicative
 import Control.Monad (Monad(..), MonadPlus(..))
-import Data.Char (isSpace)
 import Data.Foldable (toList)
 import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
 import Data.List (nub)
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
 import Data.Monoid.Null (MonoidNull(null))
 import Data.Monoid.Factorial (FactorialMonoid)
 import Data.Monoid.Textual (TextualMonoid)
@@ -24,11 +24,12 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
 
 import qualified Rank2
 
-import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
+import Text.Grampa.Class (Lexical(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
 import Text.Grampa.Internal (BinTree(..))
 
 import Prelude hiding (iterate, null, showList, span, takeWhile)
@@ -57,13 +58,15 @@
 instance Functor (ResultList s) where
    fmap f (ResultList l failure) = ResultList ((f <$>) <$> l) failure
 
+instance Semigroup (ResultList s r) where
+   ResultList rl1 f1 <> ResultList rl2 f2 = ResultList (rl1 <> rl2) (f1 <> f2)
+
 instance Monoid (ResultList s r) where
    mempty = ResultList mempty mempty
-   ResultList rl1 f1 `mappend` ResultList rl2 f2 = ResultList (rl1 <> rl2) (f1 <> f2)
+   mappend = (<>)
 
-instance Monoid FailureInfo where
-   mempty = FailureInfo 0 maxBound []
-   f1@(FailureInfo s1 pos1 exp1) `mappend` f2@(FailureInfo s2 pos2 exp2)
+instance Semigroup FailureInfo where
+   f1@(FailureInfo s1 pos1 exp1) <> f2@(FailureInfo s2 pos2 exp2)
       | s1 < s2 = f2
       | s1 > s2 = f1
       | otherwise = FailureInfo s1 pos' exp'
@@ -71,6 +74,10 @@
                          | pos1 > pos2 = (pos2, exp2)
                          | otherwise = (pos1, exp1 <> exp2)
 
+instance Monoid FailureInfo where
+   mempty = FailureInfo 0 maxBound []
+   mappend = (<>)
+
 instance Functor (Parser g s) where
    fmap f (Parser p) = Parser (fmap f . p)
 
@@ -98,6 +105,9 @@
    mzero = empty
    mplus = (<|>)
 
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
 instance Monoid x => Monoid (Parser g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -175,11 +185,10 @@
    string s = Parser p where
       p s' | Just suffix <- Cancellative.stripPrefix s s' = ResultList (Leaf $ ResultInfo suffix s) mempty
            | otherwise = ResultList mempty (FailureInfo 1 (Factorial.length s') ["string " ++ show s])
-   whiteSpace = () <$ takeCharsWhile isSpace
    concatMany (Parser p) = Parser q
       where q s = ResultList (Leaf $ ResultInfo s mempty) failure <> foldMap continue rs
                where ResultList rs failure = p s
-            continue (ResultInfo suffix prefix) = (prefix <>) <$> q suffix
+            continue (ResultInfo suffix prefix) = mappend prefix <$> q suffix
 
 instance FactorialMonoid s => Parsing (Parser g s) where
    try (Parser p) = Parser (weakenResults . p)
@@ -207,8 +216,10 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where
-   someSpace = () <$ takeCharsWhile1 isSpace
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
 fromResultList :: FactorialMonoid s => s -> ResultList s r -> ParseResults [(s, r)]
 fromResultList s (ResultList EmptyTree (FailureInfo _ pos msgs)) = 
diff --git a/src/Text/Grampa/ContextFree/SortedMemoizing.hs b/src/Text/Grampa/ContextFree/SortedMemoizing.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Grampa/ContextFree/SortedMemoizing.hs
@@ -0,0 +1,271 @@
+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,
+             RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
+module Text.Grampa.ContextFree.SortedMemoizing 
+       (FailureInfo(..), ResultList(..), Parser(..), (<<|>),
+        reparseTails, longest, peg, terminalPEG)
+where
+
+import Control.Applicative
+import Control.Monad (Monad(..), MonadPlus(..))
+import Data.Functor.Compose (Compose(..))
+import Data.List (genericLength)
+import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
+import Data.Monoid.Cancellative (LeftReductiveMonoid (isPrefixOf))
+import Data.Monoid.Null (MonoidNull(null))
+import Data.Monoid.Factorial (FactorialMonoid(length, splitPrimePrefix))
+import Data.Monoid.Textual (TextualMonoid)
+import qualified Data.Monoid.Factorial as Factorial
+import qualified Data.Monoid.Textual as Textual
+import Data.Semigroup (Semigroup((<>)))
+import Data.String (fromString)
+
+import qualified Text.Parser.Char
+import Text.Parser.Char (CharParsing)
+import Text.Parser.Combinators (Parsing(..))
+import Text.Parser.LookAhead (LookAheadParsing(..))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
+
+import qualified Rank2
+
+import Text.Grampa.Class (Lexical(..), GrammarParsing(..), MonoidParsing(..), MultiParsing(..), AmbiguousParsing(..),
+                          Ambiguous(Ambiguous), ParseResults)
+import Text.Grampa.Internal (FailureInfo(..), ResultList(..), ResultsOfLength(..), fromResultList)
+import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack
+
+import Prelude hiding (iterate, length, null, showList, span, takeWhile)
+
+-- | Parser for a context-free grammar with packrat-like sharing of parse results. It does not support left-recursive
+-- grammars.
+newtype Parser g s r = Parser{applyParser :: [(s, g (ResultList g s))] -> ResultList g s r}
+
+instance Functor (Parser g i) where
+   fmap f (Parser p) = Parser (fmap f . p)
+   {-# INLINABLE fmap #-}
+
+instance Applicative (Parser g i) where
+   pure a = Parser (\rest-> ResultList [ResultsOfLength 0 rest (a:|[])] mempty)
+   Parser p <*> Parser q = Parser r where
+      r rest = case p rest
+               of ResultList results failure -> ResultList mempty failure <> foldMap continue results
+      continue (ResultsOfLength l rest' fs) = foldMap (continue' l $ q rest') fs
+      continue' l (ResultList rs failure) f = ResultList (adjust l f <$> rs) failure
+      adjust l f (ResultsOfLength l' rest' as) = ResultsOfLength (l+l') rest' (f <$> as)
+   {-# INLINABLE pure #-}
+   {-# INLINABLE (<*>) #-}
+
+instance Alternative (Parser g i) where
+   empty = Parser (\rest-> ResultList mempty $ FailureInfo 0 (genericLength rest) ["empty"])
+   Parser p <|> Parser q = Parser r where
+      r rest = p rest <> q rest
+   {-# INLINABLE (<|>) #-}
+
+infixl 3 <<|>
+(<<|>) :: Parser g s a -> Parser g s a -> Parser g s a
+Parser p <<|> Parser q = Parser r where
+   r rest = case p rest
+            of rl@(ResultList [] _failure) -> rl <> q rest
+               rl -> rl
+
+instance Monad (Parser g i) where
+   return = pure
+   (>>) = (*>)
+   Parser p >>= f = Parser q where
+      q rest = case p rest
+               of ResultList results failure -> ResultList mempty failure <> foldMap continue results
+      continue (ResultsOfLength l rest' rs) = foldMap (continue' l . flip applyParser rest' . f) rs
+      continue' l (ResultList rs failure) = ResultList (adjust l <$> rs) failure
+      adjust l (ResultsOfLength l' rest' rs) = ResultsOfLength (l+l') rest' rs
+
+instance MonadPlus (Parser g s) where
+   mzero = empty
+   mplus = (<|>)
+
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
+instance Monoid x => Monoid (Parser g s x) where
+   mempty = pure mempty
+   mappend = liftA2 mappend
+
+instance GrammarParsing Parser where
+   type GrammarFunctor Parser = ResultList
+   nonTerminal f = Parser p where
+      p ((_, d) : _) = f d
+      p _ = ResultList mempty (FailureInfo 1 0 ["NonTerminal at endOfInput"])
+   {-# INLINE nonTerminal #-}
+
+-- | Memoizing parser guarantees O(n²) performance for grammars with unambiguous productions, but provides no left
+-- recursion support.
+--
+-- @
+-- 'parseComplete' :: ("Rank2".'Rank2.Functor' g, 'FactorialMonoid' s) =>
+--                  g (Memoizing.'Parser' g s) -> s -> g ('Compose' 'ParseResults' [])
+-- @
+instance MultiParsing Parser where
+   type ResultFunctor Parser = Compose ParseResults []
+   -- | Returns the list of all possible input prefix parses paired with the remaining input suffix.
+   parsePrefix g input = Rank2.fmap (Compose . Compose . fromResultList input) (snd $ head $ parseTails g input)
+   parseComplete :: forall g s. (Rank2.Functor g, FactorialMonoid s) =>
+                    g (Parser g s) -> s -> g (Compose ParseResults [])
+   parseComplete g input = Rank2.fmap ((snd <$>) . Compose . fromResultList input)
+                              (snd $ head $ reparseTails close $ parseTails g input)
+      where close = Rank2.fmap (<* endOfInput) g
+
+parseTails :: (Rank2.Functor g, FactorialMonoid s) => g (Parser g s) -> s -> [(s, g (ResultList g s))]
+parseTails g input = foldr parseTail [] (Factorial.tails input)
+   where parseTail s parsedTail = parsed
+            where parsed = (s,d):parsedTail
+                  d      = Rank2.fmap (($ parsed) . applyParser) g
+
+reparseTails :: Rank2.Functor g => g (Parser g s) -> [(s, g (ResultList g s))] -> [(s, g (ResultList g s))]
+reparseTails _ [] = []
+reparseTails final parsed@((s, _):_) = (s, gd):parsed
+   where gd = Rank2.fmap (`applyParser` parsed) final
+
+instance MonoidParsing (Parser g) where
+   endOfInput = eof
+   getInput = Parser p
+      where p rest@((s, _):_) = ResultList [ResultsOfLength (length rest) [last rest] (s:|[])] mempty
+            p [] = ResultList [ResultsOfLength 0 [] (mempty:|[])] mempty
+   anyToken = Parser p
+      where p rest@((s, _):t) = case splitPrimePrefix s
+                                of Just (first, _) -> ResultList [ResultsOfLength 1 t (first:|[])] mempty
+                                   _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["anyToken"])
+            p [] = ResultList mempty (FailureInfo 1 0 ["anyToken"])
+   satisfy predicate = Parser p
+      where p rest@((s, _):t) =
+               case splitPrimePrefix s
+               of Just (first, _) | predicate first -> ResultList [ResultsOfLength 1 t (first:|[])] mempty
+                  _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["satisfy"])
+            p [] = ResultList mempty (FailureInfo 1 0 ["satisfy"])
+   satisfyChar predicate = Parser p
+      where p rest@((s, _):t) =
+               case Textual.characterPrefix s
+               of Just first | predicate first -> ResultList [ResultsOfLength 1 t (first:|[])] mempty
+                  _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["satisfyChar"])
+            p [] = ResultList mempty (FailureInfo 1 0 ["satisfyChar"])
+   satisfyCharInput predicate = Parser p
+      where p rest@((s, _):t) =
+               case Textual.characterPrefix s
+               of Just first | predicate first -> ResultList [ResultsOfLength 1 t (Factorial.primePrefix s:|[])] mempty
+                  _ -> ResultList mempty (FailureInfo 1 (genericLength rest) ["satisfyCharInput"])
+            p [] = ResultList mempty (FailureInfo 1 0 ["satisfyCharInput"])
+   scan s0 f = Parser (p s0)
+      where p s rest@((i, _) : _) = ResultList [ResultsOfLength l (drop l rest) (prefix:|[])] mempty
+               where (prefix, _, _) = Factorial.spanMaybe' s f i
+                     l = Factorial.length prefix
+            p _ [] = ResultList [ResultsOfLength 0 [] (mempty:|[])] mempty
+   scanChars s0 f = Parser (p s0)
+      where p s rest@((i, _) : _) = ResultList [ResultsOfLength l (drop l rest) (prefix:|[])] mempty
+               where (prefix, _, _) = Textual.spanMaybe_' s f i
+                     l = Factorial.length prefix
+            p _ [] = ResultList [ResultsOfLength 0 [] (mempty:|[])] mempty
+   takeWhile predicate = Parser p
+      where p rest@((s, _) : _)
+               | x <- Factorial.takeWhile predicate s, l <- Factorial.length x =
+                    ResultList [ResultsOfLength l (drop l rest) (x:|[])] mempty
+            p [] = ResultList [ResultsOfLength 0 [] (mempty:|[])] mempty
+   takeWhile1 predicate = Parser p
+      where p rest@((s, _) : _)
+               | x <- Factorial.takeWhile predicate s, l <- Factorial.length x, l > 0 =
+                    ResultList [ResultsOfLength l (drop l rest) (x:|[])] mempty
+            p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["takeWhile1"])
+   takeCharsWhile predicate = Parser p
+      where p rest@((s, _) : _)
+               | x <- Textual.takeWhile_ False predicate s, l <- Factorial.length x =
+                    ResultList [ResultsOfLength l (drop l rest) (x:|[])] mempty
+            p [] = ResultList [ResultsOfLength 0 [] (mempty:|[])] mempty
+   takeCharsWhile1 predicate = Parser p
+      where p rest@((s, _) : _)
+               | x <- Textual.takeWhile_ False predicate s, l <- Factorial.length x, l > 0 =
+                    ResultList [ResultsOfLength l (drop l rest) (x:|[])] mempty
+            p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["takeCharsWhile1"])
+   string s = Parser p where
+      p rest@((s', _) : _)
+         | s `isPrefixOf` s' = ResultList [ResultsOfLength l (Factorial.drop l rest) (s:|[])] mempty
+      p rest = ResultList mempty (FailureInfo 1 (genericLength rest) ["string " ++ show s])
+      l = Factorial.length s
+   concatMany p = go
+      where go = mempty <|> mappend <$> p <*> go
+   notSatisfy predicate = Parser p
+      where p rest@((s, _):_)
+               | Just (first, _) <- splitPrimePrefix s, 
+                 predicate first = ResultList mempty (FailureInfo 1 (genericLength rest) ["notSatisfy"])
+            p rest = ResultList [ResultsOfLength 0 rest (():|[])] mempty
+   notSatisfyChar predicate = Parser p
+      where p rest@((s, _):_)
+               | Just first <- Textual.characterPrefix s, 
+                 predicate first = ResultList mempty (FailureInfo 1 (genericLength rest) ["notSatisfyChar"])
+            p rest = ResultList [ResultsOfLength 0 rest (():|[])] mempty
+   {-# INLINABLE string #-}
+
+instance MonoidNull s => Parsing (Parser g s) where
+   try (Parser p) = Parser (weakenResults . p)
+      where weakenResults (ResultList rl (FailureInfo s pos msgs)) = ResultList rl (FailureInfo (pred s) pos msgs)
+   Parser p <?> msg  = Parser (strengthenResults . p)
+      where strengthenResults (ResultList rl (FailureInfo s pos _msgs)) = ResultList rl (FailureInfo (succ s) pos [msg])
+   notFollowedBy (Parser p) = Parser (\input-> rewind input (p input))
+      where rewind t (ResultList [] _) = ResultList [ResultsOfLength 0 t (():|[])] mempty
+            rewind t ResultList{} = ResultList mempty (FailureInfo 1 (genericLength t) ["notFollowedBy"])
+   skipMany p = go
+      where go = pure () <|> p *> go
+   unexpected msg = Parser (\t-> ResultList mempty $ FailureInfo 0 (genericLength t) [msg])
+   eof = Parser f
+      where f rest@((s, _):_)
+               | null s = ResultList [ResultsOfLength 0 rest (():|[])] mempty
+               | otherwise = ResultList mempty (FailureInfo 1 (genericLength rest) ["endOfInput"])
+            f [] = ResultList [ResultsOfLength 0 [] (():|[])] mempty
+
+instance MonoidNull s => LookAheadParsing (Parser g s) where
+   lookAhead (Parser p) = Parser (\input-> rewind input (p input))
+      where rewind _ rl@(ResultList [] _) = rl
+            rewind t (ResultList rl failure) = ResultList [ResultsOfLength 0 t $ foldr1 (<>) (results <$> rl)] failure
+            results (ResultsOfLength _ _ r) = r
+
+instance (Show s, TextualMonoid s) => CharParsing (Parser g s) where
+   satisfy = satisfyChar
+   string s = Textual.toString (error "unexpected non-character") <$> string (fromString s)
+   char = satisfyChar . (==)
+   notChar = satisfyChar . (/=)
+   anyChar = satisfyChar (const True)
+   text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
+
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
+
+instance AmbiguousParsing (Parser g s) where
+   ambiguous (Parser p) = Parser q
+      where q rest | ResultList rs failure <- p rest = ResultList (groupByLength <$> rs) failure
+            groupByLength (ResultsOfLength l rest rs) = ResultsOfLength l rest (Ambiguous rs :| [])
+
+-- | Turns a context-free parser into a backtracking PEG parser that consumes the longest possible prefix of the list
+-- of input tails, opposite of 'peg'
+longest :: Parser g s a -> Backtrack.Parser g [(s, g (ResultList g s))] a
+longest p = Backtrack.Parser q where
+   q rest = case applyParser p rest
+            of ResultList [] failure -> Backtrack.NoParse failure
+               ResultList rs _ -> parsed (last rs)
+   parsed (ResultsOfLength l s (r:|_)) = Backtrack.Parsed l r s
+
+-- | Turns a backtracking PEG parser of the list of input tails into a context-free parser, opposite of 'longest'
+peg :: Backtrack.Parser g [(s, g (ResultList g s))] a -> Parser g s a
+peg p = Parser q where
+   q rest = case Backtrack.applyParser p rest
+            of Backtrack.Parsed l result suffix -> ResultList [ResultsOfLength l suffix (result:|[])] mempty
+               Backtrack.NoParse failure -> ResultList mempty failure
+
+-- | Turns a backtracking PEG parser into a context-free parser
+terminalPEG :: Monoid s => Backtrack.Parser g s a -> Parser g s a
+terminalPEG p = Parser q where
+   q [] = case Backtrack.applyParser p mempty
+            of Backtrack.Parsed l result _ -> ResultList [ResultsOfLength l [] (result:|[])] mempty
+               Backtrack.NoParse failure -> ResultList mempty failure
+   q rest@((s, _):_) = case Backtrack.applyParser p s
+                       of Backtrack.Parsed l result _ -> 
+                             ResultList [ResultsOfLength l (drop l rest) (result:|[])] mempty
+                          Backtrack.NoParse failure -> ResultList mempty failure
diff --git a/src/Text/Grampa/Internal.hs b/src/Text/Grampa/Internal.hs
--- a/src/Text/Grampa/Internal.hs
+++ b/src/Text/Grampa/Internal.hs
@@ -1,18 +1,39 @@
-module Text.Grampa.Internal (BinTree(..), FailureInfo(..)) where
+module Text.Grampa.Internal (BinTree(..), FailureInfo(..), ResultList(..), ResultsOfLength(..), fromResultList) where
 
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Foldable (toList)
+import Data.Functor.Classes (Show1(..))
+import Data.List.NonEmpty (NonEmpty)
+import Data.List (nub)
+import Data.Monoid (Monoid(mappend, mempty))
+import Data.Semigroup (Semigroup((<>)))
 import Data.Word (Word64)
 
+import Data.Monoid.Factorial (FactorialMonoid(length))
+
+import Text.Grampa.Class (ParseFailure(..), ParseResults)
+
+import Prelude hiding (length, showList)
+
 data FailureInfo = FailureInfo !Int Word64 [String] deriving (Eq, Show)
 
+data ResultsOfLength g s r = ResultsOfLength !Int ![(s, g (ResultList g s))] !(NonEmpty r)
+
+data ResultList g s r = ResultList ![ResultsOfLength g s r] !FailureInfo
+
 data BinTree a = Fork !(BinTree a) !(BinTree a)
                | Leaf !a
                | EmptyTree
                deriving (Show)
 
-instance Monoid FailureInfo where
-   mempty = FailureInfo 0 maxBound []
-   f1@(FailureInfo s1 pos1 exp1) `mappend` f2@(FailureInfo s2 pos2 exp2)
+fromResultList :: FactorialMonoid s => s -> ResultList g s r -> ParseResults [(s, r)]
+fromResultList s (ResultList [] (FailureInfo _ pos msgs)) =
+   Left (ParseFailure (length s - fromIntegral pos + 1) (nub msgs))
+fromResultList _ (ResultList rl _failure) = Right (foldMap f rl)
+   where f (ResultsOfLength _ ((s, _):_) r) = (,) s <$> toList r
+         f (ResultsOfLength _ [] r) = (,) mempty <$> toList r
+
+instance Semigroup FailureInfo where
+   f1@(FailureInfo s1 pos1 exp1) <> f2@(FailureInfo s2 pos2 exp2)
       | s1 < s2 = f2
       | s1 > s2 = f1
       | otherwise = FailureInfo s1 pos' exp'
@@ -20,18 +41,55 @@
                          | pos1 > pos2 = (pos2, exp2)
                          | otherwise = (pos1, exp1 <> exp2)
 
+instance Monoid FailureInfo where
+   mempty = FailureInfo 0 maxBound []
+   mappend = (<>)
+
+instance Show r => Show (ResultList g s r) where
+   show (ResultList l f) = "ResultList (" ++ shows l (") (" ++ shows f ")")
+
+instance Show1 (ResultList g s) where
+   liftShowsPrec _sp showList _prec (ResultList rol f) rest = 
+      "ResultList " ++ shows (simplify <$> toList rol) (shows f rest)
+      where simplify (ResultsOfLength l _ r) = "ResultsOfLength " <> show l <> " _ " <> showList (toList r) ""
+
+instance Show r => Show (ResultsOfLength g s r) where
+   show (ResultsOfLength l _ r) = "(ResultsOfLength @" ++ show l ++ " " ++ shows r ")"
+
+instance Functor (ResultsOfLength g s) where
+   fmap f (ResultsOfLength l t r) = ResultsOfLength l t (f <$> r)
+
+instance Functor (ResultList g s) where
+   fmap f (ResultList l failure) = ResultList ((f <$>) <$> l) failure
+
+instance Semigroup (ResultList g s r) where
+   ResultList rl1 f1 <> ResultList rl2 f2 = ResultList (join rl1 rl2) (f1 <> f2)
+      where join [] rl = rl
+            join rl [] = rl
+            join rl1'@(rol1@(ResultsOfLength l1 s1 r1) : rest1) rl2'@(rol2@(ResultsOfLength l2 _ r2) : rest2)
+               | l1 < l2 = rol1 : join rest1 rl2'
+               | l1 > l2 = rol2 : join rl1' rest2
+               | otherwise = ResultsOfLength l1 s1 (r1 <> r2) : join rest1 rest2
+
+instance Monoid (ResultList g s r) where
+   mempty = ResultList mempty mempty
+   mappend = (<>)
+
 instance Functor BinTree where
    fmap f (Fork left right) = Fork (fmap f left) (fmap f right)
    fmap f (Leaf a) = Leaf (f a)
    fmap _ EmptyTree = EmptyTree
 
 instance Foldable BinTree where
-   foldMap f (Fork left right) = foldMap f left <> foldMap f right
+   foldMap f (Fork left right) = foldMap f left `mappend` foldMap f right
    foldMap f (Leaf a) = f a
    foldMap _ EmptyTree = mempty
 
+instance Semigroup (BinTree a) where
+   EmptyTree <> t = t
+   t <> EmptyTree = t
+   l <> r = Fork l r
+
 instance Monoid (BinTree a) where
    mempty = EmptyTree
-   mappend EmptyTree t = t
-   mappend t EmptyTree = t
-   mappend l r = Fork l r
+   mappend = (<>)
diff --git a/src/Text/Grampa/PEG/Backtrack.hs b/src/Text/Grampa/PEG/Backtrack.hs
--- a/src/Text/Grampa/PEG/Backtrack.hs
+++ b/src/Text/Grampa/PEG/Backtrack.hs
@@ -1,16 +1,17 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
 -- | Backtracking parser for Parsing Expression Grammars
 module Text.Grampa.PEG.Backtrack (Parser(..), Result(..), alt) where
 
 import Control.Applicative (Applicative(..), Alternative(..), liftA2)
 import Control.Monad (Monad(..), MonadPlus(..))
 
-import Data.Char (isSpace)
 import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
 import Data.List (nub)
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
 import Data.Monoid.Factorial(FactorialMonoid)
+import Data.Monoid.Textual(TextualMonoid)
 import Data.String (fromString)
 
 import qualified Data.Monoid.Cancellative as Cancellative
@@ -24,8 +25,9 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
-import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
+import Text.Grampa.Class (Lexical(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
 import Text.Grampa.Internal (FailureInfo(..))
 
 data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,
@@ -78,6 +80,9 @@
    mzero = empty
    mplus = (<|>)
 
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
 instance Monoid x => Monoid (Parser g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -104,8 +109,10 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (Show s, Textual.TextualMonoid s) => TokenParsing (Parser g s) where
-   someSpace = () <$ takeCharsWhile1 isSpace
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
 instance MonoidParsing (Parser g) where
    endOfInput = Parser p
@@ -166,11 +173,10 @@
    string s = Parser p where
       p s' | Just suffix <- Cancellative.stripPrefix s s' = Parsed s suffix
            | otherwise = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])
-   whiteSpace = () <$ takeCharsWhile isSpace
    concatMany (Parser p) = Parser q
       where q rest = case p rest
                      of Parsed prefix suffix -> let Parsed prefix' suffix' = q suffix
-                                                in Parsed (prefix <> prefix') suffix'
+                                                in Parsed (mappend prefix prefix') suffix'
                         NoParse{} -> Parsed mempty rest
    {-# INLINABLE string #-}
 
diff --git a/src/Text/Grampa/PEG/Backtrack/Measured.hs b/src/Text/Grampa/PEG/Backtrack/Measured.hs
--- a/src/Text/Grampa/PEG/Backtrack/Measured.hs
+++ b/src/Text/Grampa/PEG/Backtrack/Measured.hs
@@ -1,16 +1,17 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
 -- | Backtracking parser for Parsing Expression Grammars, tracking the consumed input length
 module Text.Grampa.PEG.Backtrack.Measured (Parser(..), Result(..), alt) where
 
 import Control.Applicative (Applicative(..), Alternative(..), liftA2)
 import Control.Monad (Monad(..), MonadPlus(..))
 
-import Data.Char (isSpace)
 import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
 import Data.List (nub)
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
 import Data.Monoid.Factorial(FactorialMonoid)
+import Data.Monoid.Textual(TextualMonoid)
 import Data.String (fromString)
 
 import qualified Data.Monoid.Cancellative as Cancellative
@@ -24,8 +25,9 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
-import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
+import Text.Grampa.Class (Lexical(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
 import Text.Grampa.Internal (FailureInfo(..))
 
 data Result (g :: (* -> *) -> *) s v = Parsed{parsedLength :: !Int,
@@ -83,6 +85,9 @@
    mzero = empty
    mplus = (<|>)
 
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
 instance Monoid x => Monoid (Parser g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -109,8 +114,10 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (Show s, Textual.TextualMonoid s) => TokenParsing (Parser g s) where
-   someSpace = () <$ takeCharsWhile1 isSpace
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
 instance MonoidParsing (Parser g) where
    endOfInput = Parser p
@@ -174,11 +181,10 @@
       p s' | Just suffix <- Cancellative.stripPrefix s s' = Parsed l s suffix
            | otherwise = NoParse (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])
       l = Factorial.length s
-   whiteSpace = () <$ takeCharsWhile isSpace
    concatMany (Parser p) = Parser q
       where q rest = case p rest
                      of Parsed l prefix suffix -> let Parsed l' prefix' suffix' = q suffix
-                                                  in Parsed (l+l') (prefix <> prefix') suffix'
+                                                  in Parsed (l+l') (mappend prefix prefix') suffix'
                         NoParse{} -> Parsed 0 mempty rest
    {-# INLINABLE string #-}
 
diff --git a/src/Text/Grampa/PEG/Continued.hs b/src/Text/Grampa/PEG/Continued.hs
--- a/src/Text/Grampa/PEG/Continued.hs
+++ b/src/Text/Grampa/PEG/Continued.hs
@@ -1,15 +1,15 @@
-{-# LANGUAGE InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies #-}
+{-# LANGUAGE InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 -- | Continuation-passing parser for Parsing Expression Grammars
 module Text.Grampa.PEG.Continued (Parser(..), Result(..), alt) where
 
 import Control.Applicative (Applicative(..), Alternative(..), liftA2)
 import Control.Monad (Monad(..), MonadPlus(..))
 
-import Data.Char (isSpace)
 import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
 import Data.List (nub)
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
 import Data.Monoid.Factorial(FactorialMonoid)
 import Data.Monoid.Textual(TextualMonoid)
 import Data.String (fromString)
@@ -25,8 +25,9 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
-import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
+import Text.Grampa.Class (Lexical(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
 import Text.Grampa.Internal (FailureInfo(..))
 
 data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,
@@ -79,6 +80,9 @@
    mzero = empty
    mplus = (<|>)
 
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
 instance Monoid x => Monoid (Parser g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -110,8 +114,10 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where
-   someSpace = () <$ takeCharsWhile1 isSpace
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
 instance MonoidParsing (Parser g) where
    endOfInput = Parser p
@@ -201,12 +207,11 @@
       p s' success failure
          | Just suffix <- Cancellative.stripPrefix s s' = success s suffix
          | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])
-   whiteSpace = () <$ takeCharsWhile isSpace
    concatMany :: forall s a. Monoid a => Parser g s a -> Parser g s a
    concatMany (Parser p) = Parser q
       where q :: forall x. s -> (a -> s -> x) -> (FailureInfo -> x) -> x
             q rest success _ = p rest success' failure
-               where success' prefix suffix = q suffix (success . (prefix <>)) (const $ success prefix suffix)
+               where success' prefix suffix = q suffix (success . mappend prefix) (const $ success prefix suffix)
                      failure _ = success mempty rest
    {-# INLINABLE string #-}
 
diff --git a/src/Text/Grampa/PEG/Continued/Measured.hs b/src/Text/Grampa/PEG/Continued/Measured.hs
--- a/src/Text/Grampa/PEG/Continued/Measured.hs
+++ b/src/Text/Grampa/PEG/Continued/Measured.hs
@@ -1,15 +1,15 @@
-{-# LANGUAGE BangPatterns, InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies #-}
+{-# LANGUAGE BangPatterns, InstanceSigs, RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 -- | Continuation-passing parser for Parsing Expression Grammars that keeps track of the parsed prefix length
 module Text.Grampa.PEG.Continued.Measured (Parser(..), Result(..), alt) where
 
 import Control.Applicative (Applicative(..), Alternative(..), liftA2)
 import Control.Monad (Monad(..), MonadPlus(..))
 
-import Data.Char (isSpace)
 import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
 import Data.List (nub)
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
 import Data.Monoid.Factorial(FactorialMonoid)
 import Data.Monoid.Textual(TextualMonoid)
 import Data.String (fromString)
@@ -25,8 +25,9 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
-import Text.Grampa.Class (MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
+import Text.Grampa.Class (Lexical(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
 import Text.Grampa.Internal (FailureInfo(..))
 
 data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,
@@ -82,6 +83,9 @@
    mzero = empty
    mplus = (<|>)
 
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
 instance Monoid x => Monoid (Parser g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -113,8 +117,10 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (Show s, TextualMonoid s) => TokenParsing (Parser g s) where
-   someSpace = () <$ takeCharsWhile1 isSpace
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
 instance MonoidParsing (Parser g) where
    endOfInput = Parser p
@@ -213,13 +219,12 @@
       p s' success failure
          | Just suffix <- Cancellative.stripPrefix s s', !len <- Factorial.length s = success s len suffix
          | otherwise = failure (FailureInfo 1 (fromIntegral $ Factorial.length s') ["string " ++ show s])
-   whiteSpace = () <$ takeCharsWhile isSpace
    concatMany :: forall s a. Monoid a => Parser g s a -> Parser g s a
    concatMany (Parser p) = Parser q
       where q :: forall x. s -> (a -> Int -> s -> x) -> (FailureInfo -> x) -> x
             q rest success _ = p rest success' failure
                where success' prefix !len suffix = 
-                        q suffix (\prefix' !len'-> success (prefix <> prefix') (len + len')) 
+                        q suffix (\prefix' !len'-> success (mappend prefix prefix') (len + len')) 
                           (const $ success prefix len suffix)
                      failure _ = success mempty 0 rest
    {-# INLINABLE string #-}
diff --git a/src/Text/Grampa/PEG/Packrat.hs b/src/Text/Grampa/PEG/Packrat.hs
--- a/src/Text/Grampa/PEG/Packrat.hs
+++ b/src/Text/Grampa/PEG/Packrat.hs
@@ -1,16 +1,17 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
 -- | Packrat parser
 module Text.Grampa.PEG.Packrat (Parser(..), Result(..)) where
 
 import Control.Applicative (Applicative(..), Alternative(..), liftA2)
 import Control.Monad (Monad(..), MonadPlus(..))
 
-import Data.Char (isSpace)
 import Data.Functor.Classes (Show1(..))
 import Data.Functor.Compose (Compose(..))
 import Data.List (genericLength, nub)
-import Data.Monoid (Monoid(mappend, mempty), (<>))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(mappend, mempty))
 import Data.Monoid.Factorial(FactorialMonoid)
+import Data.Monoid.Textual(TextualMonoid)
 import Data.String (fromString)
 
 import qualified Data.Monoid.Cancellative as Cancellative
@@ -24,8 +25,10 @@
 import Text.Parser.Char (CharParsing)
 import Text.Parser.Combinators (Parsing(..))
 import Text.Parser.LookAhead (LookAheadParsing(..))
-import Text.Parser.Token (TokenParsing(someSpace))
-import Text.Grampa.Class (GrammarParsing(..), MonoidParsing(..), MultiParsing(..), ParseResults, ParseFailure(..))
+import Text.Parser.Token (TokenParsing)
+import qualified Text.Parser.Token
+import Text.Grampa.Class (Lexical(..), GrammarParsing(..), MonoidParsing(..), MultiParsing(..), 
+                          ParseResults, ParseFailure(..))
 import Text.Grampa.Internal (FailureInfo(..))
 import qualified Text.Grampa.PEG.Backtrack as Backtrack (Parser)
 
@@ -74,6 +77,9 @@
    mzero = empty
    mplus = (<|>)
 
+instance Semigroup x => Semigroup (Parser g s x) where
+   (<>) = liftA2 (<>)
+
 instance Monoid x => Monoid (Parser g s x) where
    mempty = pure mempty
    mappend = liftA2 mappend
@@ -100,8 +106,10 @@
    anyChar = satisfyChar (const True)
    text t = (fromString . Textual.toString (error "unexpected non-character")) <$> string (Textual.fromText t)
 
-instance (Show s, Textual.TextualMonoid s) => TokenParsing (Parser g s) where
-   someSpace = () <$ takeCharsWhile1 isSpace
+instance (Lexical g, LexicalConstraint Parser g s, Show s, TextualMonoid s) => TokenParsing (Parser g s) where
+   someSpace = someLexicalSpace
+   semi = lexicalSemicolon
+   token = lexicalToken
 
 instance GrammarParsing Parser where
    type GrammarFunctor Parser = Result
@@ -181,9 +189,8 @@
       p rest@((s', _) : _)
          | Cancellative.isPrefixOf s s' = Parsed s (Factorial.drop (Factorial.length s) rest)
       p rest = NoParse (FailureInfo 1 (genericLength rest) ["string " ++ show s])
-   whiteSpace = () <$ takeCharsWhile isSpace
    concatMany p = go
-      where go = (<>) <$> p <*> go <|> mempty
+      where go = mappend <$> p <*> go <|> mempty
 
 
 -- | Packrat parser
diff --git a/test/Test.hs b/test/Test.hs
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -17,6 +17,7 @@
 
 import Data.Functor.Compose (Compose(..))
 import Text.Parser.Combinators (sepBy1, skipMany)
+import Text.Parser.Token (whiteSpace)
 
 import Test.Feat (Enumerable(..), Enumerate, FreePair(Free), consts, shared, unary, uniform)
 import Test.Feat.Enumerate (pay)
@@ -29,7 +30,7 @@
 
 import qualified Rank2
 import qualified Rank2.TH
-import Text.Grampa
+import Text.Grampa hiding (symbol)
 import qualified Text.Grampa.ContextFree.Parallel as Parallel
 import qualified Text.Grampa.ContextFree.LeftRecursive as LeftRecursive
 
@@ -43,6 +44,8 @@
                              next :: f String}
 deriving instance (Show (f String), Show (f [String])) => Show (Recursive f)
 
+instance Lexical Recursive
+
 $(Rank2.TH.deriveAll ''Recursive)
 
 recursiveManyGrammar Recursive{..} = Recursive{
@@ -56,7 +59,7 @@
 nameListGrammarBuilder g@Recursive{..} = Recursive{
    start= pure (const . unwords) <*> rec <*> (True <$ symbol "," <* symbol "..." <|> pure False) <|>
           pure id <*> symbol "..." <?> "start",
-   rec= sepBy1 one (ignorable *> string "," <* whiteSpace <?> "comma") <?> "rec",
+   rec= sepBy1 one (ignorable *> string "," <?> "comma") <?> "rec",
    one= do ignorable
            identifier <- ((:) <$> satisfyChar isLetter <*> (toString (const "") <$> takeCharsWhile isLetter))
            guard (identifier /= "reserved")
@@ -93,11 +96,6 @@
              [testProperty "anyToken mempty" $ simpleParse anyToken "" == Left (ParseFailure 0 ["anyToken"]),
               testProperty "anyToken list" $
                 \(x::Word8) xs-> simpleParse anyToken (x:xs) == Right [(xs, [x])],
-              testProperty "token success" $
-                \(x::Word8) xs-> simpleParse (token [x]) (x:xs) == Right [(xs, [x])],
-              testProperty "token failure" $ \(x::Word8) y xs->
-                   x /= y ==> results (simpleParse (token [y]) (x:xs)) == [],
-              testProperty "token mempty" $ \x-> results (simpleParse (token [x]) "") == [],
               testProperty "satisfy success" $ \bools->
                    simpleParse (satisfy head) (True:bools) == Right [(bools, [True])],
               testProperty "satisfy failure" $ \bools-> results (simpleParse (satisfy head) (False:bools)) == [],
@@ -205,7 +203,6 @@
                                  DescribedParser "getInput" getInput,
                                  DescribedParser "empty" empty,
                                  DescribedParser "mempty" mempty])
-               <> pay (unary $ \t-> DescribedParser "token" (token t))
                <> pay (unary $ \s-> DescribedParser "string" (string s))
                <> pay (unary $ \pred-> DescribedParser "satisfy" (satisfy pred))
                <> pay (unary $ \pred-> DescribedParser "takeWhile" (takeWhile pred))
diff --git a/test/Test/Examples.hs b/test/Test/Examples.hs
--- a/test/Test/Examples.hs
+++ b/test/Test/Examples.hs
@@ -1,4 +1,4 @@
-{-# Language RankNTypes, ScopedTypeVariables #-}
+{-# Language FlexibleInstances, RankNTypes, ScopedTypeVariables #-}
 module Test.Examples where
 
 import Control.Applicative (empty, (<|>))
@@ -30,7 +30,8 @@
    where f = uniqueParse (fixGrammar comparisons) (Comparisons.test . Rank2.snd)
          s' = f s
 
-comparisons :: Rank2.Functor g => GrammarBuilder ArithmeticComparisons g Parser String
+comparisons :: (Rank2.Functor g, Lexical g, LexicalConstraint Parser g String) =>
+               GrammarBuilder ArithmeticComparisons g Parser String
 comparisons (Rank2.Pair a c) =
    Rank2.Pair (Arithmetic.arithmetic a) (Comparisons.comparisons c){Comparisons.term= Arithmetic.expr a}
 
@@ -39,7 +40,8 @@
    where f = uniqueParse (fixGrammar boolean) (Boolean.expr . Rank2.snd)
          s' = f s
 
-boolean :: Rank2.Functor g => GrammarBuilder ArithmeticComparisonsBoolean g Parser String
+boolean :: (Rank2.Functor g, Lexical g, LexicalConstraint Parser g String) =>
+           GrammarBuilder ArithmeticComparisonsBoolean g Parser String
 boolean (Rank2.Pair ac b) = Rank2.Pair (comparisons ac) (Boolean.boolean (Comparisons.test $ Rank2.snd ac) b)
 
 parseConditional :: Conditional -> Bool
@@ -47,7 +49,7 @@
    where f = uniqueParse (fixGrammar conditionals) (Conditionals.expr . Rank2.snd)
          s' = f s
 
-conditionals :: Rank2.Functor g => GrammarBuilder ACBC g Parser String
+conditionals :: (Rank2.Functor g, Lexical g, LexicalConstraint Parser g String) => GrammarBuilder ACBC g Parser String
 conditionals (Rank2.Pair acb c) =
    boolean acb `Rank2.Pair`
    Conditionals.conditionals c{Conditionals.test= Boolean.expr (Rank2.snd acb),
@@ -129,3 +131,7 @@
                        Right [] -> error "Unparseable"
                        Right _ -> error "Ambiguous"
                        Left (ParseFailure pos exp) -> error ("At " <> show pos <> " expected one of " <> show exp)
+
+instance Lexical ArithmeticComparisons
+instance Lexical ArithmeticComparisonsBoolean
+instance Lexical ACBC