DataMuseum.dk

top - download

    Length: 12849 (0x3231)
    Types: TextFile
    Names: »B«

└─⟦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 Slot is

    function Value (I : Standard.Integer) return Object is
    begin
        return Object'(Kind => Integer, The_Integer => I);
    end Value;

    function Value (F : Standard.Float) return Object is
    begin
        return Object'(Kind => Float, The_Float => F);
    end Value;

    function Value (B : Standard.Boolean) return Object is
    begin
        return Object'(Kind => Boolean, The_Boolean => B);
    end Value;

    function Value (C : Standard.Character) return Object is
    begin
        return (Object'(Kind => Character, The_Character => C));
    end Value;

    function Value (D : Standard.Duration) return Object is
    begin
        return (Object'(Kind => Duration, The_Duration => D));
    end Value;

    function Value (S : Standard.String) return Object is
    begin
        return (Object'(Kind => String,
                        The_String => Constant_String.Value (S)));
    end Value;



    function Get (The_Object : Object) return Standard.Integer is
    begin
        return The_Object.The_Integer;
    end Get;


    function Get (The_Object : Object) return Standard.Boolean is
    begin
        return The_Object.The_Boolean;
    end Get;

    function Get (The_Object : Object) return Standard.Float is
    begin
        return The_Object.The_Float;
    end Get;

    function Get (The_Object : Object) return Standard.Character is
    begin  
        return The_Object.The_Character;
    end Get;

    function Get (The_Object : Object) return Standard.Duration is
    begin  
        return The_Object.The_Duration;
    end Get;

    function Get (The_Object : Object) return Standard.String is
    begin
        return Constant_String.Image (The_Object.The_String);
    end Get;



    procedure Set (The_Object : in out Object; To : Standard.Integer) is
    begin
        The_Object := Value (To);
    end Set;

    procedure Set (The_Object : in out Object; To : Standard.Boolean) is
    begin
        The_Object := Value (To);
    end Set;

    procedure Set (The_Object : in out Object; To : Standard.Float) is
    begin
        The_Object := Value (To);
    end Set;

    procedure Set (The_Object : in out Object; To : Standard.Character) is
    begin  
        The_Object := Value (To);
    end Set;

    procedure Set (The_Object : in out Object; To : Standard.Duration) is
    begin  
        The_Object := Value (To);
    end Set;

    procedure Set (The_Object : in out Object; To : Standard.String) is
    begin  
        The_Object := Value (To);
    end Set;


    function Have_Same_Type (Left, Right : Object) return Standard.Boolean is
    begin
        return Left.Kind = Right.Kind;
    end Have_Same_Type;


    procedure Put (The_Object : Object; Where : Output_Stream.Object) is  
        use Output_Stream;
    begin
        case The_Object.Kind is
            when Integer =>
                Put (The_Object.The_Integer, Where);
            when Boolean =>
                Put (The_Object.The_Boolean, Where);
            when Float =>
                Put (The_Object.The_Float, Where);
            when Character =>
                Put (The_Object.The_Character, Where);
            when Duration =>
                Put (The_Object.The_Duration, Where);
            when String =>
                Constant_String.Put (The_Object.The_String, Where);
            when Enumeration =>
                Put (The_Object.The_Enumeration, Where);
            when Undefined =>
                Put ("undefined slot value", Where);
        end case;
    end Put;

    package body Operators is

        function "<" (Left, Right : Object) return Standard.Boolean is  
            use Constant_String;
            use Constant_String.Operators;
        begin  
            if Left.Kind = Right.Kind then
                case Left.Kind is
                    when Integer =>
                        return Left.The_Integer < Right.The_Integer;
                    when Boolean =>
                        return Left.The_Boolean < Right.The_Boolean;
                    when Float =>
                        return Left.The_Float < Right.The_Float;
                    when Character =>
                        return Left.The_Character < Right.The_Character;
                    when Duration =>
                        return Left.The_Duration < Right.The_Duration;
                    when String =>
                        return Left.The_String < Right.The_String;
                    when Enumeration =>
                        return Left.The_Enumeration < Right.The_Enumeration;
                    when Undefined =>
                        raise Illegal_Operation;
                end case;
            else
                raise Typing_Error;
            end if;
        end "<";

        function "<=" (Left, Right : Object) return Standard.Boolean is  
            use Constant_String;
            use Constant_String.Operators;
        begin  
            if Left.Kind = Right.Kind then
                case Left.Kind is
                    when Integer =>
                        return Left.The_Integer <= Right.The_Integer;
                    when Boolean =>
                        return Left.The_Boolean <= Right.The_Boolean;
                    when Float =>
                        return Left.The_Float <= Right.The_Float;
                    when Character =>
                        return Left.The_Character <= Right.The_Character;
                    when Duration =>
                        return Left.The_Duration <= Right.The_Duration;
                    when String =>
                        return Left.The_String <= Right.The_String;
                    when Enumeration =>
                        return Left.The_Enumeration <= Right.The_Enumeration;
                    when Undefined =>
                        raise Illegal_Operation;
                end case;
            else
                raise Typing_Error;
            end if;
        end "<=";

        function ">" (Left, Right : Object) return Standard.Boolean is  
            use Constant_String;
            use Constant_String.Operators;
        begin  
            if Left.Kind = Right.Kind then
                case Left.Kind is
                    when Integer =>
                        return Left.The_Integer > Right.The_Integer;
                    when Boolean =>
                        return Left.The_Boolean > Right.The_Boolean;
                    when Float =>
                        return Left.The_Float > Right.The_Float;
                    when Character =>
                        return Left.The_Character > Right.The_Character;
                    when Duration =>
                        return Left.The_Duration > Right.The_Duration;
                    when String =>
                        return Left.The_String > Right.The_String;
                    when Enumeration =>
                        return Left.The_Enumeration > Right.The_Enumeration;
                    when Undefined =>
                        raise Illegal_Operation;
                end case;
            else
                raise Typing_Error;
            end if;
        end ">";

        function ">=" (Left, Right : Object) return Standard.Boolean is  
            use Constant_String;
            use Constant_String.Operators;
        begin  
            if Left.Kind = Right.Kind then
                case Left.Kind is
                    when Integer =>
                        return Left.The_Integer >= Right.The_Integer;
                    when Boolean =>
                        return Left.The_Boolean >= Right.The_Boolean;
                    when Float =>
                        return Left.The_Float >= Right.The_Float;
                    when Character =>
                        return Left.The_Character >= Right.The_Character;
                    when Duration =>
                        return Left.The_Duration >= Right.The_Duration;
                    when String =>
                        return Left.The_String >= Right.The_String;
                    when Enumeration =>
                        return Left.The_Enumeration >= Right.The_Enumeration;
                    when Undefined =>
                        raise Illegal_Operation;
                end case;
            else
                raise Typing_Error;
            end if;
        end ">=";


        function "+" (Left, Right : Object) return Object is
        begin
            if Left.Kind = Right.Kind then
                case Left.Kind is
                    when Integer =>
                        return Value (Left.The_Integer + Right.The_Integer);
                    when Float =>
                        return Value (Left.The_Float + Right.The_Float);
                    when others =>
                        raise Illegal_Operation;
                end case;
            else
                raise Typing_Error;
            end if;
        end "+";

        function "-" (Left, Right : Object) return Object is
        begin
            if Left.Kind = Right.Kind then
                case Left.Kind is
                    when Integer =>
                        return Value (Left.The_Integer - Right.The_Integer);
                    when Float =>
                        return Value (Left.The_Float - Right.The_Float);
                    when others =>
                        raise Illegal_Operation;
                end case;
            else
                raise Typing_Error;
            end if;
        end "-";

        function "*" (Left, Right : Object) return Object is
        begin
            if Left.Kind = Right.Kind then
                case Left.Kind is
                    when Integer =>
                        return Value (Left.The_Integer * Right.The_Integer);
                    when Float =>
                        return Value (Left.The_Float * Right.The_Float);
                    when others =>
                        raise Illegal_Operation;
                end case;
            else
                raise Typing_Error;
            end if;

        end "*";

        function "/" (Left, Right : Object) return Object is
        begin
            if Left.Kind = Right.Kind then
                case Left.Kind is
                    when Integer =>
                        return Value (Left.The_Integer / Right.The_Integer);
                    when Float =>
                        return Value (Left.The_Float / Right.The_Float);
                    when others =>
                        raise Illegal_Operation;
                end case;
            else
                raise Typing_Error;
            end if;
        end "/";

        function "-" (Right : Object) return Object is
        begin
            case Right.Kind is
                when Integer =>
                    return Value (-Right.The_Integer);
                when Float =>
                    return Value (-Right.The_Float);
                when others =>
                    raise Illegal_Operation;
            end case;
        end "-";

        function "abs" (Right : Object) return Object is
        begin
            case Right.Kind is
                when Integer =>
                    return Value (abs Right.The_Integer);
                when Float =>
                    return Value (abs Right.The_Float);
                when others =>
                    raise Illegal_Operation;
            end case;
        end "abs";
    end Operators;



    package body Enumeration_Facilities is

        function Value (Enumeration_Value : Enumeration_Values) return Object is
            The_Value : Standard.Integer;
        begin
            The_Value := Enumeration_Values'Pos (Enumeration_Value);
            return Object'(Kind => Enumeration, The_Enumeration => The_Value);
        end Value;


        function Get (The_Object : Object) return Enumeration_Values is  
            Result : Enumeration_Values;
        begin
            if The_Object.Kind = Enumeration then
                return Enumeration_Values'Val (The_Object.The_Enumeration);
            else
                raise Constraint_Error;
            end if;
        end Get;


        procedure Set (The_Object : in out Object; To : Enumeration_Values) is
        begin  
            The_Object := Value (To);
        end Set;


        procedure Put (The_Object : Object; Where : Output_Stream.Object) is
            use Output_Stream;
            The_Value : Enumeration_Values;
        begin
            if The_Object.Kind = Enumeration then  
                The_Value := Enumeration_Values'Val
                                (The_Object.The_Enumeration);
                Put (Enumeration_Values'Image (The_Value), Where);
            else
                raise Constraint_Error;
            end if;
        end Put;

    end Enumeration_Facilities;
end Slot;