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

⟦002931737⟧ TextFile

    Length: 13039 (0x32ef)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Class_Block;
with Class_String;
with Class_Printer;
with Bounded_String;
with String_Utilities;
with Text_Io;
with Random;
with Bug_Report;

package body Class_Integer is
    function Send (This_Message : Message.Unary; To : Object.Reference)
                  return Object.Reference is
        type E_Message is (Moins, Entexte, Image, Attend, Auhasard);

        Token : E_Message;

        A_Handle : Random.Handle;

        package Bs renames Bounded_String;
        package Su renames String_Utilities;

        use Object;

    begin
        Token := E_Message'Value (Bs.Image (Message.Get (This_Message)));
        case Token is
            when Entexte =>
                Put (To);
                return To;  
            when Image =>
                return Class_String.Create
                          (Bs.Value
                              (Su.Number_To_String
                                  (Value =>
                                      Integer (Object.Get (Index_From => To))),
                               80));
            when Moins =>  
                return Create (-Object.Index'(Object.Get (Index_From => To)));
            when Attend =>
                delay (Duration (Object.Index'(Object.Get (Index_From => To))));
                return To;
            when Auhasard =>
                Random.Initialize (The_Handle => A_Handle);
                return Create
                          (Object.Index
                              (Random.Natural_Value
                                  (The_Handle => A_Handle,
                                   Max => Natural
                                             (Object.Get (Index_From => To)))));

        end case;
    exception
        when Constraint_Error =>
            raise Bug_Report.Unknown_Unary_Message;
    end Send;

    function Send (This_Message : Message.Binary; To : Object.Reference)
                  return Object.Reference is
        type E_Message is (Plus, Moins, Mul, Div, Egal, Diff,
                           Sup, Sup_Egal, Inf, Inf_Egal);

        Token : E_Message;

        package Bs renames Bounded_String;

        use Object;

    begin
        if Object.Get (Class_From =>
                          Message.Get (Argument_From => This_Message)) =
           Object.Integer_Class then
            begin
                Token := E_Message'Value (Bs.Image
                                             (Message.Get (This_Message)));
                case Token is
                    when Plus =>
                        return Create (Object.Get (Index_From => To) +
                                       Object.Get (Index_From =>
                                                      Message.Get
                                                         (Argument_From =>
                                                             This_Message)));
                    when Moins =>
                        return Create (Object.Get (Index_From => To) -
                                       Object.Get (Index_From =>
                                                      Message.Get
                                                         (Argument_From =>
                                                             This_Message)));
                    when Mul =>
                        return Create (Object.Get (Index_From => To) *
                                       Object.Get (Index_From =>
                                                      Message.Get
                                                         (Argument_From =>
                                                             This_Message)));
                    when Div =>  
                        if Object.Get
                              (Index_From =>
                                  Message.Get (Argument_From => This_Message)) =
                           0 then
                            raise Bug_Report.Divide_By_Zero;
                        end if;
                        return Create (Object.Get (Index_From => To) /
                                       Object.Get (Index_From =>
                                                      Message.Get
                                                         (Argument_From =>
                                                             This_Message)));
                    when Egal =>
                        if Object.Index'(Object.Get (Index_From => To)) =
                           Object.Get (Index_From =>
                                          Message.Get (Argument_From =>
                                                          This_Message)) then

                            return Object.Create (Object.Boolean_Class, 1);
                        else
                            return Object.Create (Object.Boolean_Class, 0);
                        end if;

                    when Diff =>
                        if Object.Index'(Object.Get (Index_From => To)) /=
                           Object.Get (Index_From =>
                                          Message.Get (Argument_From =>
                                                          This_Message)) then

                            return Object.Create (Object.Boolean_Class, 1);
                        else
                            return Object.Create (Object.Boolean_Class, 0);
                        end if;
                    when Sup =>
                        if Object.Index'(Object.Get (Index_From => To)) >
                           Object.Get (Index_From =>
                                          Message.Get (Argument_From =>
                                                          This_Message)) then

                            return Object.Create (Object.Boolean_Class, 1);
                        else
                            return Object.Create (Object.Boolean_Class, 0);
                        end if;

                    when Sup_Egal =>
                        if Object.Index'(Object.Get (Index_From => To)) >=
                           Object.Get (Index_From =>
                                          Message.Get (Argument_From =>
                                                          This_Message)) then

                            return Object.Create (Object.Boolean_Class, 1);
                        else
                            return Object.Create (Object.Boolean_Class, 0);
                        end if;
                    when Inf =>
                        if Object.Index'(Object.Get (Index_From => To)) <
                           Object.Get (Index_From =>
                                          Message.Get (Argument_From =>
                                                          This_Message)) then

                            return Object.Create (Object.Boolean_Class, 1);
                        else
                            return Object.Create (Object.Boolean_Class, 0);
                        end if;
                    when Inf_Egal =>
                        if Object.Index'(Object.Get (Index_From => To)) <=
                           Object.Get (Index_From =>
                                          Message.Get (Argument_From =>
                                                          This_Message)) then

                            return Object.Create (Object.Boolean_Class, 1);
                        else
                            return Object.Create (Object.Boolean_Class, 0);
                        end if;
                end case;
            exception
                when Constraint_Error =>
                    raise Bug_Report.Unknown_Binary_Message;
            end;
        else
            raise Bug_Report.Integer_Bad_Type;
        end if;
    end Send;


    function Send (This_Message : Message.Keyword; To : Object.Reference)
                  return Object.Reference is
        type E_Message is (Fois, Repeter, Puissance);

        Token : E_Message;

        Mess : Message.Keyword := This_Message;
        Unar : Message.Unary;
        Kwd : Message.Keyword;

        Val : Object.Tiny_String;

        package Bs renames Bounded_String;  
        package Su renames String_Utilities;


    begin
        Bs.Copy (Val, Bs.Value ("Valeur"));
        Message.Init (Mess);
        declare
            Result : Object.Reference;
            Block : Object.Reference;
            A, B : Object.Index;
            use Object;
        begin
            Token := E_Message'Value (Bs.Image (Message.Get (Mess)));
            case Token is
                when Fois =>
                    if Object.Get (Class_From =>
                                      Message.Get (Argument_From => Mess)) =
                       Object.Block_Class then

                        Message.Put (This_Name => Val, Into => Unar);
                        for I in 1 .. Object.Get (Index_From => To) loop
                            Result := Class_Block.Send
                                         (Unar, Message.Get
                                                   (Argument_From => Mess));
                        end loop;  
                        if Object.Get (Index_From => To) < 1 then
                            return To;
                        else
                            return Result;
                        end if;
                    else
                        raise Bug_Report.Integer_Bad_Type;
                    end if;

                when Repeter =>  
                    if Object.Get (Class_From =>
                                      Message.Get (Argument_From => Mess)) =
                       Object.Block_Class then

                        Block := Message.Get (Argument_From => Mess);
                        Message.Next (Mess);
                        if Su.Equal (Bs.Image (Message.Get (Name_From => Mess)),
                                     "a", True) then
                            A := Object.Get (Index_From => To);
                            B := Object.Get
                                    (Index_From => Message.Get
                                                      (Argument_From => Mess));
                            if A < B then
                                for I in A .. B loop
                                    Message.Free (This => Kwd);
                                    Message.Put (This_Name => Val, Into => Kwd);
                                    Message.Put (This_Argument =>
                                                    Create (Value => I),
                                                 Into => Kwd);
                                    Result := Class_Block.Send (Kwd, Block);
                                end loop;
                            else
                                for I in reverse B .. A loop
                                    Message.Free (This => Kwd);
                                    Message.Put (This_Name => Val, Into => Kwd);
                                    Message.Put (This_Argument =>
                                                    Create (Value => I),
                                                 Into => Kwd);
                                    Result := Class_Block.Send (Kwd, Block);
                                end loop;
                            end if;
                        else
                            raise Bug_Report.Unknown_Keyword_Message;
                        end if;
                        return Result;  
                    else
                        raise Bug_Report.Integer_Bad_Type;
                    end if;

                when Puissance =>
                    if Object.Get (Class_From =>
                                      Message.Get (Argument_From => Mess)) =
                       Object.Integer_Class then

                        return Create (Object.Index
                                          (Integer (Object.Get
                                                       (Index_From => To)) **
                                           Integer (Object.Get
                                                       (Index_From =>
                                                           Message.Get
                                                              (Argument_From =>
                                                                  Mess)))));
                    else
                        raise Bug_Report.Integer_Bad_Type;
                    end if;

            end case;

        exception
            when Constraint_Error =>
                raise Bug_Report.Unknown_Keyword_Message;
        end;
    end Send;


    function Create (Value : Object.Index := 0) return Object.Reference is
    begin
        return Object.Create (Object.Integer_Class, Value);
    end Create;

    procedure Put (An_Object : Object.Reference) is
    begin
        Class_Printer.Put ("Objet Entier { Valeur =>" &
                           Object.Index'Image (Object.Get (An_Object)) & " }");
        Class_Printer.New_Line (2);
    end Put;

end Class_Integer;