CODEWITHSUNDEEP
haskellcompiler-constructionabstract-syntax-treeoperator-precedencerecursive-descent
Károly Tóth
Károly Tóth

Reputation: 47

Realize precedence climbing in Haskell

I am trying to realise precedence climbing in Haskell, following this specific algorithm:

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

In this pseudo code, compute_atom is responsible for delivering the values and also handles the cases when natural precedence is overwritten by parenthesis. My Haskell code is the following:

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 represents the compute_atomin this context, and I believe it is fine for its purpose. However, the main function is not, because my main problem is that I am not able to fulfil all the criteria given by the while in the algorithm. Technically, this means that I should be able to pass through the proper precedence (in this context, the custom data type Preference is simply an Int) and to call the precedenceClimbing in the correct way as right now, I am not able to continue when the algorithm should retreat from the current operator as its precedence is not equal or larger then the previous one. This is the point where my code stops.
Any suggestion for improving this?
Edit
So, with a concrete example, let us have an expression, which is 2 * 3 + 5. Here, because 2 * 3 has higher precedence than 3 + 5, the algorithm should return, give back the 2 * 3 as a result (but in my context, not the result of 6, but in this form, 2 * 3), but at this stage, my algorithm stops and returning 2 * 3, as I am not realizing the while/recursion in the algorithm properly. That is the specific part I would appreciate any help.

Upvotes: 0

Views: 150

Answers (1)

Noughtmare
Noughtmare

Reputation: 10645

I would recommend that you handle the error messages before you start parsing. I assume that getToken just takes the first token from the list and shrinkTokenList just removes the first token from the list. Then you can make the functions more idiomatic using shorter names and pattern matching like this:

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

You could even use the State [Token] monad to make this nicer still and if you want to generate error messages then you can easily change it to StateT [Token] (Either MyException).

Upvotes: 2

Related Questions