DataMuseum.dk

top - download

    Length: 3621 (0xe25)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »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 Recursive_Search (Index : Positive) return Boolean is
            The_Class_Name : Class_Names;
            The_Class      : Class.Object;
        begin
            if Index > Filter'Last then
                return True;
            else
                The_Class_Name := Filter (Index).Class;
                The_Class      := The_Classes (The_Class_Name);
                case Filter (Index).Kind is
                    when Query.Find =>
                        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
                                    Result (Index) :=
                                       Class.As_User_Object (Id, The_Class);
                                    return True;
                                end if;
                            end if;
                        end loop;
                    when Query.Check_No =>
                        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;
                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;