DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦ed94624a4⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Operators, package body Query, seg_03b94d, separate Generic_Fact_Base

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



separate (Generic_Fact_Base)
package body Query is

    procedure Put (The_Patterns : Patterns;  
                   Using_Class  : Class.Object;
                   Where        : Output_Stream.Object :=
                      Output_Stream.Standard_Output) is  
        First : Boolean := True;
        use Output_Stream;
    begin
        for I in The_Patterns'Range loop
            if not First then
                Put_Line (", ", Where);
            else
                First := False;
            end if;
            Put (Class.Slot_Name_Image (From_Class => Using_Class,  
                                        For_Slot   => I), Where);
            Put (" => ", Where);
            Predicate_Put (The_Expression => The_Patterns (I), Where => Where);
        end loop;
    end Put;

    procedure Put (The_Query : Object; Where : Output_Stream.Object) is
        use Output_Stream;

    begin
        case The_Query.Kind is
            when Find | Check_No =>
                declare
                    Class_Name : constant String :=
                       Class_Names'Image (The_Query.Class);
                    The_Class  : Class.Object    :=
                       Working_Memory.Get (Using => The_Query.Class);
                begin
                    if The_Query.Kind = Find then
                        Put_Line ("Find_" & Class_Name & "_Such_As'(", Where);
                    else
                        Put_Line ("Check_No_" & Class_Name & "_Has'(", Where);
                    end if;
                    Indent_Right (Where);
                    Put (The_Patterns => The_Query.Value,
                         Using_Class  => The_Class,
                         Where        => Where);
                    Indent_Left (Where);
                    Put_Line (")", Where);
                end;
            when Evaluate =>
                Put_Line ("Check_If'(", Where);
                Indent_Right (Where);
                Expression_Put (The_Query.The_Expression, Where);
                Predicate_Put (The_Query.The_Predicate, Where);
                Indent_Left (Where);
                Put_Line (")", Where);
                null;
        end case;
    end Put;

    procedure Put (The_Queries : Objects; Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        Put ("Premiss'(", Where);
        Indent_Right (Where);
        for I in The_Queries'Range loop
            Put (The_Queries (I), Where);
            New_Line (Where);
        end loop;
        Indent_Left (Where);
        Put_Line (")", Where);
    end Put;

    package body Operators is separate;

end Query;

E3 Meta Data

    nblk1=4
    nid=3
    hdr6=6
        [0x00] rec0=1e rec1=00 rec2=01 rec3=032
        [0x01] rec0=15 rec1=00 rec2=02 rec3=04a
        [0x02] rec0=19 rec1=00 rec2=04 rec3=000
        [0x03] rec0=07 rec1=00 rec2=03 rec3=000
    tail 0x2173810f6850f4ec224a8 0x42a00088462063c03
Free Block Chain:
  0x3: 0000  00 00 00 9c 80 27 20 20 20 20 20 20 20 20 20 20  ┆     '          ┆