DataMuseum.dk

top - download

    Length: 7496 (0x1d48)
    Types: TextFile
    Names: »B«

└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Class_Block;
with Bounded_String;
with Object;
with String_Utilities;
with Text_Io;

package body Class_Boolean is

    function Send (This_Message : Object.Unary; To : Object.Reference)
                  return Object.Reference is
        type Message is (En_Texte, Non);

        Token : Message;

        package Bs renames Bounded_String;
        package Su renames String_Utilities;

    begin  
        if Bs.Length (This_Message) /= 0 then
            declare
                use Object;
                An_Object : Object.Reference := To;
            begin
                Token := Message'Value (Bs.Image (This_Message));
                case Token is
                    when Non =>
                        if Object.Index'(Object.Get (An_Object)) = 1 then
                            Object.Put (0, An_Object);
                        else
                            Object.Put (1, An_Object);
                        end if;
                        return An_Object;
                    when En_Texte =>
                        Text_Io.Put ("Objet Boolean (");
                        Text_Io.New_Line;

                        Text_Io.Put ("    Classe =>");
                        Text_Io.Put (Object.E_Class'Image (Object.Get (To)));
                        Text_Io.New_Line;

                        Text_Io.Put ("    Objet =>");
                        Text_Io.Put (Object.Index'Image (Object.Get (To)));
                        Text_Io.New_Line;

                        Text_Io.Put (" )");
                        Text_Io.New_Line (2);
                end case;
            exception
                when Constraint_Error =>
                    return Object.Void_Reference;
            end;
        end if;
    end Send;


    function Send (This_Message : Object.Binary; To : Object.Reference)
                  return Object.Reference is

        type Message is (Et, Ou, Eou);

        Token : Message;
        The_Message : Object.Binary := This_Message;

        package Bs renames Bounded_String;
        package Su renames String_Utilities;

    begin
        if Bs.Length (Object.Get (This_Message)) /= 0 then
            declare
                use Object;
                An_Object : Object.Reference := To;
                Value : Object.Index;
            begin
                Token := Message'Value (Bs.Image (Object.Get (This_Message)));
                case Token is
                    when Et =>
                        if Object.Get (An_Object) = 1 and
                           Object.Get (Object.Get (This_Message)) = 1 then
                            Object.Put (1, An_Object);
                        else
                            Object.Put (0, An_Object);
                        end if;
                        return An_Object;
                    when Ou =>
                        if Object.Get (An_Object) = 1 or
                           Object.Get (Object.Get (This_Message)) = 1 then
                            Object.Put (1, An_Object);
                        else
                            Object.Put (0, An_Object);
                        end if;
                        return An_Object;
                    when Eou =>
                        if Object.Get (An_Object) = 1 xor
                           Object.Get (Object.Get (This_Message)) = 1 then
                            Object.Put (1, An_Object);
                        else
                            Object.Put (0, An_Object);
                        end if;
                        return An_Object;
                end case;
            exception
                when Constraint_Error =>
                    return Object.Void_Reference;
            end;
        end if;
    end Send;


    function Send (This_Message : Object.Keyword; To : Object.Reference)
                  return Object.Reference is

        type Message is (Sivrai, Sifaux, Sinon);

        Token : Message;
        The_Message : Object.Keyword := This_Message;

        package Bs renames Bounded_String;
        package Su renames String_Utilities;

    begin
        if Bs.Length (Object.Get (This_Message)) /= 0 then
            declare
                use Object;
                Value : Object.Reference;
            begin
                Token := Message'Value (Bs.Image (Object.Get (This_Message)));
                case Token is
                    when Sivrai =>
                        if Object.Get (To) = 1 then
                            Object.Free (The_Message); -- ???
                            return Class_Block.Send (The_Message, To);
                        else
                            Object.Next (The_Message);
                            if (Bs.Length (Object.Get (This_Message)) /=
                                0) and then
                               Message'Value
                                  (Bs.Image (Object.Get (This_Message))) =
                               Message (Sinon) then
                                Object.Free (The_Message); -- ???
                                return Class_Block.Send (This_Message, To);
                            else
                                return Object.Create
                                          (Class => Object.Boolean_Class,
                                           Object => 0);
                            end if;
                        end if;
                    when Sifaux =>
                        if Object.Get (To) = 0 then
                            Object.Free (The_Message); -- ???
                            return Class_Block.Send (This_Message, To);
                        else
                            return Object.Create (Class => Object.Boolean_Class,
                                                  Object => 0);
                        end if;
                    when Sinon =>
                        null;
                end case;
            exception
                when Constraint_Error =>
                    return Object.Void_Reference;
            end;
        end if;
    end Send;


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


    function Image (Objet : Object.Reference) return Object.Tiny_String is
        use Object;
        Chaine : Object.Tiny_String;
        Valeur : Object.Index;
    begin
        Valeur := Object.Get (Objet);
        Bounded_String.Copy (Chaine, String_Utilities.Number_To_String
                                        (Value => Integer (Valeur)));
        return Chaine;
    end Image;


    function Value (Chaine : Object.Tiny_String) return Object.Reference is
        An_Object : Object.Reference;
        Bool : Boolean;
        Entier : Integer;
    begin
        String_Utilities.String_To_Number
           (Source => Bounded_String.Image (Chaine),
            Worked => Bool,
            Target => Entier);
        Object.Put (Object.Boolean_Class, An_Object);
        Object.Put (Object.Index (Entier), An_Object);
        return An_Object;
    end Value;


    function True return Object.Reference is
    begin
        return Object.Create (Class => Object.Boolean_Class, Object => 1);
    end True;


    function False return Object.Reference is
    begin
        return Object.Create (Class => Object.Boolean_Class, Object => 0);
    end False;

end Class_Boolean;