Haskell中仅为部分操作实现左结合解析的问题

我要构建一个解析器，要求：

• 成功解析2<3为Oper Less (Const (IntVal 2)) (Const (IntVal 3))
• 拒绝解析2 < 3 < 4这类链式比较
• 正常解析2+2 < 5

尝试用chainl1让+、-保持左结合，但pOperHelper和pTerm的使用可能有问题，对chainl1理解不足。运行后得到错误输出：

ghci> parseString "2 < 3 < 4"
Left "Unexpected error"
ghci> parseString "2 < 3"
Right (Oper Less (Const (IntVal 2)) (Const (IntVal *** Exception: Prelude.read: no parse

请问为何会出现Prelude.read错误？是否有更优方式利用chainl1或类似工具实现需求？

最小可复现代码 #

module MVEParser (ParseError, parseString, pOper, pOperHelper, pTerm, pExpr) where

import Data.Char

import Text.ParserCombinators.ReadP
import Control.Applicative ((<|>))


type ParseError = String -- you may replace this

type Parser a = ReadP a 

data Value =
  IntVal Int
  deriving (Eq, Show, Read)

data Op = Plus | Minus | Less | Greater 
  deriving (Eq, Show, Read)

data Exp =
    Const Value
  | Oper Op Exp Exp
  deriving (Eq, Show, Read)

space :: Parser Char
space = satisfy isSpace

spaceBeforeAfter :: String -> Parser String
spaceBeforeAfter x = do spaces; str <- string x; space; return str

spaces :: Parser String 
spaces = many space

symbol :: String -> Parser String
symbol = token . string

token :: Parser a -> Parser a
token combinator = (do spaces
                       combinator)

pExpr :: Parser Exp 
pExpr = {- chainl1 pTerm pOper +++  -}chainl1 pTerm (pOperHelper pOper)

pTerm :: Parser Exp 
pTerm =                      
       (do         
        skipSpaces        
        pv <- munch isDigit
        skipSpaces       
        return (Const (IntVal (read pv))))
       
pOper :: ReadP (Exp -> Exp -> Exp)
pOper = (symbol "+" >> return (Oper Plus))
        <|> (symbol "-" >> return (Oper Minus))
        <|> (symbol "<" >> return (Oper Less))
        <|> (symbol ">" >> return (Oper Greater))
       
pOperHelper :: ReadP (Exp -> Exp -> Exp) -> ReadP (Exp -> Exp -> Exp)
pOperHelper op = do
  operator <- op  
  term <- pTerm  
  skipSpaces
  nextChar  <- look
  case nextChar of
    (c:_) | c `elem` ['<', '>'] -> pfail
    _ -> return operator

parseString input = let x = readP_to_S (do e <- pExpr; token eof; return e) input
                    in case x of                         
                        [(a, "")] -> Right a                                            
                        _ -> Left "Unexpected error"

问题分析与解决 #

1. Prelude.read错误的原因 #

这个错误源于**pOperHelper的逻辑违反了chainl1的执行规则**：
chainl1 p op的核心逻辑是：先解析一个p得到e1，循环解析op得到运算符函数f，再解析p得到e2，用f e1 e2更新e1，直到无法解析op为止。

但你的pOperHelper里主动解析了一个pTerm，这导致chainl1会重复触发pTerm解析。以2 < 3为例：

• chainl1先调用pTerm得到Const (IntVal 2)
• 调用pOperHelper pOper时，先解析<得到Oper Less，再手动解析pTerm拿到3
• pOperHelper检查后续为EOF，返回Oper Less
• 此时chainl1会自动再次调用pTerm来获取e2，但输入已读完，munch isDigit得到空字符串，传给read就触发了Prelude.read: no parse异常。

另外，pTerm中用munch isDigit允许空字符串，也是潜在风险，应该用munch1确保至少读取一个数字字符。

2. 更优实现方式：分层处理运算符 #

要实现拒绝链式比较、同时让算术运算符左结合，正确的做法是分层设计解析器，将算术运算符和比较运算符分开处理：

修改后的完整代码：

module MVEParser (ParseError, parseString, pExpr) where

import Data.Char
import Text.ParserCombinators.ReadP
import Control.Applicative ((<|>))

type ParseError = String
type Parser a = ReadP a 

data Value = IntVal Int deriving (Eq, Show, Read)
data Op = Plus | Minus | Less | Greater deriving (Eq, Show, Read)
data Exp = Const Value | Oper Op Exp Exp deriving (Eq, Show, Read)

-- 空格处理辅助函数
spaces :: Parser String 
spaces = many (satisfy isSpace)

token :: Parser a -> Parser a
token p = spaces >> p >>= \x -> spaces >> return x

symbol :: String -> Parser String
symbol s = token (string s)

-- 解析数字常量（确保至少一个数字）
pFactor :: Parser Exp
pFactor = do
  digits <- token (munch1 isDigit)
  return $ Const (IntVal (read digits))

-- 处理算术运算符（+、-）的左结合
pTerm :: Parser Exp
pTerm = chainl1 pFactor pArithOp
  where
    pArithOp :: Parser (Exp -> Exp -> Exp)
    pArithOp = (symbol "+" >> return (Oper Plus))
             <|> (symbol "-" >> return (Oper Minus))

-- 处理比较运算符，禁止链式比较
pExpr :: Parser Exp
pExpr = do
  e1 <- pTerm
  (do
      op <- pCompOp
      e2 <- pTerm
      -- 检查后续是否还有比较运算符，有则解析失败
      next <- look
      case next of
        (c:_) | c `elem` ['<', '>'] -> pfail
        _ -> return $ Oper op e1 e2)
    <|> return e1
  where
    pCompOp :: Parser Op
    pCompOp = (symbol "<" >> return Less)
           <|> (symbol ">" >> return Greater)

parseString :: String -> Either ParseError Exp
parseString input = case readP_to_S (do e <- pExpr; token eof; return e) input of
  [(a, "")] -> Right a
  _ -> Left "Unexpected error"

验证效果 #

• 解析2<3：Right (Oper Less (Const (IntVal 2)) (Const (IntVal 3)))
• 解析2 < 3 < 4：Left "Unexpected error"
• 解析2+2 <5：Right (Oper Less (Oper Plus (Const (IntVal 2)) (Const (IntVal 2))) (Const (IntVal 5)))
• 解析5-3+2：Right (Oper Plus (Oper Minus (Const (IntVal 5)) (Const (IntVal 3))) (Const (IntVal 2)))（左结合逻辑正确）

关键改进点 #

1. 用munch1代替munch：确保数字解析不会得到空字符串，从根源避免read异常
2. 分层解析：将算术运算（可左结合）和比较运算（禁止链式）拆分为不同层级，逻辑更清晰
3. 移除错误的pOperHelper：不再手动解析pTerm，让chainl1和解析器分层自动处理，避免重复解析问题

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