[commit: ghc] master: Read parentheses better (bef7e78)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/bef7e784d037f720697a215b9e21f13b385e6d3e/ghc

>---------------------------------------------------------------

commit bef7e784d037f720697a215b9e21f13b385e6d3e
Author: David Feuer <david.feuer at gmail.com>
Date:   Thu Nov 10 15:20:15 2016 -0500

    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


>---------------------------------------------------------------

bef7e784d037f720697a215b9e21f13b385e6d3e
 libraries/base/GHC/Read.hs | 31 ++++++++++++++++++++++++-------
 1 file changed, 24 insertions(+), 7 deletions(-)

diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs
index ebb72c7..ad505bb 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@,