DataMuseum.dk

top - download

    Length: 4926 (0x133e)
    Types: TextFile
    Names: »B«

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

TextFile

with Object, Argument, Message, Bloc,
     Boolean_Classe, Bounded_String, Table, Text_Io;
package body Bloc_Classe is

    function Search_Empty return Id_Bloc_Table is
        Id : Id_Bloc_Table := 1;
    begin
        loop
            exit when Bloc_Table (Id) = Empty_Bloc;
            Id := Id + 1;
        end loop;
        return (Id);
    end Search_Empty;

    function Search (A_Bloc : Object.Reference) return Id_Bloc_Table is
        Id : Id_Bloc_Table := 1;
    begin
        loop
            exit when Object.Equal (Bloc_Table (Id).The_Object, A_Bloc);
            Id := Id + 1;
        end loop;
        return (Id);
    end Search;

    function Search (A_Bloc : Object.Reference) return Bloc.Node is
        Id : Id_Bloc_Table := 1;
    begin
        loop
            exit when Object.Equal (Bloc_Table (Id).The_Object, A_Bloc);
            Id := Id + 1;
        end loop;
        return (Bloc_Table (Id).The_Bloc);
    end Search;


    procedure Remove (A_Bloc : Object.Reference) is  
        Id : Id_Bloc_Table;
    begin
        Id := Search (A_Bloc);
        Bloc_Table (Id).The_Object := Object.Void_Reference;
        Bloc_Table (Id).The_Bloc := Bloc.Empty_Node;
    end Remove;

    function Create (Value : Bloc.Node) return Object.Reference is
        Id : Id_Bloc_Table;  
        Obj : Object.Reference;
    begin
        Id := Search_Empty;  
        Obj := Object.Create (Object.Bloc_Classe, Id);
        Bloc_Table (Id).The_Object := Obj;
        Bloc_Table (Id).The_Bloc := Value;
        return (Obj);
    end Create;

    function Valeur (Blk : Object.Reference) return Object.Reference is
        The_Bloc : Bloc.Node;
        Obj : Object.Reference;  
    begin  
        Text_Io.Put_Line ("bloc_classe receive message valeur");
        The_Bloc := Search (Blk);  
        Object.En_Texte (Blk);
        Obj := Bloc.Interpret (The_Bloc);
        return (Obj);
    end Valeur;


    function Valeurs (Blk : Object.Reference;  
                      The_Messsages : Message.List;
                      With_Arguments : Argument.List) return Object.Reference is
        The_Bloc : Bloc.Node;
        Obj : Object.Reference;
    begin  
        The_Bloc := Search (Blk);

        Obj := Bloc.Interpret (N => The_Bloc);
        return (Obj);
    end Valeurs;

    function Send (To_Object : Object.Reference;
                   The_Messages : Message.List;
                   With_Arguments : Argument.List) return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;
        The_Bloc_Node : Bloc.Node;
        Keywords, Identifiers : Message.List;
        S_Table : Table.Symbol_Kind;
        A_Message, A_Identifier, A_Keyword : Message.Tiny_String;
        A_Argument : Object.Reference;  
        Mess : Message.List;
        Args : Argument.List;
        Failed : Boolean := False;
        Nb_Mess : Natural;
    begin  
        Mess := The_Messages;
        Args := With_Arguments;
        Object.En_Texte (To_Object);
        The_Bloc_Node := Search (To_Object);  
        Keywords := Bloc.Keyword_List (The_Bloc_Node);
        Identifiers := Bloc.Identifier_List (The_Bloc_Node);
        S_Table := Bloc.Symbol (The_Bloc_Node);  
        Nb_Mess := Message.How_Many (The_Messages);
        for I in 1 .. Nb_Mess loop
            A_Message := Message.Get (Mess);
            A_Argument := Argument.Get (Args);
            if Bounded_String.Image (A_Message) = Message_Valeurs then
                A_Identifier := Message.Get (Identifiers);
                Table.Insert (S_Table, A_Identifier, A_Argument);
            else
                A_Keyword := Message.Get (Keywords);
                if Bounded_String.Image (A_Keyword) =
                   Bounded_String.Image (A_Message) then
                    A_Identifier := Message.Get (Identifiers);
                    Table.Insert (S_Table, A_Identifier, A_Argument);

                else
                    Failed := True;
-- ERROR
                end if;
            end if;  
            if not Failed then
                Message.Next (Identifiers, A_Identifier);
                Message.Next (Keywords, A_Keyword);
                Argument.Next (Args, A_Argument);
                Message.Next (Mess, A_Message);
            end if;
        end loop;  
        if not Failed then
            Result := Valeur (To_Object);
        end if;
        return (Result);
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Message : Message.Tiny_String) return Object.Reference is
        Result : Object.Reference;
    begin
        if Bounded_String.Image (The_Message) = Message_Valeur then
            Result := Valeur (To_Object);
        end if;
        return (Result);
    end Send;

begin

    for I in Id_Bloc_Table loop
        Bloc_Table (I).The_Bloc := Bloc.Empty_Node;
        Bloc_Table (I).The_Object := Object.Void_Reference;
    end loop;
end Bloc_Classe;