Arithmetic evaluation: Difference between revisions
Content added Content deleted
(→{{header|Python}}: comment out prints) |
(→{{header|Ada}}: Replaced by a version that generates syntax tree) |
||
Line 8: | Line 8: | ||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
{{ |
{{libheader|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 => Priorities, |
|||
Sources => Code |
|||
); |
|||
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; |
|||
) return Tokens.Argument_Token; |
|||
overriding -- Evaluates an expression in brackets |
|||
S : Stack; |
|||
function Enclose |
|||
Token : Unbounded_String; |
|||
( Context : access Simple_Expression; |
|||
Left : Tokens.Operation_Token; |
|||
Right : Tokens.Operation_Token; |
|||
List : 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 Get_Operand |
|||
( Context : in out Simple_Expression; |
|||
Code : in out Source; |
|||
Argument : out Tokens.Argument_Token; |
|||
Got_It : out Boolean |
|||
); |
|||
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 Ada.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 True; |
|||
end "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; |
|||
null; |
|||
end Check_Spelling; |
|||
else |
|||
if S.Depth = 0 then |
|||
function Check_Matched (Source : String; Pointer : Integer) |
|||
S.Push(Token); |
|||
return Boolean is |
|||
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 - 1)) |
|||
); |
|||
end Check_Matched; |
|||
end if; |
|||
function Call |
|||
end loop; |
|||
( Context : access Simple_Expression; |
|||
Operation : Tokens.Operation_Token; |
|||
List : Tokens.Arguments.Frame |
|||
) return Tokens.Argument_Token is |
|||
Result : Node_Ptr := new Expression (List'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 := Operation.Operation; |
|||
This.Location := Operation.Location; |
|||
for Argument in List'Range loop |
|||
This.Operands (Integer (Argument)) := |
|||
List (Argument).Value; |
|||
package Int_Stack is new Generic_Controlled_Stack(Integer, Image); |
|||
end loop; |
|||
end; |
|||
return (Result, Operation.Location & Link (List)); |
|||
Start : Positive := Expr'First; |
|||
end Call; |
|||
Last : Positive := Start; |
|||
Tok : Unbounded_String; |
|||
function Enclose |
|||
Right_Operand : Integer; |
|||
( Context : access Simple_Expression; |
|||
Left : Tokens.Operation_Token; |
|||
Right : Tokens.Operation_Token; |
|||
List : Tokens.Arguments.Frame |
|||
begin |
|||
) return Tokens.Argument_Token is |
|||
Result : Node_Ptr := new Expression (List'Length); |
|||
Get_Token(From => Expr, Starting => Start, |
|||
begin |
|||
Token => Tok, End_Index => Last); |
|||
declare |
|||
This : Expression renames Expression (Result.all); |
|||
begin |
|||
if Element(Tok,1) in Numeric then |
|||
This.Operation := Left.Operation; |
|||
S.Push(Integer'Value(To_String(Tok))); |
|||
This.Location := Left.Location & Right.Location; |
|||
for Argument in List'Range loop |
|||
This.Operands (Integer (Argument)) := |
|||
List (Argument).Value; |
|||
end 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 out Simple_Expression; |
|||
Code : in out Source; |
|||
Argument : out Tokens.Argument_Token; |
|||
Got_It : out Boolean |
|||
) is |
|||
Line : String renames Get_Line (Code); |
|||
Pointer : Integer := Get_Pointer (Code); |
|||
Value : Integer; |
|||
begin |
|||
S.Pop(Result); |
|||
if Is_Decimal_Digit (Line (Pointer)) then |
|||
return Result; |
|||
Get (Line, Pointer, Value); |
|||
Set_Pointer (Code, Pointer); |
|||
begin |
|||
Argument.Location := Link (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++}}== |
=={{header|C++}}== |