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

⟦aff59a994⟧ TextFile

    Length: 9092 (0x2384)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »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; Right : Slot.Object)
                          return Slot.Object;
        function Evaluate (Using_Operator : Operators;
                           Left, Right    : Slot.Object) return Slot.Object;
        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 : Slot.Object;
                end case;
            end record;
        function  Value    (For_Object : Slot.Object) 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 Slot.Object;
    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 Slot.Object;
    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 Slot.Object;
    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_Object : Slot.Object) return Object is
    begin
        return New_Node ((Sub_Class        => Primary,
                          The_Primary_Code =>
                             Primary_Expression.Value (For_Object)));
    end Value;


    function Value (For_Integer : Integer) return Object is  
        The_Object : Slot.Object := Slot.Value (For_Integer);
    begin
        return New_Node ((Sub_Class        => Primary,
                          The_Primary_Code =>
                             Primary_Expression.Value (The_Object)));
    end Value;

    function Value (For_Boolean : Boolean) return Object is  
        The_Object : Slot.Object := Slot.Value (For_Boolean);
    begin
        return New_Node ((Sub_Class        => Primary,
                          The_Primary_Code =>
                             Primary_Expression.Value (The_Object)));
    end Value;

    function Value (For_Float : Float) return Object is  
        The_Object : Slot.Object := Slot.Value (For_Float);
    begin
        return New_Node ((Sub_Class        => Primary,
                          The_Primary_Code =>
                             Primary_Expression.Value (The_Object)));
    end Value;

    function Value (For_Character : Character) return Object is  
        The_Object : Slot.Object := Slot.Value (For_Character);
    begin
        return New_Node ((Sub_Class        => Primary,
                          The_Primary_Code =>
                             Primary_Expression.Value (The_Object)));
    end Value;

    function Value (For_Duration : Duration) return Object is  
        The_Object : Slot.Object := Slot.Value (For_Duration);
    begin
        return New_Node ((Sub_Class        => Primary,
                          The_Primary_Code =>
                             Primary_Expression.Value (The_Object)));
    end Value;

    function Value (For_String : String) return Object is  
        The_Object : Slot.Object := Slot.Value (For_String);
    begin
        return New_Node ((Sub_Class        => Primary,
                          The_Primary_Code =>
                             Primary_Expression.Value (The_Object)));
    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 (Right : Object) return Object is
        The_Code : Unary_Expression.Object;
    begin
        The_Code := Unary_Expression.Make (Operator, Right);
        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 Slot.Object is
    begin
        if The_Expression = Null_Expression then
            return Slot.Null_Object;
        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;