DataMuseum.dk

top - download

    Length: 5520 (0x1590)
    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 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.Make (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;


    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; Slot : Slot_Names)
                 return Integer is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        return Class.Get (The_Fact, Slot => As_Class_Slot_Name (Slot));
    end Get;


    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,
                                        Slot => As_Class_Slot_Name (Slot));
        end loop;
        return Result;
    end Get;


    procedure Add (The_Fact : Slots) is
    begin
        Class.Add (To_Class     => The_Class_Object,
                   The_Instance => As_Anonymous (The_Fact));
    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 : Integer) is
    begin
        Check_Class_Membership (For_Object => The_Fact);
        Class.Change (The_Object => The_Fact,
                      Slot       => As_Class_Slot_Name (The_Slot),
                      To_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, 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;