DataMuseum.dk

top - download

    Length: 7304 (0x1c88)
    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 Condition is

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

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


    -- value condition

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


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


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


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


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


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


    -- alias condition

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


    function Is_Less (Value : Alias) return Condition.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 Condition.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 Condition.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 Condition.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 Condition.Object is
    begin
        return (Count => 1,
                Value => (others =>
                             (Is_Different_Than_Alias, Alias'Pos (Value))));
    end Is_Different;


    -- miscellaneous condition


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

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


    function Value_Match (Value : Integer; Against : Term) 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 : Term) 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 : Term) 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 : Term) 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 : Condition.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;

    procedure Put (The_Term : Term; Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        Put (Operators'Image (The_Term.Operator), Where);
        case The_Term.Operator is
            when Value_Operators =>
                Put (" (" & Integer'Image (The_Term.Operand) & ")", Where);
            when Alias_Operators | Say_It_Is =>
                Put (" (Alias'", Where);
                Put (Alias'Image (Alias'Val (The_Term.Operand)), Where);
                Put (")", Where);
            when Is_Any =>
                null;
        end case;
    end Put;

    procedure Put (The_Condition : Object; Where : Output_Stream.Object) is
        First : Boolean := True;
        use Output_Stream;
    begin
        if The_Condition.Count = 0 then
            Put ("Any", Where);
        else
            for I in The_Condition.Value'Range loop  
                if not First then
                    New_Line (Where);
                    Put ("  & ", Where);
                else
                    First := False;
                end if;
                Put (The_Condition.Value (I), Where);
            end loop;
        end if;
    end Put;
end Condition;