⟦8bd1a5d82⟧

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;


    function Undefined_Value return Object is
    begin
        return Null_Object;
    end Undefined_Value;


    function Is_Undefined (The_Object : Object) return Standard.Boolean is
    begin
        return The_Object = Null_Object;
    end Is_Undefined;


    procedure Make_Undefined (The_Object : in out Object) is
    begin
        The_Object := Null_Object;
    end Make_Undefined;


    function Is_A_Reference (The_Object : Object) return Standard.Boolean is
    begin
        return The_Object.Kind = Reference;
    end Is_A_Reference;


    function Reference_Value
                (The_Reference : Fact_Reference.Object) return Object is
    begin
        return (Object'(Kind => Reference,  
                        The_Reference => The_Reference));
    end Reference_Value;


    function Get_Reference (From_Object : Object)
                           return Fact_Reference.Object is
    begin  
        return From_Object.The_Reference;
    end Get_Reference;



    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 Reference =>
                Fact_Reference.Put (The_Object.The_Reference, 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 Reference | 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 Reference | 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 Reference | 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 Reference | 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 "&" (Left, Right : Object) return Object is  
            S : Constant_String.Object := Constant_String.Null_Object;
            use Constant_String;
        begin
            case Left.Kind is
                when Character =>
                    case Right.Kind is
                        when Character =>
                            S := Value (Left.The_Character &
                                        Right.The_Character);
                            return Object'(Kind => String, The_String => S);
                        when String =>
                            S := Value (Left.The_Character &
                                        Image (Right.The_String));
                            return Object'(Kind => String, The_String => S);
                        when others =>
                            raise Illegal_Operation;
                    end case;
                when String =>
                    case Right.Kind is
                        when Character =>
                            S := Value (Image (Left.The_String) &
                                        Right.The_Character);
                            return Object'(Kind => String, The_String => S);
                        when String =>
                            S := Value (Image (Left.The_String) &
                                        Image (Right.The_String));
                            return Object'(Kind => String, The_String => S);
                        when others =>
                            raise Illegal_Operation;
                    end case;
                when others =>
                    raise Illegal_Operation;
            end case;
        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;
DataMuseum.dk

Rational R1000/400 Tapes

⟦8bd1a5d82⟧ TextFile

Derivation

TextFile
