DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦459c3ee02⟧ TextFile

    Length: 7343 (0x1caf)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦e24fb53b7⟧ 
            └─⟦this⟧ 

TextFile

package body Generic_Predicate is

    type Predicate_Owners is (System, User);

    package System_Defined is
        type Operators is (Is_Equal, Is_Less, Is_Less_Or_Equal,
                           Is_Greater, Is_Greater_Or_Equal, Is_Different,
                           Is_Any, Is_Undefined, Is_Defined);

        function Match (Using_Operator : Operators; Value : Slot.Object)
                       return Boolean;

        function Match (Using_Operator : Operators;
                        Value          : Slot.Object;
                        Against        : Slot.Object) return Boolean;
        function Image (Op : Operators)               return String;
    end System_Defined;


    package Primary_Predicate is
        type Sub_Classes is (Alias_Definition, Predicate_Conjunction);
        type Object (Kind : Sub_Classes := Alias_Definition) is
            record
                case Kind is
                    when Alias_Definition =>
                        The_Alias : Alias.Name;
                    when Predicate_Conjunction =>
                        The_Left_Predicate  : Generic_Predicate.Object;
                        The_Right_Predicate : Generic_Predicate.Object;
                end case;
            end record;
        function  Make_Alias_Definition (The_Alias : Alias.Name) return Object;
        function  Make_Conjunction
                    (Left, Right : Generic_Predicate.Object) return Object;
        procedure Put (The_Object : Object; Where : Output_Stream.Object);
        function  Match (Value : Slot.Object; Against : Object) return Boolean;
    end Primary_Predicate;


    package Unary_Predicate is  
        type Object (Owner : Predicate_Owners := System) is
            record
                case Owner is
                    when System =>
                        The_System_Operator : System_Defined.Operators;
                    when User =>
                        The_User_Operator : User_Defined_Operators;
                end case;
            end record;
        function  Make  (The_Operator : System_Defined.Operators) return Object;
        function  Make  (The_Operator : User_Defined_Operators) return Object;
        procedure Put   (The_Object : Object; Where : Output_Stream.Object);
        function  Match (Value : Slot.Object; Against : Object) return Boolean;
    end Unary_Predicate;


    package Binary_Predicate is  
        type Object (Owner : Predicate_Owners := System) is
            record
                The_Operand : Expression_Object;
                case Owner is
                    when System =>
                        The_System_Operator : System_Defined.Operators;
                    when User =>
                        The_User_Operator : User_Defined_Operators;
                end case;
            end record;
        function  Make  (The_Operator : System_Defined.Operators;
                         The_Operand  : Expression_Object)      return Object;
        function  Make  (The_Operator : User_Defined_Operators;
                         The_Operand  : Expression_Object)      return Object;
        procedure Put   (The_Object : Object; Where : Output_Stream.Object);
        function  Match (Value : Slot.Object; Against : Object) return Boolean;
    end Binary_Predicate;


    type Object_Structure (Sub_Class : Sub_Classes) is
        record
            case Sub_Class is
                when Primary =>
                    The_Primary_Code : Primary_Predicate.Object;
                when Unary =>
                    The_Unary_Code : Unary_Predicate.Object;
                when Binary =>
                    The_Binary_Code : Binary_Predicate.Object;  
                when Undefined =>
                    null;
            end case;
        end record;


    function New_Node (For_Code : Object_Structure) return Object is  
        Result : Object;
    begin
        Result     := new Object_Structure (Sub_Class => For_Code.Sub_Class);
        Result.all := For_Code;
        return Result;
    end New_Node;


    function Define_As (The_Alias : Alias.Name) return Object is
        The_Predicate : Primary_Predicate.Object;
    begin
        The_Predicate := Primary_Predicate.Make_Alias_Definition (The_Alias);
        return New_Node (For_Code => (Sub_Class        => Primary,
                                      The_Primary_Code => The_Predicate));
    end Define_As;


    function "and" (Left, Right : Object) return Object is
        The_Predicate : Primary_Predicate.Object;
    begin
        if Left = Null_Predicate then
            return Right;
        elsif Right = Null_Predicate then
            return Left;
        else
            The_Predicate := Primary_Predicate.Make_Conjunction (Left, Right);
            return New_Node (For_Code => (Sub_Class        => Primary,
                                          The_Primary_Code => The_Predicate));
        end if;
    end "and";


    function Unary_User_Predicate return Object is
        The_Code : Unary_Predicate.Object;
    begin
        The_Code := Unary_Predicate.Make (Operator);
        return New_Node (For_Code => (Sub_Class      => Unary,
                                      The_Unary_Code => The_Code));
    end Unary_User_Predicate;


    function Binary_User_Predicate
                (Using_Value : Expression_Object) return Object is
        The_Code : Binary_Predicate.Object;
    begin
        The_Code := Binary_Predicate.Make (Operator, Using_Value);
        return New_Node (For_Code => (Sub_Class       => Binary,
                                      The_Binary_Code => The_Code));
    end Binary_User_Predicate;


    function Match (Value : Slot.Object; Against : Object) return Boolean is
    begin  
        if Against = Null_Predicate then
            return False;
        else
            case Against.Sub_Class is
                when Primary =>
                    return Primary_Predicate.Match
                              (Value, Against.The_Primary_Code);
                when Unary =>
                    return Unary_Predicate.Match
                              (Value, Against.The_Unary_Code);
                when Binary =>
                    return Binary_Predicate.Match
                              (Value, Against.The_Binary_Code);
                when Undefined =>
                    raise Illegal_Operation;
            end case;
        end if;
    end Match;


    procedure Put (The_Object : Object; Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        if The_Object /= Null_Predicate then
            case The_Object.Sub_Class is
                when Primary =>
                    Primary_Predicate.Put (The_Object.The_Primary_Code, Where);
                when Unary =>
                    Unary_Predicate.Put (The_Object.The_Unary_Code, Where);
                when Binary =>
                    Binary_Predicate.Put (The_Object.The_Binary_Code, Where);
                when Undefined =>
                    Put ("Undefined predicate", Where);
            end case;
        end if;
    end Put;

    package body System_Defined is separate;
    package body Primary_Predicate is separate;
    package body Unary_Predicate is separate;
    package body Binary_Predicate is separate;
    package body System_Defined_Predicate is separate;
end Generic_Predicate;