|
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: 11269 (0x2c05)
Types: TextFile
Names: »B«
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─⟦6f12a12be⟧ »DATA«
└─⟦this⟧
package body Generic_Expression is
type Alias_Storage is array (Alias) of Integer;
The_Aliases : Alias_Storage := (others => 0);
type Kind_Of_Operation is (System_Defined_Operator,
User_Defined_Operator,
Value_Definition,
Alias_Definition,
Alias_Reference,
Predicate_Conjunction,
Undefined);
-- predicates have only left nodes
type Intermediate_Code (Kind : Kind_Of_Operation := Undefined) is
record
Is_Predicate : Boolean := False;
case Kind is
when System_Defined_Operator =>
The_System_Operator : System_Defined_Operators;
The_Left_System_Operand : Object;
The_Right_System_Operand : Object;
when User_Defined_Operator =>
The_User_Operator : User_Defined_Operators;
The_Left_User_Operand : Object;
The_Right_User_Operand : Object;
when Value_Definition =>
The_Value : Integer;
when Alias_Definition =>
The_Defined_Alias : Alias;
when Alias_Reference =>
The_Referenced_Alias : Alias;
when Predicate_Conjunction =>
The_Left_Predicate : Object;
The_Right_Predicate : Object;
when Undefined =>
null;
end case;
end record;
type Intermediate_Codes is array (Object range <>) of Intermediate_Code;
The_Expressions : Intermediate_Codes (1 .. Object (Max_Expression_Count)) :=
(others => Intermediate_Code'(Kind => Undefined, Is_Predicate => False));
The_Last_Expression : Object := 0;
function New_Node (For_Code : Intermediate_Code) return Object is
begin
if The_Last_Expression = Object (Max_Expression_Count) then
raise Overflow;
else
The_Last_Expression := The_Last_Expression + 1;
The_Expressions (The_Last_Expression) := For_Code;
return The_Last_Expression;
end if;
end New_Node;
function Value (For_Integer : Integer) return Object is
begin
return New_Node (For_Code => (Kind => Value_Definition,
Is_Predicate => False,
The_Value => For_Integer));
end Value;
function Value (For_Alias : Alias) return Object is
begin
return New_Node (For_Code => (Kind => Alias_Reference,
Is_Predicate => False,
The_Referenced_Alias => For_Alias));
end Value;
function Define_As (The_Alias : Alias) return Object is
begin
return New_Node (For_Code => (Kind => Alias_Definition,
Is_Predicate => True,
The_Defined_Alias => The_Alias));
end Define_As;
function "and" (Left, Right : Object) return Object is
The_Left_Code, The_Right_Code : Intermediate_Code;
begin
if Left = Null_Expression then
return Right;
elsif Right = Null_Expression then
return Left;
else
The_Left_Code := The_Expressions (Left);
The_Right_Code := The_Expressions (Right);
if The_Left_Code.Is_Predicate and The_Right_Code.Is_Predicate then
return New_Node (For_Code => (Kind => Predicate_Conjunction,
Is_Predicate => True,
The_Left_Predicate => Left,
The_Right_Predicate => Right));
else
raise Illegal_Operation;
end if;
end if;
end "and";
function Unary_System_Predicate return Object is
begin
return New_Node (For_Code =>
(Kind => System_Defined_Operator,
Is_Predicate => True,
The_System_Operator => Operator,
The_Left_System_Operand |
The_Right_System_Operand => Null_Expression));
end Unary_System_Predicate;
function Binary_System_Predicate (Using_Value : Object) return Object is
begin
return New_Node (For_Code =>
(Kind => System_Defined_Operator,
Is_Predicate => True,
The_System_Operator => Operator,
The_Left_System_Operand => Using_Value,
The_Right_System_Operand => Null_Expression));
end Binary_System_Predicate;
function Unary_System_Expression (Using_Value : Object) return Object is
begin
return New_Node (For_Code =>
(Kind => System_Defined_Operator,
Is_Predicate => False,
The_System_Operator => Operator,
The_Left_System_Operand => Using_Value,
The_Right_System_Operand => Null_Expression));
end Unary_System_Expression;
function Binary_System_Expression (Left, Right : Object) return Object is
begin
return New_Node (For_Code => (Kind => System_Defined_Operator,
Is_Predicate => False,
The_System_Operator => Operator,
The_Left_System_Operand => Left,
The_Right_System_Operand => Right));
end Binary_System_Expression;
function Unary_User_Predicate return Object is
begin
return New_Node (For_Code =>
(Kind => User_Defined_Operator,
Is_Predicate => True,
The_User_Operator => Operator,
The_Left_User_Operand | The_Right_User_Operand =>
Null_Expression));
end Unary_User_Predicate;
function Binary_User_Predicate (Using_Value : Object) return Object is
begin
return New_Node (For_Code =>
(Kind => User_Defined_Operator,
Is_Predicate => True,
The_User_Operator => Operator,
The_Left_User_Operand => Using_Value,
The_Right_User_Operand => Null_Expression));
end Binary_User_Predicate;
function Unary_User_Expression (Using_Value : Object) return Object is
begin
return New_Node (For_Code =>
(Kind => User_Defined_Operator,
Is_Predicate => False,
The_User_Operator => Operator,
The_Left_User_Operand => Using_Value,
The_Right_User_Operand => Null_Expression));
end Unary_User_Expression;
function Binary_User_Expression (Left, Right : Object) return Object is
begin
return New_Node (For_Code => (Kind => User_Defined_Operator,
Is_Predicate => False,
The_User_Operator => Operator,
The_Left_User_Operand => Left,
The_Right_User_Operand => Right));
end Binary_User_Expression;
function Evaluate (The_Expression : Object) return Integer is
The_Code : Intermediate_Code;
begin
if The_Expression = Null_Expression then
return 0;
else
The_Code := The_Expressions (The_Expression);
if The_Code.Is_Predicate then
raise Illegal_Operation;
else
case The_Code.Kind is
when System_Defined_Operator =>
return
System_Defined_Evaluate
(Using_Operator => The_Code.The_System_Operator,
Left =>
Evaluate (The_Code.The_Left_System_Operand),
Right =>
Evaluate (The_Code.The_Right_System_Operand));
when User_Defined_Operator =>
return
User_Defined_Evaluate
(Using_Operator => The_Code.The_User_Operator,
Left =>
Evaluate (The_Code.The_Left_User_Operand),
Right =>
Evaluate (The_Code.The_Right_User_Operand));
when Value_Definition =>
return The_Code.The_Value;
when Alias_Reference =>
return The_Aliases (The_Code.The_Referenced_Alias);
when Alias_Definition | Predicate_Conjunction | Undefined =>
raise Illegal_Operation;
end case;
end if;
end if;
end Evaluate;
function Match (Value : Integer; Against : Object) return Boolean is
The_Code : Intermediate_Code := The_Expressions (Against);
begin
if The_Code.Is_Predicate then
case The_Code.Kind is
when System_Defined_Operator =>
return System_Defined_Match
(The_Code.The_System_Operator, Value,
Against =>
Evaluate (The_Code.The_Left_System_Operand));
when User_Defined_Operator =>
return User_Defined_Match
(The_Code.The_User_Operator, Value,
Against =>
Evaluate (The_Code.The_Left_User_Operand));
when Alias_Definition =>
The_Aliases (The_Code.The_Defined_Alias) := Value;
return True;
when Predicate_Conjunction =>
return Match
(Value,
Against => The_Code.The_Left_Predicate) and then
Match (Value,
Against => The_Code.The_Right_Predicate);
when Value_Definition | Alias_Reference | Undefined =>
raise Illegal_Operation;
end case;
else
raise Illegal_Operation;
end if;
end Match;
procedure Put (The_Object : Object; Where : Output_Stream.Object) is
begin
null;
end Put;
end Generic_Expression;