Arithmetic evaluation

Arithmetic evaluation
You are encouraged to solve this task according to the task description, using any language you may know.

Create a program which parses and evaluates arithmetic expressions. Requirements: an wp:Abstract_syntax_tree 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 wp:Binary_relation binary relations with conventional precedence rules. Precedence-control parentheses must also be supported.

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

• Parentheses
• Exponents (not in this program)
• Multiplication/Division (left to right)
• Addition/Subtraction (left to right)

Ada

This example is produced in several packages. The first package provides a simple generic stack implementation employing a controlled type. Controlled types are automatically finalized during assignment and when the variable goes out of scope.

<ada>with Ada.Finalization;

generic
   type Element_Type is private;
   with function Image(Item : Element_Type) return String;
   
package Generic_Controlled_Stack is
   type Stack is tagged private;
   procedure Push(Onto : in out Stack; Item : Element_Type);
   procedure Pop(From : in out Stack; Item : out Element_Type);
   function Top(Item : Stack) return Element_Type;
   function Depth(Item : Stack) return Natural;
   procedure Print(Item : Stack);
   
   Stack_Empty_Error : exception;
private
   type Node;
   type Node_Access is access Node;
   type Node is record
      Value : Element_Type;
      Next  : Node_Access := null;
   end record;
   
   type Stack is new Ada.Finalization.Controlled with record
      Top : Node_Access := null;
      Count : Natural := 0;
   end record;
   
   procedure Finalize(Object : in out Stack);
   
end Generic_Controlled_Stack;</ada>

The type Ada.Finalization.Controlled is an abstract type. The Finalize procedure is overridden in this example to provide automatic clean up of all dynamically allocated elements in the stack. The implementation of the package follows:

<ada>with Ada.Unchecked_Deallocation;

with Ada.Text_IO; use Ada.Text_IO;

package body Generic_Controlled_Stack is 

   procedure Free is new Ada.Unchecked_Deallocation(Node, Node_Access);
   
   ----------
   -- Push --
   ---------- 

   procedure Push (Onto : in out Stack; Item : Element_Type) is
      Temp : Node_Access := new Node;
   begin
      Temp.Value := Item;
      Temp.Next := Onto.Top;
      Onto.Top := Temp;
      Onto.Count := Onto.Count + 1;
   end Push;

   ---------
   -- Pop --
   ---------

   procedure Pop (From : in out Stack; Item : out Element_Type) is
      temp : Node_Access := From.Top;
   begin
      if From.Count = 0 then
         raise Stack_Empty_Error;
      end if;
      Item := Temp.Value;
      From.Count := From.Count - 1;
      From.Top := Temp.Next;
      Free(Temp);
   end Pop;
   
   -----------
   -- Depth --
   -----------
   function Depth(Item : Stack) return Natural is
   begin
      return Item.Count;
   end Depth;
   
   ---------
   -- Top --
   ---------
   function Top(Item : Stack) return Element_Type is
   begin
      if Item.Count = 0 then
         raise Stack_Empty_Error;
      end if;
      return Item.Top.Value;
   end Top;

   -----------
   -- Print --
   -----------
   
   procedure Print(Item : Stack) is
      Temp : Node_Access := Item.Top;
   begin
      while Temp /= null loop
         Put_Line(Image(Temp.Value));
         Temp := Temp.Next;
      end loop;
   end Print;
   
   --------------
   -- Finalize --
   --------------
   
   procedure Finalize(Object : in out Stack) is
      Temp : Node_Access := Object.Top;
   begin
      while Object.Top /= null loop
         Object.Top := Object.Top.Next;
         Free(Temp);
      end loop;
      Object.Count := 0;
   end Finalize; 

end Generic_Controlled_Stack;</ada>

The next little package gets the tokens for the arithmetic evaluator.

<ada>with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

package Arithmetic_Tokens is
   procedure Get_token(From : String; 
                       Starting : Positive; 
                       Token : out Unbounded_String; 
                       End_Index : out Positive);
end Arithmetic_Tokens;</ada>

