Rosetta Code

Arithmetic evaluation: Difference between revisions

Page Discussion

Arithmetic evaluation (view source)

Revision as of 19:10, 5 September 2008

1,275 bytes added ,  15 years ago
→‎{{header|Ada}}: Replaced by a version that generates syntax tree
(→‎{{header|Python}}: comment out prints)
(→‎{{header|Ada}}: Replaced by a version that generates syntax tree)
Line 8:
 
=={{header|Ada}}==
{{incorrectlibheader|Simple components for Ada}}
The following implementation uses table-driven parsers provided by [[Simple components for Ada]]. A parser is controlled by the tables of prefix, infix and postfix operations. Between the operations it calls ''Get_Operand'' in order to recognize expression terms. The parser communicates with its back end using the primitive operations ''Call'' and ''Enclose''. The former is used for operations, the latter is for brackets. For this example we generate the parsing tree from there. There are many other operations which are used for advanced parsing and optimization, here they are defined as trivially returning True or False.
Example does not produce an AST. Instead it produces a postfix version of the code
that it is able to evaluate.
 
A parsing tree node has one operation ''Evaluate'' in order to calculate the expression. The nodes are allocated in an arena implemented by a storage pool. The pools is organized as a stack, so that the whole tree is popped when no more needed. This is a standard technique in compiler construction.
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.
 
The implementation provides an advanced error handling and skipping blanks and Ada comments (these are taken from the library).
<ada>with Ada.Finalization;
<ada>
generic
with Ada.Unchecked_Deallocation;
type Element_Type is private;
with Parsers.String_Source; use Parsers.String_Source;
with function Image(Item : Element_Type) return String;
with Parsers.Generic_Lexer.Ada_Blanks;
with Parsers.Generic_Token.Segmented_Lexer;
package Generic_Controlled_Stack is
with Stack_Storage;
type Stack is tagged private;
with Tables.Names;
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>
 
package Parsers.Simple is
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:
type Operations is (Add, Sub, Mul, Div, Left_Bracket, Right_Bracket);
type Priorities is mod 3; -- The levels of association
 
function "and" (Left, Right : Operations) return Boolean;
<ada>with Ada.Unchecked_Deallocation;
function Is_Commutative (Left, Right : Operations) return Boolean;
with Ada.Text_IO; use Ada.Text_IO;
function Is_Inverse (Operation : Operations) return Boolean;
function Group_Inverse (Operation : Operations) return Operations;
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>
 
