DataMuseum.dk

top - download

    Length: 13654 (0x3556)
    Types: TextFile
    Names: »B«

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

TextFile

with Boolean_Class;
with Bounded_String;
with Msg_Report;
with Object;
with Pen_Class;
with Scanner;
with Turtle_Class;

package body Symbol_Table is

    Global_Symbols_Name : constant String := "Global_Symbols";
    Void_Name : constant String := "Void";
    Default_Name : constant String := "No_Name_";

    subtype Symbol_Table_Reference is The_Symbol_Table.Map;

    Symbol_Table_Id : Symbol_Table_Reference;

    Current_Block_Name : Scanner.B_String;
    Current_Block_Number : Natural;


    -- initialiser la table des symboles
    -- =================================

    procedure Create is

        Value : Table_Reference;
        Ident : Scanner.B_String;

    begin  
        The_Symbol_Table.Initialize (Symbol_Table_Id);

        -- inserer le bloc contenant les symboles globaux
        Bounded_String.Copy (Current_Block_Name, Global_Symbols_Name);
        Bounded_String.Copy (Value.Father_Name, Void_Name);

        Block_Table.Initialize (Value.Block_Access);

        The_Symbol_Table.Define
           (Symbol_Table_Id, Bounded_String.Image (Current_Block_Name), Value);

        -- inserer les identificateurs predefinis: Tortue, Stylo, Vrai, Faux, Vide
        Bounded_String.Copy (Ident, Turtle_Class.Predefined_Turtle);
        Insert (Ident, Turtle_Class.Create);

        Bounded_String.Copy (Ident, Pen_Class.Predefined_Pen);
        Insert (Ident, Pen_Class.Create);

        Bounded_String.Copy (Ident, Boolean_Class.Predefined_True);
        Insert (Ident, Boolean_Class.Create (True));

        Bounded_String.Copy (Ident, Boolean_Class.Predefined_False);
        Insert (Ident, Boolean_Class.Create (False));

        Bounded_String.Copy (Ident, Object.Predefined_Void);
        Insert (Ident, Object.Void_Reference);

        -- initialiser le nombre de blocs "sans nom" existants
        Current_Block_Number := 0;

    end Create;


    -- entrer dans un bloc nomme de la table des symboles
    -- ==================================================

    procedure Enter (Block_Name : in Scanner.B_String) is

        Value : Table_Reference;
        Found : Boolean;

    begin
        -- recherche du bloc dans la table des symboles
        The_Symbol_Table.Find (Symbol_Table_Id,
                               Bounded_String.Image (Block_Name), Value, Found);

        if (not Found) then
            -- inserer un nouveau bloc dans la table des symboles
            Bounded_String.Copy (Value.Father_Name, Current_Block_Name);

            Block_Table.Initialize (Value.Block_Access);

            The_Symbol_Table.Define (Symbol_Table_Id,
                                     Bounded_String.Image (Block_Name), Value);
        end if;

        -- mise a jour du nom du nouveau bloc courant
        Bounded_String.Copy (Current_Block_Name, Block_Name);

        Msg_Report.Information ("Current block: " &
                                Bounded_String.Image (Current_Block_Name));

    end Enter;


    -- entrer dans un bloc "sans nom" de la table des symboles
    -- =======================================================

    procedure New_Enter (Block_Name : in out Scanner.B_String) is

        Value : Table_Reference;
        Block_Number : Scanner.B_String;

    begin
        -- incrementer le nombre de blocs "sans nom" existants
        Current_Block_Number := Current_Block_Number + 1;

        -- conversion numero de bloc entier -> chaine
        Bounded_String.Copy (Block_Number,
                             Positive'Image (Current_Block_Number));
        Bounded_String.Delete (Block_Number, 1);

        -- donner au bloc un nom par defaut
        Bounded_String.Copy (Block_Name, Default_Name);
        Bounded_String.Append (Block_Name, Block_Number);

        -- inserer le nouveau bloc "sans nom" dans la table des symboles
        Bounded_String.Copy (Value.Father_Name, Current_Block_Name);

        Block_Table.Initialize (Value.Block_Access);

        The_Symbol_Table.Define (Symbol_Table_Id,
                                 Bounded_String.Image (Block_Name), Value);

        -- mise a jour du nom du nouveau bloc courant
        Bounded_String.Copy (Current_Block_Name, Block_Name);

        Msg_Report.Information ("Current block: " &
                                Bounded_String.Image (Current_Block_Name));

    end New_Enter;


    -- quitter le bloc courant de la table des symboles
    -- ================================================

    procedure Leave is

        Value : Table_Reference;

    begin
        -- recherche du bloc courant
        Value := The_Symbol_Table.Eval
                    (Symbol_Table_Id, Bounded_String.Image
                                         (Current_Block_Name));

        if Bounded_String.Image (Value.Father_Name) /= Void_Name then

            -- mise a jour du nom du nouveau bloc courant
            Bounded_String.Copy (Current_Block_Name, Value.Father_Name);

        end if;

        Msg_Report.Information ("Current block: " &
                                Bounded_String.Image (Current_Block_Name));

    end Leave;


    -- retourne le bloc courant
    -- ========================

    function Current_Block return Scanner.B_String is

    begin
        return Current_Block_Name;

    end Current_Block;


    -- inserer un element dans le bloc courant
    -- =======================================

    procedure Insert (Identifier : Scanner.B_String;
                      Content : Object.Reference) is

        Value : Table_Reference;

    begin
        -- rechercher le bloc courant
        Value := The_Symbol_Table.Eval
                    (Symbol_Table_Id, Bounded_String.Image
                                         (Current_Block_Name));

        -- inserer l'element
        Block_Table.Define (Value.Block_Access,
                            Bounded_String.Image (Identifier), Content);

    end Insert;


    -- rechercher si un identificateur existe dans le bloc courant
    -- ===========================================================

    function Is_Found_In_Block (Identifier : Scanner.B_String) return Boolean is

        Value : Table_Reference;
        Content : Object.Reference;
        Success : Boolean;

    begin
        -- rechercher le bloc courant
        Value := The_Symbol_Table.Eval
                    (Symbol_Table_Id, Bounded_String.Image
                                         (Current_Block_Name));
        -- rechercher l'identificateur
        Block_Table.Find (Value.Block_Access,
                          Bounded_String.Image (Identifier), Content, Success);

        return Success;

    end Is_Found_In_Block;


    -- detruire un identificateur dans le bloc courant
    -- ===============================================

    procedure Remove (Identifier : Scanner.B_String) is

        Value : Table_Reference;

    begin
        -- rechercher le bloc courant
        Value := The_Symbol_Table.Eval
                    (Symbol_Table_Id, Bounded_String.Image
                                         (Current_Block_Name));
        -- retrait de l'identificateur
        Block_Table.Undefine (Value.Block_Access,
                              Bounded_String.Image (Identifier));

    end Remove;


    -- recherche ascendante d'un identificateur dans la table
    -- ======================================================

    procedure Search (Identifier : Scanner.B_String;
                      Search_Block : Table_Reference;
                      Success_Block : out Table_Reference;
                      Success : out Boolean) is

        Father_Block : Table_Reference;

        Cont : Object.Reference;
        Found : Boolean;

    begin
        -- recherche de l'identificateur dans le bloc courant
        Block_Table.Find (Search_Block.Block_Access,
                          Bounded_String.Image (Identifier), Cont, Found);

        if Found then
            -- identificateur trouve
            Success_Block := Search_Block;
            Success := True;

        else
            if Bounded_String.Image (Search_Block.Father_Name) = Void_Name then
                -- fin de recherche, identificateur non trouve
                Success := False;
            else
                -- recherche de l'identificateur dans le bloc pere
                Father_Block := The_Symbol_Table.Eval
                                   (Symbol_Table_Id,
                                    Bounded_String.Image
                                       (Search_Block.Father_Name));

                Search (Identifier, Father_Block, Success_Block, Success);

            end if;
        end if;

    end Search;


    -- rechercher si un identificateur existe dans la table des symboles
    -- =================================================================

    function Is_Found (Identifier : Scanner.B_String) return Boolean is

        Current_Block, Found_Block : Table_Reference;
        Success : Boolean;

    begin
        -- recherche du bloc courant
        Current_Block := The_Symbol_Table.Eval
                            (Symbol_Table_Id, Bounded_String.Image
                                                 (Current_Block_Name));

        -- recherche de l'identificateur dans le bloc courant ou dans un bloc pere
        Search (Identifier, Current_Block, Found_Block, Success);

        return Success;

    end Is_Found;


    -- mise a jour du contenu de l'identificateur dans la table des symboles
    -- =====================================================================

    procedure Set_Info (Identifier : Scanner.B_String;
                        Content : Object.Reference) is

        Current_Block, Found_Block : Table_Reference;
        Found : Boolean;

    begin
        -- recherche du bloc courant
        Current_Block := The_Symbol_Table.Eval
                            (Symbol_Table_Id, Bounded_String.Image
                                                 (Current_Block_Name));

        -- recherche de l'identificateur dans le bloc courant ou dans un bloc pere
        Search (Identifier, Current_Block, Found_Block, Found);

        if Found then
            -- mise a jour du contenu
            Block_Table.Define (Found_Block.Block_Access,
                                Bounded_String.Image (Identifier), Content);
        end if;

    end Set_Info;


    -- lecture du contenu de l'identificateur dans la table des symboles
    -- =================================================================

    function Get_Info (Identifier : Scanner.B_String) return Object.Reference is

        Current_Block, Found_Block : Table_Reference;
        Found : Boolean;

    begin
        -- recherche du bloc courant
        Current_Block := The_Symbol_Table.Eval
                            (Symbol_Table_Id, Bounded_String.Image
                                                 (Current_Block_Name));

        -- recherche de l'identificateur dans le bloc courant ou dans un bloc pere
        Search (Identifier, Current_Block, Found_Block, Found);

        if Found then
            return Block_Table.Eval (Found_Block.Block_Access,
                                     Bounded_String.Image (Identifier));
        end if;

    end Get_Info;


    -- affichage du contenu de la table des symboles
    -- =============================================

    procedure Image_Table is

        Iter : The_Symbol_Table.Iterator;
        Block_Name : Scanner.B_String;
        Value : Table_Reference;

    begin
        -- initialiser l'iterateur
        The_Symbol_Table.Init (Iter, Symbol_Table_Id);

        while not The_Symbol_Table.Done (Iter) loop
            Bounded_String.Copy (Block_Name,
                                 Bounded_String.Value
                                    (The_Symbol_Table.Value (Iter)));

            -- lire le contenu
            Value := The_Symbol_Table.Eval (Symbol_Table_Id,
                                            Bounded_String.Image (Block_Name));

            Msg_Report.Information ("Symbol Table contents");
            Msg_Report.Continue
               ("Block name: " & Bounded_String.Image (Block_Name) &
                ", Father name: " & Bounded_String.Image (Value.Father_Name));

            -- afficher le contenu du bloc
            Image_Block (Block_Name);

            The_Symbol_Table.Next (Iter);

        end loop;

    end Image_Table;


    -- affichage du contenu du bloc courant
    -- ====================================

    procedure Image_Block (Block_Name : Scanner.B_String) is

        Iter : Block_Table.Iterator;
        Name : Scanner.B_String;
        Value : Table_Reference;
        Content : Object.Reference;

    begin
        -- rechercher le bloc courant
        Value := The_Symbol_Table.Eval (Symbol_Table_Id,
                                        Bounded_String.Image (Block_Name));

        -- initialiser l'iterateur
        Block_Table.Init (Iter, Value.Block_Access);

        Msg_Report.Information ("Block Table contents");
        while not Block_Table.Done (Iter) loop
            Bounded_String.Copy (Name, Bounded_String.Value
                                          (Block_Table.Value (Iter)));

            -- lire le contenu
            Content := Block_Table.Eval (Value.Block_Access,
                                         Bounded_String.Image (Name));
            Msg_Report.Continue
               ("Identifier: " & Bounded_String.Image (Name) & ", Class: " &
                Object.Class'Image (Object.The_Class (Content)) &
                ", Value: " & Integer'Image (Object.Identificator (Content)));

            Block_Table.Next (Iter);

        end loop;

    end Image_Block;

end Symbol_Table;