⟦677e440cf⟧

TextFile

with Calendar;
with Constant_String;
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 => Max_Condition_Elements,
               Fact_Query             => Fact_Query,
               Null_Fact_Query        => Null_Fact_Query,
               Fact_Queries           => Fact_Queries);

    -------------------------------------------------------------------------

    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.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_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_Inference_Count    : Natural  := 0;
    The_Elapsed_Time       : Duration := 0.0;
    The_Firings_Per_Second : Natural  := 0;

    -------------------------------------------------------------------------

    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 => Empty_Fact_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;

    procedure Null_Action (On : Fact_Collection) is
    begin
        null;
    end Null_Action;

    procedure Infere is  
        Firing                 : Boolean;
        Started_At, Stopped_At : Calendar.Time;
        use Calendar;
    begin
        The_Inference_Count := 0;
        Started_At          := Calendar.Clock;
        loop  
            Firing := False;
            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
                        Do_Action (For_Rule => I, On_Facts => Answer);  
                        Firing              := True;  
                        The_Inference_Count := The_Inference_Count + 1;
                        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;

    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_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;
DataMuseum.dk

Rational R1000/400 Tapes

⟦677e440cf⟧ TextFile

Derivation

TextFile