Again, the most interesting parts are in the package body.

<ada>package body Arithmetic_Tokens is

   ---------------
   -- Get_token --
   ---------------

   procedure Get_token (From : String;
         Starting : Positive;
         Token : out Unbounded_String;
         End_Index : out Positive) is
      Result : Unbounded_String := Null_Unbounded_String;
      Is_Numeric : Boolean := False;
      Found_Token : Boolean := False;
      subtype Numeric_Char is Character range '0'..'9';
   begin
      End_Index := Starting;
      if Starting <= From'Last then
         loop -- find beginning of token
            case From(End_Index) is
               when Numeric_Char =>
                  Found_Token := True;
                  Is_Numeric := True;
               when '(' | ')' =>
                  Found_Token := True;
               when '*' | '/' | '+' | '-' =>
                  Found_Token := True;
               when others =>
                  End_Index := End_Index + 1;
            end case;
            exit when Found_Token or End_Index > From'Last;
         end loop;
         if Found_Token then
            if is_numeric then
               while Is_Numeric loop
                  Append(Result, From(End_Index));
                  End_Index := End_Index + 1;
                  if End_Index > From'last or else From(End_Index) not in Numeric_Char then
                     Is_Numeric := False;
                  end if;
               end loop;
            else
               Append(Result, From(End_Index));
               End_Index := End_Index + 1;
            end if;
         end if;
      end if;
      Token := Result;
   end Get_token; 

end Arithmetic_Tokens;</ada>

Finally, we come to the arithmetic evaluator itself. This approach first converts the infix formula into a postfix formula. The calculations are performed on the postfix version.

<ada>with Ada.Text_Io; use Ada.Text_Io;

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Generic_Controlled_Stack;
with Arithmetic_Tokens; use Arithmetic_Tokens;

