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

⟦f25777eaa⟧ TextFile

    Length: 7594 (0x1daa)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Arguments;
with Block_Class;
with Msg_Report;
with Object;
with String_Class;
with String_Utilities;

package body Boolean_Class is

    function Is_Equal_String
                (Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
                return Boolean renames String_Utilities.Equal;


    -- creation d'un objet booleen
    -- ===========================

    function Create (Value : Boolean) return Object.Reference is

        use Object;

        Val : Integer;

    begin  
        if Value then
            Val := 1;
        else
            Val := 0;
        end if;

        return Object.Create (C_Boolean, Val);

    end Create;


    function Unary_Msg_Not (The_Object : Object.Reference)
                           return Object.Reference is
        Value : Integer;

    begin
        Value := Object.Identificator (The_Object);
        if Value = 0 then
            return Create (True);
        else
            return Create (False);
        end if;

    end Unary_Msg_Not;


    function Unary_Msg_Image (The_Object : Object.Reference)
                             return Object.Reference is
        Value : Integer;

    begin
        Value := Object.Identificator (The_Object);
        if Value = 0 then
            Msg_Report.Information ("Boolean object = False");
            return String_Class.Create (Predefined_False);
        else
            Msg_Report.Information ("Boolean object = True");
            return String_Class.Create (Predefined_True);
        end if;

    end Unary_Msg_Image;


    function Binary_Msg_Or (The_Object : Object.Reference; Arg_Value : Integer)
                           return Object.Reference is
        Value : Integer;

    begin
        Value := Object.Identificator (The_Object);
        if (Value = 1) or (Arg_Value = 1) then
            return Create (True);
        else
            return Create (False);
        end if;

    end Binary_Msg_Or;


    function Binary_Msg_And (The_Object : Object.Reference; Arg_Value : Integer)
                            return Object.Reference is
        Value : Integer;

    begin
        Value := Object.Identificator (The_Object);
        if (Value = 1) and (Arg_Value = 1) then
            return Create (True);
        else
            return Create (False);
        end if;

    end Binary_Msg_And;


    function Keyword_Msg_If_True (The_Object, Arg_Object : Object.Reference)
                                 return Object.Reference is
        use Object;

        Value : Integer;
        New_Msg : Message.Selector;

    begin
        Value := Object.Identificator (The_Object);
        if (Value = 1) then
            Message.Copy (New_Msg, Block_Class.Evaluate_Msg);
            return Block_Class.Send (Arg_Object, New_Msg);
        else
            return Object.Void_Reference;
        end if;

    end Keyword_Msg_If_True;


    function Keyword_Msg_If_False (The_Object, Arg_Object : Object.Reference)
                                  return Object.Reference is
        use Object;

        Value : Integer;
        New_Msg : Message.Selector;

    begin
        Value := Object.Identificator (The_Object);
        if (Value = 0) then
            Message.Copy (New_Msg, Block_Class.Evaluate_Msg);
            return Block_Class.Send (Arg_Object, New_Msg);
        else
            return Object.Void_Reference;
        end if;

    end Keyword_Msg_If_False;


    -- envoi d'un message a un objet booleen
    -- =====================================

    function Send (To_Object : Object.Reference;
                   The_Message : Message.Selector;
                   With_Arguments : Arguments.List := Arguments.Void_Arguments)
                  return Object.Reference is

        use Object;

        Nb_Argument : Natural;

        Msg_List, Msg : Message.Selector := Message.Void_Selector;

        Arg_Object, Temporary_Result : Object.Reference;
        Result : Object.Reference := Object.Void_Reference;
        Arg_Value : Integer;
        Arg_List : Arguments.List;

    begin
        Nb_Argument := Arguments.How_Many (With_Arguments);

        if Nb_Argument = 0 then

            -- reception d'un message unaire

            if Is_Equal_String (Message.Image (The_Message), "Non") then

                Msg_Report.Information ("Boolean object: unary message -> Non");
                Result := Unary_Msg_Not (To_Object);

            elsif Is_Equal_String (Message.Image (The_Message), "EnTexte") then

                Msg_Report.Information
                   ("Boolean object: unary message -> Entexte");
                Result := Unary_Msg_Image (To_Object);

            else

                Msg_Report.Interpret_Error
                   ("Incorrect unary method " &
                    Message.Image (The_Message) & " for Boolean object");

                raise Incorrect_Method;
            end if;

        elsif not Message.Is_Keyword (The_Message) then

            -- reception d'un message binaire

            Arg_List := With_Arguments;

            Arguments.First (Arg_List);
            Arguments.Read (Arg_List, Arg_Object);
            Arg_Value := Object.Identificator (Arg_Object);

            if Is_Equal_String (Message.Image (The_Message), "|") then

                Msg_Report.Information ("Boolean object: binary message -> |");
                Result := Binary_Msg_Or (To_Object, Arg_Value);

            elsif Is_Equal_String (Message.Image (The_Message), "&") then

                Msg_Report.Information ("Boolean object: binary message -> &");
                Result := Binary_Msg_And (To_Object, Arg_Value);

            else

                Msg_Report.Interpret_Error
                   ("Incorrect binary method " &
                    Message.Image (The_Message) & " for Boolean object");

                raise Incorrect_Method;
            end if;

        else

            -- reception d'un message a mots cles

            Message.Cat (Msg_List, The_Message);

            Arg_List := With_Arguments;

            Arguments.First (Arg_List);

            while (Nb_Argument /= 0) loop

                Arguments.Read (Arg_List, Arg_Object);
                Nb_Argument := Nb_Argument - 1;

                Message.Extract_Keyword (Msg_List, Msg);

                if Is_Equal_String (Message.Image (Msg), "SiVrai") then

                    Msg_Report.Information
                       ("Boolean object: keyword message -> SiVrai:");
                    Temporary_Result := Keyword_Msg_If_True
                                           (To_Object, Arg_Object);
                    if Temporary_Result /= Object.Void_Reference then
                        Result := Temporary_Result;
                    end if;

                elsif Is_Equal_String (Message.Image (Msg), "SiFaux") then

                    Msg_Report.Information
                       ("Boolean object: keyword message -> SiFaux:");
                    Temporary_Result := Keyword_Msg_If_False
                                           (To_Object, Arg_Object);
                    if Temporary_Result /= Object.Void_Reference then
                        Result := Temporary_Result;
                    end if;

                else
                    -- message inexistant
                    Msg_Report.Interpret_Error
                       ("Incorrect keyword method " &
                        Message.Image (Msg) & " for Boolean object");

                    raise Incorrect_Method;
                end if;

            end loop;

        end if;

        return Result;

    end Send;

end Boolean_Class;