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: ┃ B T ┃

⟦3f44fc66c⟧ TextFile

    Length: 19745 (0x4d21)
    Types: TextFile
    Names: »B«

Derivation

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

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;