DataMuseum.dk

top - download

    Length: 3396 (0xd44)
    Types: TextFile
    Names: »B«

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

TextFile

with Bounded_String;

package body Class_Boolean is

    function "and" (Left : Object.Reference; Right : Object.Reference)
                   return Object.Reference is
        use Object;
    begin  
        if Left.Id_Class /= Bool or else Right.Id_Class /= Bool then
            return Object.Reference'(Id_Class => Object.Void, Id_Object => 0);
        elsif Left.Id_Object = 1 and Right.Id_Object = 1 then
            return Object.Reference'(Id_Class => Object.Bool, Id_Object => 1);
        else
            return Object.Reference'(Id_Class => Object.Bool, Id_Object => 0);
        end if;
    end "and";

    function "or" (Left : Object.Reference; Right : Object.Reference)
                  return Object.Reference is
        use Object;
    begin
        if Left.Id_Class /= Bool or else Right.Id_Class /= Bool then
            return Object.Reference'(Id_Class => Object.Void, Id_Object => 0);
        elsif Left.Id_Object = 0 and Right.Id_Object = 0 then
            return Object.Reference'(Id_Class => Object.Bool, Id_Object => 0);
        else
            return Object.Reference'(Id_Class => Object.Bool, Id_Object => 1);
        end if;
    end "or";

    function If_True_Bloc (Left : Object.Reference; Right : Object.Reference)
                          return Object.Reference is
        use Object;
    begin
        if Left.Id_Class /= Bool or else Right.Id_Class /= Bool then
            return Object.Reference'(Id_Class => Object.Void, Id_Object => 0);
        elsif Left.Id_Object = 0 and Right.Id_Object = 0 then
            return Object.Reference'(Id_Class => Object.Bool, Id_Object => 0);
        else
            return Object.Reference'(Id_Class => Object.Bool, Id_Object => 1);
        end if;
    end If_True_Bloc;

    function Send (This_Message : Object.Message; To : Object.Reference)
                  return Object.Reference is
        type Message is (If_True_Bloc, If_False_Bloc, If_True_Bloc_Else_Bloc,
                         And_Boolean, Or_Boolean, Xor_Boolean, Boolean_Not);
        Token : Message;
        package Name renames Object.Message_Name_List;
        package Argument renames Object.Message_Argument_List;
    begin

        if not Name.Is_Empty (This_Message.Name) then
            begin
                Token := Message'Value (Bounded_String.Image
                                           (Name.First (This_Message.Name)));
                case Token is
                    when If_True_Bloc =>
                        null;
                    when If_False_Bloc =>
                        null;
                    when If_True_Bloc_Else_Bloc =>
                        null;
                    when And_Boolean =>
                        return To & (Argument.First (This_Message.Argument));
                    when Or_Boolean =>
                        null;
                    when Xor_Boolean =>
                        null;
                    when Boolean_Not =>
                        null;
                end case;
            exception
                when Constraint_Error =>
                    return Object.Reference'
                              (Id_Class => Object.Void, Id_Object => 0);
            end;
        end if;
    end Send;

    function Create return Object.Reference is  
    begin
        return Object.Reference'(Id_Class => Object.Bool, Id_Object => 0);

    end Create;
end Class_Boolean;