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

⟦162ea9b3f⟧ TextFile

    Length: 6980 (0x1b44)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

package body Generic_Expression is

    type Expression_Owners is (System, User);

    package System_Defined is
        type Operators is ('+', '-', '*', '/', Abs_Op);

        function Evaluate (Using_Operator : Operators; Left, Right : Integer)
                          return Integer;
        function Image    (Op : Operators) return String;
    end System_Defined;


    package Primary_Expression is
        type Sub_Classes is (Alias_Value, Immediate_Value);
        type Object (Kind : Sub_Classes := Immediate_Value) is
            record
                case Kind is
                    when Alias_Value =>
                        The_Alias : Alias.Name;
                    when Immediate_Value =>
                        The_Value : Integer;
                end case;
            end record;
        function  Value    (For_Integer : Integer)  return Object;
        function  Value    (For_Alias : Alias.Name) return Object;
        procedure Put      (The_Object : Object; Where : Output_Stream.Object);
        function  Evaluate (The_Object : Object)    return Integer;
    end Primary_Expression;


    package Unary_Expression is  
        type Object (Owner : Expression_Owners := System) is
            record
                The_Operand : Generic_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  : Generic_Expression.Object) return Object;
        function  Make (The_Operator : User_Defined_Operators;
                        The_Operand  : Generic_Expression.Object) return Object;
        procedure Put (The_Object : Object; Where : Output_Stream.Object);
        function  Evaluate (The_Object : Object) return Integer;
    end Unary_Expression;


    package Binary_Expression is  
        type Object (Owner : Expression_Owners := System) is
            record
                The_Left_Operand  : Generic_Expression.Object;
                The_Right_Operand : Generic_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_Left_Operand  : Generic_Expression.Object;
                            The_Right_Operand : Generic_Expression.Object)
                      return Object;
        function  Make     (The_Operator      : User_Defined_Operators;
                            The_Left_Operand  : Generic_Expression.Object;
                            The_Right_Operand : Generic_Expression.Object)
                      return Object;
        procedure Put      (The_Object : Object; Where : Output_Stream.Object);
        function  Evaluate (The_Object : Object) return Integer;
    end Binary_Expression;


    type Object_Structure (Sub_Class : Sub_Classes) is
        record
            case Sub_Class is
                when Primary =>
                    The_Primary_Code : Primary_Expression.Object;
                when Unary =>
                    The_Unary_Code : Unary_Expression.Object;
                when Binary =>
                    The_Binary_Code : Binary_Expression.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 Value (For_Integer : Integer) return Object is
    begin
        return New_Node ((Sub_Class        => Primary,
                          The_Primary_Code =>
                             Primary_Expression.Value (For_Integer)));
    end Value;


    function Value (For_Alias : Alias.Name) return Object is
    begin
        return New_Node ((Sub_Class        => Primary,
                          The_Primary_Code =>
                             Primary_Expression.Value (For_Alias)));
    end Value;


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


    function Binary_User_Expression (Left, Right : Object) return Object is
        The_Code : Binary_Expression.Object;
    begin
        The_Code := Binary_Expression.Make (Operator, Left, Right);
        return New_Node (For_Code => (Sub_Class       => Binary,
                                      The_Binary_Code => The_Code));
    end Binary_User_Expression;


    function Evaluate (The_Expression : Object) return Integer is
    begin
        if The_Expression = Null_Expression then
            return 0;
        else
            case The_Expression.Sub_Class is
                when Primary =>
                    return Primary_Expression.Evaluate
                              (The_Expression.The_Primary_Code);
                when Unary =>
                    return Unary_Expression.Evaluate
                              (The_Expression.The_Unary_Code);
                when Binary =>
                    return Binary_Expression.Evaluate
                              (The_Expression.The_Binary_Code);
                when Undefined =>
                    raise Illegal_Operation;
            end case;
        end if;
    end Evaluate;


    procedure Put (The_Object : Object; Where : Output_Stream.Object) is
        use Output_Stream;
    begin
        if The_Object /= Null_Expression then
            case The_Object.Sub_Class is
                when Primary =>
                    Primary_Expression.Put (The_Object.The_Primary_Code, Where);
                when Unary =>
                    Unary_Expression.Put (The_Object.The_Unary_Code, Where);
                when Binary =>
                    Binary_Expression.Put (The_Object.The_Binary_Code, Where);
                when Undefined =>
                    Put ("Undefined expression", Where);
            end case;
        end if;
    end Put;

    package body System_Defined is separate;
    package body Primary_Expression is separate;
    package body Unary_Expression is separate;
    package body Binary_Expression is separate;
    package body System_Defined_Expression is separate;
end Generic_Expression;