Arithmetic evaluation/Phix

From Rosetta Code

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...

-- demo\rosetta\Arithmetic_evaluationD.exw
with javascript_semantics
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 = {{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
--pp(Tree,{pp_Nest,9999})
    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)
--  pp(ast)
    CalcVis(ast,expr)
catch e
    ?e
end try
?"done"
{} = wait_key()
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