Tree_Pool : Stack_Storage.Pool (2048, 128); -- Arena for the tree
The next little package gets the tokens for the arithmetic evaluator.
-- Tree nodes
type Node is abstract tagged limited null record;
function Evaluate (Item : Node) return Integer is abstract;
type Node_Ptr is access Node'Class;
for Node_Ptr'Storage_Pool use Tree_Pool;
procedure Free is
new Standard.Ada.Unchecked_Deallocation (Node'Class, Node_Ptr);
-- Stub of the arena
type Mark is new Node with null record;
overriding function Evaluate (Item : Mark) return Integer;
-- Terminal nodes
type Literal is new Node with record
Location : Parsers.String_Source.Location;
Value : Integer;
end record;
overriding function Evaluate (Item : Literal) return Integer;
-- Non-terminal nodes
type Argument_List is array (Positive range <>) of Node_Ptr;
type Expression (Count : Positive) is new Node with record
Operation : Operations;
Location : Parsers.String_Source.Location;
Operands : Argument_List (1..Count);
end record;
overriding function Evaluate (Item : Expression) return Integer;
 
package Tokens is -- The lexical tokens
<ada>with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
new Parsers.Generic_Token
( Operation_Type => Operations,
package Arithmetic_Tokens is
Argument_Type => Node_Ptr,
procedure Get_token(From : String;
Priority_Type => Starting : Positive; Priorities,
Sources => Token : out Unbounded_String; Code
End_Index : out Positive);
use Tokens;
end Arithmetic_Tokens;</ada>
 
procedure Check_Spelling (Name : String);
Again, the most interesting parts are in the package body.
function Check_Matched (Source : String; Pointer : Integer)
return Boolean;
package Token_Tables is new Tokens.Vocabulary.Names;
-- The tables of prefix, infix and postfix operations
Prefixes : aliased Token_Tables.Dictionary;
Infixes : aliased Token_Tables.Dictionary;
Postfixes : aliased Token_Tables.Dictionary;
 
package Lexers is new Tokens.Segmented_Lexer; -- Table driven lexers
<ada>package body Arithmetic_Tokens is
package Blank_Skipping_Lexers is -- Lexers that skip Ada blanks
new Lexers.Token_Lexer.Implementation.Ada_Blanks (Lexers.Lexer);
---------------
-- 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.
 
type Simple_Expression is -- The lexer that uses our tables
<ada>with Ada.Text_Io; use Ada.Text_Io;
new Blank_Skipping_Lexers.Lexer
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
( Prefixes => Prefixes'Access,
with Generic_Controlled_Stack;
Infixes => Infixes'Access,
with Arithmetic_Tokens; use Arithmetic_Tokens;
Postfixes => Postfixes'Access
) with null record;
procedure Arithmetic_Evaluator is
overriding -- Evaluates an operator
function Call
function Calculate(Expr : String) return Integer is
( Context : access Simple_Expression;
function To_Postfix(Expr : String) return String is
Operation : Tokens.Operation_Token;
package String_Stack is new Generic_Controlled_Stack(Unbounded_String, To_String);
List : Tokens.Arguments.Frame
use String_Stack;
Postfix : Unbounded_String := Null_Unbounded_String ) return Tokens.Argument_Token;
overriding -- Evaluates an expression in brackets
S : Stack;
function Enclose
Token : Unbounded_String;
Temp ( Context : Unbounded_Stringaccess Simple_Expression;
Start : Positive Left := Expr'FirstTokens.Operation_Token;
Last : Positive Right := StartTokens.Operation_Token;
First_Tok List : Character;Tokens.Arguments.Frame
) return Tokens.Argument_Token;
function Is_Higher_Precedence(Left, Right : Character) return Boolean is
overriding -- Recognizes an operand (float number)
Result : Boolean := False;
procedure beginGet_Operand
case Left is ( Context : in out Simple_Expression;
when '*' | '/'Code => : in out Source;
caseArgument Right: isout Tokens.Argument_Token;
Got_It when: '*'out | '/' =>Boolean
Result := False);
end Parsers.Simple;
when others =>
</ada>
Result := True;
Here is the implementation of the package.
end case;
<ada>
when '+' | '-' =>
with Ada.Characters.Handling; use Ada.Characters.Handling;
case Right is
with Ada.Exceptions; use when '0'Ada..'9' =>Exceptions;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
Result := True;
with Strings_Edit.Integers; use Strings_Edit.Integers;
when others =>
 
Result := False;
package body Parsers.Simple is
end case;
 
when others =>
function "and" (Left, Right : Operations) return Boolean is
Result := False;
begin
end case;
return ResultTrue;
end Is_Higher_Precedence"and";
 
begin
function Is_Commutative (Left, Right : Operations) return Boolean is
while Last <= Expr'last loop
begin
Get_Token(From => Expr, Starting => Start,
return False;
Token => Token, End_Index => Last);
end Is_Commutative;
Start := Last;
 
exit when Length(Token) = 0;
function Is_Inverse (Operation : Operations) return Boolean is
First_Tok := Element(Token,1);
begin
if First_Tok in '0'..'9' then
return False;
Append(Postfix, ' ');
end Is_Inverse;
Append(Postfix, Token);
 
elsif First_Tok = '(' then
function Group_Inverse (Operation : Operations) return Operations is
S.Push(Token);
begin
elsif First_Tok = ')' then
return Mul;
while S.Depth > 0 and then Element(S.Top,1) /= '(' loop
end Group_Inverse;
S.Pop(Temp);
 
Append(Postfix, ' ');
procedure Check_Spelling (Name : String) is
Append(Postfix, Temp);
begin
end loop;
S.Pop(Temp)null;
end Check_Spelling;
else
 
if S.Depth = 0 then
function Check_Matched (Source : String; Pointer : Integer)
S.Push(Token);
return Boolean elseis
begin
while S.Depth > 0 and then Is_Higher_Precedence(Element(S.Top, 1), First_Tok) loop
return
S.Pop(Temp);
( not Is_Alphanumeric (Source (Pointer))
Append(Postfix, ' ');
or else
Append(Postfix, Temp);
not Is_Alphanumeric (Source (Pointer - end loop;1))
S.Push(Token);
end ifCheck_Matched;
 
end if;
function Call
end loop;
while S.Depth >( 0 loopContext : access Simple_Expression;
S Operation : Tokens.Pop(Temp)Operation_Token;
Append(Postfix, Temp); List : Tokens.Arguments.Frame
end loop; ) return Tokens.Argument_Token is
Result : Node_Ptr := returnnew Expression To_String(PostfixList'Length);
begin
end To_Postfix;
declare
This : Expression renames Expression (Result.all);
function Evaluate_Postfix (Expr : String) return Integer is
begin
function Image(Item : Integer) return String is
This.Operation begin:= Operation.Operation;
This.Location := return Integer'Image(Item)Operation.Location;
for endArgument Image;in List'Range loop
This.Operands (Integer (Argument)) :=
List (Argument).Value;
package Int_Stack is new Generic_Controlled_Stack(Integer, Image);
end use Int_Stackloop;
S : Stackend;
return (Result, Operation.Location & Link (List));
Start : Positive := Expr'First;
end Call;
Last : Positive := Start;
 
Tok : Unbounded_String;
function Enclose
Right_Operand : Integer;
Left_Operand ( Context : Integeraccess Simple_Expression;
Result Left : IntegerTokens.Operation_Token;
subtype Numeric is Character range '0'.Right : Tokens.'9'Operation_Token;
List : Tokens.Arguments.Frame
begin
while Last <=) Expr'Last loopreturn Tokens.Argument_Token is
Result : Node_Ptr := new Expression (List'Length);
Get_Token(From => Expr, Starting => Start,
begin
Token => Tok, End_Index => Last);
Start := Last;declare
This : Expression renames exitExpression when Length(TokResult.all) = 0;
begin
if Element(Tok,1) in Numeric then
This.Operation := Left.Operation;
S.Push(Integer'Value(To_String(Tok)));
This.Location := Left.Location else& Right.Location;
for Argument in List'Range S.Pop(Right_Operand);loop
This.Operands (Integer S.Pop(Left_OperandArgument);) :=
List case Element(Tok,1Argument) is.Value;
end when '*' =>loop;
end;
Result := Left_Operand * Right_Operand;
return (Result, Left.Location & Right.Location & Link (List));
when '/' =>
end Enclose;
Result := Left_Operand / Right_Operand;
 
when '+' =>
procedure Get_Operand
Result := Left_Operand + Right_Operand;
( Context : in whenout '-' =>Simple_Expression;
Code Result := Left_Operandin -out Right_OperandSource;
Argument : out when others =>Tokens.Argument_Token;
Got_It : out null;Boolean
) end case;is
Line : String renames Get_Line S.Push(ResultCode);
Pointer : Integer := Get_Pointer end if(Code);
Value : end loopInteger;
begin
S.Pop(Result);
if Is_Decimal_Digit (Line (Pointer)) then
return Result;
end Evaluate_Postfix Get (Line, Pointer, Value);
Set_Pointer (Code, Pointer);
begin
return Evaluate_Postfix(To_Postfix Argument.Location := Link (Expr)Code);
Argument.Value := new Literal;
end Calculate;
declare
begin
Result : Literal renames Literal (Argument.Value.all);
Put_line("(3 * 50) - (100 / 10)= " & Integer'Image(Calculate("(3 * 50) - (100 / 10)")));
begin
end Arithmetic_Evaluator;</ada>
Result.Value := Value;
Result.Location := Argument.Location;
end;
Got_It := True;
else
Got_It := False;
end if;
exception
when Constraint_Error =>
Raise_Exception
( Parsers.Syntax_Error'Identity,
"Too large number at " & Image (Link (Code))
);
when Data_Error =>
Raise_Exception
( Parsers.Syntax_Error'Identity,
"Malformed number at " & Image (Link (Code))
);
when End_Error =>
Got_It := False;
end Get_Operand;
 
function Evaluate (Item : Mark) return Integer is
begin
return 0;
end Evaluate;
 
function Evaluate (Item : Literal) return Integer is
begin
return Item.Value;
end Evaluate;
 
function Evaluate (Item : Expression) return Integer is
Argument : array (Item.Operands'Range) of Integer;
begin
for I in Argument'Range loop
Argument (I) := Item.Operands (I).Evaluate;
end loop;
case Item.Operation is
when Add => return Argument (1) + Argument (2);
when Sub => return Argument (1) - Argument (2);
when Mul => return Argument (1) * Argument (2);
when Div => return Argument (1) / Argument (2);
when others => return Argument (1);
end case;
exception
when Constraint_Error =>
Raise_Exception
( Parsers.Syntax_Error'Identity,
"Numeric error at " & Image (Item.Location)
);
end Evaluate;
 
use type Tokens.Descriptors.Descriptor_Class;
use Lexers.Lexical_Descriptors.Operation;
use Lexers.Lexical_Arguments;
 
begin
Add_Operator (Infixes, "+", Add, 1, 1);
Add_Operator (Infixes, "-", Sub, 1, 1);
Add_Operator (Infixes, "*", Mul, 2, 2);
Add_Operator (Infixes, "/", Div, 2, 2);
 
Add_Bracket (Prefixes, "(", Left_Bracket);
Add_Bracket (Postfixes, ")", Right_Bracket);
 
end Parsers.Simple;
</ada>
The next is a little test. It reads a line from the keyboard and then evaluates it. The program stops when the input is empty:
<ada>
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;
with Parsers.Simple; use Parsers.Simple;
with Parsers.String_Source; use Parsers.String_Source;
with Strings_Edit.Integers; use Strings_Edit.Integers;
with Parsers.Generic_Source.Text_IO;
 
procedure Test_Simple_Parser is
use Lexers, Tokens;
 
package Text_IO is new Code.Text_IO;
use Text_IO;
 
Parser : Simple_Expression;
Result : Argument_Token;
Stub : Node_Ptr;
begin
loop
Put ("Expression:");
declare
Line : aliased String := Get_Line;
Code : Source (Line'Access);
begin
exit when Line'Length = 0;
Stub := new Mark; -- Mark the tree stack
begin
Parse (Parser, Code, Result);
Put_Line
( Image (Result.Location)
& " = "
& Image (Result.Value.Evaluate)
);
exception
when Error : Parsers.Syntax_Error =>
Put_Line ("Error : " & Exception_Message (Error));
end;
Free (Stub); -- Release the stack
end;
end loop;
end Test_Simple_Parser;
</ada>
Sample exchange. When the expression is evaluated its range in the source string is indicated. Upon errors, the location of is shown as well:
<pre>
Expression:(3 * 50) - (100 / 10)
1..21 = 140
Expression:1+
Error : Operand expected at 3
Expression:39999999999*9999999999+23
Error : Too large number at 1
Expression:5/0
Error : Numeric error at 2..2
Expression:
</pre>
 
=={{header|C++}}==
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/50508"