LaTeX reader: build command dispatch maps once per parse.

The dispatch maps (inlineCommands, blockCommands, environments) have
types that mention the parser monad, so they are compiled as functions
of the PandocMonad dictionary and were being rebuilt from scratch --
hundreds of Map entries -- every time a command or environment was
dispatched.  SPECIALIZE pragmas can't fix this on the CLI path, since
the reader table abstracts over the monad dictionary.

Instead, add a ReaderT layer to the LP monad carrying a LaTeXEnv
record with the three dispatch maps, built once per parse in readLaTeX
(and once per chunk in rawLaTeXParser's callers), and consult it via
askEnv at the dispatch sites.  Internal `lift $ runParserT` sub-parses
share the environment automatically.

Benchmark (1.8MB LaTeX file): allocations drop from 17.85GB to 9.97GB
and wall time from ~4.7s to ~3.4s.  On a stress test of 100k \emph
commands, allocations drop from 36GB to 10.5GB.

Co-Authored-By: Claude <noreply@anthropic.com>

src/Text/Pandoc/Readers/LaTeX.hs

@@ -24,6 +24,8 @@ module Text.Pandoc.Readers.LaTeX ( readLaTeX,
 import Control.Applicative (many, optional, (<|>))
 import Control.Monad
 import Control.Monad.Except (throwError)
+import Control.Monad.Reader (runReaderT)
+import Control.Monad.Trans (lift)
 import Data.Containers.ListUtils (nubOrd)
 import Data.Char (isDigit, isLetter, isAlphaNum, toUpper, chr)
 import Data.Default
@@ -87,12 +89,22 @@ readLaTeX :: (PandocMonad m, ToSources a)
           -> m Pandoc
 readLaTeX opts ltx = do
   let sources = toSources ltx
-  parsed <- runParserT parseLaTeX def{ sOptions = opts } "source"
+  parsed <- flip runReaderT latexEnv $
+               runParserT parseLaTeX def{ sOptions = opts } "source"
                (TokStream False (tokenizeSources sources))
   case parsed of
     Right result -> return result
     Left e       -> throwError $ fromParsecError sources e
 
+-- | The command dispatch tables, built once per parse and shared
+-- through the reader environment (see 'LaTeXEnv').
+latexEnv :: PandocMonad m => LaTeXEnv m
+latexEnv = LaTeXEnv
+  { envInlineCommands = inlineCommands
+  , envBlockCommands  = blockCommands
+  , envEnvironments   = environments
+  }
+
 parseLaTeX :: PandocMonad m => LP m Pandoc
 parseLaTeX = do
   bs <- blocks
@@ -156,7 +168,7 @@ rawLaTeXBlock = do
   lookAhead (try (char '\\' >> letter))
   toks <- getInputTokens
   snd <$> (
-          rawLaTeXParser toks
+          rawLaTeXParser latexEnv toks
              (makeAtLetterSection <|>
               macroDef (const mempty) <|>
               do choice (map controlSeq
@@ -164,7 +176,7 @@ rawLaTeXBlock = do
                  skipMany opt
                  braced
                  return mempty) blocks
-      <|> rawLaTeXParser toks
+      <|> rawLaTeXParser latexEnv toks
            (void (environment <|> blockCommand))
            (mconcat <$> many (block <|> beginOrEndCommand)))
 
@@ -199,10 +211,10 @@ rawLaTeXInline = do
   lookAhead (try (char '\\' >> letter))
   toks <- getInputTokens
   raw <- snd <$>
-          (   rawLaTeXParser toks
+          (   rawLaTeXParser latexEnv toks
               (mempty <$ (controlSeq "input" >> skipMany rawopt >> braced))
               inlines
-          <|> rawLaTeXParser toks (void inline) inlines
+          <|> rawLaTeXParser latexEnv toks (void inline) inlines
           )
   finalbraces <- mconcat <$> many (try (string "{}")) -- see #5439
   return $ raw <> T.pack finalbraces
@@ -211,7 +223,8 @@ inlineCommand :: PandocMonad m => ParsecT Sources ParserState m Inlines
 inlineCommand = do
   lookAhead (try (char '\\' >> letter))
   toks <- getInputTokens
-  fst <$> rawLaTeXParser toks (void (inlineEnvironment <|> inlineCommand'))
+  fst <$> rawLaTeXParser latexEnv toks
+          (void (inlineEnvironment <|> inlineCommand'))
           inlines
 
 -- inline elements:
@@ -337,7 +350,8 @@ inlineCommand' = try $ do
        rawcommand <- getRawCommand name (cmd <> star)
        (guardEnabled Ext_raw_tex >> return (rawInline "latex" rawcommand))
          <|> ignore rawcommand
-  lookupListDefault raw names inlineCommands
+  commandMap <- envInlineCommands <$> askEnv
+  lookupListDefault raw names commandMap
 
 tok :: PandocMonad m => LP m Inlines
 tok = tokWith inline
@@ -847,7 +861,7 @@ opt = do
   toks <- try (sp *> bracketedToks <* sp)
   -- now parse the toks as inlines
   st <- getState
-  parsed <- runParserT (mconcat <$> many inline) st "bracketed option"
+  parsed <- lift $ runParserT (mconcat <$> many inline) st "bracketed option"
               (TokStream False toks)
   case parsed of
     Right result -> return result
@@ -1050,7 +1064,8 @@ blockCommand = try $ do
         lookAhead $ blankline <|> startCommand
         return $ curr <> mconcat rest
   let raw = rawDefiniteBlock <|> rawMaybeBlock
-  lookupListDefault raw names blockCommands
+  commandMap <- envBlockCommands <$> askEnv
+  lookupListDefault raw names commandMap
 
 closing :: PandocMonad m => LP m Blocks
 closing = do
@@ -1279,7 +1294,8 @@ environment :: PandocMonad m => LP m Blocks
 environment = try $ do
   controlSeq "begin"
   name <- untokenize <$> braced
-  M.findWithDefault mzero name environments <|>
+  envMap <- envEnvironments <$> askEnv
+  M.findWithDefault mzero name envMap <|>
     langEnvironment name <|>
     theoremEnvironment blocks inlines opt name <|>
     if M.member name (inlineEnvironments

src/Text/Pandoc/Readers/LaTeX/Parsing.hs

@@ -25,6 +25,9 @@ module Text.Pandoc.Readers.LaTeX.Parsing
   , LaTeXState(..)
   , defaultLaTeXState
   , LP
+  , LaTeXEnv(..)
+  , emptyLaTeXEnv
+  , askEnv
   , TokStream(..)
   , withVerbatimMode
   , rawLaTeXParser
@@ -98,6 +101,7 @@ module Text.Pandoc.Readers.LaTeX.Parsing
 import Control.Applicative (many, (<|>))
 import Control.Monad
 import Control.Monad.Except (throwError)
+import Control.Monad.Reader (ReaderT, ask, runReaderT)
 import Control.Monad.Trans (lift)
 import Data.Char (chr, isAlphaNum, isDigit, isLetter, ord)
 import Data.Default
@@ -281,7 +285,26 @@ instance Monad m => Stream TokStream m Tok where
   uncons (TokStream _ []) = return Nothing
   uncons (TokStream _ (t:ts)) = return $ Just (t, TokStream False ts)
 
-type LP m = ParsecT TokStream LaTeXState m
+type LP m = ParsecT TokStream LaTeXState (ReaderT (LaTeXEnv m) m)
+
+-- | Environment holding the command dispatch tables.  Because these
+-- tables have types that mention the parser monad, they cannot be
+-- top-level constants; passing them in a reader environment ensures
+-- they are constructed once per parse rather than once per use.
+data LaTeXEnv m = LaTeXEnv
+  { envInlineCommands :: M.Map Text (LP m Inlines)
+  , envBlockCommands  :: M.Map Text (LP m Blocks)
+  , envEnvironments   :: M.Map Text (LP m Blocks)
+  }
+
+-- | An environment with empty dispatch tables, for running parsers
+-- that do not consult them.
+emptyLaTeXEnv :: LaTeXEnv m
+emptyLaTeXEnv = LaTeXEnv mempty mempty mempty
+
+-- | Retrieve the command dispatch tables.
+askEnv :: Monad m => LP m (LaTeXEnv m)
+askEnv = lift ask
 
 withVerbatimMode :: PandocMonad m => LP m a -> LP m a
 withVerbatimMode parser = do
@@ -295,9 +318,9 @@ withVerbatimMode parser = do
        return result
 
 rawLaTeXParser :: (PandocMonad m, HasMacros s, HasReaderOptions s, Show a)
-               => [Tok] -> LP m () -> LP m a
+               => LaTeXEnv m -> [Tok] -> LP m () -> LP m a
                -> ParsecT Sources s m (a, Text)
-rawLaTeXParser toks parser valParser = do
+rawLaTeXParser lenv toks parser valParser = do
   pstate <- getState
   let lstate = def{ sOptions = extractReaderOptions pstate }
   let lstate' = lstate { sMacros = extractMacros pstate :| [] }
@@ -306,12 +329,14 @@ rawLaTeXParser toks parser valParser = do
                       _ -> return ()
   let preparser = setStartPos >> parser
   let rawparser = (,) <$> withRaw valParser <*> getState
-  res' <- lift $ runParserT (withRaw (preparser >> getPosition))
+  res' <- lift $ flip runReaderT lenv $
+                 runParserT (withRaw (preparser >> getPosition))
                             lstate "chunk" $ TokStream False toks
   case res' of
        Left _    -> mzero
        Right (endpos, toks') -> do
-         res <- lift $ runParserT rawparser lstate' "chunk"
+         res <- lift $ flip runReaderT lenv $
+                       runParserT rawparser lstate' "chunk"
                      $ TokStream False toks'
          case res of
               Left _    -> mzero
@@ -342,7 +367,8 @@ applyMacros s = (guardDisabled Ext_latex_macros >> return s) <|>
       pstate <- getState
       let lstate = def{ sOptions = extractReaderOptions pstate
                       , sMacros  = extractMacros pstate :| [] }
-      res <- runParserT retokenize lstate "math" $
+      res <- flip runReaderT emptyLaTeXEnv $
+                 runParserT retokenize lstate "math" $
                  TokStream False (tokenize (initialPos "math") s)
       case res of
            Left e   -> Prelude.fail (show e)