DataMuseum.dk

top - download

    Length: 5870 (0x16ee)
    Types: TextFile
    Names: »B«

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

TextFile

with Object;
with Class_Block;
with Bounded_String;  
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;

        Mess : Object.Unary := This_Message;

        package Bs renames Bounded_String;

    begin

        Object.Init (Mess);
        if not Object.Is_Done (Mess) then
            declare
                use Object;
            begin
                Token := Message'Value (Bs.Image (Object.Get (Mess)));
                case Token is
                    when Non =>
                        if Object.Get (To) = 1 then
                            return False;
                        else
                            return True;
                        end if;
                    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);  
                        return To;
                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;

        Mess : Object.Binary := This_Message;

        package Bs renames Bounded_String;

        Value : Object.Index;

    begin
        if Bs.Length (Object.Get (Mess)) /= 0 then
            declare
                use Object;
            begin
                Token := Message'Value (Bs.Image (Object.Get (Mess)));
                case Token is
                    when Et =>
                        if Object.Get (To) = 1 and
                           Object.Get (Object.Get (Mess)) = 1 then
                            return True;
                        else
                            return False;
                        end if;
                    when Ou =>
                        if Object.Get (To) = 1 or
                           Object.Get (Object.Get (This_Message)) = 1 then
                            return True;
                        else
                            return False;
                        end if;
                    when Eou =>
                        if Object.Get (To) = 1 xor
                           Object.Get (Object.Get (This_Message)) = 1 then
                            return True;
                        else
                            return False;
                        end if;
                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);

        Token : Message;

        Mess : Object.Keyword := This_Message;
        Run : Object.Unary;

        package Bs renames Bounded_String;
        Val : Object.Tiny_String;

    begin  
        Bs.Copy (Val, Bs.Value ("Valeur"));
        Object.Init (Mess);
        Object.Put (This => Val, Into => Run);
        Object.Init (This => Run);
        while not Object.Is_Done (Mess) loop
            declare
                use Object;
            begin

                Token := Message'Value (Bs.Image (Object.Get (Mess)));

                case Token is
                    when Sivrai =>
                        if Object.Get (To) = 1 then
                            Object.Next (Mess);
                            return Class_Block.Send (Run, To);
                        end if;
                    when Sifaux =>
                        if Object.Get (To) = 0 then
                            Object.Next (Mess);
                            return Class_Block.Send (Run, To);
                        end if;
                end case;
            exception
                when Constraint_Error =>
                    return Object.Void_Reference;
            end;
        end loop;
    end Send;


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


    function Image (An_Object : Object.Reference) return Object.Tiny_String is
        use Object;
        Valeur : Object.Index;
    begin
        Valeur := Object.Get (An_Object);
        return Bounded_String.Value (String_Utilities.Number_To_String
                                        (Value => Integer (Valeur)));
    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);
        return Create (Object.Index (Entier));
    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;