procedure Arithmetic_Evaluator is

   function Calculate(Expr : String) return Integer is
      function To_Postfix(Expr : String) return String is
         package String_Stack is new Generic_Controlled_Stack(Unbounded_String, To_String);
         use String_Stack;
         Postfix : Unbounded_String := Null_Unbounded_String;
         S : Stack;
         Token : Unbounded_String;
         Temp  : Unbounded_String;
         Start : Positive := Expr'First;
         Last  : Positive := Start;
         First_Tok : Character;
         function Is_Higher_Precedence(Left, Right : Character) return Boolean is
            Result : Boolean := False;
         begin
            case Left is
               when '*' | '/' => 
                  case Right is
                     when '*' | '/' =>
                        Result := False;
                     when others =>
                        Result := True;
                  end case;
               when '+' | '-' =>
                  case Right is
                     when '0'..'9' =>
                        Result := True;
                     when others =>
                        Result := False;
                  end case;
               when others =>
                  Result := False;
            end case;
            return Result;
         end Is_Higher_Precedence;
      begin
         while Last <= Expr'last loop
            Get_Token(From => Expr, Starting => Start,
               Token => Token, End_Index => Last);
            Start := Last;
            exit when Length(Token) = 0;
            First_Tok := Element(Token,1);
            if First_Tok in '0'..'9' then
               Append(Postfix, ' ');
               Append(Postfix, Token);
            elsif First_Tok = '(' then
               S.Push(Token);
            elsif First_Tok = ')' then
               while S.Depth > 0 and then Element(S.Top,1) /= '(' loop
                  S.Pop(Temp);
                  Append(Postfix, ' ');
                  Append(Postfix, Temp);
               end loop;
               S.Pop(Temp);
            else
               if S.Depth = 0 then
                  S.Push(Token);
               else
                  while S.Depth > 0 and then Is_Higher_Precedence(Element(S.Top, 1), First_Tok) loop
                     S.Pop(Temp);
                     Append(Postfix, ' ');
                     Append(Postfix, Temp);
                  end loop;
                  S.Push(Token);
               end if;
            end if;
         end loop;
         while S.Depth > 0 loop
            S.Pop(Temp);
            Append(Postfix, Temp);
         end loop;
         return To_String(Postfix);
      end To_Postfix;
      
      function Evaluate_Postfix (Expr : String) return Integer is
         function Image(Item : Integer) return String is
         begin
            return Integer'Image(Item);
         end Image;
         
         package Int_Stack is new Generic_Controlled_Stack(Integer, Image);
         use Int_Stack;
         S : Stack;
         Start : Positive := Expr'First;
         Last  : Positive := Start;
         Tok : Unbounded_String;
         Right_Operand : Integer;
         Left_Operand  : Integer;
         Result : Integer;
         subtype Numeric is Character range '0'..'9';
      begin
         while Last <= Expr'Last loop
            Get_Token(From => Expr, Starting => Start,
               Token => Tok, End_Index => Last);
            Start := Last;
            exit when Length(Tok) = 0;
            if Element(Tok,1) in Numeric then
               S.Push(Integer'Value(To_String(Tok)));
            else
               S.Pop(Right_Operand);
               S.Pop(Left_Operand);
               case Element(Tok,1) is
                  when '*' =>
                     Result := Left_Operand * Right_Operand;
                  when '/' =>
                     Result := Left_Operand / Right_Operand;
                  when '+' =>
                     Result := Left_Operand + Right_Operand;
                  when '-' =>
                     Result := Left_Operand - Right_Operand;
                  when others =>
                     null;
               end case;
               S.Push(Result);
            end if;
         end loop;
         S.Pop(Result);
         return Result;
      end Evaluate_Postfix;
   begin
      return Evaluate_Postfix(To_Postfix(Expr));
   end Calculate;
begin
   Put_line("(3 * 50) - (100 / 10)= " & Integer'Image(Calculate("(3 * 50) - (100 / 10)")));
end Arithmetic_Evaluator;</ada>

C++

Works with: g++ version 4.1.2 20061115 (prerelease) (SUSE Linux)

Libraries: Boost.Spirit 1.8.4

#include <boost/spirit.hpp>
#include <boost/spirit/tree/ast.hpp>
#include <string>
#include <cassert>
#include <iostream>
#include <istream>
#include <ostream>

using boost::spirit::rule;
using boost::spirit::parser_tag;
using boost::spirit::ch_p;
using boost::spirit::real_p;

using boost::spirit::tree_node;
using boost::spirit::node_val_data;

// The grammar
struct parser: public boost::spirit::grammar<parser>
{
  enum rule_ids { addsub_id, multdiv_id, value_id, real_id };

  struct set_value
  {
    set_value(parser const& p): self(p) {}
    void operator()(tree_node<node_val_data<std::string::iterator,
                                            double> >& node,
                    std::string::iterator begin,
                    std::string::iterator end) const
    {
      node.value.value(self.tmp);
    }
    parser const& self;
  };

  mutable double tmp;

  template<typename Scanner> struct definition
  {
    rule<Scanner, parser_tag<addsub_id> > addsub;
    rule<Scanner, parser_tag<multdiv_id> > multdiv;
    rule<Scanner, parser_tag<value_id> > value;
    rule<Scanner, parser_tag<real_id> > real;

    definition(parser const& self)
    {
      using namespace boost::spirit;
      addsub = multdiv
        >> *((root_node_d[ch_p('+')] | root_node_d[ch_p('-')]) >> multdiv);
      multdiv = value
        >> *((root_node_d[ch_p('*')] | root_node_d[ch_p('/')]) >> value);
      value = real | inner_node_d[('(' >> addsub >> ')')];
      real = leaf_node_d[access_node_d[real_p[assign_a(self.tmp)]][set_value(self)]];
    }

    rule<Scanner, parser_tag<addsub_id> > const& start() const
    {
      return addsub;
    }
  };
};

template<typename TreeIter>
double evaluate(TreeIter const& i)
{
  double op1, op2;
  switch (i->value.id().to_long())
  {
  case parser::real_id:
    return i->value.value();
  case parser::value_id:
  case parser::addsub_id:
  case parser::multdiv_id:
    op1 = evaluate(i->children.begin());
    op2 = evaluate(i->children.begin()+1);
    switch(*i->value.begin())
    {
    case '+':
      return op1 + op2;
    case '-':
      return op1 - op2;
    case '*':
      return op1 * op2;
    case '/':
      return op1 / op2;
    default:
      assert(!"Should not happen");
    }
  default:
    assert(!"Should not happen");
  }
  return 0;
}

// the read/eval/write loop
int main()
{
  parser eval;
  std::string line;
  while (std::cout << "Expression: "
         && std::getline(std::cin, line)
         && !line.empty())
  {
    typedef boost::spirit::node_val_data_factory<double> factory_t;
    boost::spirit::tree_parse_info<std::string::iterator, factory_t> info =
      boost::spirit::ast_parse<factory_t>(line.begin(), line.end(),
                                          eval, boost::spirit::space_p);
    if (info.full)
    {
      std::cout << "Result: " << evaluate(info.trees.begin()) << std::endl;
    }
    else
    {
      std::cout << "Error in expression." << std::endl;
    }
  }
};

D

Following the previous number-operator dual stacks approach, an AST is built while previous version is evaluating the expression value. After the AST tree is constructed, a visitor pattern is used to display the AST structure and calculate the value. <d>//module evaluate ; import std.stdio, std.string, std.ctype, std.conv ;

// simple stack template void push(T)(inout T[] stk, T top) { stk ~= top ; } T pop(T)(inout T[] stk, bool discard = true) {

 T top ;
 if (stk.length == 0) throw new Exception("Stack Empty") ;
 top = stk[$-1] ;
 if (discard) stk.length = stk.length - 1 ;
 return top ;

}

alias int Type ; enum { Num, OBkt, CBkt, Add, Sub, Mul, Div } ; // Type string[] opChar = ["#","(",")","+","-","*","/"] ; int[] opPrec = [0,-9,-9,1,1,2,2] ;

abstract class Visitor { void visit(XP e) ; }

class XP {

 Type type ;
 string str ;
 int pos ;  // optional, for dispalying AST struct.
 XP LHS, RHS = null ;
 this(string s = ")", int p = -1) {
   str = s ; pos = p ;
   type = Num ;
   for(Type t = Div ; t > Num ; t--)
     if(opChar[t] == s) type = t ;
 }
 int opCmp(XP rhs) { return opPrec[type] - opPrec[rhs.type] ; }
 void accept(Visitor v) { v.visit(this) ; } ;

}

class AST {

 XP root ;
 XP[] num, opr ;
 string xpr, token ;
 int xpHead, xpTail ;

 void joinXP(XP x) { x.RHS = num.pop() ; x.LHS = num.pop() ; num.push(x) ; }

 string nextToken() {
   while (xpHead < xpr.length && xpr[xpHead] == ' ') 
     xpHead++ ; // skip spc
   xpTail = xpHead ;
   if(xpHead < xpr.length) {
     token = xpr[xpTail..xpTail+1] ;
     switch(token) {
       case "(",")","+","-","*","/": // valid non-number
         xpTail++ ; 
         return token ;
       default: // should be number
         if(isdigit(token[0])) {
           while(xpTail < xpr.length && isdigit(xpr[xpTail]))
             xpTail++ ;
           return xpr[xpHead..xpTail] ;          
         } // else may be error 
     } // end switch 
   }
   if(xpTail < xpr.length)
     throw new Exception("Invalid Char <" ~ xpr[xpTail] ~ ">") ; 
   return null ;
 } // end nextToken

 AST parse(string s) {
   bool expectingOP ;
   xpr = s ;
   try {
     xpHead = xpTail = 0 ; 
     num = opr = null ;
     root = null ;
     opr.push(new XP) ; // CBkt, prevent evaluate null OP precidence
     while((token = nextToken) !is null) {
       XP tokenXP = new XP(token, xpHead) ;
       if(expectingOP) {   // process OP-alike XP
         switch(token) {
           case ")":
             while(opr.pop(false).type != OBkt)
               joinXP(opr.pop()) ;
             opr.pop() ;
             expectingOP = true ; break ;
           case "+","-","*","/":
             while (tokenXP <= opr.pop(false))
               joinXP(opr.pop()) ;
             opr.push(tokenXP) ;
             expectingOP = false ; break ;
           default:
             throw new Exception("Expecting Operator or ), not <" ~ token ~ ">") ;
         }
       } else {            // process Num-alike XP
         switch(token) {
           case "+","-","*","/",")":
             throw new Exception("Expecting Number or (, not <" ~ token ~ ">") ;
           case "(":
             opr.push(tokenXP) ;
             expectingOP = false ; break ;
           default: // number
             num.push(tokenXP) ;
             expectingOP = true ; 
         }
       } 
       xpHead = xpTail ;       
     } // end while              
     
     while (opr.length > 1) // join pending Op
       joinXP(opr.pop()) ;
       
   }catch(Exception e) {
     writefln("%s\n%s\n%s^", e.msg, xpr, repeat(" ", xpHead)) ;
     root = null ;
     return this ;
   }
 
   if(num.length != 1) { // should be one XP left
     writefln("Parse Error...") ;
     root = null ;
   } else
     root = num.pop() ;
   return this ;
 } // end Parse

} // end class AST

// for display AST fancy struct void ins(inout char[][] s, string v, int p, int l) {

 while(s.length < l + 1) s.length = s.length + 1 ;
 while(s[l].length < p + v.length + 1) s[l] ~= " " ;
 s[l][p..p +v.length] = v ;    

}

