|
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