Haskell如何将Token列表加入解析错误的输出信息中

你遇到的问题根源是rexpr函数的兜底错误分支没有将当前剩余的Token列表拼接到错误信息中，只输出了固定文本。只需要修改对应error调用的参数，把Token列表序列化后追加到错误信息末尾即可。

具体修改位置 #

1. 修改rexpr函数的最后一行兜底匹配逻辑，将当前匹配的Token列表x用show序列化后拼接到错误信息：

-- 修改前
rexpr x = error "Parse Error: invalid expression"
-- 修改后
rexpr x = error $ "Parse Error: invalid expression " ++ show x

如果需要其他错误场景也附带Token信息，可以同步修改其他error调用，比如缺少右括号的分支：

-- 修改前
_ ->  error "Parse Error: expected closing parenthesis"
-- 修改后
_ ->  error $ "Parse Error: expected closing parenthesis, remaining tokens: " ++ show r1

修改后完整代码 #

module Test where

data Token = OpenParen
           | CloseParen
           | Operator Char
           | PosNum Double
     deriving (Show, Eq)

data ParseTree = NumNode Double
               | OpNode Char [ParseTree]
         deriving Show

scan :: String ->[Token]
scan xs
     | null lexeme = []
     | c == '(' = OpenParen:scan rest
     | c == ')' = CloseParen:scan rest
     | elem c ['+', '-', '*', '/'] = Operator c: scan (cs ++ rest)
     | elem c ['0'..'9'] = PosNum (read (c:cs):: Double):scan rest
     | otherwise = error ("Lexical Error - invalid character: " ++ [c])
     where [(lexeme, rest)] = lex xs
           c:cs = lexeme

recognize :: [Token] -> Bool
recognize ts = let (s, r) = rexpr ts
     in s && null r

-- <expr> ->OPENPAREN OPERATOR <operands> CLOSEPAREN |  POSNUMBER
rexpr :: [Token] -> (Bool, [Token])
rexpr (OpenParen:Operator  _: rest) = let(b1,r1) = roperands rest
     in case r1 of
          CloseParen:r2 -> (b1, r2)
          _ ->  error $ "Parse Error: expected closing parenthesis, remaining tokens: " ++ show r1
          
rexpr (PosNum _:rest) = (True, rest)
rexpr x = error $ "Parse Error: invalid expression " ++ show x

-- <operands> ->  <expr> [<operands>]
roperands :: [Token] -> (Bool, [Token])
roperands ts = let (b1, r1) = rexpr ts
     in case isValidStart r1 of
          True -> let (b2, r2) = roperands r1 in (b1 && b2, r2)
          False     -> (b1, r1)

isValidStart :: [Token] -> Bool
isValidStart (OpenParen: _) = True
isValidStart (PosNum _:_) = True
isValidStart _ = False

check:: String -> Bool
check = recognize.scan

验证结果 #

运行测试用例check "(+ 4 (3 5 ))"即可得到符合要求的输出，如果不需要显示CallStack，可以编译时添加-fno-caller-sites参数，或者在GHCi中执行:set -fno-caller-sites后再运行测试。

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