DataMuseum.dk

top - download

    Length: 4485 (0x1185)
    Types: TextFile
    Names: »B«

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

TextFile

with Arguments;
with Block;
with Boolean_Class;
with Message;
with Msg_Report;
with Object;
with String_Utilities;

package body Block_Class is

    Max : constant := 100;

    Instance_Table : array (1 .. Max) of Struct_Table;


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

    function First_Free return Natural is
        Pos : Natural := 0;

    begin
        for I in Instance_Table'Range loop
            if Instance_Table (I).Indic = Unused then
                Pos := I;
                exit;
            end if;
        end loop;

        if Pos /= 0 then
            return Pos;
        else  
            Msg_Report.Interpret_Error ("sorry, block instance table is full");
            raise Instance_Table_Full;
        end if;

    end First_Free;



    function Create (Value : Block.Node) return Object.Reference is  
        Pos : Natural;
        The_Class : Object.Class := Object.C_Block;

    begin
        Pos := First_Free;
        Instance_Table (Pos).Indic := Used;
        Instance_Table (Pos).Value := Value;
        return Object.Create (The_Class, Pos);  
    end Create;


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

        Result : Object.Reference;
        N : Block.Node;  
        Msg : Message.Selector;

        Evaluate_Msg_While_True : constant String := "Tantquevrai";  
        Evaluate_Msg_While_False : constant String := "Tantquefaux";

        use Object;
    begin

        N := Instance_Table (Object.Identificator (To_Object)).Value;

        if Message.Is_Keyword (The_Message) then

            if Is_Equal_String (Message.Format (The_Message),
                                Evaluate_Msg_While_True) then

                loop  
                    Message.Copy (Msg, Evaluate_Msg);
                    Result := Send (To_Object, Msg);

                    if Object.The_Class (Result) = C_Boolean then
                        Message.Copy (Msg, Boolean_Class.Evaluate_Msg_Is_True);  
                        Result := Boolean_Class.Send
                                     (Result, Msg, With_Arguments);
                        if Object.The_Class (Result) = C_Void then
                            exit;
                        end if;
                    else
                        Msg_Report.Interpret_Error
                           ("Incorrect return block object, must be a boolean not " &
                            Object.Class'Image (Object.The_Class (Result)));
                        raise Incorrect_Return_Object;
                    end if;  
                end loop;

            elsif Is_Equal_String (Message.Format (The_Message),
                                   Evaluate_Msg_While_False) then

                loop  
                    Message.Copy (Msg, Evaluate_Msg);
                    Result := Send (To_Object, Msg);

                    if Object.The_Class (Result) = C_Boolean then
                        Message.Copy (Msg, Boolean_Class.Evaluate_Msg_Is_False);
                        Result := Boolean_Class.Send
                                     (Result, Msg, With_Arguments);
                        if Object.The_Class (Result) = C_Void then
                            exit;
                        end if;
                    else
                        Msg_Report.Interpret_Error
                           ("Incorrect return block object, must be a boolean not " &
                            Object.Class'Image (Object.The_Class (Result)));
                        raise Incorrect_Return_Object;
                    end if;  
                end loop;

            else  
                Result := Block.Interpret
                             (N, To_Object, The_Message, With_Arguments);  
            end if;

        else

            if Is_Equal_String (Message.Image (The_Message), Evaluate_Msg) then
                Result := Block.Interpret (N, To_Object, The_Message);

            else
                Msg_Report.Interpret_Error ("Incorrect block method " &
                                            Message.Image (The_Message));
                raise Incorrect_Method;
            end if;

        end if;

        return Result;
    end Send;

end Block_Class;