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

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@,