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

⟦b86f40063⟧ TextFile

    Length: 11269 (0x2c05)
    Types: TextFile
    Names: »B«

Derivation

└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 

TextFile

package body Generic_Expression is

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

    type Kind_Of_Operation is (System_Defined_Operator,  
                               User_Defined_Operator,  
                               Value_Definition,  
                               Alias_Definition,  
                               Alias_Reference,  
                               Predicate_Conjunction,  
                               Undefined);

    -- predicates have only left  nodes

    type Intermediate_Code (Kind : Kind_Of_Operation := Undefined) is
        record
            Is_Predicate : Boolean := False;  
            case Kind is
                when System_Defined_Operator =>
                    The_System_Operator      : System_Defined_Operators;
                    The_Left_System_Operand  : Object;
                    The_Right_System_Operand : Object;
                when User_Defined_Operator =>
                    The_User_Operator      : User_Defined_Operators;
                    The_Left_User_Operand  : Object;
                    The_Right_User_Operand : Object;
                when Value_Definition =>
                    The_Value : Integer;
                when Alias_Definition =>
                    The_Defined_Alias : Alias;
                when Alias_Reference =>
                    The_Referenced_Alias : Alias;
                when Predicate_Conjunction =>
                    The_Left_Predicate  : Object;
                    The_Right_Predicate : Object;
                when Undefined =>
                    null;
            end case;
        end record;

    type Intermediate_Codes is array (Object range <>) of Intermediate_Code;

    The_Expressions : Intermediate_Codes (1 .. Object (Max_Expression_Count)) :=
       (others => Intermediate_Code'(Kind => Undefined, Is_Predicate => False));

    The_Last_Expression : Object := 0;


    function New_Node (For_Code : Intermediate_Code) return Object is  
    begin
        if The_Last_Expression = Object (Max_Expression_Count) then
            raise Overflow;
        else
            The_Last_Expression                   := The_Last_Expression + 1;
            The_Expressions (The_Last_Expression) := For_Code;
            return The_Last_Expression;
        end if;
    end New_Node;

    function Value (For_Integer : Integer) return Object is
    begin
        return New_Node (For_Code => (Kind         => Value_Definition,
                                      Is_Predicate => False,
                                      The_Value    => For_Integer));
    end Value;


    function Value (For_Alias : Alias) return Object is
    begin  
        return New_Node (For_Code => (Kind                 => Alias_Reference,
                                      Is_Predicate         => False,
                                      The_Referenced_Alias => For_Alias));
    end Value;


    function Define_As (The_Alias : Alias) return Object is
    begin  
        return New_Node (For_Code => (Kind              => Alias_Definition,
                                      Is_Predicate      => True,
                                      The_Defined_Alias => The_Alias));
    end Define_As;


    function "and" (Left, Right : Object) return Object is
        The_Left_Code, The_Right_Code : Intermediate_Code;
    begin
        if Left = Null_Expression then
            return Right;
        elsif Right = Null_Expression then
            return Left;
        else
            The_Left_Code  := The_Expressions (Left);
            The_Right_Code := The_Expressions (Right);
            if The_Left_Code.Is_Predicate and The_Right_Code.Is_Predicate then
                return New_Node (For_Code => (Kind => Predicate_Conjunction,
                                              Is_Predicate => True,
                                              The_Left_Predicate => Left,
                                              The_Right_Predicate => Right));
            else
                raise Illegal_Operation;
            end if;
        end if;
    end "and";


    function Unary_System_Predicate return Object is  
    begin
        return New_Node (For_Code =>
                            (Kind => System_Defined_Operator,
                             Is_Predicate => True,
                             The_System_Operator => Operator,
                             The_Left_System_Operand |
                             The_Right_System_Operand => Null_Expression));
    end Unary_System_Predicate;


    function Binary_System_Predicate (Using_Value : Object) return Object is
    begin
        return New_Node (For_Code =>
                            (Kind => System_Defined_Operator,
                             Is_Predicate => True,
                             The_System_Operator => Operator,
                             The_Left_System_Operand => Using_Value,
                             The_Right_System_Operand => Null_Expression));
    end Binary_System_Predicate;


    function Unary_System_Expression (Using_Value : Object) return Object is
    begin
        return New_Node (For_Code =>
                            (Kind => System_Defined_Operator,
                             Is_Predicate => False,  
                             The_System_Operator => Operator,
                             The_Left_System_Operand => Using_Value,
                             The_Right_System_Operand => Null_Expression));

    end Unary_System_Expression;

    function Binary_System_Expression (Left, Right : Object) return Object is
    begin
        return New_Node (For_Code => (Kind => System_Defined_Operator,
                                      Is_Predicate => False,  
                                      The_System_Operator => Operator,
                                      The_Left_System_Operand => Left,
                                      The_Right_System_Operand => Right));

    end Binary_System_Expression;

    function Unary_User_Predicate return Object is
    begin  
        return New_Node (For_Code =>
                            (Kind => User_Defined_Operator,
                             Is_Predicate => True,  
                             The_User_Operator => Operator,
                             The_Left_User_Operand | The_Right_User_Operand =>
                                Null_Expression));
    end Unary_User_Predicate;


    function Binary_User_Predicate (Using_Value : Object) return Object is
    begin
        return New_Node (For_Code =>
                            (Kind                   => User_Defined_Operator,
                             Is_Predicate           => True,
                             The_User_Operator      => Operator,
                             The_Left_User_Operand  => Using_Value,
                             The_Right_User_Operand => Null_Expression));
    end Binary_User_Predicate;


    function Unary_User_Expression (Using_Value : Object) return Object is
    begin
        return New_Node (For_Code =>
                            (Kind                   => User_Defined_Operator,
                             Is_Predicate           => False,  
                             The_User_Operator      => Operator,
                             The_Left_User_Operand  => Using_Value,
                             The_Right_User_Operand => Null_Expression));

    end Unary_User_Expression;

    function Binary_User_Expression (Left, Right : Object) return Object is
    begin
        return New_Node (For_Code => (Kind => User_Defined_Operator,
                                      Is_Predicate => False,  
                                      The_User_Operator => Operator,
                                      The_Left_User_Operand => Left,
                                      The_Right_User_Operand => Right));

    end Binary_User_Expression;

    function Evaluate (The_Expression : Object) return Integer is  
        The_Code : Intermediate_Code;
    begin
        if The_Expression = Null_Expression then
            return 0;
        else
            The_Code := The_Expressions (The_Expression);
            if The_Code.Is_Predicate then
                raise Illegal_Operation;
            else
                case The_Code.Kind is
                    when System_Defined_Operator =>
                        return
                           System_Defined_Evaluate
                              (Using_Operator => The_Code.The_System_Operator,
                               Left           =>
                                  Evaluate (The_Code.The_Left_System_Operand),
                               Right          =>
                                  Evaluate (The_Code.The_Right_System_Operand));
                    when User_Defined_Operator =>
                        return
                           User_Defined_Evaluate
                              (Using_Operator => The_Code.The_User_Operator,
                               Left           =>
                                  Evaluate (The_Code.The_Left_User_Operand),
                               Right          =>
                                  Evaluate (The_Code.The_Right_User_Operand));
                    when Value_Definition =>
                        return The_Code.The_Value;
                    when Alias_Reference =>
                        return The_Aliases (The_Code.The_Referenced_Alias);
                    when Alias_Definition | Predicate_Conjunction | Undefined =>
                        raise Illegal_Operation;
                end case;
            end if;
        end if;
    end Evaluate;


    function Match (Value : Integer; Against : Object) return Boolean is
        The_Code : Intermediate_Code := The_Expressions (Against);
    begin
        if The_Code.Is_Predicate then
            case The_Code.Kind is
                when System_Defined_Operator =>
                    return System_Defined_Match
                              (The_Code.The_System_Operator, Value,
                               Against =>
                                  Evaluate (The_Code.The_Left_System_Operand));
                when User_Defined_Operator =>
                    return User_Defined_Match
                              (The_Code.The_User_Operator, Value,
                               Against =>  
                                  Evaluate (The_Code.The_Left_User_Operand));
                when Alias_Definition =>
                    The_Aliases (The_Code.The_Defined_Alias) := Value;
                    return True;  
                when Predicate_Conjunction =>
                    return Match
                              (Value,
                               Against => The_Code.The_Left_Predicate) and then
                           Match (Value,
                                  Against => The_Code.The_Right_Predicate);
                when Value_Definition | Alias_Reference | Undefined =>
                    raise Illegal_Operation;
            end case;
        else
            raise Illegal_Operation;
        end if;
    end Match;


    procedure Put (The_Object : Object; Where : Output_Stream.Object) is
    begin
        null;
    end Put;


end Generic_Expression;