|
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: 29696 (0x7400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Generic_Fact_Base, seg_03c051
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Alias;
with Constant_String;
with Output_Stream;
with Fact_Reference;
with Slot;
generic
type Class_Names is (<>);
Null_Class_Name : Class_Names := Class_Names'Last;
Max_Slots : Natural := 20;
type User_Defined_Operators is (<>);
with function User_Defined_Unary_Match
(Using_Operator : User_Defined_Operators;
Value : Slot.Object) return Boolean is <>;
with function User_Defined_Binary_Match
(Using_Operator : User_Defined_Operators;
Value, Against : Slot.Object) return Boolean is <>;
with function User_Defined_Image
(Op : User_Defined_Operators) return String is
User_Defined_Operators'Image;
type Expression_Object is private;
with function Slot_Object_Expression
(For_Object : Slot.Object) return Expression_Object;
with function Alias_Expression
(For_Alias : Alias.Name) return Expression_Object;
with function Expression_Evaluate
(The_Object : Expression_Object) return Slot.Object;
with procedure Expression_Put (The_Object : Expression_Object;
Where : Output_Stream.Object);
package Generic_Fact_Base is
package Predicate is
type Object is private;
Null_Predicate : constant Object;
type Objects is array (Natural range <>) of Object;
function Define_As (The_Alias : Alias.Name) return Object;
function "and" (Left, Right : Object) return Object;
function Collection (Of_Objects : Objects) return Object;
-- user defined predicates
generic
Operator : User_Defined_Operators;
function Unary_User_Predicate return Object;
generic
Operator : User_Defined_Operators;
function Binary_User_Predicate
(Using_Value : Expression_Object) return Object;
function Match (Value : Slot.Object; Against : Object) return Boolean;
procedure Put (The_Object : Object; Where : Output_Stream.Object);
package System_Defined_Predicate is
function Is_Equal (The_Object : Expression_Object) return Object;
function Is_Less (The_Object : Expression_Object) return Object;
function Is_Less_Or_Equal
(The_Object : Expression_Object) return Object;
function Is_Greater (The_Object : Expression_Object) return Object;
function Is_Greater_Or_Equal
(The_Object : Expression_Object) return Object;
function Is_Different
(The_Object : Expression_Object) return Object;
function Is_Any return Object;
function Is_Undefined return Object;
function Is_Defined return Object;
-- Slot value predicates
function Is_Equal (The_Value : Slot.Object) return Object;
function Is_Less (The_Value : Slot.Object) return Object;
function Is_Less_Or_Equal (The_Value : Slot.Object) return Object;
function Is_Greater (The_Value : Slot.Object) return Object;
function Is_Greater_Or_Equal
(The_Value : Slot.Object) return Object;
function Is_Different (The_Value : Slot.Object) return Object;
-- Integer value predicate shortcuts
function Is_Equal (The_Value : Integer) return Object;
function Is_Less (The_Value : Integer) return Object;
function Is_Less_Or_Equal (The_Value : Integer) return Object;
function Is_Greater (The_Value : Integer) return Object;
function Is_Greater_Or_Equal (The_Value : Integer) return Object;
function Is_Different (The_Value : Integer) return Object;
-- Boolean value predicate shortcuts
function Is_Equal (The_Value : Boolean) return Object;
function Is_Different (The_Value : Boolean) return Object;
-- Float value predicate shortcuts
function Is_Equal (The_Value : Float) return Object;
function Is_Less (The_Value : Float) return Object;
function Is_Less_Or_Equal (The_Value : Float) return Object;
function Is_Greater (The_Value : Float) return Object;
function Is_Greater_Or_Equal (The_Value : Float) return Object;
function Is_Different (The_Value : Float) return Object;
-- Duration value predicate shortcuts
function Is_Equal (The_Value : Duration) return Object;
function Is_Less (The_Value : Duration) return Object;
function Is_Less_Or_Equal (The_Value : Duration) return Object;
function Is_Greater (The_Value : Duration) return Object;
function Is_Greater_Or_Equal (The_Value : Duration) return Object;
function Is_Different (The_Value : Duration) return Object;
-- Character value predicate shortcuts
function Is_Equal (The_Value : Character) return Object;
function Is_Less (The_Value : Character) return Object;
function Is_Less_Or_Equal (The_Value : Character) return Object;
function Is_Greater (The_Value : Character) return Object;
function Is_Greater_Or_Equal (The_Value : Character) return Object;
function Is_Different (The_Value : Character) return Object;
-- String value predicate shortcuts
function Is_Equal (The_Value : String) return Object;
function Is_Less (The_Value : String) return Object;
function Is_Less_Or_Equal (The_Value : String) return Object;
function Is_Greater (The_Value : String) return Object;
function Is_Greater_Or_Equal (The_Value : String) return Object;
function Is_Different (The_Value : String) return Object;
-- Alias predicate shortcuts
function Is_Equal (The_Alias : Alias.Name) return Object;
function Is_Less (The_Alias : Alias.Name) return Object;
function Is_Less_Or_Equal (The_Alias : Alias.Name) return Object;
function Is_Greater (The_Alias : Alias.Name) return Object;
function Is_Greater_Or_Equal (The_Alias : Alias.Name) return Object;
function Is_Different (The_Alias : Alias.Name) return Object;
end System_Defined_Predicate;
Illegal_Operation : exception;
private
type Sub_Classes is (Primary, Unary, Binary, Undefined);
type Object_Structure (Sub_Class : Sub_Classes);
type Object is access Object_Structure;
Null_Predicate : constant Object := null;
Null_Predicates : constant Objects (1 .. 0) :=
(others => Null_Predicate);
end Predicate;
package Query is
subtype Query_Size is Natural range 0 .. Max_Slots;
type Query_Qualifier is (Find, Check_No, Evaluate);
subtype Slot_Names is Query_Size range 1 .. Max_Slots;
subtype Patterns is Predicate.Objects;
type Object (Size : Query_Size := 0; Kind : Query_Qualifier := Find) is
record
case Kind is
when Find | Check_No =>
Class : Class_Names;
Value : Patterns (1 .. Size);
when Evaluate =>
The_Expression : Expression_Object;
The_Predicate : Predicate.Object;
end case;
end record;
type Objects is array (Positive range <>) of Object;
Null_Query : constant Object :=
Query.Object'(Size => 0,
Kind => Find,
Class => Null_Class_Name,
Value => (1 .. 0 => Predicate.Null_Predicate));
Null_Queries : constant Objects := (1 .. 0 => Null_Query);
package Operators is
function Match (The_Expression : Expression_Object;
The_Predicate : Predicate.Object) return Boolean;
function Satisfying (E : Expression_Object; P : Predicate.Object)
return Object;
function Satisfying (The_Slot : Slot.Object; P : Predicate.Object)
return Object;
function Satisfying (The_Alias : Alias.Name; P : Predicate.Object)
return Object;
function Satisfying (The_Integer : Integer; P : Predicate.Object)
return Object;
function Satisfying (The_Float : Float; P : Predicate.Object)
return Object;
function Satisfying (The_Boolean : Boolean; P : Predicate.Object)
return Object;
function Satisfying
(The_Character : Character; P : Predicate.Object)
return Object;
function Satisfying (The_String : String; P : Predicate.Object)
return Object;
function Satisfying (The_Duration : Duration; P : Predicate.Object)
return Object;
end Operators;
procedure Put (The_Query : Object; Where : Output_Stream.Object);
procedure Put (The_Queries : Objects; Where : Output_Stream.Object);
end Query;
package Class is
type Object is private;
Null_Class : constant Object;
subtype User_Object is Fact_Reference.Object;
Null_User_Object : constant User_Object := Fact_Reference.Null_Object;
type User_Objects is array (Positive range <>) of User_Object;
function No_User_Objects return User_Objects;
type Instance_Name is new Natural;
subtype Instance_Size is Natural range 0 .. Max_Slots;
subtype Slot_Names is Instance_Size range 1 .. Max_Slots;
type Slots is array (Slot_Names range <>) of Slot.Object;
type Slot_Names_Images is
array (Slot_Names range <>) of Constant_String.Object;
function "=" (Left, Right : User_Object) return Standard.Boolean
renames Fact_Reference."=";
function Is_Equal (Left, Right : Slot.Object) return Boolean;
function As_User_Object
(The_Instance : Instance_Name; For_Class : Class.Object)
return User_Object;
function As_User_Object (The_Slot : Slot.Object) return User_Object;
function Class_Of (The_Object : User_Object) return Class.Object;
function Instance_Of (The_Object : User_Object) return Instance_Name;
function Class_Name_Of (The_Object : User_Object) return Class_Names;
function Class_Name_Of (The_Object : Object) return Class_Names;
function Last_Instance (Of_Class : Object) return Instance_Name;
function Make (Name : Class_Names;
Class_Size : Natural;
Names : Slot_Names_Images) return Object;
procedure Make_Empty (The_Class : in out Class.Object);
function Slot_Name_Image
(From_Class : Class.Object; For_Slot : Slot_Names)
return String;
function Match (The_Instance : Instance_Name;
Against_Patterns : Query.Patterns;
Using_Class : Class.Object) return Boolean;
function Get (The_Object : User_Object) return Slots;
function Get (The_Object : User_Object; The_Slot : Slot_Names)
return Slot.Object;
procedure Add (To_Class : Class.Object;
The_Instance : Slots;
Its_Reference : out Slot.Object);
procedure Delete (The_Object : User_Object);
procedure Change (The_Object : User_Object; To_Value : Slots);
procedure Change (The_Object : User_Object;
The_Slot : Slot_Names;
To_Value : Slot.Object);
procedure Default_Put (The_Object : User_Object;
Where : Output_Stream.Object);
procedure Default_Put (The_Collection : User_Objects;
Where : Output_Stream.Object);
procedure Default_Put (The_Class : Class.Object;
Where : Output_Stream.Object);
generic
with procedure Put (The_Object : User_Object;
Where : Output_Stream.Object) is Default_Put;
procedure Generic_Put (The_Class : Class.Object;
Where : Output_Stream.Object);
Overflow : exception;
private
Null_Instance_Name : constant Instance_Name := 0;
type Object_Structure (Class_Size : Instance_Name);
type Object is access Object_Structure;
Null_Class : constant Object := null;
end Class;
generic
Class_Name : Class_Names;
Class_Size : Natural;
type Slot_Names is (<>);
package Generic_Class is
type Slots is array (Slot_Names) of Slot.Object;
type Patterns is array (Slot_Names) of Predicate.Object;
function Class_Object return Class.Object;
function Exist (What : Patterns) return Query.Object;
function Not_Any (What : Patterns) return Query.Object;
function Absent (What : Patterns) return Query.Object renames Not_Any;
function Such_As (What : Patterns) return Predicate.Object;
function Get (The_Fact : Class.User_Object) return Slots;
function Get (The_Fact : Class.User_Object; The_Slot : Slot_Names)
return Slot.Object;
function Get (The_Fact : Class.User_Object; The_Slot : Slot_Names)
return Class.User_Object;
function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
return Integer;
function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
return Boolean;
function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
return Float;
function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
return Character;
function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
return Duration;
function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
return String;
procedure Add (The_Fact : Slots; Its_Reference : out Slot.Object);
procedure Add (The_Fact : Slots);
procedure Delete (The_Fact : Class.User_Object);
procedure Change (The_Fact : Class.User_Object; Value : Slots);
procedure Change (The_Fact : Class.User_Object;
The_Slot : Slot_Names;
To_Value : Slot.Object);
procedure Change (The_Fact : Class.User_Object;
The_Slot : Slot_Names;
To_Value : Integer);
procedure Change (The_Fact : Class.User_Object;
The_Slot : Slot_Names;
To_Value : Boolean);
procedure Change (The_Fact : Class.User_Object;
The_Slot : Slot_Names;
To_Value : Float);
procedure Change (The_Fact : Class.User_Object;
The_Slot : Slot_Names;
To_Value : Character);
procedure Change (The_Fact : Class.User_Object;
The_Slot : Slot_Names;
To_Value : Duration);
procedure Change (The_Fact : Class.User_Object;
The_Slot : Slot_Names;
To_Value : String);
generic
with function Image (For_Slot : Slot_Names; Value : Slot.Object)
return String;
procedure Generic_Put (The_Fact : Class.User_Object;
Where : Output_Stream.Object);
Illegal_Access : exception;
end Generic_Class;
package Working_Memory is
procedure Make_Empty;
procedure Register (The_Class : Class.Object);
function Get (Using : Class_Names) return Class.Object;
generic
type Rule_Id is private;
type Instance_Object is private;
with function Instance_Value (The_Rule : Rule_Id;
The_Facts : Class.User_Objects)
return Instance_Object;
with procedure Add_To_Conflict_Set (The_Instance : Instance_Object);
procedure Retrieve_With_Conflict_Set
(The_Rule : Rule_Id; Filter : Query.Objects);
function Retrieve (Filter : Query.Objects) return Class.User_Objects;
generic
with procedure Put (The_Fact : Class.User_Object;
Where : Output_Stream.Object) is
Class.Default_Put;
procedure Generic_Put (Where : Output_Stream.Object);
procedure Default_Put (Where : Output_Stream.Object);
end Working_Memory;
end Generic_Fact_Base;
nblk1=1c
nid=0
hdr6=38
[0x00] rec0=1d rec1=00 rec2=01 rec3=038
[0x01] rec0=01 rec1=00 rec2=1b rec3=010
[0x02] rec0=1b rec1=00 rec2=0f rec3=030
[0x03] rec0=0e rec1=00 rec2=1a rec3=078
[0x04] rec0=14 rec1=00 rec2=13 rec3=04a
[0x05] rec0=01 rec1=00 rec2=19 rec3=030
[0x06] rec0=11 rec1=00 rec2=18 rec3=092
[0x07] rec0=04 rec1=00 rec2=0b rec3=004
[0x08] rec0=0e rec1=00 rec2=17 rec3=080
[0x09] rec0=04 rec1=00 rec2=0d rec3=014
[0x0a] rec0=10 rec1=00 rec2=16 rec3=006
[0x0b] rec0=1b rec1=00 rec2=14 rec3=056
[0x0c] rec0=16 rec1=00 rec2=12 rec3=09c
[0x0d] rec0=01 rec1=00 rec2=11 rec3=006
[0x0e] rec0=13 rec1=00 rec2=0e rec3=020
[0x0f] rec0=19 rec1=00 rec2=09 rec3=00a
[0x10] rec0=00 rec1=00 rec2=0a rec3=010
[0x11] rec0=14 rec1=00 rec2=15 rec3=006
[0x12] rec0=00 rec1=00 rec2=02 rec3=034
[0x13] rec0=17 rec1=00 rec2=10 rec3=05e
[0x14] rec0=1a rec1=00 rec2=04 rec3=00a
[0x15] rec0=15 rec1=00 rec2=07 rec3=03c
[0x16] rec0=02 rec1=00 rec2=03 rec3=06c
[0x17] rec0=14 rec1=00 rec2=0c rec3=01a
[0x18] rec0=00 rec1=00 rec2=06 rec3=00c
[0x19] rec0=18 rec1=00 rec2=08 rec3=02c
[0x1a] rec0=1a rec1=00 rec2=05 rec3=07a
[0x1b] rec0=09 rec1=00 rec2=1c rec3=000
tail 0x21739dc788570810c02ac 0x42a00088462063c03