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
- 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++
1.8.4
<cpp> #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;
}
}
};
</cpp>
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
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.
Perl
<perl>sub ev
- Evaluates an arithmetic expression like "(1+3)*7" and returns
- its value.
{my $exp = shift;
# Delete all meaningless characters. (Scientific notation,
# infinity, and not-a-number aren't supported.)
$exp =~ tr {0-9.+-/*()} {}cd;
return ev_ast(astize($exp));}
{my $balanced_paren_regex;
$balanced_paren_regex = qr
{\( ( [^()]+ | (??{$balanced_paren_regex}) )+ \)}x;
# ??{ ... } interpolates lazily (only when necessary),
# permitting recursion to arbitrary depths.
sub astize
# Constructs an abstract syntax tree by recursively
# transforming textual arithmetic expressions into array
# references of the form [operator, left oprand, right oprand].
{my $exp = shift;
# If $exp is just a number, return it as-is.
$exp =~ /[^0-9.]/ or return $exp;
# If parentheses surround the entire expression, get rid of
# them.
$exp = substr($exp, 1, length($exp) - 2)
while $exp =~ /\A($balanced_paren_regex)\z/;
# Replace stuff in parentheses with placeholders.
my @paren_contents;
$exp =~ s {($balanced_paren_regex)}
{push(@paren_contents, $1);
"[p$#paren_contents]"}eg;
# Scan for operators in order of increasing precedence,
# preferring the rightmost.
$exp =~ m{(.+) ([+-]) (.+)}x or
$exp =~ m{(.+) ([*/]) (.+)}x or
# The expression must've been malformed somehow.
# (Note that unary minus isn't supported.)
die "Eh?: [$exp]\n";
my ($op, $lo, $ro) = ($2, $1, $3);
# Restore the parenthetical expressions.
s {\[p(\d+)\]} {($paren_contents[$1])}eg
foreach $lo, $ro;
# And recurse.
return [$op, astize($lo), astize($ro)];}}
{my %ops =
('+' => sub {$_[0] + $_[1]},
'-' => sub {$_[0] - $_[1]},
'*' => sub {$_[0] * $_[1]},
'/' => sub {$_[0] / $_[1]});
sub ev_ast
# Evaluates an abstract syntax tree of the form returned by
# &astize.
{my $ast = shift;
# If $ast is just a number, return it as-is.
ref $ast or return $ast;
# Otherwise, recurse.
my ($op, @operands) = @$ast;
$_ = ev_ast($_) foreach @operands;
return $ops{$op}->(@operands);}}</perl>
Pop11
/* Scanner routines */
/* Uncomment the following to parse data from standard input
vars itemrep;
incharitem(charin) -> itemrep;
*/
;;; Current symbol
vars sym;
define get_sym();
itemrep() -> sym;
enddefine;
define expect(x);
lvars x;
if x /= sym then
printf(x, 'Error, expected %p\n');
mishap(sym, 1, 'Example parser error');
endif;
get_sym();
enddefine;
lconstant res_list = [( ) + * ];
lconstant reserved = newproperty(
maplist(res_list, procedure(x); [^x ^(true)]; endprocedure),
20, false, "perm");
/*
Parser for arithmetic expressions
*/
/*
expr: term
| expr "+" term
| expr "-" term
;
*/
define do_expr() -> result;
lvars result = do_term(), op;
while sym = "+" or sym = "-" do
sym -> op;
get_sym();
[^op ^result ^(do_term())] -> result;
endwhile;
enddefine;
/*
term: factor
| term "*" factor
| term "/" factor
;
*/
define do_term() -> result;
lvars result = do_factor(), op;
while sym = "*" or sym = "/" do
sym -> op;
get_sym();
[^op ^result ^(do_factor())] -> result;
endwhile;
enddefine;
/*
factor: word
| constant
| "(" expr ")"
;
*/
define do_factor() -> result;
if sym = "(" then
get_sym();
do_expr() -> result;
expect(")");
elseif isinteger(sym) or isbiginteger(sym) then
sym -> result;
get_sym();
else
if reserved(sym) then
printf(sym, 'unexpected symbol %p\n');
mishap(sym, 1, 'Example parser syntax error');
endif;
sym -> result;
get_sym();
endif;
enddefine;
/* Expression evaluator, returns false on error (currently only
division by 0 */
define arith_eval(expr);
lvars op, arg1, arg2;
if not(expr) then
return(expr);
endif;
if isinteger(expr) or isbiginteger(expr) then
return(expr);
endif;
expr(1) -> op;
arith_eval(expr(2)) -> arg1;
arith_eval(expr(3)) -> arg2;
if not(arg1) or not(arg2) then
return(false);
endif;
if op = "+" then
return(arg1 + arg2);
elseif op = "-" then
return(arg1 - arg2);
elseif op = "*" then
return(arg1 * arg2);
elseif op = "/" then
if arg2 = 0 then
return(false);
else
return(arg1 div arg2);
endif;
else
printf('Internal error\n');
return(false);
endif;
enddefine;
/* Given list, create item repeater. Input list is stored in a
closure are traversed when new item is requested. */
define listitemrep(lst);
procedure();
lvars item;
if lst = [] then
termin;
else
front(lst) -> item;
back(lst) -> lst;
item;
endif;
endprocedure;
enddefine;
/* Initialise scanner */
listitemrep([(3 + 50) * 7 - 100 / 10]) -> itemrep;
get_sym();
;;; Test it
arith_eval(do_expr()) =>
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).