diff options
author | David Feuer <david.feuer@gmail.com> | 2016-11-10 15:20:15 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2016-11-10 15:25:39 -0500 |
commit | bef7e784d037f720697a215b9e21f13b385e6d3e (patch) | |
tree | b957387ca612a3e1d3e18776fb7a8f586c24e407 | |
parent | e06e21af1fd077067149f2c41fb5b2553622f499 (diff) | |
download | haskell-bef7e784d037f720697a215b9e21f13b385e6d3e.tar.gz |
Read parentheses better
Instead of pulling a token and looking for `'('` or `')'`,
just look for the character itself. This prevents us from
lexing every single item twice, once to see if it's a
left parenthesis and once to actually parse it.
Partially fixes #12665
Make parens faster more aggressively
* Strip spaces before parsing, so we never have to strip
the same spaces twice.
* String parsers together manually, to try to avoid unnecessary closure
creation.
Test Plan: Validate
Reviewers: austin, hvr, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2630
GHC Trac Issues: #12665
-rw-r--r-- | libraries/base/GHC/Read.hs | 31 |
1 files changed, 24 insertions, 7 deletions
diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs index ebb72c77da..ad505bb106 100644 --- a/libraries/base/GHC/Read.hs +++ b/libraries/base/GHC/Read.hs @@ -287,22 +287,39 @@ lexP = lift L.lex expectP :: L.Lexeme -> ReadPrec () expectP lexeme = lift (L.expect lexeme) +expectCharP :: Char -> ReadPrec a -> ReadPrec a +expectCharP c a = do + q <- get + if q == c + then a + else pfail +{-# INLINE expectCharP #-} + +skipSpacesThenP :: ReadPrec a -> ReadPrec a +skipSpacesThenP m = + do s <- look + skip s + where + skip (c:s) | isSpace c = get *> skip s + skip _ = m + paren :: ReadPrec a -> ReadPrec a -- ^ @(paren p)@ parses \"(P0)\" -- where @p@ parses \"P0\" in precedence context zero -paren p = do expectP (L.Punc "(") - x <- reset p - expectP (L.Punc ")") - return x +paren p = skipSpacesThenP (paren' p) + +paren' :: ReadPrec a -> ReadPrec a +paren' p = expectCharP '(' $ reset p >>= \x -> + skipSpacesThenP (expectCharP ')' (pure x)) parens :: ReadPrec a -> ReadPrec a -- ^ @(parens p)@ parses \"P\", \"(P0)\", \"((P0))\", etc, -- where @p@ parses \"P\" in the current precedence context -- and parses \"P0\" in precedence context zero parens p = optional - where - optional = p +++ mandatory - mandatory = paren optional + where + optional = skipSpacesThenP (p +++ mandatory) + mandatory = paren' optional list :: ReadPrec a -> ReadPrec [a] -- ^ @(list p)@ parses a list of things parsed by @p@, |