|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 41984 (0xa400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Binary_Predicate, package body Predicate, package body Primary_Predicate, package body System_Defined, package body System_Defined_Predicate, package body Unary_Predicate, seg_03bb5f, seg_03c0c4, seg_03c52f, seg_03c6d6, separate Generic_Fact_Base
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
separate (Generic_Fact_Base)
package body 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 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 : Predicate.Object;
The_Right_Predicate : 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 : Predicate.Object) return Object;
function Make_Collection (Of_Objects : Predicate.Objects) return Object;
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 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 Predicate;
nblk1=28
nid=3
hdr6=14
[0x00] rec0=1a rec1=00 rec2=01 rec3=028
[0x01] rec0=15 rec1=00 rec2=27 rec3=010
[0x02] rec0=17 rec1=00 rec2=22 rec3=010
[0x03] rec0=0e rec1=00 rec2=04 rec3=00a
[0x04] rec0=1c rec1=00 rec2=20 rec3=02c
[0x05] rec0=09 rec1=00 rec2=25 rec3=07e
[0x06] rec0=1d rec1=00 rec2=1e rec3=01c
[0x07] rec0=18 rec1=00 rec2=1d rec3=01e
[0x08] rec0=1c rec1=00 rec2=1c rec3=026
[0x09] rec0=04 rec1=00 rec2=16 rec3=000
[0x0a] rec0=1c rec1=00 rec2=1c rec3=026
[0x0b] rec0=04 rec1=00 rec2=16 rec3=000
[0x0c] rec0=04 rec1=00 rec2=16 rec3=000
[0x0d] rec0=1d rec1=00 rec2=1e rec3=01c
[0x0e] rec0=18 rec1=00 rec2=1d rec3=01e
[0x0f] rec0=1c rec1=00 rec2=1c rec3=026
[0x10] rec0=04 rec1=00 rec2=16 rec3=000
[0x11] rec0=1d rec1=00 rec2=10 rec3=05a
[0x12] rec0=26 rec1=00 rec2=0f rec3=034
[0x13] rec0=1c rec1=00 rec2=0e rec3=014
[0x14] rec0=21 rec1=00 rec2=0d rec3=010
[0x15] rec0=1e rec1=00 rec2=0c rec3=068
[0x16] rec0=1b rec1=00 rec2=0b rec3=066
[0x17] rec0=1b rec1=00 rec2=0a rec3=014
[0x18] rec0=1c rec1=00 rec2=09 rec3=016
[0x19] rec0=1c rec1=00 rec2=08 rec3=020
[0x1a] rec0=1f rec1=00 rec2=07 rec3=03e
[0x1b] rec0=17 rec1=00 rec2=06 rec3=000
[0x1c] rec0=1c rec1=00 rec2=08 rec3=020
[0x1d] rec0=1f rec1=00 rec2=07 rec3=03e
[0x1e] rec0=17 rec1=00 rec2=06 rec3=000
[0x1f] rec0=1f rec1=00 rec2=07 rec3=03e
[0x20] rec0=17 rec1=00 rec2=06 rec3=000
[0x21] rec0=1c rec1=00 rec2=09 rec3=016
[0x22] rec0=1c rec1=00 rec2=08 rec3=020
[0x23] rec0=1f rec1=00 rec2=07 rec3=03e
[0x24] rec0=17 rec1=00 rec2=06 rec3=000
[0x25] rec0=1f rec1=00 rec2=07 rec3=03e
[0x26] rec0=17 rec1=00 rec2=06 rec3=000
[0x27] rec0=00 rec1=40 rec2=10 rec3=540
tail 0x217398ad685407f1e3cd8 0x42a00088462063c03
Free Block Chain:
0x3: 0000 00 26 03 fc 80 20 2c 20 52 69 67 68 74 20 3a 20 ┆ & , Right : ┆
0x26: 0000 00 21 03 fc 80 1d 61 73 73 65 73 20 3a 3d 20 41 ┆ ! asses := A┆
0x21: 0000 00 23 01 a3 80 22 65 20 3d 3e 20 28 53 75 62 5f ┆ # "e => (Sub_┆
0x23: 0000 00 24 03 fc 80 27 5f 49 73 5f 41 6e 79 20 28 57 ┆ $ '_Is_Any (W┆
0x24: 0000 00 02 03 fc 80 13 20 50 72 65 64 69 63 61 74 65 ┆ Predicate┆
0x2: 0000 00 1f 00 06 80 03 73 5f 41 03 65 2e 4f 62 6a 65 ┆ s_A e.Obje┆
0x1f: 0000 00 06 00 17 80 14 6c 61 73 73 20 20 20 20 20 20 ┆ lass ┆
0x6: 0000 00 07 03 04 80 24 71 75 61 6c 20 28 41 6c 69 61 ┆ $qual (Alia┆
0x7: 0000 00 08 03 fc 80 36 72 6e 20 49 73 5f 47 72 65 61 ┆ 6rn Is_Grea┆
0x8: 0000 00 09 03 fc 80 44 20 72 65 74 75 72 6e 20 49 73 ┆ D return Is┆
0x9: 0000 00 0a 03 fc 80 3e 20 20 72 65 74 75 72 6e 20 49 ┆ > return I┆
0xa: 0000 00 0b 03 fc 80 0e 74 75 72 6e 20 4f 62 6a 65 63 ┆ turn Objec┆
0xb: 0000 00 0c 03 fc 80 09 4f 62 6a 65 63 74 20 69 73 09 ┆ Object is ┆
0xc: 0000 00 0d 03 fc 80 47 20 20 20 20 72 65 74 75 72 6e ┆ G return┆
0xd: 0000 00 0e 03 fc 80 03 67 69 6e 03 00 3b 20 20 20 20 ┆ gin ; ┆
0xe: 0000 00 0f 03 fc 80 06 69 63 61 74 65 73 06 00 00 00 ┆ icates ┆
0xf: 0000 00 10 03 fc 80 20 72 65 73 73 69 6f 6e 5f 4f 62 ┆ ression_Ob┆
0x10: 0000 00 14 03 fc 80 15 20 3a 20 45 78 70 72 65 73 73 ┆ : Express┆
0x14: 0000 00 11 00 34 80 31 6e 63 74 69 6f 6e 20 4d 61 6b ┆ 4 1nction Mak┆
0x11: 0000 00 12 03 fc 80 09 6e 65 64 2e 4d 61 74 63 68 09 ┆ ned.Match ┆
0x12: 0000 00 13 03 fc 80 20 20 72 65 74 75 72 6e 20 46 72 ┆ return Fr┆
0x13: 0000 00 15 03 fc 80 3b 20 20 20 20 20 20 20 20 20 20 ┆ ; ┆
0x15: 0000 00 19 03 fc 80 02 69 73 02 00 50 20 20 20 20 20 ┆ is P ┆
0x19: 0000 00 17 00 11 80 0e 61 72 79 5f 50 72 65 64 69 63 ┆ ary_Predic┆
0x17: 0000 00 05 03 fc 00 35 20 20 20 20 20 20 20 20 20 20 ┆ 5 ┆
0x5: 0000 00 18 00 04 80 01 3b 01 20 54 68 65 5f 55 73 65 ┆ ; The_Use┆
0x18: 0000 00 28 03 fc 80 30 20 20 20 20 20 20 20 20 20 20 ┆ ( 0 ┆
0x28: 0000 00 1a 01 92 80 33 65 66 69 6e 69 74 69 6f 6e 20 ┆ 3efinition ┆
0x1a: 0000 00 1b 03 fc 80 1a 20 20 20 72 65 74 75 72 6e 20 ┆ return ┆
0x1b: 0000 00 00 03 fc 80 27 20 20 20 20 20 20 20 20 20 20 ┆ ' ┆