DataMuseum.dk

top - download

    Length: 5000 (0x1388)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦e24fb53b7⟧ 
            └─⟦this⟧ 

TextFile

separate (Generic_Fact_Base)
package body Working_Memory is

    type Class_Objects is array (Class_Names) of Class.Object;
    The_Classes : Class_Objects := (others => Class.Null_Class);

    procedure Make_Empty is
    begin
        for C in Class_Names loop  
            if C /= Null_Class_Name then
                Class.Make_Empty (The_Classes (C));
            end if;
        end loop;
    end Make_Empty;

    function Get (Using : Class_Names) return Class.Object is
    begin
        return The_Classes (Using);
    end Get;






    function Retrieve (Filter : Query.Objects) return Class.User_Objects is
        Result : Class.User_Objects (Filter'Range);


        function Twins_Exist
                    (Start_Index : Positive; The_Fact : Class.User_Object)
                    return Boolean is
            use Class;
        begin
            for I in (Start_Index) .. Result'Last loop
                if Result (I) = The_Fact then
                    return True;
                end if;
            end loop;
            return False;
        end Twins_Exist;


        function Recursive_Search (Index : Positive) return Boolean is
            The_Class_Name    : Class_Names;
            The_Class         : Class.Object;
            The_Matching_Fact : Class.User_Object;
        begin
            if Index > Filter'Last then
                return True;
            else

                case Filter (Index).Kind is
                    when Query.Find =>
                        The_Class_Name := Filter (Index).Class;
                        The_Class      := The_Classes (The_Class_Name);
                        for Id in 1 .. Class.Last_Instance (The_Class) loop
                            if Class.Match (The_Instance     => Id,
                                            Against_Patterns =>
                                               Filter (Index).Value,
                                            Using_Class      => The_Class) then
                                if Recursive_Search (Index + 1) then
                                    The_Matching_Fact :=
                                       Class.As_User_Object (Id, The_Class);
                                    if not Twins_Exist (Index + 1,
                                                        The_Matching_Fact) then
                                        Result (Index) := The_Matching_Fact;
                                        return True;
                                    end if;
                                end if;
                            end if;
                        end loop;
                    when Query.Check_No =>  
                        The_Class_Name := Filter (Index).Class;
                        The_Class      := The_Classes (The_Class_Name);
                        for Id in 1 .. Class.Last_Instance (The_Class) loop
                            if Class.Match (The_Instance     => Id,
                                            Against_Patterns =>
                                               Filter (Index).Value,
                                            Using_Class      => The_Class) then
                                return False;
                            end if;
                        end loop;
                        if Recursive_Search (Index + 1) then
                            Result (Index) := Class.Null_User_Object;
                            return True;
                        end if;
                    when Query.Evaluate =>
                        if Query.Operators.Match
                              (Filter (Index).The_Expression,
                               Filter (Index).The_Predicate) then
                            if Recursive_Search (Index + 1) then
                                Result (Index) := Class.Null_User_Object;
                                return True;
                            end if;
                        end if;
                end case;
                return False;
            end if;
        end Recursive_Search;
    begin
        if Filter'Length /= 0 and then Recursive_Search (Filter'First) then
            return Result;
        else
            return Class.No_User_Objects;
        end if;
    end Retrieve;



    procedure Generic_Put (Where : Output_Stream.Object) is  
        procedure Class_Put is new Class.Generic_Put (Put);
    begin
        for C in The_Classes'Range loop  
            if C /= Null_Class_Name then
                Class_Put (The_Class => The_Classes (C), Where => Where);
            end if;
        end loop;
    end Generic_Put;

    procedure Default_Put (Where : Output_Stream.Object) is
        procedure Default_Working_Memory_Put is
           new Generic_Put (Class.Default_Put);
    begin
        Default_Working_Memory_Put (Where);
    end Default_Put;

    procedure Register (The_Class : Class.Object) is
    begin
        The_Classes (Class.Class_Name_Of (The_Class)) := The_Class;
    end Register;

end Working_Memory;