diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,7 @@
+# 0.10.0.1
+
+- Add changelog
+
 # 0.10
 
 - Remove `Args`, and use `Results` instead
diff --git a/Earley.cabal b/Earley.cabal
--- a/Earley.cabal
+++ b/Earley.cabal
@@ -1,5 +1,5 @@
 name:                Earley
-version:             0.10.0.1
+version:             0.10.1.0
 synopsis:            Parsing all context-free grammars using Earley's algorithm.
 description:         See <https://www.github.com/ollef/Earley> for more
                      information and
@@ -28,6 +28,7 @@
 Flag Examples
   Description: "Build examples"
   Default:     False
+  Manual:      True
 
 source-repository    head
   type:     git
diff --git a/Text/Earley/Grammar.hs b/Text/Earley/Grammar.hs
--- a/Text/Earley/Grammar.hs
+++ b/Text/Earley/Grammar.hs
@@ -4,9 +4,10 @@
   ( Prod(..)
   , satisfy
   , (<?>)
+  , alts
   , Grammar(..)
   , rule
-  , alts
+  , runGrammar
   ) where
 import Control.Applicative
 import Control.Monad
@@ -146,3 +147,17 @@
 -- | Create a new non-terminal by giving its production.
 rule :: Prod r e t a -> Grammar r (Prod r e t a)
 rule p = RuleBind p return
+
+-- | Run a grammar, given an action to perform on productions to be turned into
+-- non-terminals.
+runGrammar :: MonadFix m
+           => (forall e t a. Prod r e t a -> m (Prod r e t a))
+           -> Grammar r b -> m b
+runGrammar r grammar = case grammar of
+  RuleBind p k -> do
+    nt <- r p
+    runGrammar r $ k nt
+  Return a -> return a
+  FixBind f k -> do
+    a <- mfix $ runGrammar r <$> f
+    runGrammar r $ k a
diff --git a/Text/Earley/Internal.hs b/Text/Earley/Internal.hs
--- a/Text/Earley/Internal.hs
+++ b/Text/Earley/Internal.hs
@@ -4,7 +4,6 @@
 module Text.Earley.Internal where
 import Control.Applicative
 import Control.Arrow
-import Control.Monad.Fix
 import Control.Monad
 import Control.Monad.ST
 import Data.ListLike(ListLike)
@@ -22,8 +21,39 @@
 data Rule s r e t a = Rule
   { ruleProd  :: ProdR s r e t a
   , ruleConts :: !(STRef s (STRef s [Cont s r e t a r]))
+  , ruleNulls :: !(Results s a)
   }
 
+mkRule :: ProdR s r e t a -> ST s (Rule s r e t a)
+mkRule p = mdo
+  c <- newSTRef =<< newSTRef mempty
+  computeNullsRef <- newSTRef $ do
+    writeSTRef computeNullsRef $ return []
+    ns <- unResults $ prodNulls p
+    writeSTRef computeNullsRef $ return ns
+    return ns
+  return $ Rule (removeNulls p) c (Results $ join $ readSTRef computeNullsRef)
+
+prodNulls :: ProdR s r e t a -> Results s a
+prodNulls prod = case prod of
+  Terminal {}     -> empty
+  NonTerminal r p -> ruleNulls r <**> prodNulls p
+  Pure a          -> pure a
+  Alts as p       -> mconcat (map prodNulls as) <**> prodNulls p
+  Many a p        -> prodNulls (pure [] <|> pure <$> a) <**> prodNulls p
+  Named p _       -> prodNulls p
+
+-- | Remove (some) nulls from a production
+removeNulls :: ProdR s r e t a -> ProdR s r e t a
+removeNulls prod = case prod of
+  Terminal {}      -> prod
+  NonTerminal {}   -> prod
+  Pure _           -> empty
+  Alts as (Pure f) -> alts (map removeNulls as) $ Pure f
+  Alts {}          -> prod
+  Many {}          -> prod
+  Named p n        -> Named (removeNulls p) n
+
 type ProdR s r e t a = Prod (Rule s r) e t a
 
 resetConts :: Rule s r e t a -> ST s ()