class calcVis : Visitor {

 int result, level = 0 ;
 string Result = null ;
 char[][] Tree = null ;
 static void opCall(AST a) {
   if (a && a.root) {
     calcVis c = new calcVis ;
     a.root.accept(c) ;
     for(int i = 1; i < c.Tree.length ; i++) { // more fancy
       bool flipflop = false ; char mk = '.' ;
       for(int j = 0 ; j < c.Tree[i].length ; j++) {
         while(j >= c.Tree[i-1].length) c.Tree[i-1] ~= " " ;         
         char c1 = c.Tree[i][j] ; char c2 = c.Tree[i-1][j] ;
         if(flipflop && (c1 == ' ') && c2 == ' ')
           c.Tree[i-1][j] = mk ;
         if(c1 != mk && c1 != ' ' && (j == 0 || !isdigit(c.Tree[i][j-1])))
           flipflop = !flipflop ;
       }
     }
     foreach(t; c.Tree) writefln(t) ;
     writefln("%s ==>\n%s = %s", a.xpr,c.Result,c.result) ;
   } else
     writefln("Evalute invalid or null Expression") ;
 }
 void visit(XP xp) {// calc. the value, display AST struct and eval order.
   ins(Tree, xp.str, xp.pos, level) ;
   level++ ;
   if (xp.type == Num) {
     Result ~= xp.str ;
     result = toInt(xp.str) ;
   } else {
     Result ~= "(" ;
     xp.LHS.accept(this) ;
     int lhs = result ; 
     Result ~= opChar[xp.type] ;
     xp.RHS.accept(this) ;
     Result ~= ")" ;
     switch(xp.type) {
       case Add: result = lhs + result ; break ;
       case Sub: result = lhs - result ; break ;
       case Mul: result = lhs * result ; break ;
       case Div: result = lhs / result ; break ;
       default: throw new Exception("Invalid type") ;
     }
   } // 
   level-- ;
 }

}

