Arithmetic evaluation: Difference between revisions
m (Updated category: Now there are no longer less than 5 examples) |
(Pascal version) |
||
Line 567: | Line 567: | ||
Right expr -> evaluate expr |
Right expr -> evaluate expr |
||
Left _ -> error "Did not parse" |
Left _ -> error "Did not parse" |
||
=={{header|Pascal}}== |
|||
{{works with|GNU Pascal|20060325, based on gcc-3.4.4}} |
|||
Note: This code is completely standard pascal, checked with <tt>gpc --classic-pascal</tt>. 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. |
|||
=={{header|Prolog}}== |
=={{header|Prolog}}== |
Revision as of 22:46, 27 February 2008
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;
C++
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
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) ; } } }
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.
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).