@@ -47,6 +77,10 @@
   pure  = return
   (<*>) = ap
 
+instance Alternative (Results s) where
+  empty = Results $ pure []
+  Results sxs <|> Results sys = Results $ (<|>) <$> sxs <*> sys
+
 instance Monad (Results s) where
   return = Results . pure . pure
   Results stxs >>= f = Results $ do
@@ -54,16 +88,22 @@
     concat <$> mapM (unResults . f) xs
 
 instance Monoid (Results s a) where
-  mempty = Results $ pure []
-  mappend (Results sxs) (Results sys) = Results $ (++) <$> sxs <*> sys
+  mempty = empty
+  mappend = (<|>)
 
 -------------------------------------------------------------------------------
 -- * States and continuations
 -------------------------------------------------------------------------------
+data BirthPos
+  = Previous
+  | Current
+  deriving Eq
+
 -- | An Earley state with result type @a@.
 data State s r e t a where
   State :: !(ProdR s r e t a)
         -> !(a -> Results s b)
+        -> !BirthPos
         -> !(Conts s r e t b c)
         -> State s r e t c
   Final :: !(Results s a) -> State s r e t a
@@ -89,9 +129,9 @@
 contraMapCont f (Cont g p args cs) = Cont (f >=> g) p args cs
 contraMapCont f (FinalCont args)   = FinalCont (f >=> args)
 
-contToState :: Results s a -> Cont s r e t a c -> State s r e t c
-contToState r (Cont g p args cs) = State p (\f -> fmap f (r >>= g) >>= args) cs
-contToState r (FinalCont args)   = Final $ r >>= args
+contToState :: BirthPos -> Results s a -> Cont s r e t a c -> State s r e t c
+contToState pos r (Cont g p args cs) = State p (\f -> fmap f (r >>= g) >>= args) pos cs
+contToState _   r (FinalCont args)   = Final $ r >>= args
 
 -- | Strings of non-ambiguous continuations can be optimised by removing
 -- indirections.
@@ -109,25 +149,9 @@
 -------------------------------------------------------------------------------
 -- * Grammars
 -------------------------------------------------------------------------------
-mkRule :: ProdR s r e t a -> ST s (Rule s r e t a)
-mkRule p = do
-  c  <- newSTRef =<< newSTRef mempty
-  return $ Rule p c
-
--- | Interpret an abstract 'Grammar'.
-grammar :: Grammar (Rule s r) a -> ST s a
-grammar g = case g of
-  RuleBind p k -> do
-    r <- mkRule p
-    grammar $ k $ NonTerminal r $ Pure id
-  FixBind f k   -> do
-    a <- mfix $ fmap grammar f
-    grammar $ k a
-  Return x      -> return x
-
 -- | Given a grammar, construct an initial state.
 initialState :: ProdR s a e t a -> ST s (State s a e t a)
-initialState p = State p pure <$> (newConts =<< newSTRef [FinalCont pure])
+initialState p = State p pure Previous <$> (newConts =<< newSTRef [FinalCont pure])
 
 -------------------------------------------------------------------------------
 -- * Parsing
@@ -166,15 +190,15 @@
 data ParseEnv s e i t a = ParseEnv
   { results :: ![ST s [a]]
     -- ^ Results ready to be reported (when this position has been processed)
-  , next  :: ![State s a e t a]
+  , next    :: ![State s a e t a]
     -- ^ States to process at the next position
-  , reset :: !(ST s ())
+  , reset   :: !(ST s ())
     -- ^ Computation that resets the continuation refs of productions
-  , names :: ![e]
+  , names   :: ![e]
     -- ^ Named productions encountered at this position
-  , pos   :: !Int
+  , curPos  :: !Int
     -- ^ The current position in the input string
-  , input :: !i
+  , input   :: !i
     -- ^ The input string
   }
 
