|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Rule_Base, package body Generic_Rule_Bundle, package body Rule_Instance, seg_02ad68
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Constant_String;
with Fact;
with Generic_Condition_Element;
with Generic_Conflict_Set;
with Output_Stream;
package body Generic_Rule_Base is
package Condition_Elements is
new Generic_Condition_Element (Max_Condition_Elements);
-------------------------------------------------------------------------
subtype Premiss_Size is Natural range 0 .. Max_Condition_Elements_By_Rule;
subtype Rule_Name is Constant_String.Object;
Null_Rule_Name : Rule_Name renames Constant_String.Null_Object;
function As_Rule_Name (For_String : String) return Rule_Name
renames Constant_String.Make;
function Image (Of_Rule_Name : Rule_Name) return String
renames Constant_String.Image;
-------------------------------------------------------------------------
type Rule (The_Query_Count : Premiss_Size := 0) is
record
The_Bundle : Rule_Bundles;
The_Rule : Natural;
The_Name : Rule_Name;
The_Premiss : Condition_Elements.Ids (1 .. The_Query_Count);
end record;
Null_Rule : constant Rule := (The_Query_Count => 0,
The_Bundle => Rule_Bundles'First,
The_Rule => 0,
The_Name => Null_Rule_Name,
The_Premiss => (others => 1));
subtype Rule_Index is Rule_Id range 1 .. Rule_Id (Max_Rules);
type Rules is array (Rule_Index) of Rule;
The_Rules : Rules := (others => Null_Rule);
The_Last_Rule : Rule_Id := No_Rule;
The_Last_Fired_Rule : Rule_Id := No_Rule;
-------------------------------------------------------------------------
package Rule_Instance is
type Object (Size : Premiss_Size := 0) is
record
The_Rule : Rule_Id;
The_Facts : Fact.Collection (1 .. Size);
end record;
Null_Object : constant Object :=
(Size => 0, The_Rule => No_Rule, The_Facts => Fact.Empty_Collection);
function "<" (Left, Right : Object) return Boolean;
procedure Put (The_Instance : Object; Where : Output_Stream.Object);
end Rule_Instance;
package body Rule_Instance is separate;
package Conflict_Set is new Generic_Conflict_Set
(Instance => Rule_Instance.Object,
"<" => Rule_Instance."<",
Put => Rule_Instance.Put);
-------------------------------------------------------------------------
function Count return Natural is
begin
return The_Last_Rule;
end Count;
function Valid_Id (R : Rule_Id) return Boolean is
begin
return R > 0 and then R <= Max_Rules;
end Valid_Id;
function Get (R : Rule_Id) return Rule_Bundles is
begin
if Valid_Id (R) then
return The_Rules (R).The_Bundle;
else
raise Illegal_Rule_Id;
end if;
end Get;
function Get (R : Rule_Id) return Rule is
begin
if Valid_Id (R) then
return The_Rules (R);
else
raise Illegal_Rule_Id;
end if;
end Get;
function Firable_On_Facts return Fact.Collection is
use Fact;
begin
The_Last_Fired_Rule := No_Rule;
for I in The_Rules'First .. The_Last_Rule loop
declare
Answer : constant Fact.Collection :=
Fact.Retrieve (Filter => Condition_Elements.Get
(The_Rules (I).The_Premiss));
begin
if Answer /= Empty_Collection then
The_Last_Fired_Rule := I;
return Answer;
end if;
end;
end loop;
return Empty_Collection;
end Firable_On_Facts;
function Firable_On_Rule return Rule_Id is
begin
return The_Last_Fired_Rule;
end Firable_On_Rule;
procedure Put (R : Rule_Id; Where : Output_Stream.Object) is
The_Rule : Rule renames The_Rules (R);
The_Premiss : constant Fact.Queries :=
Condition_Elements.Get (The_Rule.The_Premiss);
use Output_Stream;
begin
Put_Line ("Rule'(", Where);
Indent_Right (Where);
Put ("The_Bundle => ", Where);
Put_Line (Rule_Bundles'Image (The_Rule.The_Bundle), Where);
Put ("The_rule => ", Where);
Put_Line (Image (The_Rule.The_Name), Where);
Put ("The_premiss => ", Where);
Fact.Put (The_Premiss, Where);
Indent_Left (Where);
Put_Line (")", Where);
end Put;
package body Generic_Rule_Bundle is separate;
end Generic_Rule_Base;
nblk1=a
nid=6
hdr6=c
[0x00] rec0=1f rec1=00 rec2=01 rec3=008
[0x01] rec0=19 rec1=00 rec2=07 rec3=04c
[0x02] rec0=1e rec1=00 rec2=04 rec3=02c
[0x03] rec0=1f rec1=00 rec2=09 rec3=024
[0x04] rec0=20 rec1=00 rec2=02 rec3=000
[0x05] rec0=02 rec1=00 rec2=05 rec3=000
[0x06] rec0=16 rec1=00 rec2=05 rec3=000
[0x07] rec0=09 rec1=00 rec2=06 rec3=000
[0x08] rec0=20 rec1=00 rec2=09 rec3=000
[0x09] rec0=41 rec1=07 rec2=b6 rec3=430
tail 0x21723f01683e5762b7c5e 0x42a00088462063c03
Free Block Chain:
0x6: 0000 00 08 03 fc 80 2c 20 20 20 20 20 20 20 57 68 65 ┆ , Whe┆
0x8: 0000 00 03 00 64 80 38 20 20 20 20 20 20 20 20 20 20 ┆ d 8 ┆
0x3: 0000 00 0a 03 fc 80 06 63 74 69 6f 6e 3b 06 00 20 20 ┆ ction; ┆
0xa: 0000 00 00 03 fc 80 06 63 74 69 6f 6e 3b 06 00 20 20 ┆ ction; ┆