在 Haskell 中实现优先攀登

Question

我正在尝试按照以下特定算法在 Haskell 中实现优先级攀升：

compute_expr(min_prec):
  result = compute_atom()
  while cur token is a binary operator with precedence >= min_prec:
    prec, assoc = precedence and associativity of current token
    if assoc is left:
      next_min_prec = prec + 1
    else:
      next_min_prec = prec
    rhs = compute_expr(next_min_prec)
    result = compute operator(result, rhs)

  return result

在此伪代码中，compute_atom 负责传递值并处理自然优先级被括号覆盖的情况。 我的 Haskell 代码如下：

precedenceClimbing :: Tokens -> [Either MyException Tokens] -> Precedence -> (Expr, [Either MyException Tokens])
precedenceClimbing tok listOfTokens prec = 
 let result = returnPrecExpr tok listOfTokens
     nextTBinOp = getToken (snd result)
 in  if checkBinopTok nextTBinOp  -- checkRParTok nextTBinOp
     then let listOfTokensBinOp = shrinkTokenList (snd result)
              binOp = convertTokenToBinOp nextTBinOp
              binOpParsed = parseBinop nextTBinOp listOfTokensBinOp
              prec_cur = handleBinopsPrecedence binOp 
          in  if prec_cur >= prec
              then let newPrec = prec_cur + 1
                       nextTokAtom = getToken (snd binOpParsed)
                       listOfTokensAtom = shrinkTokenList (snd binOpParsed)
                       newCalc = precedenceClimbing nextTokAtom listOfTokensAtom newPrec
                       newBinExpr = ExprBinOp (fst binOpParsed) (fst result) (fst newCalc)
                       in (newBinExpr, snd newCalc)
              else result --This is the most unsure section
     else result

returnPrecExpr :: Tokens -> [Either MyException Tokens] -> (Expr, [Either MyException Tokens])
returnPrecExpr tok listOfTokens = 
     if checkLParTok tok
     then let nextTokValue = getToken listOfTokens
              listOfTokensNValue = shrinkTokenList listOfTokens
              result = precedenceClimbing nextTokValue listOfTokensNValue 1
              nextRPar = getToken (snd result)
              listOfTokensRPar = shrinkTokenList (snd result)
          in  if checkRParTok nextRPar
              then (fst result, listOfTokensRPar)
              else undefined --error handling
     else let token = convertTokenToValue tok
              result = returnTokValueData token
          in (result, listOfTokens)

returnPrecExpr 在这种情况下代表compute_atom，我相信它的目的是好的。但是，主要功能不是，因为我的主要问题是我无法满足算法中 while 给出的所有标准。从技术上讲，这意味着我应该能够通过适当的优先级（在这种情况下，自定义数据类型Preference 只是一个Int）并以现在正确的方式调用precedenceClimbing，我当算法应该退出当前运算符时，我无法继续，因为它的优先级不等于或大于前一个运算符。这是我的代码停止的地方。
有什么改进的建议吗？
编辑
因此，通过一个具体的例子，让我们有一个表达式，即 2 * 3 + 5。这里，因为 2 * 3 的优先级高于 3 + 5，所以算法应该返回，返回 2 * 3 作为结果 (但在我的上下文中，不是 6 的结果，而是这种形式的 2 * 3)，但在这个阶段，我的算法停止并返回 2 * 3，因为我没有正确实现算法中的 while/recursion。这是我希望得到任何帮助的具体部分。

Answer 1

我建议您在开始解析之前处理错误消息。我假设getToken 只是从列表中获取第一个标记，shrinkTokenList 只是从列表中删除第一个标记。然后，您可以使用更短的名称和模式匹配来使函数更惯用，如下所示：

precedenceClimbing :: [Token] -> Precedence -> (Expr, [Token])
precedenceClimbing toks prec
  | checkBinopTok tok1 && curPrec >= prec
  = let (op, toks2) = parseBinop tok1 toks1
        (r , toks3) = precedenceClimbing toks2 (curPrec + 1)
    in  (ExprBinOp op l r, toks3)
  | otherwise = result
 where
  result@(l, tok1 : toks1) = returnPrecExpr toks
  curPrec                  = handleBinopsPrecedence (convertTokenToBinOp tok1)

returnPrecExpr :: [Token] -> (Expr, [Token])
returnPrecExpr (tok : toks)
  | checkLParTok tok = if checkRParTok tok' then (e, toks') else undefined --error handling
  | otherwise        = (returnTokValueData (convertTokenToValue tok), toks)
  where (e, tok' : toks') = precedenceClimbing toks 1

您甚至可以使用 State [Token] monad 来使这个更好，如果您想生成错误消息，那么您可以轻松地将其更改为 StateT [Token] (Either MyException)。