DataMuseum.dk

top - download

    Length: 4809 (0x12c9)
    Types: TextFile
    Names: »B«

└─⟦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 Constant_String;
with Fact;
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);

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

    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.Make;

    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_Last_Fired_Rule : Rule_Id := No_Rule;

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

    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 => Fact.Empty_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;

    function Firable_On_Facts return Fact.Collection is
        use Fact;
    begin
        The_Last_Fired_Rule := No_Rule;
        for I in The_Rules'First .. The_Last_Rule loop
            declare
                Answer : constant Fact.Collection :=
                   Fact.Retrieve (Filter => Condition_Elements.Get
                                               (The_Rules (I).The_Premiss));
            begin
                if Answer /= Empty_Collection then
                    The_Last_Fired_Rule := I;
                    return Answer;
                end if;
            end;
        end loop;
        return Empty_Collection;
    end Firable_On_Facts;

    function Firable_On_Rule return Rule_Id is
    begin
        return The_Last_Fired_Rule;
    end Firable_On_Rule;

    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);
        Fact.Put (The_Premiss, Where);
        Indent_Left (Where);
        Put_Line (")", Where);
    end Put;


    package body Generic_Rule_Bundle is separate;


end Generic_Rule_Base;