DataMuseum.dk

top - download

    Length: 6258 (0x1872)
    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;
package body Conditions is

    type Alias_Storage is array (Alias) of Integer;
    The_Aliases : Alias_Storage := (others => 0);

    function Is_Any return Conditions.Object is
    begin
        return (Count => 0, Value => (others => (Is_Any, 0)));
    end Is_Any;


    -- value conditions

    function Is_Equal (Value : Integer) return Conditions.Object is
    begin
        return (Count => 1, Value => (others => (Is_Equal, Value)));
    end Is_Equal;


    function Is_Less (Value : Integer) return Conditions.Object is
    begin
        return (Count => 1, Value => (others => (Is_Less, Value)));
    end Is_Less;


    function Is_Less_Or_Equal (Value : Integer) return Conditions.Object is
    begin
        return (Count => 1, Value => (others => (Is_Less_Or_Equal, Value)));
    end Is_Less_Or_Equal;


    function Is_Greater (Value : Integer) return Conditions.Object is
    begin
        return (Count => 1, Value => (others => (Is_Greater, Value)));
    end Is_Greater;


    function Is_Greater_Or_Equal (Value : Integer) return Conditions.Object is
    begin
        return (Count => 1, Value => (others => (Is_Greater_Or_Equal, Value)));
    end Is_Greater_Or_Equal;


    function Is_Different (Value : Integer) return Conditions.Object is
    begin
        return (Count => 1, Value => (others => (Is_Different, Value)));
    end Is_Different;


    -- alias conditions

    function Is_Equal (Value : Alias) return Conditions.Object is
    begin
        return (Count => 1,
                Value => (others => (Is_Equal_To_Alias, Alias'Pos (Value))));
    end Is_Equal;


    function Is_Less (Value : Alias) return Conditions.Object is
    begin
        return (Count => 1,
                Value => (others => (Is_Less_Than_Alias, Alias'Pos (Value))));
    end Is_Less;


    function Is_Less_Or_Equal (Value : Alias) return Conditions.Object is
    begin
        return (Count => 1,
                Value => (others =>
                             (Is_Less_Or_Equal_Than_Alias, Alias'Pos (Value))));
    end Is_Less_Or_Equal;


    function Is_Greater (Value : Alias) return Conditions.Object is
    begin
        return (Count => 1,
                Value => (others =>
                             (Is_Greater_Than_Alias, Alias'Pos (Value))));
    end Is_Greater;


    function Is_Greater_Or_Equal (Value : Alias) return Conditions.Object is
    begin
        return (Count => 1,
                Value => (others => (Is_Greater_Or_Equal_Than_Alias,
                                     Alias'Pos (Value))));
    end Is_Greater_Or_Equal;


    function Is_Different (Value : Alias) return Conditions.Object is
    begin
        return (Count => 1,
                Value => (others =>
                             (Is_Different_Than_Alias, Alias'Pos (Value))));
    end Is_Different;


    -- miscellaneous conditions


    function Say_It_Is (Object : Alias) return Conditions.Object is
    begin
        return (Count => 1,
                Value => (others => (Say_It_Is, Alias'Pos (Object))));
    end Say_It_Is;

    function "and" (Left, Right : Conditions.Object) return Conditions.Object is
    begin
        return (Count => Left.Count + Right.Count,
                Value => Left.Value & Right.Value);
    end "and";


    function Value_Match
                (Value : Integer; Against : Condition_Element) return Boolean is
        Operator : Operators renames Against.Operator;
        Operand  : Integer   renames Against.Operand;
    begin
        case Value_Operators'(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;
        end case;
    end Value_Match;


    function Alias_Match
                (Value : Integer; Against : Condition_Element) return Boolean is
        Operator : Operators renames Against.Operator;
        Alias_Id : constant Alias := Alias'Val (Against.Operand);
        Operand  : Integer   renames The_Aliases (Alias_Id);
    begin
        case Alias_Operators'(Operator) is
            when Is_Equal_To_Alias =>
                return Value = Operand;
            when Is_Less_Than_Alias =>
                return Value < Operand;
            when Is_Less_Or_Equal_Than_Alias =>
                return Value <= Operand;
            when Is_Greater_Than_Alias =>
                return Value > Operand;
            when Is_Greater_Or_Equal_Than_Alias =>
                return Value >= Operand;
            when Is_Different_Than_Alias =>
                return Value /= Operand;
        end case;
    end Alias_Match;



    function Miscellaneous_Match
                (Value : Integer; Against : Condition_Element) return Boolean is
        Operator : Operators renames Against.Operator;
        Operand  : Integer   renames Against.Operand;
    begin
        case Miscellaneous_Operators'(Operator) is
            when Is_Any =>
                return True;
            when Say_It_Is =>
                The_Aliases (Alias'Val (Operand)) := Value;
                return True;
        end case;
    end Miscellaneous_Match;



    function Match (Value : Integer; Against : Condition_Element)
                   return Boolean is
        Operator : Operators renames Against.Operator;
    begin
        case Operator is
            when Value_Operators =>
                return Value_Match (Value, Against);
            when Alias_Operators =>
                return Alias_Match (Value, Against);
            when Miscellaneous_Operators =>
                return Miscellaneous_Match (Value, Against);
        end case;
    end Match;


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

end Conditions;