diff --git a/Earley.cabal b/Earley.cabal
--- a/Earley.cabal
+++ b/Earley.cabal
@@ -1,5 +1,5 @@
 name:                Earley
-version:             0.9.0
+version:             0.10.0
 synopsis:            Parsing all context-free grammars using Earley's algorithm.
 description:         See <https://www.github.com/ollef/Earley> for more
                      information and
@@ -13,6 +13,13 @@
 category:            Parsing
 build-type:          Simple
 cabal-version:       >=1.10
+tested-with:
+                     GHC == 7.8.1,
+                     GHC == 7.8.2,
+                     GHC == 7.8.3,
+                     GHC == 7.8.4,
+                     GHC == 7.10.1,
+                     GHC == 7.10.2
 
 Flag Examples
   Description: "Build examples"
@@ -86,6 +93,15 @@
   if !flag(examples)
     buildable:         False
   main-is:             Words.hs
+  ghc-options:         -Wall
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  build-depends:       base, Earley
+
+executable earley-infinite
+  if !flag(examples)
+    buildable:         False
+  main-is:             Infinite.hs
   ghc-options:         -Wall
   hs-source-dirs:      examples
   default-language:    Haskell2010
diff --git a/Text/Earley/Grammar.hs b/Text/Earley/Grammar.hs
--- a/Text/Earley/Grammar.hs
+++ b/Text/Earley/Grammar.hs
@@ -6,6 +6,7 @@
   , (<?>)
   , Grammar(..)
   , rule
+  , alts
   ) where
 import Control.Applicative
 import Control.Monad
@@ -71,32 +72,33 @@
   fmap f (Many p q)        = Many p $ fmap (f .) q
   fmap f (Named p n)       = Named (fmap f p) n
 
-alts :: [Prod r e t a] -> Prod r e t a
-alts as = Alts (as >>= go) $ pure id
+-- | Smart constructor for alternatives.
+alts :: [Prod r e t a] -> Prod r e t (a -> b) -> Prod r e t b
+alts as p = case as >>= go of
+  []  -> empty
+  [a] -> a <**> p
+  as' -> Alts as' p
   where
