diff --git a/Earley.cabal b/Earley.cabal
--- a/Earley.cabal
+++ b/Earley.cabal
@@ -1,5 +1,5 @@
 name:                Earley
-version:             0.6.0
+version:             0.7.0
 synopsis:            Parsing all context-free grammars using Earley's algorithm.
 description:         See <https://www.github.com/ollef/Earley> for more
                      information and
@@ -21,7 +21,7 @@
 library
   exposed-modules:     Text.Earley.Derived, Text.Earley.Grammar, Text.Earley.Parser Text.Earley
   -- other-modules:
-  build-depends:       base ==4.8.*, containers >=0.5, kan-extensions >=4.2, ListLike >=4.1
+  build-depends:       base ==4.8.*, containers >=0.5, ListLike >=4.1
   -- hs-source-dirs:
   default-language:    Haskell2010
   ghc-options:         -Wall -funbox-strict-fields
diff --git a/Text/Earley.hs b/Text/Earley.hs
--- a/Text/Earley.hs
+++ b/Text/Earley.hs
@@ -6,6 +6,8 @@
     symbol, namedSymbol, word
   , -- * Parsing
     Report(..), Result(..), parser, allParses, fullParses
+    -- * Recognition
+  , report
   )
   where
 import Text.Earley.Grammar
diff --git a/Text/Earley/Grammar.hs b/Text/Earley/Grammar.hs
--- a/Text/Earley/Grammar.hs
+++ b/Text/Earley/Grammar.hs
@@ -88,8 +88,9 @@
   Named p m <|> q         = Named (p <|> q) m
   p         <|> Named q n = Named (p <|> q) n
   p         <|> q         = Plus p q
-  many p       = Many p $ Pure id
-  some p       = (:) <$> p <*> many p
+  many Empty = pure []
+  many p     = Many p $ Pure id
+  some p     = (:) <$> p <*> many p
 
 -- | A context-free grammar.
 --
@@ -131,6 +132,6 @@
 instance MonadFix (Grammar r e) where
   mfix f = FixBind f return
 
--- | Create a new non-terminal by listing its production rule.
+-- | Create a new non-terminal by giving its production.
 rule :: Prod r e t a -> Grammar r e (Prod r e t a)
 rule p = RuleBind p return
diff --git a/Text/Earley/Parser.hs b/Text/Earley/Parser.hs
--- a/Text/Earley/Parser.hs
+++ b/Text/Earley/Parser.hs
@@ -6,12 +6,13 @@
   , parser
   , allParses
   , fullParses
+  , report
   ) where
 import Control.Applicative
 import Control.Arrow
+import Control.Monad
 import Control.Monad.Fix
 import Control.Monad.ST.Lazy
-import Data.Functor.Yoneda
 import Data.ListLike(ListLike)
 import qualified Data.ListLike as ListLike
 import Data.STRef.Lazy
