Make some combinators more efficient

This commit is contained in:
mrkkrp 2016-02-07 19:42:11 +06:00
parent 4bde699b84
commit 7727821c2a
3 changed files with 8 additions and 10 deletions

View File

@ -57,13 +57,11 @@ choice = asum
-- | @count n p@ parses @n@ occurrences of @p@. If @n@ is smaller or
-- equal to zero, the parser equals to @return []@. Returns a list of @n@
-- values.
--
-- This parser is defined in terms of 'count'', like this:
--
-- > count n = count' n n
count :: Alternative m => Int -> m a -> m [a]
count n = count' n n
count :: Applicative m => Int -> m a -> m [a]
count n p
| n <= 0 = pure []
| otherwise = sequenceA (replicate n p)
{-# INLINE count #-}
-- | @count\' m n p@ parses from @m@ to @n@ occurrences of @p@. If @n@ is
@ -108,7 +106,6 @@ endBy1 p sep = some (p <* sep)
manyTill :: Alternative m => m a -> m end -> m [a]
manyTill p end = ([] <$ end) <|> someTill p end
{-# INLINE manyTill #-}
-- | @someTill p end@ works similarly to @manyTill p end@, but @p@ should
-- succeed at least once.
@ -148,7 +145,6 @@ sepBy1 p sep = (:) <$> p <*> many (sep *> p)
sepEndBy :: Alternative m => m a -> m sep -> m [a]
sepEndBy p sep = sepEndBy1 p sep <|> pure []
{-# INLINE sepEndBy #-}
-- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@,
-- separated and optionally ended by @sep@. Returns a list of values

View File

@ -171,6 +171,7 @@ mergeError e1@(ParseError pos1 _) e2@(ParseError pos2 ms2) =
LT -> e2
EQ -> addErrorMessages ms2 e1
GT -> e1
{-# INLINE mergeError #-}
-- | @showMessages ms@ transforms list of error messages @ms@ into
-- their textual representation.

View File

@ -91,6 +91,7 @@ longestMatch s1@(State _ pos1 _) s2@(State _ pos2 _) =
LT -> s2
EQ -> s2
GT -> s1
{-# INLINE longestMatch #-}
-- | All information available after parsing. This includes consumption of
-- input, success (with return value) or failure (with parse error), parser
@ -383,9 +384,9 @@ pZero = ParsecT $ \s@(State _ pos _) _ _ _ eerr ->
pPlus :: ParsecT s m a -> ParsecT s m a -> ParsecT s m a
pPlus m n = ParsecT $ \s cok cerr eok eerr ->
let meerr err ms =
let ncerr err' s' = cerr (err' <> err) (longestMatch ms s')
let ncerr err' s' = cerr (mergeError err' err) (longestMatch ms s')
neok x s' hs = eok x s' (toHints err <> hs)
neerr err' s' = eerr (err' <> err) (longestMatch ms s')
neerr err' s' = eerr (mergeError err' err) (longestMatch ms s')
in unParser n s cok ncerr neok neerr
in unParser m s cok cerr eok meerr
{-# INLINE pPlus #-}