DataMuseum.dk

top - download

    Length: 4734 (0x127e)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 

TextFile

separate (Generic_Fact_Base)
package body Working_Memory is

    Last_Frame : Object := 0;

    type Frames is array (Object range <>) of Frame;

    Content : Frames (1 .. Object (Max_Frame_Count)) := (others => Null_Frame);

    function Image (Of_Class : Class_Name) return String
        renames Constant_String.Image;


    function "=" (Left, Right : Class_Name) return Boolean
        renames Constant_String."=";

    function Make (The_Class : Class_Name; The_Slots : Slots) return Frame is
    begin
        return Frame'(Size  => The_Slots'Length,
                      Class => The_Class,
                      Value => The_Slots);
    end Make;

    function Last return Object is
    begin
        return Last_Frame;
    end Last;

    procedure Make_Empty is
    begin
        Content := (others => Null_Frame);
    end Make_Empty;

    function Get (The_Fact : Object) return Frame is
    begin
        return Content (The_Fact);
    end Get;

    function Get (The_Fact : Object; Slot : Slot_Names) return Integer is
    begin  
        return Content (The_Fact).Value (Slot);
    end Get;


    procedure Add (The_Fact : Frame) is
    begin
        for I in Content'Range loop
            if Content (I) = Null_Frame then
                Content (I) := The_Fact;
                if I > Last_Frame then
                    Last_Frame := I;
                end if;
                return;
            end if;
        end loop;
        raise Overflow;
    end Add;


    procedure Delete (The_Fact : Object) is
    begin
        Content (The_Fact) := Null_Frame;
        if Last_Frame = The_Fact then  
            Last_Frame := Last_Frame - 1;
            for I in reverse 1 .. Last_Frame loop
                exit when Content (I) /= Null_Frame;
                Last_Frame := I;
            end loop;
        end if;
    end Delete;


    procedure Change (The_Fact : Object; Value : Frame) is
    begin
        Content (The_Fact) := Value;
    end Change;


    procedure Change (The_Fact : Object;
                      The_Slot : Slot_Names;
                      To_Value : Integer) is  
    begin
        Content (The_Fact).Value (The_Slot) := To_Value;
    end Change;

    function Match (The_Fact_Class, The_Filter_Class : Class_Name)
                   return Boolean is  
        Result : Boolean;
    begin
        Result := The_Fact_Class /= Null_Class_Name and then
                     The_Fact_Class = The_Filter_Class;
        return Result;
    end Match;

    function Match (The_Slots : Slots; Against : Patterns) return Boolean is
    begin
        for I in The_Slots'Range loop  
            if not Expression_Match (The_Slots (I), Against (I)) then  
                return False;
            end if;
        end loop;
        return True;
    end Match;


    function Match (The_Element : Object; Against : Query) return Boolean is
    begin
        return Match (Content (The_Element).Class, Against.Class) and then
                  Match (Content (The_Element).Value, Against.Value);
    end Match;



    procedure Put (The_Slots : Slots;
                   Where     : Output_Stream.Object :=
                      Output_Stream.Standard_Output) is
        First : Boolean := True;
        use Output_Stream;
    begin
        for I in The_Slots'Range loop
            if not First then
                Put (", ", Where);
                if I mod 2 /= 0 then
                    New_Line (Where);
                end if;
            else
                First := False;
            end if;
            Put ("Slot" & Slot_Names'Image (I) & " =>", Where);
            Put (Integer'Image (The_Slots (I)), Where);
        end loop;
    end Put;


    procedure Put (The_Frame : Frame; Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        if The_Frame /= Null_Frame then
            Put_Line (Image (The_Frame.Class) & "'(", Where);
            Indent_Right (Where);
            Put (The_Slots => The_Frame.Value, Where => Where);
            Indent_Left (Where);
            Put_Line (")", Where);
        end if;
    end Put;


    procedure Put (The_Fact : Object; Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        if The_Fact /= Null_Object then  
            Put (Content (The_Fact), Where);
        else
            Put ("No name", Where);
        end if;
    end Put;


    procedure Put (Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        Put_Line ("Working_Memory'(", Where);
        Indent_Right (Where);
        for Object in Content'Range loop  
            Put (Content (Object), Where);
        end loop;
        Indent_Left (Where);
        Put_Line (")", Where);
    end Put;


end Working_Memory;