Add INLINABLE pragmas to most overloaded combinators

This adds INLINABLE pragmas to most exported combinators, which enables
cross-module specialization of the Stream constraint (which can in turn
enable further optimizations). This improves performance of these
combinators in scenarios where GHC chooses not to inline them, since
they may still be specialized instead.

This change is primarily in response to a performance regression
discovered by the GHC performance test suite when running haddock (since
haddock uses parsec). The full discussion is available here:

    https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3041

The gist is that, without these pragmas, performance relies too heavily
on inlining heuristics working out in our favor, and subtle changes in
the optimizer can cause regressions.

The GHC performance tests suggest this patch reliably reduces runtime of
haddock on base by 7–9% and allocation by 3–5%. Pretty good for doing
something so simple!

src/Text/Parsec/Char.hs

@@ -30,6 +30,7 @@ import Control.Applicative ((*>))
 -- >   vowel  = oneOf "aeiou"
 
 oneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char
+{-# INLINABLE oneOf #-}
 oneOf cs            = satisfy (\c -> elem c cs)
 
 -- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current
@@ -39,28 +40,33 @@ oneOf cs            = satisfy (\c -> elem c cs)
 -- >  consonant = noneOf "aeiou"
 
 noneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char
+{-# INLINABLE noneOf #-}
 noneOf cs           = satisfy (\c -> not (elem c cs))
 
 -- | Skips /zero/ or more white space characters. See also 'skipMany'.
 
 spaces :: (Stream s m Char) => ParsecT s u m ()
+{-# INLINABLE spaces #-}
 spaces              = skipMany space        <?> "white space"
 
 -- | Parses a white space character (any character which satisfies 'isSpace')
 -- Returns the parsed character.
 
 space :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE space #-}
 space               = satisfy isSpace       <?> "space"
 
 -- | Parses a newline character (\'\\n\'). Returns a newline character.
 
 newline :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE newline #-}
 newline             = char '\n'             <?> "lf new-line"
 
 -- | Parses a carriage return character (\'\\r\') followed by a newline character (\'\\n\').
 -- Returns a newline character.
 
 crlf :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE crlf #-}
 crlf                = char '\r' *> char '\n' <?> "crlf new-line"
 
 -- | Parses a CRLF (see 'crlf') or LF (see 'newline') end-of-line.
@@ -70,23 +76,27 @@ crlf                = char '\r' *> char '\n' <?> "crlf new-line"
 --
 
 endOfLine :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE endOfLine #-}
 endOfLine           = newline <|> crlf       <?> "new-line"
 
 -- | Parses a tab character (\'\\t\'). Returns a tab character.
 
 tab :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE tab #-}
 tab                 = char '\t'             <?> "tab"
 
 -- | Parses an upper case letter (according to 'isUpper').
 -- Returns the parsed character.
 
 upper :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE upper #-}
 upper               = satisfy isUpper       <?> "uppercase letter"
 
 -- | Parses a lower case character (according to 'isLower').
 -- Returns the parsed character.
 
 lower :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE lower #-}
 lower               = satisfy isLower       <?> "lowercase letter"
 
 -- | Parses a alphabetic or numeric Unicode characters
@@ -97,30 +107,35 @@ lower               = satisfy isLower       <?> "lowercase letter"
 -- but not by 'digit'.
 
 alphaNum :: (Stream s m Char => ParsecT s u m Char)
+{-# INLINABLE alphaNum #-}
 alphaNum            = satisfy isAlphaNum    <?> "letter or digit"
 
 -- | Parses an alphabetic Unicode characters (lower-case, upper-case and title-case letters,
 -- plus letters of caseless scripts and modifiers letters according to 'isAlpha').
 -- Returns the parsed character.
 
 letter :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE letter #-}
 letter              = satisfy isAlpha       <?> "letter"
 
 -- | Parses an ASCII digit. Returns the parsed character.
 
 digit :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE digit #-}
 digit               = satisfy isDigit       <?> "digit"
 
 -- | Parses a hexadecimal digit (a digit or a letter between \'a\' and
 -- \'f\' or \'A\' and \'F\'). Returns the parsed character.
 
 hexDigit :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE hexDigit #-}
 hexDigit            = satisfy isHexDigit    <?> "hexadecimal digit"
 
 -- | Parses an octal digit (a character between \'0\' and \'7\'). Returns
 -- the parsed character.
 
 octDigit :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE octDigit #-}
 octDigit            = satisfy isOctDigit    <?> "octal digit"
 
 -- | @char c@ parses a single character @c@. Returns the parsed
@@ -129,11 +144,13 @@ octDigit            = satisfy isOctDigit    <?> "octal digit"
 -- >  semiColon  = char ';'
 
 char :: (Stream s m Char) => Char -> ParsecT s u m Char
+{-# INLINABLE char #-}
 char c              = satisfy (==c)  <?> show [c]
 
 -- | This parser succeeds for any character. Returns the parsed character.
 
 anyChar :: (Stream s m Char) => ParsecT s u m Char
+{-# INLINABLE anyChar #-}
 anyChar             = satisfy (const True)
 
 -- | The parser @satisfy f@ succeeds for any character for which the
@@ -144,6 +161,7 @@ anyChar             = satisfy (const True)
 -- >  oneOf cs  = satisfy (\c -> c `elem` cs)
 
 satisfy :: (Stream s m Char) => (Char -> Bool) -> ParsecT s u m Char
+{-# INLINABLE satisfy #-}
 satisfy f           = tokenPrim (\c -> show [c])
                                 (\pos c _cs -> updatePosChar pos c)
                                 (\c -> if f c then Just c else Nothing)
@@ -155,4 +173,5 @@ satisfy f           = tokenPrim (\c -> show [c])
 -- >              <|> string "mod"
 
 string :: (Stream s m Char) => String -> ParsecT s u m String
+{-# INLINABLE string #-}
 string s            = tokens show updatePosString s

src/Text/Parsec/Combinator.hs

@@ -51,6 +51,7 @@ import Debug.Trace (trace)
 -- parser.
 
 choice :: (Stream s m t) => [ParsecT s u m a] -> ParsecT s u m a
+{-# INLINABLE choice #-}
 choice ps           = foldr (<|>) mzero ps
 
 -- | @option x p@ tries to apply parser @p@. If @p@ fails without
@@ -62,20 +63,23 @@ choice ps           = foldr (<|>) mzero ps
 -- >                          })
 
 option :: (Stream s m t) => a -> ParsecT s u m a -> ParsecT s u m a
+{-# INLINABLE option #-}
 option x p          = p <|> return x
 
 -- | @optionMaybe p@ tries to apply parser @p@.  If @p@ fails without
 -- consuming input, it return 'Nothing', otherwise it returns
 -- 'Just' the value returned by @p@.
 
 optionMaybe :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (Maybe a)
+{-# INLINABLE optionMaybe #-}
 optionMaybe p       = option Nothing (liftM Just p)
 
 -- | @optional p@ tries to apply parser @p@.  It will parse @p@ or nothing.
 -- It only fails if @p@ fails after consuming input. It discards the result
 -- of @p@.
 
 optional :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
+{-# INLINABLE optional #-}
 optional p          = do{ _ <- p; return ()} <|> return ()
 
 -- | @between open close p@ parses @open@, followed by @p@ and @close@.
@@ -85,13 +89,15 @@ optional p          = do{ _ <- p; return ()} <|> return ()
 
 between :: (Stream s m t) => ParsecT s u m open -> ParsecT s u m close
             -> ParsecT s u m a -> ParsecT s u m a
+{-# INLINABLE between #-}
 between open close p
                     = do{ _ <- open; x <- p; _ <- close; return x }
 
 -- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping
 -- its result.
 
 skipMany1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
+{-# INLINABLE skipMany1 #-}
 skipMany1 p         = do{ _ <- p; skipMany p }
 {-
 skipMany p          = scan
@@ -105,6 +111,7 @@ skipMany p          = scan
 -- >  word  = many1 letter
 
 many1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]
+{-# INLINABLE many1 #-}
 many1 p             = do{ x <- p; xs <- many p; return (x:xs) }
 {-
 many p              = scan id
@@ -122,12 +129,14 @@ many p              = scan id
 -- >  commaSep p  = p `sepBy` (symbol ",")
 
 sepBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
+{-# INLINABLE sepBy #-}
 sepBy p sep         = sepBy1 p sep <|> return []
 
 -- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated
 -- by @sep@. Returns a list of values returned by @p@.
 
 sepBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
+{-# INLINABLE sepBy1 #-}
 sepBy1 p sep        = do{ x <- p
                         ; xs <- many (sep >> p)
                         ; return (x:xs)
@@ -139,6 +148,7 @@ sepBy1 p sep        = do{ x <- p
 -- returned by @p@.
 
 sepEndBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
+{-# INLINABLE sepEndBy1 #-}
 sepEndBy1 p sep     = do{ x <- p
                         ; do{ _ <- sep
                             ; xs <- sepEndBy p sep
@@ -154,13 +164,15 @@ sepEndBy1 p sep     = do{ x <- p
 -- >  haskellStatements  = haskellStatement `sepEndBy` semi
 
 sepEndBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
+{-# INLINABLE sepEndBy #-}
 sepEndBy p sep      = sepEndBy1 p sep <|> return []
 
 
 -- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, separated
 -- and ended by @sep@. Returns a list of values returned by @p@.
 
 endBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
+{-# INLINABLE endBy1 #-}
 endBy1 p sep        = many1 (do{ x <- p; _ <- sep; return x })
 
 -- | @endBy p sep@ parses /zero/ or more occurrences of @p@, separated
@@ -169,13 +181,15 @@ endBy1 p sep        = many1 (do{ x <- p; _ <- sep; return x })
 -- >   cStatements  = cStatement `endBy` semi
 
 endBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
+{-# INLINABLE endBy #-}
 endBy p sep         = many (do{ x <- p; _ <- sep; return x })
 
 -- | @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 returned by @p@.
 
 count :: (Stream s m t) => Int -> ParsecT s u m a -> ParsecT s u m [a]
+{-# INLINABLE count #-}
 count n p           | n <= 0    = return []
                     | otherwise = sequence (replicate n p)
 
@@ -186,6 +200,7 @@ count n p           | n <= 0    = return []
 -- returned.
 
 chainr :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
+{-# INLINABLE chainr #-}
 chainr p op x       = chainr1 p op <|> return x
 
 -- | @chainl p op x@ parses /zero/ or more occurrences of @p@,
@@ -195,6 +210,7 @@ chainr p op x       = chainr1 p op <|> return x
 -- returned.
 
 chainl :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
+{-# INLINABLE chainl #-}
 chainl p op x       = chainl1 p op <|> return x
 
 -- | @chainl1 p op@ parses /one/ or more occurrences of @p@,
@@ -214,6 +230,7 @@ chainl p op x       = chainl1 p op <|> return x
 -- >          <|> do{ symbol "-"; return (-) }
 
 chainl1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
+{-# INLINABLE chainl1 #-}
 chainl1 p op        = do{ x <- p; rest x }
                     where
                       rest x    = do{ f <- op
@@ -228,6 +245,7 @@ chainl1 p op        = do{ x <- p; rest x }
 -- by @p@.
 
 chainr1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
+{-# INLINABLE chainr1 #-}
 chainr1 p op        = scan
                     where
                       scan      = do{ x <- p; rest x }
@@ -245,6 +263,7 @@ chainr1 p op        = scan
 -- used to implement 'eof'. Returns the accepted token.
 
 anyToken :: (Stream s m t, Show t) => ParsecT s u m t
+{-# INLINABLE anyToken #-}
 anyToken            = tokenPrim show (\pos _tok _toks -> pos) Just
 
 -- | This parser only succeeds at the end of the input. This is not a
@@ -253,6 +272,7 @@ anyToken            = tokenPrim show (\pos _tok _toks -> pos) Just
 -- >  eof  = notFollowedBy anyToken <?> "end of input"
 
 eof :: (Stream s m t, Show t) => ParsecT s u m ()
+{-# INLINABLE eof #-}
 eof                 = notFollowedBy anyToken <?> "end of input"
 
 -- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser
@@ -279,6 +299,7 @@ eof                 = notFollowedBy anyToken <?> "end of input"
 -- for more details.
 
 notFollowedBy :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()
+{-# INLINABLE notFollowedBy #-}
 notFollowedBy p     = try (do{ c <- try p; unexpected (show c) }
                            <|> return ()
                           )
@@ -295,6 +316,7 @@ notFollowedBy p     = try (do{ c <- try p; unexpected (show c) }
 --    therefore the use of the 'try' combinator.
 
 manyTill :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
+{-# INLINABLE manyTill #-}
 manyTill p end      = scan
                     where
                       scan  = do{ _ <- end; return [] }
@@ -311,6 +333,7 @@ manyTill p end      = scan
 --
 -- @since 3.1.12.0
 parserTrace :: (Show t, Stream s m t) => String -> ParsecT s u m ()
+{-# INLINABLE parserTrace #-}
 parserTrace s = pt <|> return ()
     where
         pt = try $ do
@@ -332,6 +355,7 @@ parserTrace s = pt <|> return ()
 --
 -- @since 3.1.12.0
 parserTraced :: (Stream s m t, Show t) => String -> ParsecT s u m b -> ParsecT s u m b
+{-# INLINABLE parserTraced #-}
 parserTraced s p = do
   parserTrace s
   p <|> trace (s ++ " backtracked") (fail s)

src/Text/Parsec/Expr.hs

@@ -96,6 +96,7 @@ buildExpressionParser :: (Stream s m t)
                       => OperatorTable s u m a
                       -> ParsecT s u m a
                       -> ParsecT s u m a
+{-# INLINABLE buildExpressionParser #-}
 buildExpressionParser operators simpleExpr
     = foldl (makeParser) simpleExpr operators
     where

src/Text/Parsec/Prim.hs

@@ -156,6 +156,7 @@ newtype ParsecT s u m a
 -- | Low-level unpacking of the ParsecT type. To run your parser, please look to
 -- runPT, runP, runParserT, runParser and other such functions.
 runParsecT :: Monad m => ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
+{-# INLINABLE runParsecT #-}
 runParsecT p s = unParser p s cok cerr eok eerr
     where cok a s' err = return . Consumed . return $ Ok a s' err
           cerr err = return . Consumed . return $ Error err
@@ -164,6 +165,7 @@ runParsecT p s = unParser p s cok cerr eok eerr
 
 -- | Low-level creation of the ParsecT type. You really shouldn't have to do this.
 mkPT :: Monad m => (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
+{-# INLINABLE mkPT #-}
 mkPT k = ParsecT $ \s cok cerr eok eerr -> do
            cons <- k s
            case cons of
@@ -586,6 +588,7 @@ token :: (Stream s Identity t)
       -> (t -> SourcePos)         -- ^ Computes the position of a token.
       -> (t -> Maybe a)           -- ^ Matching function for the token to parse.
       -> Parsec s u a
+{-# INLINABLE token #-}
 token showToken tokpos test = tokenPrim showToken nextpos test
     where
         nextpos _ tok ts = case runIdentity (uncons ts) of
@@ -698,6 +701,7 @@ manyErr = error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is a
 
 runPT :: (Stream s m t)
       => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
+{-# INLINABLE runPT #-}
 runPT p u name s
     = do res <- runParsecT p (State s (initialPos name) u)
          r <- parserReply res

src/Text/Parsec/Token.hs

@@ -357,6 +357,7 @@ data GenTokenParser s u m
 
 makeTokenParser :: (Stream s m Char)
                 => GenLanguageDef s u m -> GenTokenParser s u m
+{-# INLINABLE makeTokenParser #-}
 makeTokenParser languageDef
     = TokenParser{ identifier = identifier
                  , reserved = reserved