@@ -185,7 +209,7 @@
   , next    = mempty
   , reset   = return ()
   , names   = mempty
-  , pos     = 0
+  , curPos  = 0
   , input   = i
   }
 
@@ -200,61 +224,71 @@
 parse [] env@ParseEnv {results = [], next = []} = do
   reset env
   return $ Ended Report
-    { position   = pos env
+    { position   = curPos env
     , expected   = names env
     , unconsumed = input env
     }
 parse [] env@ParseEnv {results = []} = do
   reset env
-  parse (next env) (emptyParseEnv $ ListLike.tail $ input env) {pos = pos env + 1}
+  parse (next env)
+        (emptyParseEnv $ ListLike.tail $ input env) {curPos = curPos env + 1}
 parse [] env = do
   reset env
-  return $ Parsed (concat <$> sequence (results env)) (pos env) (input env)
+  return $ Parsed (concat <$> sequence (results env)) (curPos env) (input env)
          $ parse [] env {results = [], reset = return ()}
 parse (st:ss) env = case st of
   Final res -> parse ss env {results = unResults res : results env}
-  State pr args scont -> case pr of
+  State pr args pos scont -> case pr of
     Terminal f p -> case safeHead $ input env of
-      Just t | f t -> parse ss env {next = State p (args . ($ t)) scont
+      Just t | f t -> parse ss env {next = State p (args . ($ t)) Previous scont
                                          : next env}
       _            -> parse ss env
     NonTerminal r p -> do
       rkref <- readSTRef $ ruleConts r
       ks    <- readSTRef rkref
       writeSTRef rkref (Cont pure p args scont : ks)
+      ns    <- unResults $ ruleNulls r
+      let addNullState
+            | null ns = id
+            | otherwise = (:)
+                        $ State p (\f -> Results (pure $ map f ns) >>= args) pos scont
       if null ks then do -- The rule has not been expanded at this position.
-        st' <- State (ruleProd r) pure <$> newConts rkref
-        parse (st' : ss)
+        st' <- State (ruleProd r) pure Current <$> newConts rkref
+        parse (addNullState $ st' : ss)
               env {reset = resetConts r >> reset env}
       else -- The rule has already been expanded at this position.
-        parse ss env
-    Pure a -> do
-      let argsRef = contsArgs scont
-      masref  <- readSTRef argsRef
-      case masref of
-        Just asref -> do -- The continuation has already been followed at this position.
-          modifySTRef asref $ mappend $ args a
-          parse ss env
-        Nothing    -> do -- It hasn't.
-          asref <- newSTRef $ args a
-          writeSTRef argsRef $ Just asref
-          ks  <- simplifyCont scont
-          res <- lazyResults $ join $ unResults <$> readSTRef asref
-          let kstates = map (contToState res) ks
-          parse (kstates ++ ss)
-                env {reset = writeSTRef argsRef Nothing >> reset env}
+        parse (addNullState ss) env
+    Pure a
+      -- Skip following continuations that stem from the current position; such
+      -- continuations are handled separately.
+      | pos == Current -> parse ss env
+      | otherwise -> do
+        let argsRef = contsArgs scont
+        masref  <- readSTRef argsRef
+        case masref of
+          Just asref -> do -- The continuation has already been followed at this position.
+            modifySTRef asref $ mappend $ args a
+            parse ss env
+          Nothing    -> do -- It hasn't.
+            asref <- newSTRef $ args a
+            writeSTRef argsRef $ Just asref
+            ks  <- simplifyCont scont
+            res <- lazyResults $ join $ unResults <$> readSTRef asref
+            let kstates = map (contToState pos res) ks
+            parse (kstates ++ ss)
+                  env {reset = writeSTRef argsRef Nothing >> reset env}
     Alts as (Pure f) -> do
       let args' = args . f
-          sts   = [State a args' scont | a <- as]
+          sts   = [State a args' pos scont | a <- as]
       parse (sts ++ ss) env
     Alts as p -> do
       scont' <- newConts =<< newSTRef [Cont pure p args scont]
-      let sts = [State a pure scont' | a <- as]
+      let sts = [State a pure Previous scont' | a <- as]
       parse (sts ++ ss) env
     Many p q -> mdo
       r <- mkRule $ pure [] <|> (:) <$> p <*> NonTerminal r (Pure id)
-      parse (State (NonTerminal r q) args scont : ss) env
-    Named pr' n -> parse (State pr' args scont : ss)
+      parse (State (NonTerminal r q) args pos scont : ss) env
+    Named pr' n -> parse (State pr' args pos scont : ss)
                          env {names = n : names env}
 
 {-# INLINE parser #-}
@@ -263,7 +297,8 @@
        => (forall r. Grammar r (Prod r e t a))
        -> ST s (i -> ST s (Result s e i a))
 parser g = do
-  s <- initialState =<< grammar g
+  let nt x = NonTerminal x $ pure id
+  s <- initialState =<< runGrammar (fmap nt . mkRule) g
   return $ parse [s] . emptyParseEnv
 
 -- | Return all parses from the result of a given parser. The result may
diff --git a/tests/Tests.hs b/tests/Tests.hs
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -1,10 +1,10 @@
 {-# LANGUAGE RecursiveDo, ScopedTypeVariables #-}
+import Control.Applicative
+import Data.Char
 import Test.Tasty
-import Test.Tasty.QuickCheck as QC
 import Test.Tasty.HUnit      as HU
+import Test.Tasty.QuickCheck as QC
 
-import Data.Char
-import Control.Applicative
 import Text.Earley
 import Text.Earley.Mixfix
 
@@ -34,6 +34,10 @@
                               , expected   = []
                               , unconsumed = input
                               }
+  , QC.testProperty "The same rule in alternatives gives many results (issue #14)" $
+    \x -> fullParses (parser (issue14 x)) ""
+    == (,) (replicate (issue14Length x) ())
+           Report { position = 0, expected = [], unconsumed = [] }
   ]
 
 unitTests :: TestTree
@@ -292,3 +296,38 @@
                   _ -> undefined)
 
     return expr
+
+data Issue14 a
+  = Pure a
+  | Alt (Issue14 a) (Issue14 a)
+  | Ap (Issue14 a) (Issue14 a)
+  deriving (Eq, Ord, Show)
+
+instance Arbitrary a => Arbitrary (Issue14 a) where
+  arbitrary = sized arbTree
+    where arbTree n | n > 0  = oneof [ Pure <$> arbitrary
+                                     , Alt <$> arbTree1 <*> arbTree1
+                                     , Ap <$> arbTree1 <*> arbTree1
+                                     ]
+                                     where arbTree1 = arbTree (n `div` 2)
+          arbTree _          = Pure <$> arbitrary
+
+  shrink (Pure a)  = Pure <$> shrink a
+  shrink (Alt a b) = a : b : [Alt a' b | a' <- shrink a] ++ [Alt a b' | b' <- shrink b]
+  shrink (Ap a b)  = a : b : [Ap a' b | a' <- shrink a] ++ [Ap a b' | b' <- shrink b]
+
+issue14Length :: Issue14 () -> Int
+issue14Length (Pure ()) = 1
+issue14Length (Alt a b) = ((+) $! issue14Length a) $! issue14Length b
+issue14Length (Ap a b)  = ((*) $! issue14Length a) $! issue14Length b
+
+issue14 :: Issue14 () -> Grammar r (Prod r () Char ())
+issue14 tree = do
+  emptyRule <- rule $ pure ()
+  let x = go emptyRule tree
+  return x
+  where
+    go x (Pure ())   = x
+    go x (Alt b1 b2) = go x b1 <|> go x b2
+    go x (Ap b1 b2)  = go x b1 <* go x b2
+