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

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;

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:

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;

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

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;

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

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;

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.

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;

D

(This D code may be bugged)

module test;
import std.stdio;

int calculate(string expr)
{
  string take(int count)
  {
    auto res = expr[0 .. count];
    expr = expr[count .. $];
    return res;
  }
  string peek(int count)
  {
    if (expr.length < count) count = expr.length;
    return expr [0 .. count];
  }
  int delegate(int level) descent;
  // grab the next number from the input expression
  int getNumber()
  {
    int res;
    // if our "number" is a parantheses-wrapped expression, evaluate it
    if (peek(1) == "(") { take(1); return descent(0); }
    while (expr.length)
    {
      auto next = peek(1)[0];
      // if the next character is a digit ...
      if (next >= '0' && next <= '9')
      {
        res = res * 10 + (next-'0');
        take(1);
      } else return res;
    }
    return res;
  }
  // descent evaluates a level-l expression (1: multiplication and division, 0: also addition and subtraction)
  descent = (int l) {
    auto num = getNumber; // get the first number of our expression
    while (expr.length)
    {
      auto op = take(1)[0];
      if (op == ')') return num; // expression end
      if (op == '*') num *= getNumber;
      if (op == '/') num /= getNumber;
      if (l == 1) return num;
      if (op == '+') num += descent(1);
      if (op == '-') num -= descent(1);
    }
    return num;
  };
  return descent(0);
}

void main()
{
  writefln(calculate("(3+50)*7-9"), ", ", (3+50)*7-9);
}

Works with: DMD version 2.007

I'm a D newbie, hope this D code reveals some D unique features.

module eval;
import std.stdio;
import std.regexp ;
import std.string ;
import std.conv ;

// simple stack template
void push(U)(inout U[] stk, U top) {
	stk = stk ~ top ;
}

U pop(U)(inout U[] stk, bool peektop = false) {
	U top ;
	if (stk.length > 0) {
		top = stk[$ - 1] ;
		if (!peektop) 
			stk.length = stk.length - 1 ;
	} else 
		throw new Exception("Invalid Expression") ; // or Empty Stack
	return top ;				
}

// evalutor function
T eval(T = long)(string expression) {
	
	string[] opr ; // operator stack
	T[]	num ; // number stack 

	uint tokensum = 0 ; 
	
	int[char[]] prece = ["=":0, "(":1, ")":1,"+":2,"-":2,"*":3,"/":3] ;
		
	void doMath(string op) { // operator executor
		T valR = num.pop() ;
		T valL = num.pop() ;		
		switch (op) {
			case "+": return num.push(valL + valR) ;
			case "-": return num.push(valL - valR) ;
			case "*": return num.push(valL * valR) ;
			case "/": return num.push(valL / valR) ;				
		}
	}
	
	opr.push("=") ;

	foreach(m ; RegExp(r"[+*-/()]|\d+").search(expression)) {
		string token = m.match(0) ;
		tokensum += token.length ;
		if (token[0] >= '0' && token[0] <= '9') 
			num.push(to!(T)(token)) ;
		else if (token == "(") 
			opr.push(token) ;
		else if (token == ")") {
			while(opr.pop(true) != "(") 
				doMath(opr.pop()) ;
			opr.pop() ;		
		} else {
			while (prece[opr.pop(true)] >= prece[token]) 
				doMath(opr.pop()) ;
			opr.push(token) ;			
		}		
	}

	if (tokensum + count(expression, " ") != expression.length) 
		throw new Exception("Invalid Tokens") ;

	while (opr.length > 1)
		doMath(opr.pop()) ;
		
	if (num.length != 1)
		throw new Exception("Invalid Expression") ;
				
	return num.pop() ;
}

void main(string[] args) {
	foreach(xpr ; std.string.split(join(args[1..$], " "),",")) {
		try{
			writefln("long: %s = %d", xpr, eval(xpr)) ;
			writefln("int : %s = %d", xpr, eval!(int)(xpr)) ;
		}
		catch (Exception e) {
			writefln("%s : %s", e.msg, xpr) ;
		}
	}
}

/*** sample output
D:\00MY\dmd>dmd eval
h:\dmd\bin\..\..\dm\bin\link.exe eval,,,user32+kernel32/noi;

D:\00MY\dmd>eval 1 + * 2, 4*5-3*2, a1 + b,4*(5-3)*2, 128*256*256*256+1
Invalid Expression : 1 + * 2
long:  4*5-3*2 = 14
int :  4*5-3*2 = 14
Invalid Tokens :  a1 + b
long: 4*(5-3)*2 = 16
int : 4*(5-3)*2 = 16
long:  128*256*256*256+1 = 2147483649
int :  128*256*256*256+1 = -2147483647
***/

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"

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