@@ -24,7 +25,7 @@
 data Rule s r e t a = Rule
   { ruleProd     :: ProdR s r e t a
   , ruleNullable :: {-# UNPACK #-} !(STRef s (Maybe [a]))
-  , ruleConts    :: {-# UNPACK #-} !(STRef s (Conts s r e t a r))
+  , ruleConts    :: {-# UNPACK #-} !(STRef s (STRef s [Cont s r e t a r]))
   }
 
 type ProdR s r e t a = Prod (Rule s r) e t a
@@ -53,6 +54,25 @@
 nullableProd Empty             = return mempty
 nullableProd (Named p _)       = nullableProd p
 
+-- | If we have something of type @f@, @'Args' s f a@ is what we need to do to
+-- @f@ to produce @a@s.
+type Args s f a = f -> ST s [a]
+
+noArgs :: Args s a a
+noArgs = return . pure
+
+pureArg :: x -> Args s f a -> Args s (x -> f) a
+pureArg x args = args . ($ x)
+
+impureArgs :: ST s [x] -> Args s f a -> Args s (x -> f) a
+impureArgs mxs args f = fmap concat . mapM (args . f) =<< mxs
+
+mapArgs :: (a -> b) -> Args s f a -> Args s f b
+mapArgs = fmap . fmap . fmap
+
+composeArgs :: Args s a b -> Args s b c -> Args s a c
+composeArgs ab bc a = fmap concat . mapM bc =<< ab a
+
 -------------------------------------------------------------------------------
 -- * States and continuations
 -------------------------------------------------------------------------------
@@ -61,37 +81,45 @@
 -- | An Earley state with result type @a@.
 data State s r e t a where
   State :: {-# UNPACK #-} !Pos
-        -> !(ProdR s r e t b)
+        -> !(ProdR s r e t f)
+        -> {-# UNPACK #-} !(Args s f b)
         -> {-# UNPACK #-} !(Conts s r e t b a)
         -> State s r e t a
-  Final :: a -> State s r e t a
+  Final :: f -> Args s f a -> State s r e t a
 
 -- | A continuation accepting an @a@ and producing a @b@.
 data Cont s r e t a b where
   Cont      :: {-# UNPACK #-} !Pos
-            -> !(ProdR s r e t (a -> b))
-            -> {-# UNPACK #-} !(Conts s r e t b c)
-            -> Cont s r e t a c
-  FinalCont :: (a -> c) -> Cont s r e t a c
+            -> {-# UNPACK #-} !(Args s a b)
+            -> !(ProdR s r e t (b -> c))
+            -> {-# UNPACK #-} !(Args s c d)
+            -> {-# UNPACK #-} !(Conts s r e t d e')
+            -> Cont s r e t a e'
+  FinalCont :: Args s a c -> Cont s r e t a c
 
-type Conts s r e t a c = STRef s [Cont s r e t a c]
+data Conts s r e t a c = Conts
+  { conts     :: {-# UNPACK #-} !(STRef s [Cont s r e t a c])
+  , contsArgs :: {-# UNPACK #-} !(STRef s (Maybe (STRef s (ST s [a]))))
+  }
 
-contraMapCont :: (b -> a) -> Cont s r e t a c -> Cont s r e t b c
-contraMapCont f (Cont pos p cs) = (Cont pos $! ((. f) <$> p)) cs
-contraMapCont f (FinalCont g)   = FinalCont (g . f)
+contraMapCont :: Args s b a -> Cont s r e t a c -> Cont s r e t b c
+contraMapCont f (Cont pos g p args cs) = Cont pos (composeArgs f g) p args cs
+contraMapCont f (FinalCont args)       = FinalCont (composeArgs f args)
 
-contToState :: a -> Cont s r e t a c -> State s r e t c
-contToState a (Cont pos p cs) = State pos (($ a) <$> p) cs
-contToState a (FinalCont f)   = Final (f a)
+contToState :: ST s [a] -> Cont s r e t a c -> State s r e t c
+contToState r (Cont pos g p args cs) = 
+  let mb = fmap concat . mapM g =<< r in
+  State pos p (impureArgs mb args) cs
+contToState r (FinalCont args)       = Final id (impureArgs r args)
 
 -- | Strings of non-ambiguous continuations can be optimised by removing
 --   indirections.
 simplifyCont :: Conts s r e t b a -> ST s [Cont s r e t b a]
-simplifyCont cont = readSTRef cont >>= go False
+simplifyCont Conts {conts = cont} = readSTRef cont >>= go False
   where
-    go !_ [Cont _ (Pure f) cont'] = do
+    go !_ [Cont _ g (Pure f) args cont'] = do
       ks' <- simplifyCont cont'
-      go True $ map (contraMapCont f) ks'
+      go True $ map (contraMapCont $ mapArgs f g `composeArgs` args) ks'
     go True ks = do
       writeSTRef cont ks
       return ks
@@ -114,10 +142,10 @@
 
 -- | Given a grammar, construct an initial state.
 initialState :: ProdR s a e t a -> ST s (State s a e t a)
-initialState r = do
-  rs <- newSTRef [FinalCont id]
-  return $ State (-1) r rs
+initialState p = State (-1) p noArgs
+              <$> (Conts <$> newSTRef [FinalCont noArgs] <*> newSTRef Nothing)
 
+
 -------------------------------------------------------------------------------
 -- * Parsing
 -------------------------------------------------------------------------------
@@ -137,11 +165,13 @@
 data Result s e i a
   = Ended (Report e i)
     -- ^ The parser ended.
-  | Parsed a Int i (i -> ST s (Result s e i a))
-    -- ^ The parser parsed something, namely an 'a'. The 'Int' is the position
-    -- in the input where it did so, the 'i' is the rest of the input, and the
-    -- function is the parser continuation. This allows incrementally feeding
-    -- the parser more input (e.g. when the 'i' is empty).
+  | Parsed (ST s [a]) Int i (ST s (Result s e i a))
+    -- ^ The parser parsed a number of @a@s.  These are given as a computation,
+    -- @'ST' s [a]@ that constructs the 'a's when run.  We can thus save some
+    -- work by ignoring this computation if we do not care about the results.
+    -- The 'Int' is the position in the input where these results were
+    -- obtained, the @i@ the rest of the input, and the last component is the
+    -- continuation.
   deriving (Functor)
 
 {-# INLINE uncons #-}
@@ -156,60 +186,90 @@
   | ListLike.null ts' = ts'
   | otherwise         = ListLike.tail ts'
 
-{-# SPECIALISE parse :: [State s a e t a] -> [State s a e t a] -> ST s () -> [e] -> Pos -> [t] -> ST s (Result s e [t] a) #-}
+{-# SPECIALISE parse :: [State s a e t a]
+                     -> [ST s [a]]
+                     -> [State s a e t a]
+                     -> ST s ()
+                     -> [e]
+                     -> Pos
+                     -> [t]
+                     -> ST s (Result s e [t] a) #-}
 -- | The internal parsing routine
 parse :: ListLike i t
       => [State s a e t a] -- ^ States to process at this position
+      -> [ST s [a]]        -- ^ Results ready to be reported (when this position has been processed)
       -> [State s a e t a] -- ^ States to process at the next position
       -> ST s ()           -- ^ Computation that resets the continuation refs of productions
       -> [e]               -- ^ Named productions encountered at this position
       -> Pos               -- ^ The current position in the input string
       -> i                 -- ^ The input string
       -> ST s (Result s e i a)
-parse []      []    !reset names !pos   !ts = do
+parse [] [] [] !reset names !pos !ts = do
   reset
   return $ Ended Report {position = pos, expected = names, unconsumed = ts}
-parse []      !next !reset _names !pos !ts = do
+parse [] [] !next !reset _ !pos !ts = do
   reset
-  parse next [] (return ()) [] (pos + 1) (safeTail ts)
-parse (st:ss) !next !reset names !pos !ts = case st of
-  Final a -> return $ Parsed a pos ts $ parse ss next reset names pos
-  State spos pr scont -> case pr of
+  parse next [] [] (return ()) [] (pos + 1) $ safeTail ts
+parse [] !results !next !reset names !pos !ts = do
+  reset
+  return $ Parsed (concat <$> sequence results) pos ts
+         $ parse [] [] next (return ()) names pos ts
+parse (st:ss) !results !next !reset names !pos !ts = case st of
+  Final f args -> parse ss (args f : results) next reset names pos ts
+  State spos pr args scont -> case pr of
     Terminal f p -> case uncons ts of
-      Just (t, _) | f t -> parse ss (State spos (($ t) <$> p) scont : next) reset names pos ts
-      _                 -> parse ss next reset names pos ts
+      Just (t, _) | f t ->
+        parse ss results (State spos p (pureArg t args) scont : next) reset names pos ts
+      _                 -> parse ss results next reset names pos ts
     NonTerminal r p -> do
       rkref <- readSTRef $ ruleConts r
       ks    <- readSTRef rkref
-      writeSTRef rkref (Cont spos p scont : ks)
-      nulls' <- nullable r
-      let notExpanded = null ks
-          p'          = liftYoneda p
-          nulls       = fmap (\a -> State spos (lowerYoneda $ ($ a) <$> p') scont) nulls'
-      if notExpanded then do
-        let st' = State pos (ruleProd r) rkref
-        parse (st' : nulls ++ ss)
+      writeSTRef rkref (Cont spos noArgs p args scont : ks)
+      nulls <- nullable r
+      let nullStates = [State spos p (pureArg a args) scont | a <- nulls]
+      if null ks then do -- The rule has not been expanded at this position.
+        asref <- newSTRef Nothing
+        let st' = State pos (ruleProd r) noArgs (Conts rkref asref)
+        parse (st' : nullStates ++ ss)
+              results
               next
               ((writeSTRef (ruleConts r) =<< newSTRef mempty) >> reset)
               names
               pos
               ts
-      else
-        parse (nulls ++ ss) next reset names pos ts
+      else -- The rule has already been expanded at this position.
+        parse (nullStates ++ ss) results next reset names pos ts
     Pure a | spos /= pos -> do
-      conts <- simplifyCont scont
-      parse (map (contToState a) conts ++ ss) next reset names pos ts
-           | otherwise -> parse ss next reset names pos ts
+      let argsRef = contsArgs scont
+      masref  <- readSTRef argsRef
+      case masref of
+        Just asref -> do -- The continuation has already been followed at this position.
+          modifySTRef asref (((++) <$> args a) <*>)
+          parse ss results next reset names pos ts
+        Nothing    -> do -- It hasn't.
+          asref <- newSTRef (return mempty)
+          modifySTRef asref (((++) <$> args a) <*>)
+          writeSTRef argsRef $ Just asref
+          ks  <- simplifyCont scont
+          let kstates = map (contToState $ join $ readSTRef asref) ks
+          parse (kstates ++ ss)
+                results
+                next
+                (writeSTRef argsRef Nothing >> reset)
+                names
+                pos
+                ts
+           | otherwise -> parse ss results next reset names pos ts
 
-    Plus p q    -> parse (State spos p scont : State spos q scont : ss) next reset names pos ts
+    Plus p q    -> parse (State spos p args scont : State spos q args scont : ss) results next reset names pos ts
     Many p q    -> do
-      rkref <- newSTRef [Cont spos (Many p ((\f as a -> f (a : as)) <$> q)) scont]
-      let st' = State pos p rkref
-          nst = State spos (($ []) <$> q) scont
-      parse (st' : nst : ss) next reset names pos ts
-    Empty       -> parse ss next reset names pos ts
-
-    Named pr' n -> parse (State spos pr' scont : ss) next reset (n : names) pos ts
+      scont' <- Conts <$> newSTRef [Cont spos noArgs (Many p ((\f as a -> f (a : as)) <$> q)) args scont]
+                      <*> newSTRef Nothing
+      let st' = State pos p noArgs scont'
+          nst = State spos q (pureArg [] args) scont
+      parse (st' : nst : ss) results next reset names pos ts
+    Empty       -> parse ss results next reset names pos ts
+    Named pr' n -> parse (State spos pr' args scont : ss) results next reset (n : names) pos ts
 
 {-# INLINE parser #-}
 -- | Create a parser from the given grammar.
@@ -219,7 +279,7 @@
        -> ST s (Result s e i a)
 parser g xs = do
   s <- initialState =<< grammar g
-  parse [s] [] (return ()) [] 0 xs
+  parse [s] [] [] (return ()) [] 0 xs
 
 -- | Return all parses from the result of a given parser. The result may
 -- contain partial parses. The 'Int's are the position at which a result was
@@ -229,8 +289,10 @@
   where
     go :: Result s e i a -> ST s ([(a, Int)], Report e i)
     go r = case r of
-      Ended report     -> return ([], report)
-      Parsed a pos i k -> fmap (first ((a, pos) :)) $ go =<< k i
+      Ended rep         -> return ([], rep)
+      Parsed mas pos _ k -> do
+        as <- mas
+        fmap (first (zip as (repeat pos) ++)) $ go =<< k
 
 {-# INLINE fullParses #-}
 -- | Return all parses that reached the end of the input from the result of a
@@ -240,7 +302,21 @@
   where
     go :: ListLike i t => Result s e i a -> ST s ([a], Report e i)
     go r = case r of
-      Ended report -> return ([], report)
-      Parsed a _ i k
-        | ListLike.null i -> fmap (first (a :)) $ go =<< k i
-        | otherwise       -> go =<< k i
+      Ended rep -> return ([], rep)
+      Parsed mas _ i k
+        | ListLike.null i -> do
+          as <- mas
+          fmap (first (as ++)) $ go =<< k
+        | otherwise       -> go =<< k
+
+{-# INLINE report #-}
+-- | See e.g. how far the parser is able to parse the input string before it
+-- fails.  This can be much faster than getting the parse results for highly
+-- ambiguous grammars.
+report :: ListLike i t => (forall s. ST s (Result s e i a)) -> Report e i
+report p = runST $ p >>= go
+  where
+    go :: ListLike i t => Result s e i a -> ST s (Report e i)
+    go r = case r of
+      Ended rep      -> return rep
+      Parsed _ _ _ k -> go =<< k
