DataMuseum.dk

top - metrics - download

    Length: 4342 (0x10f6)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Text_Io;
procedure Unary is
    Result : Boolean;

    Dummy : constant := -1;

    Robot : constant := 1;
    Ball  : constant := 2;
    Box   : constant := 3;

    Busy : constant := 1;
    Free : constant := 2;
    Heap : constant := 3;

    Red   : constant := 1;
    Blue  : constant := 2;
    Green : constant := 3;

    type Slot_Name is (Class, Size, Colour, State);

    type Object is array (Slot_Name) of Integer;

    The_Object : Object;

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

    Objects : Object_Collection (1 .. 6) :=
       (Object'(Class => Robot, Size => Dummy, Colour => Green, State => Free),
        Object'(Class => Robot, Size => Dummy, Colour => Red, State => Busy),
        Object'(Class => Ball, Size => 50, Colour => Green, State => Heap),
        Object'(Class => Ball, Size => 100, Colour => Blue, State => Heap),
        Object'(Class => Box, Size => 75, Colour => Green, State => Free),
        Object'(Class => Box, Size => 25, Colour => Blue, State => Busy));

    type Operators is (Is_Equal, Is_Less, Is_Less_Or_Equal, Is_Greater,
                       Is_Greater_Or_Equal, Is_Different, Is_Any);  
    type Condition is
        record
            Operator : Operators;
            Operand  : Integer;
        end record;

    type Query is array (Slot_Name) of Condition;

    Filter : Query;

    No_Matter : constant Condition := (Is_Any, 0);

    type Conditions is array (Positive range <>) of Condition;

    function Is_Equal (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Equal, Operand => Value);
    end Is_Equal;

    function Is_Less (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Less, Operand => Value);
    end Is_Less;

    function Is_Less_Or_Equal (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Less_Or_Equal, Operand => Value);
    end Is_Less_Or_Equal;

    function Is_Greater (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Greater, Operand => Value);
    end Is_Greater;

    function Is_Greater_Or_Equal (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Greater_Or_Equal, Operand => Value);
    end Is_Greater_Or_Equal;

    function Is_Different (Value : Integer) return Condition is
    begin
        return Condition'(Operator => Is_Different, Operand => Value);
    end Is_Different;

    function Match (Value : Integer; Against : Condition) return Boolean is
        Operator : Operators renames Against.Operator;
        Operand  : Integer   renames Against.Operand;
    begin
        case Operator is
            when Is_Equal =>
                return Value = Operand;
            when Is_Less =>
                return Value < Operand;
            when Is_Less_Or_Equal =>
                return Value <= Operand;
            when Is_Greater =>
                return Value > Operand;
            when Is_Greater_Or_Equal =>
                return Value >= Operand;
            when Is_Different =>
                return Value /= Operand;
            when Is_Any =>
                return True;
        end case;
    end Match;

    function Match (Value : Integer; Against : Conditions) return Boolean is
    begin
        for I in Against'Range loop
            if not Match (Value, Against (I)) then
                return False;
            end if;
        end loop;
        return True;
    end Match;

    function Match (Value : Object; Against : Query) return Boolean is
    begin
        for I in Value'Range loop
            if not Match (Value (I), Against (I)) then
                return False;
            end if;
        end loop;
        return True;
    end Match;

begin
    Filter := (Class          => Is_Different (Robot),
               Size           => Is_Less (100),
               Colour | State => No_Matter);

    for I in Objects'Range loop

        Result := Match (Objects (I),
                         Against => (Class          => Is_Different (Robot),
                                     Size           => Is_Less (100),
                                     Colour | State => No_Matter));

        Text_Io.Put_Line (Integer'Image (I) & " => " & Boolean'Image (Result));
    end loop;
end Unary;