DataMuseum.dk

top - download

    Length: 3344 (0xd10)
    Types: TextFile
    Names: »V«

└─⟦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

with Constant_String;
with Output_Stream;
generic

    Max_Frame_Count : Natural := 200;
    Max_Slots       : Natural := 20;

    type Predicate_Object is private;
    Null_Predicate : Predicate_Object;

    with function Predicate_Match (Value : Integer; Against : Predicate_Object)
                                  return Boolean is <>;

    with procedure Predicate_Put (The_Expression : Predicate_Object;
                                  Where          : Output_Stream.Object) is <>;

package Generic_Fact_Base is

    type Object is private;
    Null_Object : constant Object;

    type Collection is array (Positive range <>) of Object;

    subtype Value_Size is Natural range 0 .. Max_Slots;

    type Query (Size : Value_Size := 0) is private;
    Null_Query : constant Query;

    type Queries is array (Positive range <>) of Query;

    function Empty_Collection            return Collection;
    function Null_Premiss                return Queries;
    function Retrieve (Filter : Queries) return Collection;

    procedure Make_Empty;

    procedure Put (The_Query : Query; Where : Output_Stream.Object);
    procedure Put (The_Queries : Queries; Where : Output_Stream.Object);
    procedure Put (The_Fact : Object; Where : Output_Stream.Object);
    procedure Put (The_Collection : Collection; Where : Output_Stream.Object);
    procedure Put (Where : Output_Stream.Object);  -- The working memory

    Overflow : exception;

    generic
        Class_Name : String;
        type Slot_Names is (<>);
        with function Attribute_Image (I : Integer) return String is
           Integer'Image;
    package Generic_Fact is

        type Slots    is array (Slot_Names) of Integer;
        type Patterns is array (Slot_Names) of Predicate_Object;

        function Exist   (What : Patterns) return Query;
        function Not_Any (What : Patterns) return Query;
        function Absent  (What : Patterns) return Query renames Not_Any;

        function Get (The_Fact : Object)                    return Slots;
        function Get (The_Fact : Object; Slot : Slot_Names) return Integer;

        procedure Add    (The_Fact : Slots);
        procedure Delete (The_Fact : Object);
        procedure Change (The_Fact : Object; Value : Slots);
        procedure Change (The_Fact : Object;
                          The_Slot : Slot_Names;
                          To_Value : Integer);

        procedure Put (The_Fact : Object; Where : Output_Stream.Object);

    end Generic_Fact;

private
    type Object is new Natural;
    Null_Object : constant Object := 0;

    subtype Slot_Names is Value_Size range 1 .. Max_Slots;

    type Patterns is array (Slot_Names range <>) of Predicate_Object;

    subtype Class_Name is Constant_String.Object;
    Null_Class_Name : Class_Name renames Constant_String.Null_Object;

    type Query_Qualifier is (Find, Check_No);
    type Query (Size : Value_Size := 0) is
        record
            Kind  : Query_Qualifier;
            Class : Class_Name;
            Value : Patterns (1 .. Size);
        end record;

    Null_Query : constant Query := Query'(Size  => 0,
                                          Kind  => Find,
                                          Class => Null_Class_Name,
                                          Value => (1 .. 0 => Null_Predicate));

end Generic_Fact_Base;