void main(string[] args) {

 string expression = args.length > 1 ? join(args[1..$]," ") : 
   "1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1" ; // should be 60    
 calcVis((new AST).parse(expression)) ;

}</d>

Haskell

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr

data Exp = Num Int
         | Add Exp Exp
         | Sub Exp Exp
         | Mul Exp Exp
         | Div Exp Exp

expr = buildExpressionParser table factor

table = [[op "*" (Mul) AssocLeft, op "/" (Div) AssocLeft]
        ,[op "+" (Add) AssocLeft, op "-" (Sub) AssocLeft]]
        where op s f assoc = Infix (do string s; return f) assoc

factor =  do char '(' ; x <- expr ; char ')'
             return x 
      <|> do ds <- many1 digit
             return $ Num (read ds)

evaluate (Num x) = fromIntegral x
evaluate (Add a b) = (evaluate a)   +   (evaluate b)
evaluate (Sub a b) = (evaluate a)   -   (evaluate b)
evaluate (Mul a b) = (evaluate a)   *   (evaluate b)
evaluate (Div a b) = (evaluate a) `div` (evaluate b)

solution exp = case parse expr [] exp of
                 Right expr -> evaluate expr
                 Left _ -> error "Did not parse"

Pascal

Works with: GNU Pascal version 20060325, based on gcc-3.4.4

