⟦eb95d4610⟧

TextFile

separate (Generic_Fact_Base)
package body Generic_Class is

    The_Class_Object : Class.Object;

    function Slot_Count return Natural is
        First : Natural := Slot_Names'Pos (Slot_Names'First);
        Last  : Natural := Slot_Names'Pos (Slot_Names'Last);
    begin
        return Last - First + 1;
    end Slot_Count;

    function As_Query_Slot_Name
                (Slot_Name : Slot_Names) return Query.Slot_Names is
    begin
        return Slot_Names'Pos (Slot_Name) -
                  Slot_Names'Pos (Slot_Names'First) + 1;
    end As_Query_Slot_Name;


    function As_Class_Slot_Name
                (Slot_Name : Slot_Names) return Class.Slot_Names is
    begin
        return Slot_Names'Pos (Slot_Name) -
                  Slot_Names'Pos (Slot_Names'First) + 1;
    end As_Class_Slot_Name;


    function As_Anonymous (What : Patterns) return Query.Patterns is
        Result : Query.Patterns (1 .. Slot_Count);
    begin  
        for Slot_Name in What'Range loop
            Result (As_Query_Slot_Name (Slot_Name)) := What (Slot_Name);
        end loop;
        return Result;
    end As_Anonymous;


    function As_Anonymous (What : Slots) return Class.Slots is
        Result : Class.Slots (1 .. Slot_Count);
    begin
        for Slot_Name in What'Range loop
            Result (As_Class_Slot_Name (Slot_Name)) := What (Slot_Name);
        end loop;
        return Result;
    end As_Anonymous;

    function Get_Slot_Names_Images return Class.Slot_Names_Images is
        Result : Class.Slot_Names_Images (1 .. Slot_Count);
    begin  
        for I in Slot_Names loop
            Result (As_Class_Slot_Name (I)) :=
               Constant_String.Value (Slot_Names'Image (I));
        end loop;
        return Result;
    end Get_Slot_Names_Images;

    function Class_Object return Class.Object is
    begin
        return The_Class_Object;
    end Class_Object;

    function Exist (What : Patterns) return Query.Object is
    begin
        return Query.Object'(Kind  => Query.Find,
                             Class => Class.Class_Name_Of (The_Class_Object),
                             Size  => Slot_Count,
                             Value => As_Anonymous (What));
    end Exist;


    function Not_Any (What : Patterns) return Query.Object is
    begin
        return Query.Object'(Kind  => Query.Check_No,
                             Class => Class.Class_Name_Of (The_Class_Object),
                             Size  => Slot_Count,
                             Value => As_Anonymous (What));
    end Not_Any;


    function Such_As (What : Patterns) return Predicate_Object is
    begin
        return Predicate_Collection (As_Anonymous (What));
    end Such_As;


    procedure Check_Class_Membership (For_Object : Class.User_Object) is
    begin
        if Class."/=" (Class.Class_Of (For_Object), The_Class_Object) then
            raise Illegal_Access;
        end if;
    end Check_Class_Membership;


    function Get (The_Fact : Class.User_Object) return Slots is
        Result : Slots;
    begin
        Check_Class_Membership (For_Object => The_Fact);
        for Slot in Slot_Names loop
            Result (Slot) := Class.Get (The_Object => The_Fact,
                                        The_Slot => As_Class_Slot_Name (Slot));
        end loop;
        return Result;
    end Get;


    function Get (The_Fact : Class.User_Object; The_Slot : Slot_Names)
                 return Slot.Object is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        return Class.Get (The_Fact, The_Slot => As_Class_Slot_Name (The_Slot));
    end Get;


    function Get (The_Fact : Class.User_Object; The_Slot : Slot_Names)
                 return Class.User_Object is
    begin
        return Class.As_User_Object (Get (The_Fact, The_Slot));
    end Get;


    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Integer is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Boolean is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Float is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Character is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return Duration is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;

    function Get (The_Object : Class.User_Object; The_Slot : Slot_Names)
                 return String is
    begin
        return Slot.Get (Generic_Class.Get (The_Object, The_Slot));
    end Get;


    procedure Add (The_Fact : Slots; Its_Reference : out Slot.Object) is
    begin
        Class.Add (To_Class      => The_Class_Object,
                   The_Instance  => As_Anonymous (The_Fact),
                   Its_Reference => Its_Reference);
    end Add;


    procedure Add (The_Fact : Slots) is  
        Unused_Slot : Slot.Object;
    begin
        Class.Add (To_Class      => The_Class_Object,
                   The_Instance  => As_Anonymous (The_Fact),
                   Its_Reference => Unused_Slot);
    end Add;


    procedure Delete (The_Fact : Class.User_Object) is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        Class.Delete (The_Fact);
    end Delete;


    procedure Change (The_Fact : Class.User_Object; Value : Slots) is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        Class.Change (The_Fact, To_Value => As_Anonymous (Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Slot.Object) is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        Class.Change (The_Object => The_Fact,
                      The_Slot   => As_Class_Slot_Name (The_Slot),
                      To_Value   => To_Value);
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Integer) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Boolean) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Float) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Character) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : Duration) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;

    procedure Change (The_Fact : Class.User_Object;
                      The_Slot : Slot_Names;
                      To_Value : String) is
    begin
        Change (The_Fact, The_Slot, To_Value => Slot.Value (To_Value));
    end Change;


    procedure Generic_Put (The_Fact : Class.User_Object;
                           Where    : Output_Stream.Object) is
        First      : Boolean         := True;
        Class_Name : constant String :=
           Class_Names'Image (Class.Class_Name_Of (The_Class_Object));
        use Output_Stream;
    begin
        Check_Class_Membership (For_Object => The_Fact);
        Put (Class_Name & "'(", Where);
        Indent_Right (Where);
        New_Line (Where);
        for I in Slot_Names loop
            if not First then
                Put_Line (", ", Where);
            else
                First := False;
            end if;
            Put (Slot_Names'Image (I) & " =>", Where);
            Put (Image (I, Get (The_Fact, The_Slot => I)), Where);
        end loop;
        Indent_Left (Where);
        Put_Line (")", Where);
    end Generic_Put;


begin
    The_Class_Object := Class.Make (Name       => Class_Name,  
                                    Class_Size => Class_Size,
                                    Names      => Get_Slot_Names_Images);
    Working_Memory.Register (The_Class_Object);
end Generic_Class;
DataMuseum.dk

Rational R1000/400 Tapes

⟦eb95d4610⟧ TextFile

Derivation

TextFile
