|
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 - downloadIndex: ┃ T V ┃
Length: 7081 (0x1ba9)
Types: TextFile
Names: »V«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦e24fb53b7⟧
└─⟦this⟧
with Constant_String;
with Output_Stream;
generic
type Class_Names is (<>);
Null_Class_Name : Class_Names := Class_Names'Last;
Max_Slots : Natural := 20;
type Predicate_Object is private;
Null_Predicate : Predicate_Object;
with function Predicate_Match (Value : Integer; Against : Predicate_Object)
return Boolean is <>;
with procedure Predicate_Put (The_Expression : Predicate_Object;
Where : Output_Stream.Object) is <>;
package Generic_Fact_Base is
package Query is
subtype Query_Size is Natural range 0 .. Max_Slots;
type Query_Qualifier is (Find, Check_No);
subtype Slot_Names is Query_Size range 1 .. Max_Slots;
type Patterns is array (Slot_Names range <>) of Predicate_Object;
type Object (Size : Query_Size := 0) is
record
Kind : Query_Qualifier;
Class : Class_Names;
Value : Patterns (1 .. Size);
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 => Null_Predicate));
Null_Queries : constant Objects := (1 .. 0 => Null_Query);
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;
type User_Object is private;
Null_User_Object : constant User_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 Integer;
type Slot_Names_Images is
array (Slot_Names range <>) of Constant_String.Object;
function As_User_Object
(The_Instance : Instance_Name; For_Class : Class.Object)
return User_Object;
function Class_Of (The_Object : User_Object) return Class.Object;
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; Slot : Slot_Names)
return Integer;
procedure Add (To_Class : Class.Object; The_Instance : Slots);
procedure Delete (The_Object : User_Object);
procedure Change (The_Object : User_Object; To_Value : Slots);
procedure Change (The_Object : User_Object;
Slot : Slot_Names;
To_Value : Integer);
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;
type User_Object is
record
Isa : Class.Object := Class.Null_Class;
Name : Class.Instance_Name := Class.Null_Instance_Name;
end record;
Null_User_Object : constant User_Object :=
(Isa => Class.Null_Class, Name => Class.Null_Instance_Name);
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 Integer;
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 Get (The_Fact : Class.User_Object) return Slots;
function Get (The_Fact : Class.User_Object; Slot : Slot_Names)
return Integer;
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 : Integer);
generic
with function Image (For_Slot : Slot_Names; Value : Integer)
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;
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;