Note: This code is completely standard pascal, checked with gpc --classic-pascal. It uses certain features of standard Pascal which are not implemented in all Pascal compilers (e.g. the code will not compile with Turbo/Borland Pascal or Free Pascal).

program calculator(input, output);

type
 NodeType = (binop, number, error);

 pAstNode = ^tAstNode;
 tAstNode = record
             case typ: NodeType of
              binop:
              (
                operation: char;
                first, second: pAstNode;
              );
              number:
               (value: integer);
              error:
               ();
            end;

function newBinOp(op: char; left: pAstNode): pAstNode;
 var
  node: pAstNode;
 begin
  new(node, binop);
  node^.operation := op;
  node^.first := left;
  node^.second := nil;
  newBinOp := node;
 end;

procedure disposeTree(tree: pAstNode);
 begin
  if tree^.typ = binop
   then
    begin
     if (tree^.first <> nil)
      then
       disposeTree(tree^.first);
     if (tree^.second <> nil)
      then
       disposeTree(tree^.second)
    end;
  dispose(tree);
 end;

procedure skipWhitespace(var f: text);
 var
  ch:char;
 function isWhite: boolean;
  begin
   isWhite := false;
   if not eoln(f)
    then
     if f^ = ' '
      then
       isWhite := true
  end;
 begin
  while isWhite do
   read(f, ch)
 end;

function parseAddSub(var f: text): pAstNode; forward;
function parseMulDiv(var f: text): pAstNode; forward;
function parseValue(var f: text): pAstNode; forward;

function parseAddSub;
 var
  node1, node2: pAstNode;
  continue: boolean;
 begin
  node1 := parseMulDiv(f);
  if node1^.typ <> error
   then
    begin
     continue := true;
     while continue and not eoln(f) do
      begin
       skipWhitespace(f);
       if f^ in ['+', '-']
        then
         begin
          node1 := newBinop(f^, node1);
          get(f);
          node2 := parseMulDiv(f);
          if (node2^.typ = error)
           then
            begin
             disposeTree(node1);
             node1 := node2;
             continue := false
            end
           else
            node1^.second := node2
         end
        else
         continue := false
      end;
    end;
  parseAddSub := node1;
 end;

function parseMulDiv;
 var
  node1, node2: pAstNode;
  continue: boolean;
 begin
  node1 := parseValue(f);
  if node1^.typ <> error
   then
    begin
     continue := true;
     while continue and not eoln(f) do
      begin
       skipWhitespace(f);
       if f^ in ['*', '/']
        then
         begin
          node1 := newBinop(f^, node1);
          get(f);
          node2 := parseValue(f);
          if (node2^.typ = error)
           then
            begin
             disposeTree(node1);
             node1 := node2;
             continue := false
            end
           else
            node1^.second := node2
         end
        else
         continue := false
      end;
    end;
  parseMulDiv := node1;
 end;

function parseValue;
 var
  node:  pAstNode;
  value: integer;
  neg:   boolean;
 begin
  node := nil;
  skipWhitespace(f);
  if f^ = '('
   then
    begin
     get(f);
     node := parseAddSub(f);
     if node^.typ <> error
      then
       begin
        skipWhitespace(f);
        if f^ = ')'
         then
          get(f)
         else
          begin
           disposeTree(node);
           new(node, error)
          end
       end
    end
   else if f^ in ['0' .. '9', '+', '-']
    then
     begin
      neg := f^ = '-';
      if f^ in ['+', '-']
       then
        get(f);
      value := 0;
      if f^ in ['0' .. '9']
       then
        begin
         while f^ in ['0' .. '9'] do
          begin
           value := 10 * value + (ord(f^) - ord('0'));
           get(f)
          end;
         new(node, number);
         if (neg)
          then
           node^.value := -value
          else
           node^.value := value
        end
     end;
  if node = nil
   then
    new(node, error);
  parseValue := node
 end;

