parsing - Haskellでの優先順位の上昇:パーセク相互再帰エラー

Question

Haskell で優先度上昇アルゴリズムをプログラミングしていますが、理由がわからないため、機能しません。ある時点で Parsec の状態情報が失われていると思いますが、それがエラーの原因であることさえわかりません。

module PrecedenceClimbing where

import Text.Parsec
import Text.Parsec.Char

{-
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
-}

type Precedence = Int
data Associativity = LeftAssoc
                   | RightAssoc
                   deriving (Eq, Show)
data OperatorInfo = OPInfo Precedence Associativity (Int -> Int -> Int)

mkOperator :: Char -> OperatorInfo
mkOperator = \c -> case c of
                     '+' -> OPInfo 1 LeftAssoc  (+)
                     '-' -> OPInfo 1 LeftAssoc  (-)
                     '*' -> OPInfo 2 LeftAssoc  (*)
                     '/' -> OPInfo 2 LeftAssoc  div
                     '^' -> OPInfo 3 RightAssoc (^)

getPrecedence :: OperatorInfo -> Precedence
getPrecedence (OPInfo prec _ _) = prec

getAssoc :: OperatorInfo -> Associativity
getAssoc (OPInfo _ assoc _) = assoc

getFun :: OperatorInfo -> (Int -> Int -> Int)
getFun (OPInfo _ _ fun) = fun

number :: Parsec String () Int
number = do
  spaces
  fmap read $ many1 digit

operator :: Parsec String () OperatorInfo
operator = do
  spaces
  fmap mkOperator $ oneOf "+-*/^"

computeAtom = do
  spaces
  number

loop minPrec res = (do
  oper <- operator
  let prec = getPrecedence oper
  if prec >= minPrec
  then do
    let assoc = getAssoc oper
        next_min_prec = if assoc == LeftAssoc
                        then prec + 1
                        else prec
    rhs <- computeExpr(next_min_prec)
    loop minPrec $ getFun oper res rhs
  else return res) <|> (return res)

computeExpr :: Int -> Parsec String () Int
computeExpr minPrec = (do
  result <- computeAtom
  loop minPrec result) <|> (computeAtom)

getResult minPrec = parse (computeExpr minPrec) ""

何らかの理由で私のプログラムは、ケースに応じて最初の操作または最初のオペランドのみを処理していますが、それ以上は処理していません

GHCi セッション:

*PrecedenceClimbing> getResult 1 "46+10"
Right 56
*PrecedenceClimbing> getResult 1 "46+10+1"
Right 56