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

⟦abed6e89d⟧ TextFile

    Length: 11829 (0x2e35)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with String_Utilities;
with Bounded_String;
with Error_Broadcaster;
with Text_Io;
with Random;
package body Integer_Class is



    type Binary_Message is (Plus, Minus, Mul, Div, Less, Greater, Equal,
                            Less_Equal, Greater_Equal, Different);
    type Unary_Message is (Absolut, Aucube, Entexte,
                           Oppose, Aucarre, Randomize);

    function Create (Value : Object.Message) return Object.Reference is
        Obj : Object.Reference;
        Result : Boolean;
    begin
        String_Utilities.String_To_Number
           (Bounded_String.Image (Value), Obj.Identity, Result);
        return (Object.Tiny_Integer, Obj.Identity);
    end Create;
    function Translate_To_Tiny_Boolean
                (To_Object : Object.Reference;
                 The_Message : Binary_Message;
                 The_Argument : Object.Reference) return Object.Reference is
        Obj : Object.Reference;
    begin
        case The_Message is
            when Less =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity < The_Argument.Identity) then
                    Obj.Identity := 1;
                else
                    Obj.Identity := 0;  
                end if;
            when Greater =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity > The_Argument.Identity) then
                    Obj.Identity := 1;
                else  
                    Obj.Identity := 0;
                end if;  
            when Equal =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity = The_Argument.Identity) then
                    Obj.Identity := 1;
                else  
                    Obj.Identity := 0;
                end if;  
            when Less_Equal =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity <= The_Argument.Identity) then
                    Obj.Identity := 1;
                else  
                    Obj.Identity := 0;
                end if;
            when Greater_Equal =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity >= The_Argument.Identity) then
                    Obj.Identity := 1;
                else
                    Obj.Identity := 0;
                end if;  
            when Different =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity /= The_Argument.Identity) then
                    Obj.Identity := 1;
                else
                    Obj.Identity := 0;
                end if;  
            when Plus | Minus | Mul | Div =>
                null;
        end case;


        return (Obj);

    end Translate_To_Tiny_Boolean;

    function Translate_To_Binary_Message
                (The_Message : Object.Message) return Binary_Message is

    begin

        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "=", True) then
            return (Equal);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "<", True) then
            return (Less);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), ">", True) then
            return (Greater);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "<=", True) then
            return (Less_Equal);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), ">=", True) then
            return (Greater_Equal);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "<>", True) then
            return (Different);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "+", True) then
            return (Plus);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "-", True) then
            return (Minus);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "*", True) then
            return (Mul);
        end if;
        if String_Utilities.Equal
              (Bounded_String.Image (The_Message), "/", True) then
            return (Div);
        end if;
        if True then
            raise Error_Broadcaster.Unknown_Binary_Message;
        end if;
    end Translate_To_Binary_Message;
    function Entexte (To_Object : Object.Reference) return String is
    begin
        return

           String_Utilities.Number_To_String (To_Object.Identity, 10, 6);
    end Entexte;





    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return String is
        Message : Unary_Message;
    begin
        Message := Unary_Message'Value (Bounded_String.Image (The_Message));
        case Message is

            when Absolut | Randomize | Aucube | Oppose | Aucarre =>
                return ("");
            when Entexte =>
                return Entexte (To_Object);

        end case;

    end Send;


    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return Object.Reference is
        Message : Unary_Message;
        Obj : Object.Reference;  
        Tiny_Handle : Random.Handle;
    begin
        Message := Unary_Message'Value (Bounded_String.Image (The_Message));
        Obj := To_Object;
        case Message is
            when Absolut =>
                Obj.Identity := abs (To_Object.Identity);
                Obj.Class := Object.Tiny_Integer;
            when Aucube =>
                Obj.Identity := To_Object.Identity ** 3;
                Obj.Class := Object.Tiny_Integer;
            when Entexte =>
                Text_Io.Put (String_Utilities.Number_To_String
                                (To_Object.Identity));
                Obj.Identity := To_Object.Identity;
                Obj.Class := To_Object.Class;
            when Oppose =>

                Obj.Identity := -1 * To_Object.Identity;
                Obj.Class := Object.Tiny_Integer;

            when Aucarre =>
                Obj.Identity := To_Object.Identity ** 2;
                Obj.Class := Object.Tiny_Integer;
            when Randomize =>
                Random.Initialize (Tiny_Handle);
                Obj.Identity := Integer
                                   (Random.Natural_Value
                                       (Tiny_Handle, abs (To_Object.Identity)));
                Obj.Class := Object.Tiny_Integer;
        end case;
        return Obj;
    exception
        when Constraint_Error =>
            raise Error_Broadcaster.Unknown_Unary_Message;

    end Send;



    function Send (To_Object : Object.Reference;
                   The_Message : Object.Message;
                   The_Argument : Object.Reference) return Object.Reference is
        Message : Binary_Message;
        Obj : Object.Reference;

    begin
        Message := Translate_To_Binary_Message (The_Message);
        case Message is
            when Plus =>
                Obj.Identity := To_Object.Identity + The_Argument.Identity;
                Obj.Class := Object.Tiny_Integer;
            when Minus =>
                Obj.Identity := To_Object.Identity - The_Argument.Identity;
                Obj.Class := Object.Tiny_Integer;
            when Mul =>
                Obj.Identity := To_Object.Identity * The_Argument.Identity;
                Obj.Class := Object.Tiny_Integer;
            when Div =>
                if The_Argument.Identity /= 0 then
                    Obj.Identity := To_Object.Identity / The_Argument.Identity;
                    Obj.Class := Object.Tiny_Integer;
                else
                    raise Error_Broadcaster.Divide_By_Zero;  
                end if;
            when Less =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Greater =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Equal =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Less_Equal =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Greater_Equal =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Different =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
        end case;
        return Obj;  
    exception
        when Error_Broadcaster.Unknown_Binary_Message =>  
            raise Error_Broadcaster.Integer_Bad_Type;  
        when Error_Broadcaster.Divide_By_Zero =>
            Error_Broadcaster.Dividebyzero;
            raise Error_Broadcaster.Divide_By_Zero;
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Argument : Object.Parameters.List)
                  return Object.Reference is

        Bloc_Object, Iteration_Object, Bound_Object, Obj :
           Object.Reference := To_Object;
        Local_Argument : Object.Parameters.List := The_Argument;
        Bloc_Argument : Object.Parameters.List;
        The_Message, Iteration_Message : Object.Message;
    begin
        Bounded_String.Copy (The_Message, "valeur");
        if (String_Utilities.Equal
               (Bounded_String.Image
                   (Object.Parameters.Selector (Local_Argument)),
                "fois:", True)) then
            Object.Parameters.Get (Local_Argument, Bloc_Object);
            while (Iteration_Object.Identity /= 0) loop
                Obj := (Object.Send (Bloc_Object, The_Message));
                Iteration_Object.Identity := Iteration_Object.Identity - 1;
            end loop;
            return Obj;

        elsif (String_Utilities.Equal
                  (Bounded_String.Image
                      (Object.Parameters.Selector (Local_Argument)),
                   "a:repeter:", True)) then
            Bounded_String.Copy (The_Message, "valeur:");
            Object.Parameters.Get (Local_Argument, Bound_Object);
            Object.Parameters.Get (Local_Argument, Bloc_Object);
            Object.Parameters.Add (The_Message, Obj, Bloc_Argument);
            Object.Parameters.Get (Bloc_Argument, Obj);

            if (Bound_Object.Identity >= To_Object.Identity) then

                while (Iteration_Object.Identity <= Bound_Object.Identity) loop
                    Object.Parameters.Add (Iteration_Message,
                                           Iteration_Object, Bloc_Argument);
                    Obj := Object.Send (Bloc_Object, Bloc_Argument);
                    Iteration_Object.Identity := Iteration_Object.Identity + 1;
                    Object.Parameters.Get (Bloc_Argument, Obj);
                end loop;
                return Iteration_Object;
            elsif (Bound_Object.Identity < To_Object.Identity) then

                while (Iteration_Object.Identity >= Bound_Object.Identity) loop
                    Object.Parameters.Add (Iteration_Message,
                                           Iteration_Object, Bloc_Argument);
                    Obj := Object.Send (Bloc_Object, Bloc_Argument);
                    Iteration_Object.Identity := Iteration_Object.Identity - 1;
                    Object.Parameters.Get (Bloc_Argument, Obj);
                end loop;
                return Iteration_Object;
            end if;
        else  
            raise Error_Broadcaster.Unknown_Keyword_Message;
        end if;
        return To_Object;
    end Send;
end Integer_Class;