|
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: ┃ B T ┃
Length: 15499 (0x3c8b)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Instancecounter;
separate (Expertsystem)
package body Motor is
Maxrule : constant Positive := 30;
Maxstrategy : constant Positive := 30;
type Condition is array (1 .. Maxrule) of Boolean;
type Ordered_Rule is array (1 .. Maxstrategy) of Natural;
type Strategic is
record
Rule_Array : Ordered_Rule := (others => 0);
Count : Natural := 0;
end record;
The_Strategie : Strategic;
Rule_Condition : Condition;
Localid : Contextid;
Cst : Tuple.Object;
Cstc : Tuplecollection.Object;
procedure Reset is
begin
for I in 1 .. Maxstrategy loop
The_Strategie.Rule_Array (I) := 0;
end loop;
The_Strategie.Count := 0;
end Reset;
function Evaluate (Rule : Natural) return Boolean is
Result : Boolean;
begin
if not Rulemanager.Ismasked (Context_Name, Rule) then
case Rule is
when 1 =>
Result := Condition_1;
when 2 =>
Result := Condition_2;
when 3 =>
Result := Condition_3;
when 4 =>
Result := Condition_4;
when 5 =>
Result := Condition_5;
when 6 =>
Result := Condition_6;
when 7 =>
Result := Condition_7;
when 8 =>
Result := Condition_8;
when 9 =>
Result := Condition_9;
when 10 =>
Result := Condition_10;
when 11 =>
Result := Condition_11;
when 12 =>
Result := Condition_12;
when 13 =>
Result := Condition_13;
when 14 =>
Result := Condition_14;
when 15 =>
Result := Condition_15;
when 16 =>
Result := Condition_16;
when 17 =>
Result := Condition_17;
when 18 =>
Result := Condition_18;
when 19 =>
Result := Condition_19;
when 20 =>
Result := Condition_20;
when 21 =>
Result := Condition_21;
when 22 =>
Result := Condition_22;
when 23 =>
Result := Condition_23;
when 24 =>
Result := Condition_24;
when 25 =>
Result := Condition_25;
when 26 =>
Result := Condition_26;
when 27 =>
Result := Condition_27;
when 28 =>
Result := Condition_28;
when 29 =>
Result := Condition_29;
when 30 =>
Result := Condition_30;
when others =>
Result := False;
end case;
else
Result := False;
end if;
if Debugger.Isdebugged (Debugger.Conditionevalued) then
case Rule is
when 1 =>
Debugger.Sendconditionevalued (Name_1, 1, Result, Cstc);
when 2 =>
Debugger.Sendconditionevalued (Name_2, 2, Result, Cstc);
when 3 =>
Debugger.Sendconditionevalued (Name_3, 3, Result, Cstc);
when 4 =>
Debugger.Sendconditionevalued (Name_4, 4, Result, Cstc);
when 5 =>
Debugger.Sendconditionevalued (Name_5, 5, Result, Cstc);
when 6 =>
Debugger.Sendconditionevalued (Name_6, 6, Result, Cstc);
when 7 =>
Debugger.Sendconditionevalued (Name_7, 7, Result, Cstc);
when 8 =>
Debugger.Sendconditionevalued (Name_8, 8, Result, Cstc);
when 9 =>
Debugger.Sendconditionevalued (Name_9, 9, Result, Cstc);
when 10 =>
Debugger.Sendconditionevalued (Name_10, 10, Result, Cstc);
when 11 =>
Debugger.Sendconditionevalued (Name_11, 11, Result, Cstc);
when 12 =>
Debugger.Sendconditionevalued (Name_12, 12, Result, Cstc);
when 13 =>
Debugger.Sendconditionevalued (Name_13, 13, Result, Cstc);
when 14 =>
Debugger.Sendconditionevalued (Name_14, 14, Result, Cstc);
when 15 =>
Debugger.Sendconditionevalued (Name_15, 15, Result, Cstc);
when 16 =>
Debugger.Sendconditionevalued (Name_16, 16, Result, Cstc);
when 17 =>
Debugger.Sendconditionevalued (Name_17, 17, Result, Cstc);
when 18 =>
Debugger.Sendconditionevalued (Name_18, 18, Result, Cstc);
when 19 =>
Debugger.Sendconditionevalued (Name_19, 19, Result, Cstc);
when 20 =>
Debugger.Sendconditionevalued (Name_20, 20, Result, Cstc);
when 21 =>
Debugger.Sendconditionevalued (Name_21, 21, Result, Cstc);
when 22 =>
Debugger.Sendconditionevalued (Name_22, 22, Result, Cstc);
when 23 =>
Debugger.Sendconditionevalued (Name_23, 23, Result, Cstc);
when 24 =>
Debugger.Sendconditionevalued (Name_24, 24, Result, Cstc);
when 25 =>
Debugger.Sendconditionevalued (Name_25, 25, Result, Cstc);
when 26 =>
Debugger.Sendconditionevalued (Name_26, 26, Result, Cstc);
when 27 =>
Debugger.Sendconditionevalued (Name_27, 27, Result, Cstc);
when 28 =>
Debugger.Sendconditionevalued (Name_28, 28, Result, Cstc);
when 29 =>
Debugger.Sendconditionevalued (Name_29, 29, Result, Cstc);
when 30 =>
Debugger.Sendconditionevalued (Name_30, 30, Result, Cstc);
when others =>
null;
end case;
end if;
return Result;
end Evaluate;
procedure Execute (Rule : Natural) is
begin
case Rule is
when 1 =>
Action_1;
when 2 =>
Action_2;
when 3 =>
Action_3;
when 4 =>
Action_4;
when 5 =>
Action_5;
when 6 =>
Action_6;
when 7 =>
Action_7;
when 8 =>
Action_8;
when 9 =>
Action_9;
when 10 =>
Action_10;
when 11 =>
Action_11;
when 12 =>
Action_12;
when 13 =>
Action_13;
when 14 =>
Action_14;
when 15 =>
Action_15;
when 16 =>
Action_16;
when 17 =>
Action_17;
when 18 =>
Action_18;
when 19 =>
Action_19;
when 20 =>
Action_20;
when 21 =>
Action_21;
when 22 =>
Action_22;
when 23 =>
Action_23;
when 24 =>
Action_24;
when 25 =>
Action_25;
when 26 =>
Action_26;
when 27 =>
Action_27;
when 28 =>
Action_28;
when 29 =>
Action_29;
when 30 =>
Action_30;
when others =>
null;
end case;
if Rule /= 0 and then (Debugger.Isdebugged (Debugger.Choosedaction) or
Debugger.Isdebugged (Debugger.Actionfact)) then
case Rule is
when 1 =>
Debugger.Sendchoosedaction (Name_1, 1, Cst);
when 2 =>
Debugger.Sendchoosedaction (Name_2, 2, Cst);
when 3 =>
Debugger.Sendchoosedaction (Name_3, 3, Cst);
when 4 =>
Debugger.Sendchoosedaction (Name_4, 4, Cst);
when 5 =>
Debugger.Sendchoosedaction (Name_5, 5, Cst);
when 6 =>
Debugger.Sendchoosedaction (Name_6, 6, Cst);
when 7 =>
Debugger.Sendchoosedaction (Name_7, 7, Cst);
when 8 =>
Debugger.Sendchoosedaction (Name_8, 8, Cst);
when 9 =>
Debugger.Sendchoosedaction (Name_9, 9, Cst);
when 10 =>
Debugger.Sendchoosedaction (Name_10, 10, Cst);
when 11 =>
Debugger.Sendchoosedaction (Name_11, 11, Cst);
when 12 =>
Debugger.Sendchoosedaction (Name_12, 12, Cst);
when 13 =>
Debugger.Sendchoosedaction (Name_13, 13, Cst);
when 14 =>
Debugger.Sendchoosedaction (Name_14, 14, Cst);
when 15 =>
Debugger.Sendchoosedaction (Name_15, 15, Cst);
when 16 =>
Debugger.Sendchoosedaction (Name_16, 16, Cst);
when 17 =>
Debugger.Sendchoosedaction (Name_17, 17, Cst);
when 18 =>
Debugger.Sendchoosedaction (Name_18, 18, Cst);
when 19 =>
Debugger.Sendchoosedaction (Name_19, 19, Cst);
when 20 =>
Debugger.Sendchoosedaction (Name_20, 20, Cst);
when 21 =>
Debugger.Sendchoosedaction (Name_21, 21, Cst);
when 22 =>
Debugger.Sendchoosedaction (Name_22, 22, Cst);
when 23 =>
Debugger.Sendchoosedaction (Name_23, 23, Cst);
when 24 =>
Debugger.Sendchoosedaction (Name_24, 24, Cst);
when 25 =>
Debugger.Sendchoosedaction (Name_25, 25, Cst);
when 26 =>
Debugger.Sendchoosedaction (Name_26, 26, Cst);
when 27 =>
Debugger.Sendchoosedaction (Name_27, 27, Cst);
when 28 =>
Debugger.Sendchoosedaction (Name_28, 28, Cst);
when 29 =>
Debugger.Sendchoosedaction (Name_29, 29, Cst);
when 30 =>
Debugger.Sendchoosedaction (Name_30, 30, Cst);
when others =>
Debugger.Sendchoosedaction ("NO OPERATION ! ", 0, Cst);
end case;
end if;
Debugger.Sendnewstep;
if Rule = 0 then
Debugger.Sendfailed;
end if;
end Execute;
function Lruinfer return Boolean is
The_Rule : Natural := 0;
Pos : Natural := 0;
Last_Pos : Natural := Integer'Last;
begin
Debugger.Sendconflictsetstarted;
for I in 1 .. Used_Rules loop
Rule_Condition (I) := Evaluate (I);
if Rule_Condition (I) then
Pos := 0;
for J in 1 .. The_Strategie.Count loop
if The_Strategie.Rule_Array (J) = I then
Pos := J;
end if;
end loop;
if Pos = 0 then
The_Rule := I;
exit;
elsif Pos < Last_Pos then
Last_Pos := Pos;
The_Rule := The_Strategie.Rule_Array (Last_Pos);
end if;
end if;
end loop;
Debugger.Sendconflictsetfinished;
if The_Rule = 0 then
Reset;
Debugger.Sendnewstep;
Debugger.Sendfailed;
return False;
end if;
The_Strategie.Count := The_Strategie.Count + 1;
if The_Strategie.Count >= Maxstrategy then
The_Strategie.Count := Maxstrategy;
for I in 1 .. Maxstrategy - 1 loop
The_Strategie.Rule_Array (I) :=
The_Strategie.Rule_Array (I + 1);
end loop;
end if;
The_Strategie.Rule_Array (The_Strategie.Count) := The_Rule;
if Debugger.Isdebugged (Debugger.Choosedrule) or
Debugger.Isdebugged (Debugger.Rulefacts) then
Debugger.Sendchoosedrule (The_Rule, Cst);
end if;
Execute (The_Rule);
return True;
end Lruinfer;
function Firstinfer return Boolean is
begin
Debugger.Sendconflictsetstarted;
for I in 1 .. Used_Rules loop
Rule_Condition (I) := Evaluate (I);
if Rule_Condition (I) then
Debugger.Sendconflictsetfinished;
if Debugger.Isdebugged (Debugger.Choosedrule) or
Debugger.Isdebugged (Debugger.Rulefacts) then
Debugger.Sendchoosedrule (I, Cst);
end if;
Execute (I);
return True;
end if;
end loop;
Debugger.Sendnewstep;
Debugger.Sendfailed;
return False;
end Firstinfer;
generic
with function Inferstrategy return Boolean;
Strategynam : Strategyname := " ??? ";
function Stepnumber (Step : Natural) return Boolean;
function Stepnumber (Step : Natural) return Boolean is
Astep : Boolean;
begin
Debugger.Sendcontextentered (Context_Name, Localid);
Debugger.Sendstrategyused (Strategynam);
if Step = Any then
loop
Astep := Inferstrategy;
exit when not Astep;
end loop;
else
for I in 1 .. Step loop
Astep := Inferstrategy;
exit when not Astep;
end loop;
end if;
return Astep;
end Stepnumber;
function Lrustrategy is new Stepnumber (Lruinfer, " LRU ");
function Firststrategy is new Stepnumber (Firstinfer, "FIRST");
function Inference (Step : Natural := 1) return Boolean is
begin
if Resolution = Lru then
return Lrustrategy (Step);
else
return Firststrategy (Step);
end if;
end Inference;
begin
Localid := Instancecounter.Newcontext (Context_Name);
Debugger.Sendrulesnames (Localid, Context_Name, Name_1, Name_2,
Name_3, Name_4, Name_5, Name_6, Name_7,
Name_8, Name_9, Name_10, Name_11, Name_12,
Name_13, Name_14, Name_15, Name_16, Name_17,
Name_18, Name_19, Name_20, Name_21, Name_22,
Name_23, Name_24, Name_25, Name_26,
Name_27, Name_28, Name_29, Name_30);
end Motor;