DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ E T

⟦9bbc6fcb7⟧ TextFile

    Length: 14912 (0x3a40)
    Types: TextFile
    Names: »ENGINE_ADA«

Derivation

└─⟦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⟧ 

TextFile

with instanceCounter;

separate(expertSystem)

package body engine is

   maxRule   : constant positive := 30;
   maxLRU    : constant positive := 30;

   type sorted_rule is array(1..maxLRU) of natural;
   type lru_resolution is record
      rule_array : sorted_rule := (others => 0);
      count      : natural     := 0;
   end record;

   lru_strategy : lru_resolution;

   CSt       : tuple.object;
   CStsort   : tuple.object;
   CSrule    : natural := 0;
   tc        : tupleCollection.object;
   t         : tuple.object;
   the_tuple : tuple.object;

   localID   : contextID;

   function "<" (left, right : reference) return boolean is
   begin
      return left.date<right.date;
   end "<";

   procedure sortDate is new tuple.sort("<");

   procedure evaluateTupleCollection (rule : positive) is
   begin
      if not ruleManager.isMasked(context_name,rule) then
         case rule is
            when 1  => tc := condition_1;
            when 2  => tc := condition_2;
            when 3  => tc := condition_3;
            when 4  => tc := condition_4;
            when 5  => tc := condition_5;
            when 6  => tc := condition_6;
            when 7  => tc := condition_7;
            when 8  => tc := condition_8;
            when 9  => tc := condition_9;
            when 10 => tc := condition_10;
            when 11 => tc := condition_11;
            when 12 => tc := condition_12;
            when 13 => tc := condition_13;
            when 14 => tc := condition_14;
            when 15 => tc := condition_15;
            when 16 => tc := condition_16;
            when 17 => tc := condition_17;
            when 18 => tc := condition_18;
            when 19 => tc := condition_19;
            when 20 => tc := condition_20;
            when 21 => tc := condition_21;
            when 22 => tc := condition_22;
            when 23 => tc := condition_23;
            when 24 => tc := condition_24;
            when 25 => tc := condition_25;
            when 26 => tc := condition_26;
            when 27 => tc := condition_27;
            when 28 => tc := condition_28;
            when 29 => tc := condition_29;
            when 30 => tc := condition_30;
            when others => null;
         end case;
      else
         declare
            tc1 : tupleCollection.object;
         begin
            tc := tc1;
         end;
      end if;

	 if debugger.isDebugged(debugger.conditionEvalued) then
         case rule is
            when 1  => debugger.sendConditionEvalued(name_1,1,tupleCollection.isNotNull(tc),tc);
            when 2  => debugger.sendConditionEvalued(name_2,2,tupleCollection.isNotNull(tc),tc);
            when 3  => debugger.sendConditionEvalued(name_3,3,tupleCollection.isNotNull(tc),tc);
            when 4  => debugger.sendConditionEvalued(name_4,4,tupleCollection.isNotNull(tc),tc);
            when 5  => debugger.sendConditionEvalued(name_5,5,tupleCollection.isNotNull(tc),tc);
            when 6  => debugger.sendConditionEvalued(name_6,6,tupleCollection.isNotNull(tc),tc);
            when 7  => debugger.sendConditionEvalued(name_7,7,tupleCollection.isNotNull(tc),tc);
            when 8  => debugger.sendConditionEvalued(name_8,8,tupleCollection.isNotNull(tc),tc);
            when 9  => debugger.sendConditionEvalued(name_9,9,tupleCollection.isNotNull(tc),tc);
            when 10 => debugger.sendConditionEvalued(name_10,10,tupleCollection.isNotNull(tc),tc);
            when 11 => debugger.sendConditionEvalued(name_11,11,tupleCollection.isNotNull(tc),tc);
            when 12 => debugger.sendConditionEvalued(name_12,12,tupleCollection.isNotNull(tc),tc);
            when 13 => debugger.sendConditionEvalued(name_13,13,tupleCollection.isNotNull(tc),tc);
            when 14 => debugger.sendConditionEvalued(name_14,14,tupleCollection.isNotNull(tc),tc);
            when 15 => debugger.sendConditionEvalued(name_15,15,tupleCollection.isNotNull(tc),tc);
            when 16 => debugger.sendConditionEvalued(name_16,16,tupleCollection.isNotNull(tc),tc);
            when 17 => debugger.sendConditionEvalued(name_17,17,tupleCollection.isNotNull(tc),tc);
            when 18 => debugger.sendConditionEvalued(name_18,18,tupleCollection.isNotNull(tc),tc);
            when 19 => debugger.sendConditionEvalued(name_19,19,tupleCollection.isNotNull(tc),tc);
            when 20 => debugger.sendConditionEvalued(name_20,20,tupleCollection.isNotNull(tc),tc);
            when 21 => debugger.sendConditionEvalued(name_21,21,tupleCollection.isNotNull(tc),tc);
            when 22 => debugger.sendConditionEvalued(name_22,22,tupleCollection.isNotNull(tc),tc);
            when 23 => debugger.sendConditionEvalued(name_23,23,tupleCollection.isNotNull(tc),tc);
            when 24 => debugger.sendConditionEvalued(name_24,24,tupleCollection.isNotNull(tc),tc);
            when 25 => debugger.sendConditionEvalued(name_25,25,tupleCollection.isNotNull(tc),tc);
            when 26 => debugger.sendConditionEvalued(name_26,26,tupleCollection.isNotNull(tc),tc);
            when 27 => debugger.sendConditionEvalued(name_27,27,tupleCollection.isNotNull(tc),tc);
            when 28 => debugger.sendConditionEvalued(name_28,28,tupleCollection.isNotNull(tc),tc);
            when 29 => debugger.sendConditionEvalued(name_29,29,tupleCollection.isNotNull(tc),tc);
            when 30 => debugger.sendConditionEvalued(name_30,30,tupleCollection.isNotNull(tc),tc);
            when others => null;
         end case;
      end if;

   end evaluateTupleCollection;

   procedure executeTuple (rule : natural) is
   begin
      case rule is
         when 1  => action_1(CSt);
         when 2  => action_2(CSt);
         when 3  => action_3(CSt);
         when 4  => action_4(CSt);
         when 5  => action_5(CSt);
         when 6  => action_6(CSt);
         when 7  => action_7(CSt);
         when 8  => action_8(CSt);
         when 9  => action_9(CSt);
         when 10 => action_10(CSt);
         when 11 => action_11(CSt);
         when 12 => action_12(CSt);
         when 13 => action_13(CSt);
         when 14 => action_14(CSt);
         when 15 => action_15(CSt);
         when 16 => action_16(CSt);
         when 17 => action_17(CSt);
         when 18 => action_18(CSt);
         when 19 => action_19(CSt);
         when 20 => action_20(CSt);
         when 21 => action_21(CSt);
         when 22 => action_22(CSt);
         when 23 => action_23(CSt);
         when 24 => action_24(CSt);
         when 25 => action_25(CSt);
         when 26 => action_26(CSt);
         when 27 => action_27(CSt);
         when 28 => action_28(CSt);
         when 29 => action_29(CSt);
         when 30 => action_30(CSt);
         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 executeTuple;

   procedure LRUreset is
   begin
      for i in 1..maxLRU loop
         lru_strategy.rule_array(i) := 0;
      end loop;
      lru_strategy.count := 0;
   end LRUreset;

   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
         evaluateTupleCollection(i);
         if tupleCollection.isNotNull(tc) then
            pos := 0;
            for j in 1..lru_strategy.count loop
               if lru_strategy.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 := lru_strategy.rule_array(last_pos);
            end if;
         end if;
      end loop;

      debugger.sendConflictSetFinished;

      if the_rule = 0 then
         LRUreset;

         debugger.sendNewStep;
         debugger.sendFailed;
     
         return FALSE;
      end if;

      lru_strategy.count := lru_strategy.count + 1;
      if lru_strategy.count > maxLRU then
         lru_strategy.count := maxLRU;
         for i in 1..maxLRU-1 loop
            lru_strategy.rule_array(i) := lru_strategy.rule_array(i+1);
         end loop;
      end if;
      lru_strategy.rule_array(lru_strategy.count) := the_rule;

      evaluateTupleCollection(the_rule);
      CSt := tupleCollection.first(tc);
      if  debugger.isDebugged(debugger.choosedRule)	or
	  debugger.isDebugged(debugger.RuleFacts)	then
          debugger.sendChoosedRule(the_rule,CSt);
      end if;

      executeTuple(the_rule);
      return TRUE;
   end LRUinfer;

   function LEXorMEAinfer return boolean is 
      first_tuple : boolean := TRUE;
   begin
      CSrule := 0;
      debugger.sendConflictSetStarted;
      for i in 1..used_rules loop
	 evaluateTupleCollection(i);
         for j in 1..tupleCollection.cardinality(tc) loop
            t := tupleCollection.get(tc,j);
            if first_tuple then
               CSt := t;
               sortDate(t);
               CStsort := t;
               CSrule := i;
               first_tuple := FALSE;
            else
	       if resolution = MEA and
                  tuple.first(t).date>tuple.first(CSt).date then
		  CSrule := i;
                  CSt := t;
	       else
                  the_tuple := t;
                  sortDate(t);

                  for k in 1..tuple.cardinality(t) loop
                     if tuple.get(t,k).date > tuple.get(CStsort,k).date then 
                        CSrule := i;
                        CSt := the_tuple;
                        CStsort := t;
                        exit;
                     elsif tuple.get(t,k).date < tuple.get(CStsort,k).date then 
                        exit;
                     end if;
                     if k = tuple.cardinality(CSt) then
                        exit;
                     end if;
                  end loop;
               end if;
            end if;
         end loop;
      end loop;         

      debugger.sendConflictSetFinished;


      if  CSrule/=0					and then
        ( debugger.isDebugged(debugger.choosedRule)	or
	  debugger.isDebugged(debugger.RuleFacts) )	then
          debugger.sendChoosedRule(CSrule,CSt);
      end if;



      executeTuple(CSrule);

      return CSrule /= 0;
   end LEXorMEAinfer;

   function FIRSTinfer return boolean is
   begin
      debugger.sendConflictSetStarted;
      for i in 1..used_rules loop
         evaluateTupleCollection(i);
         if tupleCollection.isNotNull(tc) then

	    debugger.sendConflictSetFinished;

            CSt := tupleCollection.first(tc);

	    if debugger.isDebugged(debugger.choosedRule) or
               debugger.isDebugged(debugger.RuleFacts)   then
               debugger.sendChoosedRule(i,CSt);
            end if;

            executeTuple(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
      if resolution=LEX then
         debugger.sendStrategyUsed(" LEX ");
      elsif resolution=MEA then
         debugger.sendStrategyUsed(" MEA ");
      else
         debugger.sendStrategyUsed(strategyNam);
      end if;

      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 LEXorMEAstrategy is new stepNumber(LEXorMEAinfer," /// ");
   
   function LRUstrategy      is new stepNumber(LRUinfer," LRU ");

   function FIRSTstrategy    is new stepNumber(FIRSTinfer,"FIRST");

   function inference(step : natural := 1) return boolean is
   begin 

      debugger.sendContextEntered(context_name,localId);

      if resolution = LEX or resolution = MEA then
         return LEXorMEAstrategy(step);
      elsif 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 engine;