|
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: 8341 (0x2095)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
package body Generic_Predicate is
type Predicate_Owners is (System, User);
package System_Defined is
type Operators is (Is_Equal, Is_Less, Is_Less_Or_Equal,
Is_Greater, Is_Greater_Or_Equal, Is_Different,
Is_Any, Is_Undefined, Is_Defined);
function Match (Using_Operator : Operators; Value : Slot.Object)
return Boolean;
function Match (Using_Operator : Operators;
Value : Slot.Object;
Against : Slot.Object) return Boolean;
function Image (Op : Operators) return String;
end System_Defined;
package Primary_Predicate is
type Sub_Classes is (Alias_Definition, Predicate_Conjunction,
Predicate_Collection);
type Collection_Access is access Generic_Predicate.Objects;
type Object (Kind : Sub_Classes := Alias_Definition) is
record
case Kind is
when Alias_Definition =>
The_Alias : Alias.Name;
when Predicate_Conjunction =>
The_Left_Predicate : Generic_Predicate.Object;
The_Right_Predicate : Generic_Predicate.Object;
when Predicate_Collection =>
The_Collection : Collection_Access;
end case;
end record;
function Make_Alias_Definition (The_Alias : Alias.Name) return Object;
function Make_Conjunction
(Left, Right : Generic_Predicate.Object) return Object;
function Make_Collection
(Of_Objects : Generic_Predicate.Objects) return Object;
function Get_Collection (From_Object : Object)
return Generic_Predicate.Objects;
procedure Put (The_Object : Object; Where : Output_Stream.Object);
function Match (Value : Slot.Object; Against : Object) return Boolean;
end Primary_Predicate;
package Unary_Predicate is
type Object (Owner : Predicate_Owners := System) is
record
case Owner is
when System =>
The_System_Operator : System_Defined.Operators;
when User =>
The_User_Operator : User_Defined_Operators;
end case;
end record;
function Make (The_Operator : System_Defined.Operators) return Object;
function Make (The_Operator : User_Defined_Operators) return Object;
procedure Put (The_Object : Object; Where : Output_Stream.Object);
function Match (Value : Slot.Object; Against : Object) return Boolean;
end Unary_Predicate;
package Binary_Predicate is
type Object (Owner : Predicate_Owners := System) is
record
The_Operand : Expression_Object;
case Owner is
when System =>
The_System_Operator : System_Defined.Operators;
when User =>
The_User_Operator : User_Defined_Operators;
end case;
end record;
function Make (The_Operator : System_Defined.Operators;
The_Operand : Expression_Object) return Object;
function Make (The_Operator : User_Defined_Operators;
The_Operand : Expression_Object) return Object;
procedure Put (The_Object : Object; Where : Output_Stream.Object);
function Match (Value : Slot.Object; Against : Object) return Boolean;
end Binary_Predicate;
type Object_Structure (Sub_Class : Sub_Classes) is
record
case Sub_Class is
when Primary =>
The_Primary_Code : Primary_Predicate.Object;
when Unary =>
The_Unary_Code : Unary_Predicate.Object;
when Binary =>
The_Binary_Code : Binary_Predicate.Object;
when Undefined =>
null;
end case;
end record;
function New_Node (For_Code : Object_Structure) return Object is
Result : Object;
begin
Result := new Object_Structure (Sub_Class => For_Code.Sub_Class);
Result.all := For_Code;
return Result;
end New_Node;
function Collection (Of_Objects : Objects) return Object is
The_Predicate : Primary_Predicate.Object;
begin
The_Predicate := Primary_Predicate.Make_Collection (Of_Objects);
return New_Node (For_Code => (Sub_Class => Primary,
The_Primary_Code => The_Predicate));
end Collection;
function Get (From_Object : Object) return Objects is
begin
return Primary_Predicate.Get_Collection (From_Object.The_Primary_Code);
end Get;
function Define_As (The_Alias : Alias.Name) return Object is
The_Predicate : Primary_Predicate.Object;
begin
The_Predicate := Primary_Predicate.Make_Alias_Definition (The_Alias);
return New_Node (For_Code => (Sub_Class => Primary,
The_Primary_Code => The_Predicate));
end Define_As;
function "and" (Left, Right : Object) return Object is
The_Predicate : Primary_Predicate.Object;
begin
if Left = Null_Predicate then
return Right;
elsif Right = Null_Predicate then
return Left;
else
The_Predicate := Primary_Predicate.Make_Conjunction (Left, Right);
return New_Node (For_Code => (Sub_Class => Primary,
The_Primary_Code => The_Predicate));
end if;
end "and";
function Unary_User_Predicate return Object is
The_Code : Unary_Predicate.Object;
begin
The_Code := Unary_Predicate.Make (Operator);
return New_Node (For_Code => (Sub_Class => Unary,
The_Unary_Code => The_Code));
end Unary_User_Predicate;
function Binary_User_Predicate
(Using_Value : Expression_Object) return Object is
The_Code : Binary_Predicate.Object;
begin
The_Code := Binary_Predicate.Make (Operator, Using_Value);
return New_Node (For_Code => (Sub_Class => Binary,
The_Binary_Code => The_Code));
end Binary_User_Predicate;
function Match (Value : Slot.Object; Against : Object) return Boolean is
begin
if Against = Null_Predicate then
return False;
else
case Against.Sub_Class is
when Primary =>
return Primary_Predicate.Match
(Value, Against.The_Primary_Code);
when Unary =>
return Unary_Predicate.Match
(Value, Against.The_Unary_Code);
when Binary =>
return Binary_Predicate.Match
(Value, Against.The_Binary_Code);
when Undefined =>
raise Illegal_Operation;
end case;
end if;
end Match;
procedure Put (The_Object : Object; Where : Output_Stream.Object) is
use Output_Stream;
begin
if The_Object /= Null_Predicate then
case The_Object.Sub_Class is
when Primary =>
Primary_Predicate.Put (The_Object.The_Primary_Code, Where);
when Unary =>
Unary_Predicate.Put (The_Object.The_Unary_Code, Where);
when Binary =>
Binary_Predicate.Put (The_Object.The_Binary_Code, Where);
when Undefined =>
Put ("Undefined predicate", Where);
end case;
end if;
end Put;
package body System_Defined is separate;
package body Primary_Predicate is separate;
package body Unary_Predicate is separate;
package body Binary_Predicate is separate;
package body System_Defined_Predicate is separate;
end Generic_Predicate;