Arithmetic evaluation/Phix

Phix

Translation of Arithmetic_evaluation#D, just for fun / in order to decipher all that abstract class Visitor/accept/visit pointless indirection stuff, when in fact a plain and simple recursion is all that it needs. For me visit(ast) and visit(node[LHS/RHS]) do exactly what it says on the tin, whereas a.root.accept(c) and xp.LHS/RHS.accept(this) do not. Plus, 221 lines -> 166 lines, should you wrongly care about that, I know I shouldn't... <lang Phix>-- demo\rosetta\Arithmetic_evaluationD.exw enum Num, OBkt, CBkt, Add, Sub, Mul, Div constant opChar = {"#", "(", ")", "+", "-", "*", "/"},

        opPrec = {0,  -9,   -9,      1,   1,   2,   2}

enum TYPE,STR,POS,LHS,RHS -- (for nodes in opr and num) sequence opr, num

function pop_opr()

   sequence res = opr[$];  opr = opr[1..-2]
   return res

end function

procedure joinXP(sequence x)

   x[RHS] = num[$];  num = num[1..-2]
   x[LHS] = num[$]
   num[$] = x

end procedure

function isDigit(integer ch)

   return ch>='0' and ch<='9'

end function

string xpr, token, resultStr integer xpHead, xpTail, result, level sequence Tree

function nextToken()

   while xpHead<=length(xpr) and xpr[xpHead]==' ' do
       xpHead += 1 -- Skip spaces
   end while
   xpTail = xpHead
   if xpHead<=length(xpr) then
       integer ch = xpr[xpHead]
       if find(ch,"()+-*/") then -- valid non-number
           xpTail += 1
       elsif isDigit(ch) then
           while xpTail<=length(xpr) and isDigit(xpr[xpTail]) do
               xpTail += 1
           end while
       end if
       if xpTail>xpHead then return xpr[xpHead..xpTail-1] end if
   end if
   if xpTail<=length(xpr) then
       throw("Invalid Char <%c>",{xpr[xpTail]})
   end if
   return ""

end function

function parse(string s)

   bool expectingOP = false
   xpr = s
   xpHead = 1
   num = {}
   opr = Template:CBkt,")",-1,NULL,NULL -- prevent evaluate null OP precedence.
   while true do
       token = nextToken()
       if token="" then exit end if
       integer Type = max(find(token,opChar),Num)
       sequence tokenXP = {Type,token,xpHead,NULL,NULL}
       if expectingOP then     -- Process OP-alike tokenXP.
           switch token
               case ")":
                   while opr[$][TYPE]!=OBkt do
                       joinXP(pop_opr())
                   end while
                   {} = pop_opr()
                   expectingOP = true
               case "+", "-", "*", "/":
                   while opPrec[tokenXP[TYPE]]<=opPrec[opr[$][TYPE]] do
                       joinXP(pop_opr())
                   end while
                   opr = append(opr,tokenXP)
                   expectingOP = false
               default:
                   throw("Expecting Operator or ), not <%s>",{token})
           end switch
       else                    -- Process Num-alike tokenXP
           switch token
               case "+", "-", "*", "/", ")":
                   throw("Expecting Number or (, not <%s>",{token})
               case "(":
                   opr = append(opr,tokenXP)
                   expectingOP = false
               default: -- Number
                   num = append(num,tokenXP)
                   expectingOP = true
           end switch
       end if
       xpHead = xpTail
   end while
   while length(opr)>1 do // Join pending Op.
       joinXP(pop_opr())
   end while
   if length(num)!=1 then // Should be just the one (nested) node left.
       throw("Parse Error...")
   end if
   return num[1]

end function

procedure visit(sequence node)

   if level+1>length(Tree) then
       Tree = append(Tree,"")
   end if
   string str = node[STR]
   integer Type = node[TYPE],
           p = node[POS],
           e = p+length(str)-1
   while length(Tree[level])<e do
       Tree[level] &= ' '
   end while
   Tree[level][p..e] = str
   level += 1
   if Type=Num then
       resultStr &= str
       result = to_integer(str)
   else
       resultStr &= "("
       visit(node[LHS])
       integer lhs = result
       resultStr &= str -- (same as &= opChar[Type])
       visit(node[RHS])
       resultStr &= ")"
       switch Type
           case Add: result = lhs+result
           case Sub: result = lhs-result
           case Mul: result = lhs*result
           case Div: result = lhs/result
           default: throw("Invalid type")
       end switch
   end if
   level -= 1

end procedure

procedure CalcVis(sequence ast, string expr)

   result = 0
   level = 1
   resultStr = ""
   Tree = {}
   visit(ast)
   -- More fancy:
   for i=2 to length(Tree) do
       bool flipflop = false
       for j=1 to length(Tree[i]) do
           while j>=length(Tree[i-1]) do
               Tree[i-1] &= " "
           end while
           integer c1 = Tree[i][j],
                   c2 = Tree[i-1][j]
           if flipflop and c1==' ' and c2==' ' then
               Tree[i-1][j] = '.'
           end if
           if c1!='.' and c1!=' '
           and (j==1 or not isDigit(Tree[i][j-1])) then
               flipflop = not flipflop
           end if
       end for
   end for
   printf(1,"%s\n%s ==>\n%s = %d\n", {join(Tree,"\n"), expr, resultStr, result})

end procedure

constant expr = "1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1" try

   sequence ast = parse(expr)
   CalcVis(ast,expr)

catch e

   ?e

end try</lang>

Output:

   ........................................................+.
 .+..                                                        1
1    *...
    2   .-..........
       3     .......*................................
            *...                 ....................-.
           2   .-.            ..-...                   1
              3   2       ...*      /...
                        .-.   5   22   .+..
                       2   4          7    *...
                                          2   .-.
                                             3   1

1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1 ==>
((1+(2*(3-((2*(3-2))*((((2-4)*5)-(22/(7+(2*(3-1)))))-1)))))+1) = 60