package Tables is
 
   generic
      with procedure Traiter (E : access St_Element_Table);
   procedure Parcourir (T : access St_Table);
   -- Appelle Traiter sur chacun des elements de la table T.
   -- L'ordre des differents appels a Traiter n'est pas defini.
 

generic
      with procedure Traiter (D : access St_Defn);
   procedure Parcourir_Bloc_Courant;
   -- Appelle Traiter sur chacune des defns du bloc courant
   -- (dans un ordre quelconque).
   -- Precondition : la pile des blocs n'est pas vide.

-------------------------------------------------------------------------------
--  Environ : specification du paquetage
--
--  Historique :
--     14/12/2003
--        - version initiale
-------------------------------------------------------------------------------
 
--|  Ce module gere UN environnement, permettant d'associer
--|  des defns a des strings representant des identificateurs.
--|  Cette association est temporaire, le temps d'analyser un bloc
--|  de defns (programme, procedure, fonction).
 
--|  L'environnement est defini comme une pile de blocs. La pile doit
--|  pouvoir contenir au moins 3 blocs. L'implantation peut fixer un
--|  nombre maximum de blocs empilables (cf. commentaire de Entrer_Bloc).
 
--|  La procedure Initialiser_Environ doit avoir ete appelee (une seule fois)
--|  avant tout appel aux primitives de l'environnement.  
--|  Apres cet appel, la pile est vide.
 
 
--|  Le bloc "courant" est le bloc en sommet de pile.
 
--|  Le plus souvent, l'environnement contiendra 2 ou 3 blocs :
--|  . le bloc des predefinis (en fond de pile)
--|  . le bloc des identificateurs globaux
--|  . le bloc des identificateurs locaux eventuellement (en sommet de pile)
--|  D'autres blocs sont empiles pour la gestion des instructions 'for'
 
 
--|  Il ne peut y avoir qu'au plus une defn associee a une chaine C
--|  dans un bloc empile.
--|  La defn "visible" pour une chaine C, si elle existe, est
--|  la premiere defn obtenue en consultant les blocs empiles,
--|  dans l'ordre du sommet vers le fond de la pile.
 
with Types_Base,Pile_p,Defns;
use  Types_Base,Pile_p,Defns;
 
