Create a program which parses and evaluates arithmetic expressions.

Requirements

 An abstract-syntax tree (AST) for the expression must be created from parsing the input. 
 The AST must be used in evaluation, also, so the input may not be directly evaluated (e.g. by calling eval or a similar language feature.) 
 The expression will be a string or list of symbols like "(1+3)*7". 
 The four symbols + - * / must be supported as binary operators with conventional precedence rules. 
 Precedence-control parentheses must also be supported.


Note

For those who don't remember, mathematical precedence is as follows:

 Parentheses
 Multiplication/Division (left to right)
 Addition/Subtraction (left to right)


C.f
 
 24 game Player.
 Parsing/RPN calculator algorithm.
 Parsing/RPN to infix conversion.


-- demo\rosetta\Arithmetic_evaluation.exw
with javascript_semantics

sequence opstack = {}       -- atom elements are literals,
                            -- sequence elements are subexpressions
                            -- on completion length(opstack) should be 1
object token

constant op_p_p = 1         --  1: expressions stored as op,p1,p2
    --   p_op_p             --  0: expressions stored as p1,op,p2
    --   p_p_op             -- -1: expressions stored as p1,p2,op

object op = 0   -- 0 if none, else "+", "-", "*", "/", "^", "%", or "u-"

string s        -- the expression being parsed
integer ch
integer sidx

procedure err(string msg)
    printf(1,"%s\n%s^ %s\n\nPressEnter...",{s,repeat(' ',sidx-1),msg})
    {} = wait_key()
    abort(0)
end procedure

procedure nxtch(object msg="eof")
    sidx += 1
    if sidx>length(s) then
        if string(msg) then err(msg) end if
        ch = -1
    else
        ch = s[sidx]
    end if
end procedure

procedure skipspaces()
    while find(ch,{' ','\t','\r','\n'})!=0 do nxtch(0) end while
end procedure

procedure get_token()
atom n, fraction
integer dec
    skipspaces()
    if ch=-1 then token = "eof" return end if
    if ch>='0' and ch<='9' then
        n = ch-'0'
        while 1 do
            nxtch(0)
            if ch<'0' or ch>'9' then exit end if
            n = n*10+ch-'0'
        end while
        if ch='.' then
            dec = 1
            fraction = 0
            while 1 do
                nxtch(0)
                if ch<'0' or ch>'9' then exit end if
                fraction = fraction*10 + ch-'0'
                dec *= 10
            end while
            n += fraction/dec
        end if
--      if find(ch,"eE") then   -- you get the idea
--      end if
        token = n
        return
    end if
    if find(ch,"+-/*()^%")=0 then err("syntax error") end if
    token = s[sidx..sidx]
    nxtch(0)
    return
end procedure

procedure Match(string t)
    if token!=t then err(t&" expected") end if
    get_token()
end procedure

procedure PopFactor()
    object p1, p2 = opstack[$]
    if op="u-" then
        p1 = 0
    else
        opstack = opstack[1..$-1]
        p1 = opstack[$]
    end if
    if op_p_p=1 then
        opstack[$] = {op,p1,p2}  -- op_p_p
    elsif op_p_p=0 then
        opstack[$] = {p1,op,p2}  -- p_op_p
    else -- -1
        opstack[$] = {p1,p2,op}  -- p_p_op
    end if
    op = 0
end procedure

procedure PushFactor(atom t)
    if op!=0 then PopFactor() end if
    opstack = append(opstack,t)
end procedure

procedure PushOp(string t)
    if op!=0 then PopFactor() end if
    op = t
end procedure

forward procedure Expr(integer p)

procedure Factor()
    if atom(token) then
        PushFactor(token)
        if ch!=-1 then
            get_token()
        end if
    elsif token="+" then -- (ignore)
        nxtch()
        Factor()
    elsif token="-" then
        get_token()
--      Factor()
        Expr(3) -- makes "-3^2" yield -9 (ie -(3^2)) not 9 (ie (-3)^2).
        if op!=0 then PopFactor() end if
        if integer(opstack[$]) then
            opstack[$] = -opstack[$]
        else
            PushOp("u-")
        end if
    elsif token="(" then
        get_token()
        Expr(0)
        Match(")")
    else
        err("syntax error")
    end if
end procedure

constant {operators,
          precedence,
          associativity} = columnize({{"^",3,0},
                                      {"%",2,1},
                                      {"*",2,1},
                                      {"/",2,1},
                                      {"+",1,1},
                                      {"-",1,1},
                                      $})

procedure Expr(integer p)
--
-- Parse an expression, using precedence climbing.
--
-- p is the precedence level we should parse to, eg/ie
--      4: Factor only (may as well just call Factor)
--      3: "" and ^
--      2: "" and *,/,%
--      1: "" and +,-
--      0: full expression (effectively the same as 1)
--  obviously, parentheses override any setting of p.
--
integer k, thisp
    Factor()
    while 1 do
        k = find(token,operators) -- *,/,+,-
        if k=0 then exit end if
        thisp = precedence[k]
        if thisp<p then exit end if
        get_token()
        Expr(thisp+associativity[k])
        PushOp(operators[k])
    end while
end procedure

function evaluate(object s)
object lhs, rhs
string op
    if atom(s) then
        return s
    end if
    if op_p_p=1 then            -- op_p_p
        {op,lhs,rhs} = s
    elsif op_p_p=0 then         -- p_op_p
        {lhs,op,rhs} = s
    else -- -1                  -- p_p_op
        {lhs,rhs,op} = s
    end if
    if sequence(lhs) then lhs = evaluate(lhs) end if
    if sequence(rhs) then rhs = evaluate(rhs) end if
    if op="+" then
        return lhs+rhs
    elsif op="-" then
        return lhs-rhs
    elsif op="*" then
        return lhs*rhs
    elsif op="/" then
        return lhs/rhs
    elsif op="^" then
        return power(lhs,rhs)
    elsif op="%" then
        return remainder(lhs,rhs)
    elsif op="u-" then
        return -rhs
    else
        ?9/0
    end if
end function

s = "3+4+5+6*7/1*5^2^3"     -- 16406262
sidx = 0
nxtch()
get_token()
Expr(0)
if op!=0 then PopFactor() end if
if length(opstack)!=1 then err("some error") end if
printf(1,"expression: \"%s\"\n",{s})
puts(1,"AST (flat): ")
?opstack[1]
puts(1,"AST (tree):\n")
ppEx(opstack[1],{pp_Nest,9999})
puts(1,"result: ")
?evaluate(opstack[1])
{} = wait_key()
