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.


procedure main()                                                #: simple arithmetical parser / evaluator
   write("Usage: Input expression = Abstract Syntax Tree = Value, ^Z to end.")
   repeat {
      writes("Input expression : ")
      if not writes(line := read()) then break
      if map(line) ? { (x := E()) & pos(0) } then
         write(" = ", showAST(x), " = ", evalAST(x))
      else
         write(" rejected")
   }
end
 
procedure evalAST(X)                                            #: return the evaluated AST
   local x
 
   if type(X) == "list" then {
      x := evalAST(get(X))
      while x := get(X)(x, evalAST(get(X) | stop("Malformed AST.")))
   }
   return \x | X
end
 
procedure showAST(X)                                            #: return a string representing the AST
   local x,s
 
   s := ""
   every x := !X do
      s ||:= if type(x) == "list" then "(" || showAST(x) || ")" else x
   return s
end
 
########
# When you're writing a big parser, a few utility recognisers are very useful
#
procedure ws()    # skip optional whitespace
   suspend tab(many(' \t')) | ""
end
 
procedure digits()
   suspend tab(many(&digits))
end
 
procedure radixNum(r)    # r sets the radix
   static chars
   initial chars := &digits || &lcase
   suspend tab(many(chars[1 +: r]))
end
########
 
global token
record HansonsDevice(precedence,associativity)
 
procedure opinfo()
   static O
   initial {
      O := HansonsDevice([], table(&null))                         # parsing table
      put(O.precedence, ["+", "-"], ["*", "/", "%"], ["^"])        # Lowest to Highest precedence
      every O.associativity[!!O.precedence] := 1                   # default to 1 for LEFT associativity
      O.associativity["^"] := 0                                    # RIGHT associativity
   }
   return O
end
 
procedure E(k)                                                  #: Expression
   local lex, pL
   static opT
   initial opT := opinfo()
 
   /k := 1
   lex := []
   if not (pL := opT.precedence[k]) then                        # this op at this level?
      put(lex, F())
   else {
      put(lex, E(k + 1))
      while ws() & put(lex, token := =!pL) do
         put(lex, E(k + opT.associativity[token]))
   }
   suspend if *lex = 1 then lex[1] else lex                     # strip useless []
end
 
procedure F()                                                   #: Factor
   suspend ws() & (    # skip optional whitespace, and ...
      (="+" & F())              |          # unary + and a Factor, or ...
      (="-" || V())             |          # unary - and a Value, or ...
      (="-" & [-1, "*", F()])   |          # unary - and a Factor, or ...
     2(="(", E(), ws(), =")")   |          # parenthesized subexpression, or ...
       V()                                 # just a value
   )
end
 
procedure V()                                                   #: Value
   local r
   suspend ws() & numeric(    # skip optional whitespace, and ...
       =(r := 1 to 36) || ="r" || radixNum(r)             |     # N-based number, or ...
       digits() || (="." || digits() | "") || exponent()        # plain number with optional fraction
   )
end
 
procedure exponent()
   suspend tab(any('eE')) || =("+" | "-" | "") || digits() | ""
end