package Environ is
 
   procedure Initialiser_Environ;
   -- configure la pile
 
   procedure Enrichir_Bloc_Courant (D1      : Defn;
                                    Present :    out Boolean;
                                    D2      :    out Defn);
   -- Cherche si Acces_String (Acces_Nom (D1)) est associee a une defn D
   -- dans le bloc courant :
   -- . si oui, Present := True et D2 := D;
   -- . si non, Present := False, D1 est rentree dans le bloc courant,
   --   et D2 := D1.
   -- Precondition : la pile des blocs n'est pas vide;
 
   procedure Enrichir_Bloc_Global (D1      : Defn;
                                   Present :    out Boolean;
                                   D2      :    out Defn);
   -- Cherche si Acces_String (Acces_Nom (D1)) est associee a une defn D
   -- dans le bloc global :
   -- . si oui, Present := True et D2 := D;
   -- . si non, Present := False, D1 est rentree dans le bloc global,
   --   et D2 := D1.
   -- Utile lorsque l'on veut mettre a jour le bloc global, alors
   -- que le bloc courant est un bloc local (par ex : defn de procedure
   -- apres analyse de ses parametres).
   -- Precondition : il y a exactement trois blocs dans la pile
 
   function Recherche (C : access St_Chaine) return Defn;
   -- Retourne la defn visible associee a Acces_String (C), s'il y en a une;
   -- retourne null sinon.
   -- Precondition : la pile des blocs n'est pas vide.
 
   procedure Entrer_Bloc;
   -- Empile un nouveau bloc (vide).
   -- Leve Erreur_Environ en cas de depassement des limites de l'implantation
 
   procedure Sortir_Bloc;
   -- Enleve le dernier bloc empile (ses defns ne sont donc plus
   -- accessibles via l'environnement).
   -- Precondition : il y a au moins un bloc dans la pile.
 
   generic
      with procedure Traiter (D : access St_Defn);
   procedure Parcourir_Bloc_Courant;  
   -- Appelle Traiter sur chacune des defns du bloc courant
   -- (dans un ordre quelconque).
   -- Precondition : la pile des blocs n'est pas vide.
   
   Erreur_Environ : exception;
 
end Environ;

-------------------------------------------------------------------------------
--  Tables : specification du paquetage  
--
--  Historique :
--     14/12/2003
--        - version initiale
-------------------------------------------------------------------------------
 
--|  Specification des types abstraits Table et Element_Table
 
--|  Une table permet d'associer des informations a une chaine
--|  et de retrouver ces informations en temps quasi-constant.
 
with Types_Base;
use  Types_Base;
generic
 
   type Info is private;
   -- L'information associee a une chaine
 
   Info_Vide : in Info;
   -- La valeur par defaut de l'information associee a une chaine
 
package Tables is
 
   -- ***** Types *****
 
   -- Le type abstrait Table.
 
   type St_Table (<> ) is limited private;
   type Table is access all St_Table;
 
   -- Le type abstrait Element_Table.
   -- Un element de table est un couple (chaine, info).
 
   type St_Element_Table (<> ) is limited private;
   type Element_Table is access all St_Element_Table;
 
 
   -- ***** Constructeurs *****
 
   function Creation (Taille : Positive) return Table;
   -- Delivre une nouvelle table, sans information;
   -- Taille est une estimation du nombre d'informations a gerer,
   -- permettant d'ajuster la taille de la table delivree.
 
 
   -- ***** Selecteurs *****
 
   function Acces_Chaine (E : access St_Element_Table) return Chaine;
   -- Retourne la chaine associee a E.
 
   function Acces_Info (E : access St_Element_Table) return Info;
   -- Retourne l'info associee a E.
 
 
   -- ***** Mutateurs *****
 
   procedure Changer_Info (E : access St_Element_Table; I : in Info);
   -- Modifie l'info associee a E.
 
 
   -- ***** Divers *****
 
   procedure Chercher (T       : access St_Table;
                       S       : in     String;
                       A_Creer : in     Boolean := False;
                       Present :    out Boolean;
                       E       :    out Element_Table);
   -- Recherche S dans T.
   -- Si elle y est deja, Present := True et E := l'element de T tel que
   --    Acces_String (Acces_Chaine (E)) = S
   -- Sinon, Present := False, et
   --    . si A_Creer = True, une nouvelle chaine C est creee, telle que
   --      Acces_String (C) = S, et un nouvel element E est ajoute dans T
   --      tel que Acces_Chaine (E) = C et Acces_Info (E) = Info_Vide
   --    . sinon, E := null.
   -- Precondition : S /= "" (leve Erreur_Table sinon)
   -- N.B. cout quasi constant si T est bien configuree.
 
   procedure Chercher (T       : access St_Table;
                       C       : access St_Chaine;
                       A_Creer : in     Boolean := False;
                       Present :    out Boolean;
                       E       :    out Element_Table);
   -- Recherche Acces_String (C) dans T.
   -- Si elle y est deja, Present := True et E := l'element de T tel que
   --    Acces_String (Acces_Chaine (E)) = Acces_String (C)
   -- Sinon, Present := False, et
   --    . si A_Creer = True, un nouvel element E est ajoute dans T
   --      tel que Acces_Chaine (E) = C et Acces_Info (E) = Info_Vide.
   --      (bien noter que C est stockee dans E sans dupliquer
   --      ses caracteres : cela rend cette procedure Chercher plus
   --      efficace que la precedente, si l'on dispose deja d'une chaine)
   --    . sinon, E := null.
   -- Precondition : Acces_String (C) /= "" (leve Erreur_Table sinon)
   -- N.B. cout quasi constant si T est bien configuree.
 
   procedure Retirer (T : access St_Table; E : access St_Element_Table);
   -- Supprime E de la table T, c.a.d. que la chaine Acces_Chaine (E) et
   -- l'information Acces_Info (E) ne font plus partie de T.
   -- Precondition : E fait partie de T (leve Erreur_Table sinon)
   -- N.B. Cette operation peut avoir un cout dependant
   --      du nombre d'elements de T.
 
   procedure Retirer (T : access St_Table; C : access St_Chaine);
   -- Supprime C de la table T, ainsi que l'information associee a C.
   -- Precondition : C fait partie de T, c.a.d. il existe un element
   --                E de T, tel que Acces_Chaine (E) = C
   --                (leve Erreur_Table sinon)
   -- N.B. Cette operation peut avoir un cout dependant du nombre d'elements
   --      de T, et peut etre moins efficace que l'autre procedure Retirer.
 
 
   -- ***** Iterateurs *****
 
   generic
      with procedure Traiter (E : access St_Element_Table);
   procedure Parcourir (T : access St_Table);
   -- Appelle Traiter sur chacun des elements de la table T.
   -- L'ordre des differents appels a Traiter n'est pas defini.
 
 
   -- ***** Exceptions *****
 
   Erreur_Table : exception; -- Levee par Chercher, Retirer
 
private
 
   type St_Table is array (Natural range <> ) of Element_Table;
 
   type St_Element_Table is
      record
         La_Chaine : Chaine;
         L_Info : Info;
         Suiv : Element_Table;
      end record;
 
end Tables;

generic
      with procedure Traiter (D : access St_Defn);
   procedure Parcourir_Bloc_Courant renames Parcourir;