Haskell手写Parser Combinator时many触发无限循环如何修复

问题原因 #

无限循环的核心原因是：默认从Control.Applicative导入的many组合子是为返回多结果的非确定性解析器设计的，而你实现的<|>是确定性左偏逻辑——只要左分支有任何结果就完全丢弃右分支。两者组合后，递归求解最长匹配的过程中，求值器需要不断深入递归判断子解析器是否能产生有效结果，无法及时触达递归终止条件，最终触发无限循环。

修复方案 #

你当前实现的是确定性解析器（每个解析器最多返回1个结果），不需要依赖默认的many实现，手动编写尾递归版本的多匹配组合子即可。该实现会直接循环消耗匹配字符直到解析失败，每次递归输入长度严格递减，必然终止，且返回你预期的最长匹配结果：

import Control.Applicative (Alternative, empty, (<|>))

data Parser a = Parser {runParser :: String -> [(a, String)]}

instance Functor Parser where
  fmap f (Parser p) = Parser $ \s -> [(f x', s') | (x', s') <- p s]

instance Applicative Parser where
  pure x = Parser $ \s -> [(x, s)]
  (Parser pf) <*> (Parser p) = Parser $ \s -> [(f' x, ss') | (f', ss) <- pf s, (x, ss') <- p ss]

instance Alternative Parser where
  empty = Parser $ \s -> []
  (Parser p1) <|> (Parser p2) = Parser $ \s ->
    case p1 s of
      [] -> p2 s
      xs -> xs

singleSpaceParser :: Parser Char
singleSpaceParser = Parser $ \s ->
  case s of
    x : xs -> if x == ' ' then [(' ', xs)] else []
    [] -> []

-- 自定义确定性解析器专用的多匹配组合子，返回最长匹配结果
many' :: Parser a -> Parser [a]
many' p = Parser $ go []
  where
    go acc s = case runParser p s of
      -- 解析失败，返回累积的匹配结果和剩余字符串
      [] -> [(reverse acc, s)]
      -- 解析成功，消耗一个字符后继续递归匹配
      [(x, s')] -> go (x:acc) s'

multiSpaceParser :: Parser [Char]
multiSpaceParser = many' singleSpaceParser

修复后在ghci中执行runParser multiSpaceParser " 123"（三个空格前缀），就会得到你预期的[(" ","123")]结果，不会触发无限循环。

如果你需要保留非确定性解析能力（返回所有可能长度的匹配结果），可以将<|>实现改为结果追加逻辑，但此时返回结果会包含零个、一个、多个空格的所有可能组合，需要自行筛选最长匹配结果，效率低于上述尾递归实现：

instance Alternative Parser where
  empty = Parser $ const []
  Parser p1 <|> Parser p2 = Parser $ \s -> p1 s ++ p2 s

内容的提问来源于stack exchange，提问作者yixing