function eval(ast: pAstNode): integer;
 begin
  with ast^ do
   case typ of
    number: eval := value;
    binop:
     case operation of
      '+': eval := eval(first) + eval(second);
      '-': eval := eval(first) - eval(second);
      '*': eval := eval(first) * eval(second);
      '/': eval := eval(first) div eval(second);
     end;
    error:
     writeln('Oops! Program is buggy!')
   end
 end;

procedure ReadEvalPrintLoop;
 var
  ast: pAstNode;
 begin
  while not eof do
   begin
    ast := parseAddSub(input);
    if (ast^.typ = error) or not eoln
     then
      writeln('Error in expression.')
     else
      writeln('Result: ', eval(ast));
    readln;
    disposeTree(ast)
   end
 end;

begin
 ReadEvalPrintLoop
end.

Prolog

% Lexer
numeric(X) :- 48 =< X, X =< 57.
not_numeric(X) :- 48 > X ; X > 57.

lex1([], []).
lex1([40|Xs], ['('|Ys]) :- lex1(Xs, Ys).
lex1([41|Xs], [')'|Ys]) :- lex1(Xs, Ys).
lex1([43|Xs], ['+'|Ys]) :- lex1(Xs, Ys).
lex1([45|Xs], ['-'|Ys]) :- lex1(Xs, Ys).
lex1([42|Xs], ['*'|Ys]) :- lex1(Xs, Ys).
lex1([47|Xs], ['/'|Ys]) :- lex1(Xs, Ys).
lex1([X|Xs], [N|Ys]) :- numeric(X), N is X - 48, lex1(Xs, Ys).

lex2([], []).
lex2([X], [X]).
lex2([Xa,Xb|Xs], [Xa|Ys]) :- atom(Xa), lex2([Xb|Xs], Ys).
lex2([Xa,Xb|Xs], [Xa|Ys]) :- number(Xa), atom(Xb), lex2([Xb|Xs], Ys).
lex2([Xa,Xb|Xs], [Y|Ys]) :- number(Xa), number(Xb), N is Xa * 10 + Xb, lex2([N|Xs], [Y|Ys]).


% Parser
oper(1, *, X, Y, X * Y). oper(1, /, X, Y, X / Y).
oper(2, +, X, Y, X + Y). oper(2, -, X, Y, X - Y).

num(D) --> [D], {number(D)}.

expr(0, Z) --> num(Z).
expr(0, Z) --> {Z = (X)}, ['('], expr(2, X), [')'].

expr(N, Z) --> {succ(N0, N)}, {oper(N, Op, X, Y, Z)}, expr(N0, X), [Op], expr(N, Y).
expr(N, Z) --> {succ(N0, N)}, expr(N0, Z).

parse(Tokens, Expr) :- expr(2, Expr, Tokens, []).


% Evaluator
evaluate(E, E) :- number(E).
evaluate(A + B, E) :- evaluate(A, Ae), evaluate(B, Be), E is Ae + Be.
evaluate(A - B, E) :- evaluate(A, Ae), evaluate(B, Be), E is Ae - Be.
evaluate(A * B, E) :- evaluate(A, Ae), evaluate(B, Be), E is Ae * Be.
evaluate(A / B, E) :- evaluate(A, Ae), evaluate(B, Be), E is Ae / Be.

% Solution
calculator(String, Value) :-
   lex1(String, Tokens1),
   lex2(Tokens1, Tokens2),
   parse(Tokens2, Expression),
   evaluate(Expression, Value).

% Example use
% calculator("(3+50)*7-9", X).