在 Haskell 中实现优先级爬升

如何解决在 Haskell 中实现优先级爬升

我正在尝试按照以下特定算法在 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/递归。这是我希望得到任何帮助的具体部分。

解决方法

我建议您在开始解析之前处理错误消息。我假设 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)。