DataMuseum.dk

top - download

    Length: 5163 (0x142b)
    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 Condition;
with Fact;
with Text_Io;
use Condition;
use Fact;
procedure Test is

    generic
        Name    : String := "no name";
        Premiss : Join_Descriptor;
        with procedure Action (On : Fact.Collection);
    function Rule return Boolean;

    function Rule return Boolean is
        Answer : constant Fact.Collection := Fact.Retrieve (Filter => Premiss);
    begin
        if Answer /= Empty_Collection then
            Action (On => Answer);
            return True;
        else
            -- Text_Io.Put_Line (Name & " not_fired");
            return False;
        end if;
    end Rule;

    generic
        with function Rule_1 return Boolean is False;
        with function Rule_2 return Boolean is False;
        with function Rule_3 return Boolean is False;
        with function Rule_4 return Boolean is False;
        with function Rule_5 return Boolean is False;
    procedure Infere;

    procedure Infere is
    begin
        loop
            exit when not (Rule_1 or else Rule_2 or else
                           Rule_3 or else Rule_4 or else Rule_5);
        end loop;
    end Infere;




    ----- <<  rule Print_The_Biggest_Red_Ball >> -----

    procedure Print_The_Biggest_Ball_Action (Objects : Fact.Collection) is
        The_Ball : Fact.Name renames Objects (1);
    begin
        Text_Io.Put_Line ("The biggest ball is : ");
        Put (The_Ball);
    end Print_The_Biggest_Ball_Action;

    function Print_The_Biggest_Ball_Rule is
       new Rule (Name    => "Print_The_Biggest_Ball",
                 Premiss => ((Find, (Class  => Is_Equal (Ball),
                                     Size   => Say_It_Is (S),
                                     Colour => Is_Equal (Red),
                                     State  => Is_Any)),

                             (Check_No, (Class          => Is_Equal (Ball),
                                         Size           => Is_Greater (S),
                                         State | Colour => Is_Any))),

                 Action  => Print_The_Biggest_Ball_Action);


    ----- <<  rule dump_the_working_memory >> -----

    procedure Dump_The_Working_Memory_Action (Objects : Fact.Collection) is
        The_Fact : Fact.Name renames Objects (1);
    begin
        Put (The_Fact);
        Delete (The_Fact);
    end Dump_The_Working_Memory_Action;

    function Dump_The_Working_Memory_Rule is

       new Rule (Name    => "Dump_The_Working_Memory",
                 Premiss => (1 => (Find,
                                   Pattern'(Class                 => Is_Any,
                                            State | Colour | Size => Is_Any))),
                 Action  => Dump_The_Working_Memory_Action);



    ----- <<  rule remove_the_robots >> -----

    procedure Remove_The_Robots_Action (Objects : Fact.Collection) is
        The_Fact : Fact.Name renames Objects (1);
    begin
        Put (The_Fact);
        Text_Io.Put_Line (" --> has been removed");
        Delete (The_Fact);
    end Remove_The_Robots_Action;

    function Remove_The_Robots_Rule is

       new Rule (Name    => "Remove_The_Robots",
                 Premiss => (1 => (Find, (Class => Is_Equal (Robot),
                                          State | Size | Colour => Is_Any))),
                 Action  => Remove_The_Robots_Action);




    ----- <<  rule Pair_Ball_And_Boxes_Rule  >> -----


    procedure Pair_Ball_And_Boxes_Action (The_Pair : Fact.Collection) is
        The_Ball : Fact.Name renames The_Pair (1);
        The_Box  : Fact.Name renames The_Pair (2);
    begin
        Text_Io.Put_Line ("Ball : ");
        Put (The_Ball);
        Text_Io.Put_Line ("Paired with box :");
        Put (The_Box);
        Change (The_Ball, State, To_Value => In_Box);
        Change (The_Box, State, To_Value => Busy);
    end Pair_Ball_And_Boxes_Action;

    function Pair_Ball_And_Boxes_Rule is
       new Rule (Name    => "Pair_Ball_And_Boxes",
                 Premiss => ((Find, (Class  => Is_Equal (Ball),
                                     Size   => Say_It_Is (S),
                                     Colour => Say_It_Is (C),
                                     State  => Is_Equal (On_Heap))),

                             (Find, (Class  => Is_Equal (Box),
                                     Colour => Is_Equal (C),
                                     Size   => Say_It_Is (T) and Is_Greater (S),
                                     State  => Is_Equal (Free))),

                             (Check_No, (Class => Is_Equal (Box),
                                         Colour => Is_Equal (C),
                                         Size => Is_Less (T) and Is_Greater (S),
                                         State => Is_Equal (Free)))),
                 Action  => Pair_Ball_And_Boxes_Action);


    ------------------------------------------------
    procedure Play_With_Ball_And_Boxes is
       new Infere (Rule_1 => Remove_The_Robots_Rule,
                   Rule_2 => Pair_Ball_And_Boxes_Rule,
                   Rule_3 => Print_The_Biggest_Ball_Rule,
                   Rule_4 => Dump_The_Working_Memory_Rule);
begin
    Play_With_Ball_And_Boxes;
end Test;