|
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: 17408 (0x4400)
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_04b45b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Calendar;
with Constant_String;
with Generic_Condition_Element;
with Output_Stream;
package body Generic_Rule_Base is
package Condition_Elements is
new Generic_Condition_Element
(Max_Condition_Elements => Max_Condition_Elements,
Fact_Query => Fact_Query,
Null_Fact_Query => Null_Fact_Query,
Fact_Queries => Fact_Queries);
-------------------------------------------------------------------------
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.Value;
function Image (Of_Rule_Name : Rule_Name) return String
renames Constant_String.Image;
-------------------------------------------------------------------------
type Rule (The_Query_Count : Premiss_Size := 0) is
record
The_Date : Recency.Object;
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_Date => Recency.Null_Object,
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_Inference_Count : Natural := 0;
The_Elapsed_Time : Duration := 0.0;
The_Firings_Per_Second : Natural := 0;
-------------------------------------------------------------------------
Stop_Infere : Boolean := False;
-------------------------------------------------------------------------
package body Rule_Instance is separate;
-------------------------------------------------------------------------
procedure Halt is
begin
Stop_Infere := True;
end Halt;
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;
procedure Null_Action (On : Fact_Collection) is
begin
null;
end Null_Action;
procedure Infere is
Firing : Boolean;
Started_At, Stopped_At : Calendar.Time;
Date : Recency.Object;
use Calendar;
begin
Stop_Infere := False;
The_Inference_Count := 0;
Started_At := Calendar.Clock;
loop
Firing := False;
exit when Stop_Infere;
for I in The_Rules'First .. The_Last_Rule loop
declare
Answer : constant Fact_Collection :=
Retrieve (Filter => Condition_Elements.Get
(The_Rules (I).The_Premiss));
begin
if Answer /= Empty_Fact_Collection then
Recency.Get (Date);
The_Rules (I).The_Date := Date;
Do_Action (For_Rule => I, On_Facts => Answer);
Firing := True;
The_Inference_Count := The_Inference_Count + 1;
Recency.Increase;
exit;
end if;
end;
end loop;
exit when not Firing;
end loop;
Stopped_At := Calendar.Clock;
The_Elapsed_Time := Stopped_At - Started_At;
The_Firings_Per_Second :=
Natural (Float (Inference_Count) / Float (Elapsed_Time));
end Infere;
procedure Infere_With_Conflict_Set
(Conflict_Set_Size : Integer := Conflict_Set.Unlimited_Size) is
Started_At, Stopped_At : Calendar.Time;
The_Instance : Rule_Instance.Object;
The_Rule_Id : Rule_Id := 0;
The_Rule : Rule := Null_Rule;
Date : Recency.Object;
use Calendar;
use Rule_Instance;
use Output_Stream;
On_Screen : Output_Stream.Object := Standard_Output;
begin
Conflict_Set.Set_Max_Instances (To => Conflict_Set_Size);
Stop_Infere := False;
The_Inference_Count := 0;
Started_At := Calendar.Clock;
loop
exit when Stop_Infere;
Conflict_Set.Clear;
for I in The_Rules'First .. The_Last_Rule loop
begin
Retrieve (The_Rule => I,
Filter => Condition_Elements.Get
(The_Rules (I).The_Premiss));
exit when Conflict_Set.Is_Full;
end;
end loop;
exit when Conflict_Set.Is_Empty;
The_Instance := Conflict_Set.Get;
The_Rule_Id := Rule_Instance.Get_Rule (The_Instance);
Recency.Increase;
Recency.Get (Date);
The_Rules (The_Rule_Id).The_Date := Date;
Do_Action (For_Rule => The_Rule_Id,
On_Facts => Rule_Instance.Get_Facts (The_Instance));
The_Inference_Count := The_Inference_Count + 1;
end loop;
Stopped_At := Calendar.Clock;
The_Elapsed_Time := Stopped_At - Started_At;
The_Firings_Per_Second :=
Natural (Float (Inference_Count) / Float (Elapsed_Time));
end Infere_With_Conflict_Set;
function One_Inference_With_Conflict_Set
(Conflict_Set_Size : Integer := Conflict_Set.Unlimited_Size)
return Boolean is
The_Instance : Rule_Instance.Object;
The_Rule_Id : Rule_Id := 0;
The_Rule : Rule := Null_Rule;
Date : Recency.Object;
begin
Conflict_Set.Clear;
for I in The_Rules'First .. The_Last_Rule loop
begin
Retrieve (The_Rule => I,
Filter => Condition_Elements.Get
(The_Rules (I).The_Premiss));
exit when Conflict_Set.Is_Full;
end;
end loop;
if Conflict_Set.Is_Empty then
return False;
end if;
The_Instance := Conflict_Set.Get;
The_Rule_Id := Rule_Instance.Get_Rule (The_Instance);
Recency.Increase;
Recency.Get (Date);
The_Rules (The_Rule_Id).The_Date := Date;
Do_Action (For_Rule => The_Rule_Id,
On_Facts => Rule_Instance.Get_Facts (The_Instance));
return True;
end One_Inference_With_Conflict_Set;
function Inference_Count return Natural is
begin
return The_Inference_Count;
end Inference_Count;
function Elapsed_Time return Duration is
begin
return The_Elapsed_Time;
end Elapsed_Time;
function Firings_Per_Second return Natural is
begin
return The_Firings_Per_Second;
end Firings_Per_Second;
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_Date => ", Where);
Recency.Put (The_Rule.The_Date, Where);
Put_Line ("", 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);
Queries_Put (The_Premiss, Where);
Indent_Left (Where);
Put_Line (")", Where);
end Put;
package body Generic_Rule_Bundle is separate;
end Generic_Rule_Base;
nblk1=10
nid=e
hdr6=1a
[0x00] rec0=1e rec1=00 rec2=01 rec3=05e
[0x01] rec0=00 rec1=00 rec2=09 rec3=006
[0x02] rec0=17 rec1=00 rec2=02 rec3=052
[0x03] rec0=01 rec1=00 rec2=0d rec3=024
[0x04] rec0=26 rec1=00 rec2=0c rec3=032
[0x05] rec0=1f rec1=00 rec2=03 rec3=04a
[0x06] rec0=18 rec1=00 rec2=04 rec3=068
[0x07] rec0=1b rec1=00 rec2=0a rec3=02e
[0x08] rec0=17 rec1=00 rec2=0b rec3=032
[0x09] rec0=1c rec1=00 rec2=10 rec3=00a
[0x0a] rec0=0a rec1=00 rec2=05 rec3=012
[0x0b] rec0=1c rec1=00 rec2=07 rec3=054
[0x0c] rec0=03 rec1=00 rec2=08 rec3=000
[0x0d] rec0=1c rec1=00 rec2=07 rec3=054
[0x0e] rec0=03 rec1=00 rec2=08 rec3=001
[0x0f] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2174ffa98867d4afcd886 0x42a00088462063c03
Free Block Chain:
0xe: 0000 00 06 00 0c 80 09 20 20 20 20 20 69 66 20 41 09 ┆ if A ┆
0x6: 0000 00 0f 00 0c 80 09 65 6e 64 20 6c 6f 6f 70 3b 09 ┆ end loop; ┆
0xf: 0000 00 00 00 0b 80 08 6c 6c 5f 52 75 6c 65 3b 08 4f ┆ ll_Rule; O┆