+    go (Alts [] _)         = []
     go (Alts as' (Pure f)) = fmap f <$> as'
+    go (Named p' n)        = map (<?> n) $ go p'
     go a                   = [a]
 
-alts' :: [Prod r e t a] -> Prod r e t (a -> b) -> Prod r e t b
-alts' [] _        = Alts [] $ pure id
-alts' as (Pure f) = alts $ fmap f <$> as
-alts' as p        = Alts as p
-
 instance Applicative (Prod r e t) where
   pure = Pure
   {-# INLINE (<*>) #-}
   Terminal b p    <*> q = Terminal b $ flip <$> p <*> q
   NonTerminal r p <*> q = NonTerminal r $ flip <$> p <*> q
   Pure f          <*> q = fmap f q
-  Alts as p       <*> q = alts' as $ flip <$> p <*> q
+  Alts as p       <*> q = alts as $ flip <$> p <*> q
   Many a p        <*> q = Many a $ flip <$> p <*> q
   Named p n       <*> q = Named (p <*> q) n
 
 instance Alternative (Prod r e t) where
-  empty = alts []
+  empty = Alts [] $ pure id
   Named p m <|> q         = Named (p <|> q) m
   p         <|> Named q n = Named (p <|> q) n
-  p         <|> q         = alts [p, q]
+  p         <|> q         = alts [p, q] $ pure id
   many (Alts [] _) = pure []
   many p           = Many p $ Pure id
   some p           = (:) <$> p <*> many p
@@ -107,8 +109,6 @@
 --
 -- @a@: The return type of the grammar (often a 'Prod').
 --
--- @e@: The type of names, used for example to report expected tokens.
---
 -- @r@: The type of a non-terminal. This plays a role similar to the @s@ in the
 --      type @ST s a@.  Since the 'parser' function expects the @r@ to be
 --      universally quantified, there is not much to do with this parameter
@@ -118,29 +118,29 @@
 -- e.g.  'Monad' and 'MonadFix'. Note that GHC has syntactic sugar for
 -- 'MonadFix': use @{-\# LANGUAGE RecursiveDo \#-}@ and @mdo@ instead of
 -- @do@.
-data Grammar r e a where
-  RuleBind :: Prod r e t a -> (Prod r e t a -> Grammar r e b) -> Grammar r e b
-  FixBind  :: (a -> Grammar r e a) -> (a -> Grammar r e b) -> Grammar r e b
-  Return   :: a -> Grammar r e a
+data Grammar r a where
+  RuleBind :: Prod r e t a -> (Prod r e t a -> Grammar r b) -> Grammar r b
+  FixBind  :: (a -> Grammar r a) -> (a -> Grammar r b) -> Grammar r b
+  Return   :: a -> Grammar r a
 
-instance Functor (Grammar r e) where
+instance Functor (Grammar r) where
   fmap f (RuleBind ps h) = RuleBind ps (fmap f . h)
   fmap f (FixBind g h)   = FixBind g (fmap f . h)
   fmap f (Return x)      = Return $ f x
 
-instance Applicative (Grammar r e) where
+instance Applicative (Grammar r) where
   pure  = return
   (<*>) = ap
 
-instance Monad (Grammar r e) where
+instance Monad (Grammar r) where
   return = Return
   RuleBind ps f >>= k = RuleBind ps (f >=> k)
   FixBind f g   >>= k = FixBind f (g >=> k)
   Return x      >>= k = k x
 
-instance MonadFix (Grammar r e) where
+instance MonadFix (Grammar r) where
   mfix f = FixBind f return
 
 -- | Create a new non-terminal by giving its production.
-rule :: Prod r e t a -> Grammar r e (Prod r e t a)
+rule :: Prod r e t a -> Grammar r (Prod r e t a)
 rule p = RuleBind p return
diff --git a/Text/Earley/Internal.hs b/Text/Earley/Internal.hs
--- a/Text/Earley/Internal.hs
+++ b/Text/Earley/Internal.hs
@@ -1,10 +1,11 @@
-{-# LANGUAGE CPP, BangPatterns, DeriveFunctor, GADTs, Rank2Types #-}
--- | This module exposes the internals of the package: its API may change independently of the PVP-compliant version number.
+{-# LANGUAGE CPP, BangPatterns, DeriveFunctor, GADTs, Rank2Types, RecursiveDo #-}
+-- | This module exposes the internals of the package: its API may change
+-- independently of the PVP-compliant version number.
 module Text.Earley.Internal where
 import Control.Applicative
 import Control.Arrow
-import Control.Monad
 import Control.Monad.Fix
+import Control.Monad
 import Control.Monad.ST
 import Data.ListLike(ListLike)
 import qualified Data.ListLike as ListLike
@@ -19,115 +20,79 @@
 -------------------------------------------------------------------------------
 -- | The concrete rule type that the parser uses
 data Rule s r e t a = Rule
-  { ruleProd     :: ProdR s r e t a
-  , ruleNullable :: !(STRef s (Maybe [a]))
-  , ruleConts    :: !(STRef s (STRef s [Cont s r e t a r]))
+  { ruleProd  :: ProdR s r e t a
+  , ruleConts :: !(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
 
-nullable :: Rule s r e t a -> ST s [a]
-nullable r = do
-  mn <- readSTRef $ ruleNullable r
-  case mn of
-    Just xs -> return xs
-    Nothing -> do
-      writeSTRef (ruleNullable r) $ Just mempty
-      res <- nullableProd $ ruleProd r
-      writeSTRef (ruleNullable r) $ Just res
-      return res
-
-nullableProd :: ProdR s r e t a -> ST s [a]
-nullableProd (Terminal _ _)    = return mempty
-nullableProd (NonTerminal r p) = do
-  as <- nullable r
-  concat <$> mapM (\a -> nullableProd $ fmap ($ a) p) as
-nullableProd (Pure a)          = return [a]
-nullableProd (Alts as p)       = (\ass fs -> fs <*> concat ass)
-                              <$> mapM nullableProd as <*> nullableProd p
-nullableProd (Many p q)        = do
-  as <- nullableProd $ (:[]) <$> p <|> pure []
-  concat <$> mapM (\a -> nullableProd $ fmap ($ a) q) as
-nullableProd (Named p _)       = nullableProd p
-
 resetConts :: Rule s r e t a -> ST s ()
-resetConts r = writeSTRef (ruleConts r) =<< newSTRef []
-
--- | 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
-
-funArg :: (f -> a) -> Args s f a
-funArg f = mapArgs f noArgs
-
-pureArg :: x -> Args s f a -> Args s (x -> f) a
-pureArg x args = args . ($ x)
+resetConts r = writeSTRef (ruleConts r) =<< newSTRef mempty
 
-pureArgs :: [x] -> Args s f a -> Args s (x -> f) a
-pureArgs xs args f = concat <$> mapM (args . f) xs
+-------------------------------------------------------------------------------
+-- * Delayed results
+-------------------------------------------------------------------------------
+newtype Results s a = Results { unResults :: ST s [a] }
+  deriving Functor
 
-impureArgs :: ST s [x] -> Args s f a -> Args s (x -> f) a
-impureArgs mxs args f = fmap concat . mapM (args . f) =<< mxs
+instance Applicative (Results s) where
+  pure  = return
+  (<*>) = ap
 
-mapArgs :: (a -> b) -> Args s f a -> Args s f b
-mapArgs = fmap . fmap . fmap
+instance Monad (Results s) where
+  return = Results . pure . pure
+  Results stxs >>= f = Results $ do
+    xs <- stxs
+    concat <$> mapM (unResults . f) xs
 
-composeArgs :: Args s a b -> Args s b c -> Args s a c
-composeArgs ab bc a = fmap concat . mapM bc =<< ab a
+instance Monoid (Results s a) where
+  mempty = Results $ pure []
+  mappend (Results sxs) (Results sys) = Results $ (++) <$> sxs <*> sys
 
 -------------------------------------------------------------------------------
 -- * States and continuations
 -------------------------------------------------------------------------------
-type Pos = Int
-
 -- | An Earley state with result type @a@.
 data State s r e t a where
-  State :: !Pos
-        -> !(ProdR s r e t f)
-        -> !(Args s f b)
-        -> !(Conts s r e t b a)
-        -> State s r e t a
-  Final :: f -> Args s f a -> State s r e t a
+  State :: !(ProdR s r e t a)
+        -> !(a -> Results s b)
+        -> !(Conts s r e t b c)
+        -> State s r e t c
+  Final :: Results s 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      :: !Pos
-            -> !(Args s a b)
+  Cont      :: !(a -> Results s b)
             -> !(ProdR s r e t (b -> c))
-            -> !(Args s c d)
+            -> !(c -> Results s d)
             -> !(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
+  FinalCont :: (a -> Results s c) -> Cont s r e t a c
 
 data Conts s r e t a c = Conts
   { conts     :: !(STRef s [Cont s r e t a c])
-  , contsArgs :: !(STRef s (Maybe (STRef s (ST s [a]))))
+  , contsArgs :: !(STRef s (Maybe (STRef s (Results s a))))
   }
 
 newConts :: STRef s [Cont s r e t a c] -> ST s (Conts s r e t a c)
 newConts r = Conts r <$> newSTRef Nothing
 
-contraMapCont :: Args s b a -> Cont s r e t a c -> Cont s r e t b c
-contraMapCont f (Cont cpos g p args cs) = Cont cpos (composeArgs f g) p args cs
-contraMapCont f (FinalCont args)       = FinalCont (composeArgs f args)
+contraMapCont :: (b -> Results s a) -> Cont s r e t a c -> Cont s r e t b c
+contraMapCont f (Cont g p args cs) = Cont (f >=> g) p args cs
+contraMapCont f (FinalCont args)   = FinalCont (f >=> args)
 
-contToState :: ST s [a] -> Cont s r e t a c -> State s r e t c
-contToState r (Cont cpos g p args cs) = 
-  let mb = fmap concat . mapM g =<< r in
-  State cpos p (impureArgs mb args) cs
-contToState r (FinalCont args)       = Final id (impureArgs r 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
 
 -- | Strings of non-ambiguous continuations can be optimised by removing
---   indirections.
+-- indirections.
 simplifyCont :: Conts s r e t b a -> ST s [Cont s r e t b a]
 simplifyCont Conts {conts = cont} = readSTRef cont >>= go False
   where
-    go !_ [Cont _ g (Pure f) args cont'] = do
+    go !_ [Cont g (Pure f) args cont'] = do
       ks' <- simplifyCont cont'
-      go True $ map (contraMapCont $ mapArgs f g `composeArgs` args) ks'
+      go True $ map (contraMapCont $ \b -> fmap f (g b) >>= args) ks'
     go True ks = do
       writeSTRef cont ks
       return ks
@@ -136,13 +101,17 @@
 -------------------------------------------------------------------------------
 -- * 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) e a -> ST s a
+grammar :: Grammar (Rule s r) a -> ST s a
 grammar g = case g of
   RuleBind p k -> do
-    c  <- newSTRef =<< newSTRef mempty
-    nr <- newSTRef Nothing
-    grammar $ k $ NonTerminal (Rule p nr c) $ Pure id
+    r <- mkRule p
+    grammar $ k $ NonTerminal r $ Pure id
   FixBind f k   -> do
     a <- mfix $ fmap grammar f
     grammar $ k a
@@ -150,7 +119,7 @@
 
 -- | 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 (-1) p noArgs <$> (newConts =<< newSTRef [FinalCont noArgs])
+initialState p = State p pure <$> (newConts =<< newSTRef [FinalCont pure])
 
 -------------------------------------------------------------------------------
 -- * Parsing
@@ -186,12 +155,6 @@
   | ListLike.null ts = Nothing
   | otherwise        = Just $ ListLike.head ts
 
-{-# INLINE safeTail #-}
-safeTail :: ListLike i t => i -> i
-safeTail ts
-  | ListLike.null ts = ts
-  | otherwise        = ListLike.tail ts
-
 data ParseEnv s e i t a = ParseEnv
   { results :: ![ST s [a]]
     -- ^ Results ready to be reported (when this position has been processed)
@@ -201,7 +164,7 @@
     -- ^ Computation that resets the continuation refs of productions
   , names :: ![e]
     -- ^ Named productions encountered at this position
-  , pos   :: !Pos
+  , pos   :: !Int
     -- ^ The current position in the input string
   , input :: !i
     -- ^ The input string
@@ -235,83 +198,76 @@
     }
 parse [] env@ParseEnv {results = []} = do
   reset env
-  parse (next env) (emptyParseEnv $ safeTail $ input env) {pos = pos env + 1}
+  parse (next env) (emptyParseEnv $ ListLike.tail $ input env) {pos = pos env + 1}
 parse [] env = do
   reset env
   return $ Parsed (concat <$> sequence (results env)) (pos env) (input env)
          $ parse [] env {results = [], reset = return ()}
 parse (st:ss) env = case st of
-  Final f args -> parse ss env {results = args f : results env}
-  State spos pr args scont -> case pr of
+  Final res -> parse ss env {results = unResults res : results env}
+  State pr args scont -> case pr of
     Terminal f p -> case safeHead $ input env of
-      Just t | f t -> parse ss env {next = State spos p (pureArg t args) scont
+      Just t | f t -> parse ss env {next = State p (args . ($ t)) scont
                                          : next env}
       _            -> parse ss env
     NonTerminal r p -> do
       rkref <- readSTRef $ ruleConts r
       ks    <- readSTRef rkref
-      writeSTRef rkref (Cont spos noArgs p args scont : ks)
-      nulls <- nullable r
-      let nullStates | null nulls = mempty
-                     | otherwise  = pure $ State spos p (pureArgs nulls args) scont
+      writeSTRef rkref (Cont pure p args scont : ks)
       if null ks then do -- The rule has not been expanded at this position.
-        st' <- State (pos env) (ruleProd r) noArgs <$> newConts rkref
-        parse (st' : nullStates ++ ss)
+        st' <- State (ruleProd r) pure <$> newConts rkref
+        parse (st' : ss)
               env {reset = resetConts r >> reset env}
       else -- The rule has already been expanded at this position.
-        parse (nullStates ++ ss) env
-    Pure a | spos /= pos env -> do
+        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 (((++) <$> args a) <*>)
+          modifySTRef asref $ mappend $ args a
           parse ss env
         Nothing    -> do -- It hasn't.
           asref <- newSTRef $ args a
           writeSTRef argsRef $ Just asref
           ks  <- simplifyCont scont
-          let kstates = map (contToState $ join $ readSTRef asref) ks
+          let kstates = map (contToState $ Results $ join $ unResults <$> readSTRef asref) ks
           parse (kstates ++ ss)
                 env {reset = writeSTRef argsRef Nothing >> reset env}
-           | otherwise -> parse ss env
     Alts as (Pure f) -> do
-      let args' = funArg f `composeArgs` args
-          sts   = [State spos a args' scont | a <- as]
+      let args' = args . f
+          sts   = [State a args' scont | a <- as]
       parse (sts ++ ss) env
     Alts as p -> do
-      scont' <- newConts =<< newSTRef [Cont spos noArgs p args scont]
-      -- State is (-1) so that nullable alts are expanded correctly
-      let sts = [State (-1) a noArgs scont' | a <- as]
+      scont' <- newConts =<< newSTRef [Cont pure p args scont]
+      let sts = [State a pure scont' | a <- as]
       parse (sts ++ ss) env
-    Many p q    -> do
-      c  <- newSTRef =<< newSTRef mempty
-      nr <- newSTRef Nothing
-      let r   = Rule (pure [] <|> (:) <$> p <*> NonTerminal r (Pure id)) nr c
-          st' = State spos (NonTerminal r q) args scont
-      parse (st' : ss) env
-    Named pr' n -> parse (State spos pr' args scont : ss)
+    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)
                          env {names = n : names env}
 
 {-# INLINE parser #-}
 -- | Create a parser from the given grammar.
 parser :: ListLike i t
-       => (forall r. Grammar r e (Prod r e t a))
-       -> i
-       -> ST s (Result s e i a)
-parser g xs = do
+       => (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
-  parse [s] $ emptyParseEnv xs
+  return $ parse [s] . emptyParseEnv
 
 -- | 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
 -- produced.
-allParses :: (forall s. ST s (Result s e i a)) -> ([(a, Int)], Report e i)
-allParses p = runST $ p >>= go
+allParses :: (forall s. ST s (i -> ST s (Result s e i a)))
+          -> i
+          -> ([(a, Int)], Report e i)
+allParses p i = runST $ p >>= ($ i) >>= go
   where
     go :: Result s e i a -> ST s ([(a, Int)], Report e i)
     go r = case r of
-      Ended rep          -> return ([], rep)
+      Ended rep           -> return ([], rep)
       Parsed mas cpos _ k -> do
         as <- mas
         fmap (first (zip as (repeat cpos) ++)) $ go =<< k
@@ -319,24 +275,30 @@
 {-# INLINE fullParses #-}
 -- | Return all parses that reached the end of the input from the result of a
 --   given parser.
-fullParses :: ListLike i t => (forall s. ST s (Result s e i a)) -> ([a], Report e i)
-fullParses p = runST $ p >>= go
+fullParses :: ListLike i t
+           => (forall s. ST s (i -> ST s (Result s e i a)))
+           -> i
+           -> ([a], Report e i)
+fullParses p i = runST $ p >>= ($ i) >>= go
   where
     go :: ListLike i t => Result s e i a -> ST s ([a], Report e i)
     go r = case r of
       Ended rep -> return ([], rep)
-      Parsed mas _ i k
-        | ListLike.null i -> do
+      Parsed mas _ i' k
+        | ListLike.null i' -> do
           as <- mas
           fmap (first (as ++)) $ go =<< k
-        | otherwise       -> 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
+report :: ListLike i t
+       => (forall s. ST s (i -> ST s (Result s e i a)))
+       -> i
+       -> Report e i
+report p i = runST $ p >>= ($ i) >>= go
   where
     go :: ListLike i t => Result s e i a -> ST s (Report e i)
     go r = case r of
diff --git a/Text/Earley/Mixfix.hs b/Text/Earley/Mixfix.hs
--- a/Text/Earley/Mixfix.hs
+++ b/Text/Earley/Mixfix.hs
@@ -3,14 +3,15 @@
   ( Associativity(..)
   , Holey
   , mixfixExpression
+  , mixfixExpressionSeparate
   ) where
 
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative
+import Data.Traversable(sequenceA)
 #endif
 import Data.Either
 import Data.Foldable(asum, foldrM)
-import Data.Traversable(sequenceA)
 import Text.Earley
 
 replicateA :: Applicative f => Int -> f a -> f [a]
@@ -51,13 +52,33 @@
   -> (Holey ident -> [expr] -> expr)
   -- ^ How to combine the successful application of a holey identifier to its
   -- arguments into an expression.
-  -> Grammar r e (Prod r e t expr)
-mixfixExpression table atom app = mdo
+  -> Grammar r (Prod r e t expr)
+mixfixExpression table atom app = mixfixExpressionSeparate table' atom
+  where
+    table' = [[(holey, assoc, app) | (holey, assoc) <- row] | row <- table]
+
+-- | A version of 'mixfixExpression' with a separate semantic action for each
+-- individual 'Holey' identifier.
+mixfixExpressionSeparate
+  :: [[(Holey (Prod r e t ident), Associativity, Holey ident -> [expr] -> expr)]]
+  -- ^ A table of holey identifier parsers, with associativity information and
+  -- semantic actions.  The identifiers should be in groups of precedence
+  -- levels listed from binding the least to the most tightly.
+  --
+  -- The associativity is taken into account when an identifier starts or ends
+  -- with holes, or both. Internal holes (e.g. after "if" in "if_then_else_")
+  -- start from the beginning of the table.
+  --
+  -- Note that this rule also applies to identifiers with multiple consecutive
+  -- holes, e.g. "if__" --- the associativity then applies to both holes.
+  -> Prod r e t expr
+  -- ^ An atom, i.e. what is parsed at the lowest level. This will
+  -- commonly be a (non-mixfix) identifier or a parenthesised expression.
+  -> Grammar r (Prod r e t expr)
+mixfixExpressionSeparate table atom = mdo
   expr <- foldrM ($) atom $ map (level expr) table
   return expr
   where
-    app' xs = app (concatMap (either (map $ const Nothing) $ map Just) xs)
-            $ concat $ lefts xs
     level expr idents next = mdo
       same <- rule $ asum $ next : map (mixfixIdent same) idents
       return same
@@ -71,8 +92,10 @@
           Right ps':rest -> Right (consA p ps')       : rest
           rest           -> Right (consA p $ pure []) : rest
 
-        mixfixIdent same (ps, a) = app' <$> go (grp ps)
+        mixfixIdent same (ps, a, f) = f' <$> go (grp ps)
           where
+            f' xs = f (concatMap (either (map $ const Nothing) $ map Just) xs)
+                   $ concat $ lefts xs
             go ps' = case ps' of
               [] -> pure []
               [Right p] -> pure . Right <$> p
diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs
--- a/bench/BenchAll.hs
+++ b/bench/BenchAll.hs
@@ -45,7 +45,7 @@
 
 -- Earley parser
 
-expr :: Grammar r String (Prod r String Token Expr)
+expr :: Grammar r (Prod r String Token Expr)
 expr = mdo
   x1 <- rule $ Add <$> x1 <* namedSymbol "+" <*> x2
             <|> x2
@@ -61,12 +61,12 @@
 isIdent (x:_) = isAlpha x
 isIdent _     = False
 
-sepBy1 :: Prod r e t a -> Prod r e t op -> Grammar r e (Prod r e t [a])
+sepBy1 :: Prod r e t a -> Prod r e t op -> Grammar r (Prod r e t [a])
 sepBy1 p op = mdo
   ops <- rule $ pure [] <|> (:) <$ op <*> p <*> ops
   rule $ (:) <$> p <*> ops
 
-expr' :: Grammar r String (Prod r String Token Expr)
+expr' :: Grammar r (Prod r String Token Expr)
 expr' = mdo
   let var = Var <$> satisfy isIdent <|> symbol "(" *> mul <* symbol ")"
   mul <- fmap (foldl1 Mul) <$> add `sepBy1` symbol "*"
@@ -74,10 +74,10 @@
   return mul
 
 parseEarley :: [Token] -> Maybe Expr
-parseEarley input = listToMaybe (fst (fullParses (parser expr input)))
+parseEarley input = listToMaybe (fst (fullParses (parser expr) input))
 
 parseEarley' :: [Token] -> Maybe Expr
-parseEarley' input = listToMaybe (fst (fullParses (parser expr' input)))
+parseEarley' input = listToMaybe (fst (fullParses (parser expr') input))
 
 -- Parsec parsec
 
diff --git a/examples/English.hs b/examples/English.hs
--- a/examples/English.hs
+++ b/examples/English.hs
@@ -22,7 +22,7 @@
                 | Verb Verb
   deriving Show
 
-sentence :: Grammar r String (Prod r String String Sentence)
+sentence :: Grammar r (Prod r String String Sentence)
 sentence = mdo
   noun       <- rule $ satisfy (`HS.member` nouns)      <?> "noun"
   verb       <- rule $ satisfy (`HS.member` verbs)      <?> "verb"
@@ -37,9 +37,9 @@
 
 main :: IO ()
 main = do
-  let p = parser sentence . words
-  print $ fullParses $ p "parsers use grammars"
-  print $ fullParses $ p "parsers munch long sentences"
-  print $ fullParses $ p "many great sentences confuse parsers"
-  print $ fullParses $ p "parsers use use"
-  print $ fullParses $ p "grammars many great confusing"
+  let p = fullParses (parser sentence) . words
+  print $ p "parsers use grammars"
+  print $ p "parsers munch long sentences"
+  print $ p "many great sentences confuse parsers"
+  print $ p "parsers use use"
+  print $ p "grammars many great confusing"
diff --git a/examples/Expr.hs b/examples/Expr.hs
--- a/examples/Expr.hs
+++ b/examples/Expr.hs
@@ -10,7 +10,7 @@
   | Var String
   deriving (Eq, Ord, Show)
 
-expr :: Grammar r String (Prod r String String Expr)
+expr :: Grammar r (Prod r String String Expr)
 expr = mdo
   x1 <- rule $ Add <$> x1 <* namedSymbol "+" <*> x2
             <|> x2
@@ -28,4 +28,4 @@
 main :: IO ()
 main = do
   x:_ <- getArgs
-  print $ fullParses $ parser expr $ words x
+  print $ fullParses (parser expr) $ words x
diff --git a/examples/Expr2.hs b/examples/Expr2.hs
--- a/examples/Expr2.hs
+++ b/examples/Expr2.hs
@@ -11,7 +11,7 @@
   | Lit Int
   deriving (Show)
 
-grammar :: forall r. Grammar r String (Prod r String Char Expr)
+grammar :: forall r. Grammar r (Prod r String Char Expr)
 grammar = mdo
 
   whitespace <- rule $ many $ satisfy isSpace
@@ -42,4 +42,4 @@
 main :: IO ()
 main = do
   x:_ <- getArgs
-  print $ fullParses $ parser grammar x
+  print $ fullParses (parser grammar) x
diff --git a/examples/Infinite.hs b/examples/Infinite.hs
new file mode 100644
--- /dev/null
+++ b/examples/Infinite.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE RecursiveDo #-}
+module Testa where
+import Control.Applicative
+import Text.Earley
+
+grammar :: Grammar r (Prod r () Char [Maybe Char])
+grammar = mdo
+  as <- rule $ pure []
+            <|> (:) <$> optional (symbol 'a') <*> as
+  return as
+
+-- This grammar has an infinite number of results. We can still recognise the
+-- language, i.e. get a report, but we can't get the results, because in doing
+-- so the library will try to force a circular value.
+main :: IO ()
+main = do
+  let input = "aaa"
+  print $ report (parser grammar) input -- Works
+  print $ fullParses (parser grammar) input -- Hangs
diff --git a/examples/Mixfix.hs b/examples/Mixfix.hs
--- a/examples/Mixfix.hs
+++ b/examples/Mixfix.hs
@@ -29,7 +29,7 @@
   , [("_*_",           LeftAssoc)]
   ]
 
-grammar :: Grammar r String (Prod r String String Expr)
+grammar :: Grammar r (Prod r String String Expr)
 grammar = mdo
   ident     <- rule $ (V . pure . Just) <$> satisfy (not . (`HS.member` mixfixParts))
                    <?> "identifier"
@@ -63,4 +63,4 @@
 main :: IO ()
 main = do
   x:_ <- getArgs
-  print $ first (map pretty) $ fullParses $ parser grammar $ tokenize x
+  print $ first (map pretty) $ fullParses (parser grammar) $ tokenize x
diff --git a/examples/VeryAmbiguous.hs b/examples/VeryAmbiguous.hs
--- a/examples/VeryAmbiguous.hs
+++ b/examples/VeryAmbiguous.hs
@@ -3,7 +3,7 @@
 import System.Environment
 import Text.Earley
 
-g :: Grammar r Char (Prod r Char Char ())
+g :: Grammar r (Prod r Char Char ())
 g = mdo
   s <- rule $ () <$ symbol 'b'
            <|> () <$ s <* s
@@ -14,4 +14,4 @@
 main :: IO ()
 main = do
   xs:_ <- getArgs
-  print $ report $ parser g xs
+  print $ report (parser g) xs
diff --git a/examples/Words.hs b/examples/Words.hs
--- a/examples/Words.hs
+++ b/examples/Words.hs
@@ -5,7 +5,7 @@
 
 import Text.Earley
 
-grammar :: Grammar r String (Prod r String Char [String])
+grammar :: Grammar r (Prod r String Char [String])
 grammar = mdo
   whitespace  <- rule $ () <$ many (satisfy isSpace)
   whitespace1 <- rule $ () <$ satisfy isSpace <* whitespace <?> "whitespace"
@@ -23,4 +23,4 @@
 main :: IO ()
 main = do
   x:_ <- getArgs
-  print $ fullParses $ parser grammar x
+  print $ fullParses (parser grammar) x
diff --git a/tests/Tests.hs b/tests/Tests.hs
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -22,14 +22,14 @@
     \e -> e `elem` parseAmbiguousExpr (prettyExpr 0 e)
   , QC.testProperty "The empty parser doesn't parse anything" $
     \(input :: String) ->
-      allParses (parser (return empty :: forall r. Grammar r () (Prod r () Char ())) input)
+      allParses (parser (return empty :: forall r. Grammar r (Prod r () Char ()))) input
       == (,) [] Report { position   = 0
                        , expected   = []
                        , unconsumed = input
                        }
   , QC.testProperty "Many empty parsers parse very little" $
     \(input :: String) ->
-      allParses (parser (return $ many empty <* pure "blah" :: forall r. Grammar r () (Prod r () Char [()])) input)
+      allParses (parser (return $ many empty <* pure "blah" :: forall r. Grammar r (Prod r () Char [()]))) input
       == (,) [([], 0)] Report { position   = 0
                               , expected   = []
                               , unconsumed = input
@@ -39,104 +39,104 @@
 unitTests :: TestTree
 unitTests = testGroup "Unit Tests"
   [ HU.testCase "VeryAmbiguous gives the right number of results" $
-      length (fst $ fullParses $ parser veryAmbiguous $ replicate 8 'b') @?= 2871
+      length (fst $ fullParses (parser veryAmbiguous) $ replicate 8 'b') @?= 2871
   , HU.testCase "VeryAmbiguous gives the correct report" $
-      report (parser veryAmbiguous $ replicate 3 'b') @?=
+      report (parser veryAmbiguous) (replicate 3 'b') @?=
       Report {position = 3, expected = "s", unconsumed = ""}
   , HU.testCase "Inline alternatives work" $
       let input = "ababbbaaabaa" in
-      allParses (parser inlineAlts input) @?= allParses (parser nonInlineAlts input)
+      allParses (parser inlineAlts) input @?= allParses (parser nonInlineAlts) input
   , HU.testCase "Some reversed words" $
       let input = "wordwordstop"
           l     = length input in
-      allParses (parser someWords input)
+      allParses (parser someWords) input
       @?= (,) [(["stop", "drow", "drow"], l)] Report { position   = l
                                                      , expected   = []
                                                      , unconsumed = []
                                                      }
   , HU.testCase "Optional Nothing" $
-      fullParses (parser (return optional_) "b")
+      fullParses (parser $ return optional_) "b"
       @?= (,) [(Nothing, 'b')] Report {position = 1, expected = "", unconsumed = ""}
   , HU.testCase "Optional Just" $
-      fullParses (parser (return optional_) "ab")
+      fullParses (parser $ return optional_) "ab"
       @?= (,) [(Just 'a', 'b')] Report {position = 2, expected = "", unconsumed = ""}
   , HU.testCase "Optional using rules Nothing" $
-      fullParses (parser optionalRule "b")
+      fullParses (parser $ optionalRule) "b"
       @?= (,) [(Nothing, 'b')] Report {position = 1, expected = "", unconsumed = ""}
   , HU.testCase "Optional using rules Just" $
-      fullParses (parser optionalRule "ab")
+      fullParses (parser $ optionalRule) "ab"
       @?= (,) [(Just 'a', 'b')] Report {position = 2, expected = "", unconsumed = ""}
   , HU.testCase "Optional without continuation Nothing" $
-      fullParses (parser (return $ optional $ namedSymbol 'a') "")
+      fullParses (parser $ return $ optional $ namedSymbol 'a') ""
       @?= (,) [Nothing] Report {position = 0, expected = "a", unconsumed = ""}
   , HU.testCase "Optional without continuation Just" $
-      fullParses (parser (return $ optional $ namedSymbol 'a') "a")
+      fullParses (parser $ return $ optional $ namedSymbol 'a') "a"
       @?= (,) [Just 'a'] Report {position = 1, expected = "", unconsumed = ""}
   , HU.testCase "Optional using rules without continuation Nothing" $
-      fullParses (parser (rule $ optional $ namedSymbol 'a') "")
+      fullParses (parser $ rule $ optional $ namedSymbol 'a') ""
       @?= (,) [Nothing] Report {position = 0, expected = "a", unconsumed = ""}
   , HU.testCase "Optional using rules without continuation Just" $
-      fullParses (parser (rule $ optional $ namedSymbol 'a') "a")
+      fullParses (parser $ rule $ optional $ namedSymbol 'a') "a"
       @?= (,) [Just 'a'] Report {position = 1, expected = "", unconsumed = ""}
 
   , HU.testCase "Mixfix 1" $
       let x = Ident [Just "x"] in
-      fullParses (parser mixfixGrammar $ words "if x then x else x")
+      fullParses (parser mixfixGrammar) (words "if x then x else x")
       @?= (,) [App ifthenelse [x, x, x]] Report {position = 6, expected = [], unconsumed = []}
   , HU.testCase "Mixfix 2" $
       let x = Ident [Just "x"] in
-      fullParses (parser mixfixGrammar $ words "prefix x postfix")
+      fullParses (parser mixfixGrammar) (words "prefix x postfix")
       @?= (,) [App prefix [App postfix [x]]] Report {position = 3, expected = [], unconsumed = []}
   , HU.testCase "Mixfix 3" $
       let x = Ident [Just "x"] in
-      fullParses (parser mixfixGrammar $ words "x infix1 x infix2 x")
+      fullParses (parser mixfixGrammar) (words "x infix1 x infix2 x")
       @?= (,) [App infix1 [x, App infix2 [x, x]]] Report {position = 5, expected = [], unconsumed = []}
   , HU.testCase "Mixfix 4" $
       let x = Ident [Just "x"] in
-      fullParses (parser mixfixGrammar $ words "[ x ]")
+      fullParses (parser mixfixGrammar) (words "[ x ]")
       @?= (,) [App closed [x]] Report {position = 3, expected = [], unconsumed = []}
 
   , let x = words "+ + 5 6 7" in
     HU.testCase "Mixfix issue #11 1" $
-    fullParses (parser (issue11 LeftAssoc) x)
+    fullParses (parser $ issue11 LeftAssoc) x
     @?= (,) [] Report {position = 1, expected = [], unconsumed = drop 1 x}
   , let x = words "+ 5 + 6 7" in
     HU.testCase "Mixfix issue #11 2" $
-    fullParses (parser (issue11 LeftAssoc) x)
+    fullParses (parser $ issue11 LeftAssoc) x
     @?= (,) [] Report {position = 2, expected = [], unconsumed = drop 2 x}
   , let x = words "+ 5 6" in
     HU.testCase "Mixfix issue #11 3" $
-    fullParses (parser (issue11 LeftAssoc) x)
+    fullParses (parser $ issue11 LeftAssoc) x
     @?= (,) [Plus11 (Var11 "5") (Var11 "6")]
             Report {position = 3, expected = [], unconsumed = []}
   , let x = words "+ + 5 6 7" in
     HU.testCase "Mixfix issue #11 4" $
-    fullParses (parser (issue11 RightAssoc) x)
+    fullParses (parser $ issue11 RightAssoc) x
     @?= (,) [Plus11 (Plus11 (Var11 "5") (Var11 "6")) (Var11 "7")]
             Report {position = 5, expected = [], unconsumed = []}
   , let x = words "+ 5 + 6 7" in
     HU.testCase "Mixfix issue #11 5" $
-    fullParses (parser (issue11 RightAssoc) x)
+    fullParses (parser $ issue11 RightAssoc) x
     @?= (,) [Plus11 (Var11 "5") (Plus11 (Var11 "6") (Var11 "7"))]
             Report {position = 5, expected = [], unconsumed = []}
   , let x = words "+ 5 6" in
     HU.testCase "Mixfix issue #11 6" $
-    fullParses (parser (issue11 RightAssoc) x)
+    fullParses (parser $ issue11 RightAssoc) x
     @?= (,) [Plus11 (Var11 "5") (Var11 "6")]
             Report {position = 3, expected = [], unconsumed = []}
   , let x = words "+ + 5 6 7" in
     HU.testCase "Mixfix issue #11 7" $
-    fullParses (parser (issue11 NonAssoc) x)
+    fullParses (parser $ issue11 NonAssoc) x
     @?= (,) [Plus11 (Plus11 (Var11 "5") (Var11 "6")) (Var11 "7")]
             Report {position = 5, expected = [], unconsumed = []}
   , let x = words "+ 5 + 6 7" in
     HU.testCase "Mixfix issue #11 8" $
-    fullParses (parser (issue11 NonAssoc) x)
+    fullParses (parser $ issue11 NonAssoc) x
     @?= (,) [Plus11 (Var11 "5") (Plus11 (Var11 "6") (Var11 "7"))]
             Report {position = 5, expected = [], unconsumed = []}
   , let x = words "+ 5 6" in
     HU.testCase "Mixfix issue #11 9" $
-    fullParses (parser (issue11 NonAssoc) x)
+    fullParses (parser $ issue11 NonAssoc) x
     @?= (,) [Plus11 (Var11 "5") (Var11 "6")]
             Report {position = 3, expected = [], unconsumed = []}
   ]
@@ -144,27 +144,27 @@
 optional_ :: Prod r Char Char (Maybe Char, Char)
 optional_ = (,) <$> optional (namedSymbol 'a') <*> namedSymbol 'b'
 
-optionalRule :: Grammar r Char (Prod r Char Char (Maybe Char, Char))
+optionalRule :: Grammar r (Prod r Char Char (Maybe Char, Char))
 optionalRule = mdo
   test <- rule $ (,) <$> optional (namedSymbol 'a') <*> namedSymbol 'b'
   return test
 
-inlineAlts :: Grammar r Char (Prod r Char Char String)
+inlineAlts :: Grammar r (Prod r Char Char String)
 inlineAlts = mdo
   p <- rule $ pure []
            <|> (:) <$> (namedSymbol 'a' <|> namedSymbol 'b') <*> p
   return p
 
-nonInlineAlts :: Grammar r Char (Prod r Char Char String)
+nonInlineAlts :: Grammar r (Prod r Char Char String)
 nonInlineAlts = mdo
   ab <- rule $ namedSymbol 'a' <|> namedSymbol 'b'
   p  <- rule $ pure [] <|> (:) <$> ab <*> p
   return p
 
-someWords :: Grammar r () (Prod r () Char [String])
+someWords :: Grammar r (Prod r () Char [String])
 someWords = return $ flip (:) <$> (map reverse <$> some (word "word")) <*> word "stop"
 
-veryAmbiguous :: Grammar r Char (Prod r Char Char ())
+veryAmbiguous :: Grammar r (Prod r Char Char ())
 veryAmbiguous = mdo
   s <- rule $ () <$ symbol 'b'
            <|> () <$ s <* s
@@ -173,10 +173,10 @@
   return s
 
 parseExpr :: String -> [Expr]
-parseExpr input = fst (fullParses (parser expr (lexExpr input))) -- We need to annotate types for point-free version
+parseExpr input = fst (fullParses (parser expr) (lexExpr input)) -- We need to annotate types for point-free version
 
 parseAmbiguousExpr :: String -> [Expr]
-parseAmbiguousExpr input = fst (fullParses (parser ambiguousExpr (lexExpr input)))
+parseAmbiguousExpr input = fst (fullParses (parser ambiguousExpr) (lexExpr input))
 
 data Expr
   = Add Expr Expr
@@ -198,7 +198,7 @@
   shrink (Add a b)  = a : b : [ Add a' b | a' <- shrink a ] ++ [ Add a b' | b' <- shrink b ]
   shrink (Mul a b)  = a : b : [ Mul a' b | a' <- shrink a ] ++ [ Mul a b' | b' <- shrink b ]
 
-expr :: Grammar r String (Prod r String String Expr)
+expr :: Grammar r (Prod r String String Expr)
 expr = mdo
   x1 <- rule $ Add <$> x1 <* namedSymbol "+" <*> x2
             <|> x2
@@ -213,7 +213,7 @@
     ident (x:_) = isAlpha x
     ident _     = False
 
-ambiguousExpr :: Grammar r String (Prod r String String Expr)
+ambiguousExpr :: Grammar r (Prod r String String Expr)
 ambiguousExpr = mdo
   x1 <- rule $ Add <$> x1 <* namedSymbol "+" <*> x1
             <|> x2
@@ -251,7 +251,7 @@
 data MixfixExpr = Ident (Holey String) | App (Holey String) [MixfixExpr]
   deriving (Eq, Show)
 
-mixfixGrammar :: Grammar r String (Prod r String String MixfixExpr)
+mixfixGrammar :: Grammar r (Prod r String String MixfixExpr)
 mixfixGrammar = mixfixExpression table
                                  (Ident . pure . Just <$> namedSymbol "x")
                                  App
@@ -280,7 +280,7 @@
   | Plus11 Mixfix11 Mixfix11
   deriving (Eq, Ord, Show)
 
-issue11 :: Associativity -> Grammar r String (Prod r String String Mixfix11)
+issue11 :: Associativity -> Grammar r (Prod r String String Mixfix11)
 issue11 a = mdo
     atomicExpr <- rule $ Var11 <$> satisfy (/= "+")