|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 4960 (0x1360)
Types: TextFile
Names: »B«
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Bounded_String;
with Stack_Generic;
package body Symbol is
String_Max_Size : constant := 80;
Table_Size : constant := 37;
package Symbol_Tree is
type Object is private;
function Name_Exist
(In_The_Object : Object;
The_Name : Bounded_String.Variable_String) return Boolean;
function Get_Value (Of_The_Var : Bounded_String.Variable_String;
In_The_Object : Object) return Naural;
function Get_Type (Of_The_Var : Bounded_String.Variable_String;
In_The_Object : Object) return Symbol_Type;
procedure Add (To : in out Object;
S : Bounded_String.Variable_String;
Of_Type : Symbol_Type);
procedure Set_Value (Of_The_Var : Bounded_String.Variable_String;
In_The_Object : Object;
To : Natural);
private
type Attributes (T : Symbol_Type) is
record
The_Name : Bounded_String.Variable_String (String_Max_Size);
The_Type : Symbol_Type;
case T is
when T_Integer | T_Time =>
The_Value : Natural;
when T_Function =>
The_Value : Natural;
end case;
end record;
type Symbol_Node;
type Object is access Symbol_Node;
type Symbol_Node is
record
The_Symbol : Attributes;
Left_Son, Right_Son : Object;
end record;
end Symbol_Tree;
package body Symbol_Tree is separate;
------------------------------------------------------------------------------
------------------------------------------------------------------------------
type Parameter;
type Parameter_Ptr is access Parameter;
type Parameter is
record
Name : Bounded_String.Variable_String (String_Max_Size);
Succ : Parameter_Ptr;
end record;
type Attributes is
record
The_Name : Bounded_String.Variable_String (String_Max_Size);
The_Type : Symbol_Type;
The_Value : Natural;
The_Parameters : Parameter_Ptr;
end record;
type Symbol_Node;
type Symbol_Node_Ptr is access Symbol_Node;
type Symbol_Node is
record
The_Symbol : Attributes;
Left_Son, Right_Son : Symbol_Node_Ptr;
end record;
type Table is array (1 .. Table_Size) of Symbol_Node_Ptr;
type Symbol_Table_Stack_Item is
record
The_Name : Bounded_String.Variable_String (String_Max_Size);
The_Table : Table := (others => null);
The_Father : Natural := 0;
end record;
package Symbol_Table_Stack is new Stack_Generic (Symbol_Table_Stack_Item);
The_Object : Symbol_Table_Stack.Stack := Symbol_Table_Stack.Empty_Stack;
Current_Table : Table;
Current_Symbol_Node : Symbol_Node;
Current_Symbol : Attributes;
Current_Parameter : Parameter_Ptr;
function End_Of_Parameter_List return Boolean is
begin
return Current_Parameter = null or else Current_Parameter.Succ = null;
end End_Of_Parameter_List;
function Exist (S : String) return Boolean is
begin
[statement]
end Exist;
function Get_Name return String is
begin
[statement]
end Get_Name;
function Get_Parameter_Name return String is
begin
return Bounded_String.Image (Current_Parameter.Name);
end Get_Parameter_Name;
function Get_Type return Symbol_Type is
begin
[statement]
end Get_Type;
function Get_Value return Natural is
begin
[statement]
end Get_Value;
function Table_Exist (T : String) return Boolean is
begin
[statement]
end Table_Exist;
procedure Close is
begin
[statement]
end Close;
procedure First_Parameter is
begin
[statement]
end First_Parameter;
procedure Insert (S : String) is
begin
[statement]
end Insert;
procedure Next_Parameter is
begin
[statement]
end Next_Parameter;
procedure New_Table (T : String) is
begin
[statement]
end New_Table;
procedure Open is
begin
Symbol_Table_Stack.Make_Empty (The_Object);
end Open;
procedure Remove is
begin
[statement]
end Remove;
procedure Set_Parameter_Name (To : String) is
begin
[statement]
end Set_Parameter_Name;
procedure Set_Type (To : Symbol_Type) is
begin
[statement]
end Set_Type;
procedure Set_Value (To : Natural) is
begin
[statement]
end Set_Value;
procedure Table_Go_Back is
begin
[statement]
end Table_Go_Back;
end Symbol;