path: root/src/vhdl/vhdl-sem_scopes.adb

--  Semantic analysis.
--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
--
--  This program is free software: you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation, either version 2 of the License, or
--  (at your option) any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program.  If not, see <gnu.org/licenses>.
with Logging; use Logging;
with Tables;
with Flags; use Flags;
with Name_Table; -- use Name_Table;
with Files_Map; use Files_Map;
with Errorout; use Errorout;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;

package body Vhdl.Sem_Scopes is
   --  An interpretation cell is the element of the simply linked list
   --  of interpretation for an identifier.
   --  Interpretation cells are stored in table Interpretations.
   type Interpretation_Cell is record
      --  The declaration for this interpretation.
      Decl: Iir;

      --  If True, the declaration is potentially visible (ie visible via a
      --  use clause).
      Is_Potential : Boolean;

      --  If True, previous declarations in PREV chain are hidden and shouldn't
      --  be considered.
      Prev_Hidden : Boolean;

      --  Previous interpretation for this identifier.
      --  If No_Name_Interpretation, this (not PREV) interpretation is the last
      --  one. If Prev_Hidden is True, PREV must be ignored.  If Prev_Hidden is
      --  false, the identifier is overloaded.
      Prev: Name_Interpretation_Type;

      --  Previous added identifier in the declarative region.  This forms a
      --  linked list used to remove interpretations when a declarative
      --  region is closed.
      Prev_In_Region : Name_Id;
   end record;
   pragma Pack (Interpretation_Cell);

   package Interpretations is new Tables
     (Table_Component_Type => Interpretation_Cell,
      Table_Index_Type => Name_Interpretation_Type,
      Table_Low_Bound => First_Valid_Interpretation,
      Table_Initial => 1024);

   --  Cached value of Prev_In_Region of current region.
   Last_In_Region : Name_Id := Null_Identifier;

   --  First interpretation in the current declarative region.
   Current_Region_Start : Name_Interpretation_Type :=
     First_Valid_Interpretation;

   --  First valid interpretation.  All interpretations smaller than this
   --  value are part of a previous (and nested) analysis and must not be
   --  considered.
   First_Interpretation : Name_Interpretation_Type :=
     First_Valid_Interpretation;

   --  List of non-local hidden declarations.
   type Hide_Index is new Nat32;
   No_Hide_Index : constant Hide_Index := 0;

   package Hidden_Decls is new Tables
     (Table_Component_Type => Name_Interpretation_Type,
      Table_Index_Type => Hide_Index,
      Table_Low_Bound => No_Hide_Index + 1,
      Table_Initial => 32);

   --  First non-local hidden declarations.  In VHDL, it is possible to hide
   --  an overloaded declaration (by declaring a subprogram with the same
   --  profile).   If the overloaded declaration is local, the interpretation
   --  can simply be modified.  But if it is not local, the interpretation is
   --  removed from the chain and saved in the Hidden_Decls table.
   First_Hide_Index : Hide_Index := No_Hide_Index;

   -- To manage the list of interpretation and to add informations to this
   -- list, a stack is used.
   -- Elements of stack can be of kind:
   -- Save_Cell:
   --   the element contains the interpretation INTER for the indentifier ID
   --   for the outer declarative region.
   --   A save cell is always created each time a declaration is added to save
   --   the previous interpretation.
   -- Region_Start:
   --   A new declarative region start at interpretation INTER.  Here, INTER
   --   is used as an index in the interpretations stack (table).
   --   ID is used as an index into the unidim_array stack.
   -- Barrier_start, Barrier_end:
   --   All currents interpretations are saved between both INTER, and
   --   are cleared.  This is used to call semantic during another semantic.

   type Scope_Cell_Kind_Type is (Scope_Start, Scope_Region);

   type Scope_Cell is record
      Kind: Scope_Cell_Kind_Type;

      --  Values for the previous scope.
      Saved_Last_In_Region : Name_Id;
      Saved_Region_Start : Name_Interpretation_Type;
      Saved_First_Hide_Index : Hide_Index;
      Saved_First_Interpretation : Name_Interpretation_Type;
   end record;

   package Scopes is new Tables
     (Table_Component_Type => Scope_Cell,
      Table_Index_Type => Natural,
      Table_Low_Bound => 1,
      Table_Initial => 64);

   function Valid_Interpretation (Inter : Name_Interpretation_Type)
                                 return Boolean is
   begin
      return Inter >= First_Interpretation;
   end Valid_Interpretation;

   --  Return True iff NI means there is a conflict for the identifier: no
   --  valid interpretation due to potentially visible homoraph.
   function Is_Conflict_Declaration (Ni : Name_Interpretation_Type)
                                    return Boolean is
   begin
      pragma Assert (Valid_Interpretation (Ni));
      return Interpretations.Table (Ni).Decl = Null_Iir;
   end Is_Conflict_Declaration;

   --  Get the current interpretation for ID.  The result is raw: it may not
   --  be valid.
   function Get_Interpretation_Raw (Id : Name_Id)
                                   return Name_Interpretation_Type is
   begin
      return Name_Interpretation_Type (Name_Table.Get_Name_Info (Id));
   end Get_Interpretation_Raw;

   procedure Set_Interpretation
     (Id : Name_Id; Inter : Name_Interpretation_Type) is
   begin
      Name_Table.Set_Name_Info (Id, Int32 (Inter));
   end Set_Interpretation;

   function Get_Interpretation_From_Raw (Inter : Name_Interpretation_Type)
                                        return Name_Interpretation_Type is
   begin
      if Valid_Interpretation (Inter)
        and then not Is_Conflict_Declaration (Inter)
      then
         --  In the current scopes set and not a conflict.
         return Inter;
      else
         return No_Name_Interpretation;
      end if;
   end Get_Interpretation_From_Raw;

   function Get_Interpretation (Id : Name_Id)
                               return Name_Interpretation_Type is
   begin
      return Get_Interpretation_From_Raw (Get_Interpretation_Raw (Id));
   end Get_Interpretation;

   procedure Check_Interpretations;
   pragma Unreferenced (Check_Interpretations);

   procedure Check_Interpretations
   is
      Inter: Name_Interpretation_Type;
      Last : constant Name_Interpretation_Type := Interpretations.Last;
      Err : Boolean;
   begin
      Err := False;
      for I in 0 .. Name_Table.Last_Name_Id loop
         Inter := Get_Interpretation (I);
         if Inter > Last then
            Log_Line ("bad interpretation for " & Name_Table.Image (I));
            Err := True;
         end if;
      end loop;
      if Err then
         raise Internal_Error;
      end if;
   end Check_Interpretations;

   procedure Push_Interpretations is
   begin
      Scopes.Append ((Kind => Scope_Start,
                      Saved_Last_In_Region => Last_In_Region,
                      Saved_Region_Start => Current_Region_Start,
                      Saved_First_Hide_Index => First_Hide_Index,
                      Saved_First_Interpretation => First_Interpretation));
      Last_In_Region := Null_Identifier;
      Current_Region_Start := Interpretations.Last + 1;
      First_Hide_Index := Hidden_Decls.Last + 1;
      First_Interpretation := Interpretations.Last + 1;
   end Push_Interpretations;

   procedure Pop_Interpretations
   is
      Cell : Scope_Cell renames Scopes.Table (Scopes.Last);
   begin
      pragma Assert (Scopes.Table (Scopes.Last).Kind = Scope_Start);

      --  All the declarative regions must have been removed.
      pragma Assert (Last_In_Region = Null_Identifier);
      pragma Assert (Current_Region_Start = Interpretations.Last + 1);
      pragma Assert (First_Hide_Index = Hidden_Decls.Last + 1);
      pragma Assert (First_Interpretation = Interpretations.Last + 1);

      Last_In_Region := Cell.Saved_Last_In_Region;
      Current_Region_Start := Cell.Saved_Region_Start;
      First_Hide_Index := Cell.Saved_First_Hide_Index;
      First_Interpretation := Cell.Saved_First_Interpretation;

      Scopes.Decrement_Last;
   end Pop_Interpretations;

   --  Create a new declarative region.
   --  Simply push a region_start cell and update current_scope_start.
   procedure Open_Declarative_Region is
   begin
      Scopes.Append ((Kind => Scope_Region,
                      Saved_Last_In_Region => Last_In_Region,
                      Saved_Region_Start => Current_Region_Start,
                      Saved_First_Hide_Index => First_Hide_Index,
                      Saved_First_Interpretation => No_Name_Interpretation));
      Last_In_Region := Null_Identifier;
      Current_Region_Start := Interpretations.Last + 1;
      First_Hide_Index := Hidden_Decls.Last + 1;
   end Open_Declarative_Region;

   --  Close a declarative region.
   --  Update interpretation of identifiers.
   procedure Close_Declarative_Region
   is
      Cell : Scope_Cell renames Scopes.Table (Scopes.Last);
      Id : Name_Id;
   begin
      pragma Assert (Cell.Kind = Scope_Region);

      --  Restore hidden declarations.
      for I in reverse First_Hide_Index .. Hidden_Decls.Last loop
         declare
            Inter : constant Name_Interpretation_Type :=
              Hidden_Decls.Table (I);
            Prev_Inter, Next_Inter : Name_Interpretation_Type;
         begin
            Prev_Inter := Interpretations.Table (Inter).Prev;
            Next_Inter := Interpretations.Table (Prev_Inter).Prev;
            Interpretations.Table (Inter).Prev := Next_Inter;
            Interpretations.Table (Prev_Inter).Prev := Inter;
         end;
      end loop;
      Hidden_Decls.Set_Last (First_Hide_Index - 1);

      --  Remove interpretations of that region.
      Id := Last_In_Region;
      if Id /= Null_Identifier then
         declare
            Inter : Name_Interpretation_Type;
         begin
            loop
               Inter := Get_Interpretation_Raw (Id);
               pragma Assert (Inter >= Current_Region_Start);
               Set_Interpretation (Id, Interpretations.Table (Inter).Prev);
               Id := Interpretations.Table (Inter).Prev_In_Region;
               exit when Id = Null_Identifier;
            end loop;
            pragma Assert (Inter = Current_Region_Start);
         end;
         Interpretations.Set_Last (Current_Region_Start - 1);
      end if;

      Last_In_Region := Cell.Saved_Last_In_Region;
      Current_Region_Start := Cell.Saved_Region_Start;
      First_Hide_Index := Cell.Saved_First_Hide_Index;

      Scopes.Decrement_Last;
   end Close_Declarative_Region;

   procedure Open_Scope_Extension renames Open_Declarative_Region;
   procedure Close_Scope_Extension renames Close_Declarative_Region;

   function Get_Next_Interpretation (Ni : Name_Interpretation_Type)
                                    return Name_Interpretation_Type
   is
      pragma Assert (Valid_Interpretation (Ni));
      Cell : Interpretation_Cell renames Interpretations.Table (Ni);
   begin
      if Cell.Prev_Hidden
        or else not Valid_Interpretation (Cell.Prev)
      then
         return No_Name_Interpretation;
      else
         return Cell.Prev;
      end if;
   end Get_Next_Interpretation;

   function Get_Declaration (Ni : Name_Interpretation_Type) return Iir is
   begin
      pragma Assert (Valid_Interpretation (Ni));
      return Interpretations.Table (Ni).Decl;
   end Get_Declaration;

   function Get_Under_Interpretation (Id : Name_Id)
                                     return Name_Interpretation_Type
   is
      Inter : constant Name_Interpretation_Type := Get_Interpretation (Id);
   begin
      --  ID has no interpretation.
      --  So, there is no 'under' interpretation (FIXME: prove it).
      pragma Assert (Valid_Interpretation (Inter));

      declare
         Cell : Interpretation_Cell renames Interpretations.Table (Inter);
         Prev : constant Name_Interpretation_Type := Cell.Prev;
      begin
         --  Get_Under_Interpretation can be used only to get a hidden
         --  interpretation.
         pragma Assert (Cell.Prev_Hidden);

         if Valid_Interpretation (Prev)
           --  Not a conflict one (use clauses).
           and then Get_Declaration (Prev) /= Null_Iir
         then
            return Prev;
         else
            return No_Name_Interpretation;
         end if;
      end;
   end Get_Under_Interpretation;

   function Strip_Non_Object_Alias (Decl : Iir) return Iir
   is
      Res : Iir;
   begin
      Res := Decl;
      if Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then
         Res := Get_Named_Entity (Get_Name (Res));
      end if;
      return Res;
   end Strip_Non_Object_Alias;

   function Get_Non_Alias_Declaration (Ni : Name_Interpretation_Type)
                                      return Iir is
   begin
      return Strip_Non_Object_Alias (Get_Declaration (Ni));
   end Get_Non_Alias_Declaration;

   --  Return TRUE if INTER was made directly visible via a use clause.
   function Is_Potentially_Visible (Inter : Name_Interpretation_Type)
                                   return Boolean is
   begin
      return Interpretations.Table (Inter).Is_Potential;
   end Is_Potentially_Visible;

   --  Return TRUE iif DECL can be overloaded.
   function Is_Overloadable (Decl : Iir) return Boolean is
   begin
      --  LRM93 10.3:
      --  The overloaded declarations considered in this chapter are those for
      --  subprograms and enumeration literals.
      case Get_Kind (Decl) is
         when Iir_Kind_Enumeration_Literal
           | Iir_Kind_Function_Declaration
           | Iir_Kind_Procedure_Declaration
           | Iir_Kind_Interface_Function_Declaration
           | Iir_Kind_Interface_Procedure_Declaration =>
            return True;
         when Iir_Kind_Non_Object_Alias_Declaration =>
            case Get_Kind (Get_Named_Entity (Get_Name (Decl))) is
               when Iir_Kind_Enumeration_Literal
                 | Iir_Kind_Function_Declaration
                 | Iir_Kind_Procedure_Declaration
                 | Iir_Kind_Interface_Function_Declaration
                 | Iir_Kind_Interface_Procedure_Declaration =>
                  return True;
               when Iir_Kind_Non_Object_Alias_Declaration =>
                  raise Internal_Error;
               when others =>
                  return False;
            end case;
         when others =>
            return False;
      end case;
   end Is_Overloadable;

   --  Return TRUE if INTER was made direclty visible in the current
   --  declarative region.
   function Is_In_Current_Declarative_Region (Inter : Name_Interpretation_Type)
                                             return Boolean is
   begin
      return Inter >= Current_Region_Start;
   end Is_In_Current_Declarative_Region;

   --  Emit a warning when DECL hides PREV_DECL.
   procedure Warning_Hide (Decl : Iir; Prev_Decl : Iir)
   is
   begin
      if Get_Kind (Decl) in Iir_Kinds_Interface_Declaration
        and then Get_Kind (Get_Parent (Decl)) = Iir_Kind_Component_Declaration
      then
         --  Do not warn when an interface in a component hides a declaration.
         --  This is a common case (eg: in testbenches), and there is no real
         --  hiding.
         return;
      end if;

      if Get_Kind (Decl) = Iir_Kind_Element_Declaration then
         --  Do not warn for record elements.  They are used by selection.
         return;
      end if;

      if Decl = Prev_Decl then
         --  Can happen in configuration.  No real hidding.
         return;
      end if;

      if Name_Table.Get_Name_Ptr (Get_Identifier (Decl))(1) = 'P' then
         --  Do not warn for labels starting with 'P'.  These are canonicalized
         --  process labels which are scoped.
         --  This can happen as an architecture is canonicalized during
         --  analysis and then its declarations are 'imported' by a
         --  configuration.
         return;
      end if;

      Warning_Msg_Sem (Warnid_Hide, +Decl,
                       "declaration of %i hides %n", (+Decl, +Prev_Decl));
   end Warning_Hide;

   --  Add interpretation DECL to the identifier of DECL.
   --  POTENTIALLY is true if the identifier comes from a use clause.
   procedure Add_Name (Decl : Iir; Ident : Name_Id; Potentially : Boolean)
   is
      -- Current interpretation of ID.  This is the one before DECL is
      -- added (if so).
      Raw_Inter : constant Name_Interpretation_Type :=
        Get_Interpretation_Raw (Ident);
      Current_Inter : constant Name_Interpretation_Type :=
        Get_Interpretation_From_Raw (Raw_Inter);
      Current_Decl : Iir;

      --  Add DECL in the chain of interpretation for the identifier.
      procedure Add_New_Interpretation (Hid_Prev : Boolean; D : Iir := Decl) is
      begin
         Interpretations.Append ((Decl => D,
                                  Prev => Raw_Inter,
                                  Is_Potential => Potentially,
                                  Prev_Hidden => Hid_Prev,
                                  Prev_In_Region => Last_In_Region));
         Set_Interpretation (Ident, Interpretations.Last);
         Last_In_Region := Ident;
      end Add_New_Interpretation;
   begin
      if Ident = Null_Identifier then
         --  Missing identifier can happen only in case of parse error.
         pragma Assert (Flags.Flag_Force_Analysis);
         return;
      end if;

      if not Valid_Interpretation (Raw_Inter) then
         --  Very simple: no hidding, no overloading.
         Add_New_Interpretation (True);
         return;
      end if;

      if Is_Conflict_Declaration (Raw_Inter) then
         --  The current declaration for RAW_INTER is a conflict: there are
         --  multiple *potentially* visible declarations for the identifier.
         if Potentially then
            --  Yet another conflicting interpretation.
            return;
         else
            --  Very simple: no hidding, no overloading.
            --  (current interpretation is Conflict_Interpretation if there is
            --   only potentially visible declarations that are not made
            --   directly visible).
            --  Note: in case of conflict interpretation, it may be unnecessary
            --  to keep the current interpretation (but it is simpler as is).
            Add_New_Interpretation (True);
            return;
         end if;
      end if;

      if Potentially then
         --  Do not re-add a potential decl.  This handles cases like:
         --  'use p.all; use p.all;'.
         --  FIXME: add a flag (or reuse Visible_Flag) to avoid walking all
         --  the interpretations.
         declare
            Inter : Name_Interpretation_Type := Current_Inter;
         begin
            while Valid_Interpretation (Inter) loop
               if Get_Declaration (Inter) = Decl then
                  return;
               end if;
               Inter := Get_Next_Interpretation (Inter);
            end loop;
         end;
      end if;

      --  LRM 10.3 Visibility
      --  Each of two declarations is said to be a homograph of the other if
      --  both declarations have the same identifier, operator symbol, or
      --  character literal, and overloading is allowed for at most one
      --  of the two.
      --
      --  GHDL: the condition 'overloading is allowed for at most one of the
      --  two' is false iff overloading is allowed for both; this is a nand.

      --  Note: at this stage, current_inter is valid.
      Current_Decl := Get_Declaration (Current_Inter);

      if Is_Overloadable (Current_Decl) and then Is_Overloadable (Decl) then
         --  Current_Inter and Decl overloads (well, they have the same
         --  designator).

         --  LRM 10.3 Visibility
         --  If overloading is allowed for both declarations, then each of the
         --  two is a homograph of the other if they have the same identifier,
         --  operator symbol or character literal, as well as the same
         --  parameter and result profile.

         declare
            Homograph : Name_Interpretation_Type;
            Prev_Homograph : Name_Interpretation_Type;

            --  Hide HOMOGRAPH (ie unlink it from the chain of interpretation).
            procedure Hide_Homograph
            is
               S : Name_Interpretation_Type;
            begin
               if Prev_Homograph = No_Name_Interpretation then
                  Prev_Homograph := Interpretations.Last;
               end if;

               --  PREV_HOMOGRAPH must be the interpretation just before
               --  HOMOGRAPH.
               pragma Assert
                 (Interpretations.Table (Prev_Homograph).Prev = Homograph);

               --  Hide previous interpretation.
               Hidden_Decls.Append (Homograph);

               S := Interpretations.Table (Homograph).Prev;
               Interpretations.Table (Homograph).Prev := Prev_Homograph;
               Interpretations.Table (Prev_Homograph).Prev := S;
            end Hide_Homograph;

            function Get_Hash_Non_Alias (D : Iir) return Iir_Int32 is
            begin
               return Get_Subprogram_Hash (Strip_Non_Object_Alias (D));
            end Get_Hash_Non_Alias;

            --  Return True iff D is an implicit declaration (either a
            --  subprogram or an implicit alias).
            function Is_Implicit_Declaration (D : Iir) return Boolean is
            begin
               case Get_Kind (D) is
                  when Iir_Kind_Non_Object_Alias_Declaration =>
                     return Get_Implicit_Alias_Flag (D);
                  when Iir_Kind_Enumeration_Literal =>
                     return False;
                  when Iir_Kind_Procedure_Declaration
                    | Iir_Kind_Function_Declaration =>
                     return Is_Implicit_Subprogram (D);
                  when others =>
                     Error_Kind ("is_implicit_declaration", D);
               end case;
            end Is_Implicit_Declaration;

            --  Return TRUE iff D is an implicit alias of an implicit
            --  subprogram.
            function Is_Implicit_Alias (D : Iir) return Boolean is
            begin
               --  FIXME: Is it possible to have an implicit alias of an
               --  explicit subprogram ? Yes for enumeration literal and
               --  physical units.
               return Get_Kind (D) = Iir_Kind_Non_Object_Alias_Declaration
                 and then Get_Implicit_Alias_Flag (D)
                 and then Is_Implicit_Subprogram (Get_Named_Entity
                                                    (Get_Name (D)));
            end Is_Implicit_Alias;

            --  Replace the homograph of DECL by DECL.
            procedure Replace_Homograph is
            begin
               Interpretations.Table (Homograph).Decl := Decl;
            end Replace_Homograph;

            Decl_Hash : Iir_Int32;
            Hash : Iir_Int32;
         begin
            Decl_Hash := Get_Hash_Non_Alias (Decl);
            --  The hash must have been computed.
            pragma Assert (Decl_Hash /= 0);

            --  LRM02 10.3 Visibility
            --  Each of two declarations is said to be a /homograph/ of the
            --  other if both declarations have the same identifier, operator
            --  symbol, or character literal, and if overloading is allowed for
            --  at most one of the two.
            --
            --  LRM08 12.3 Visibility
            --  Each of two declarations is said to be a /homograph/ of the
            --  other if and only if both declarations have the same
            --  designator, and they denote different named entities, and
            --  either overloading is allows for at most one of the two, or
            --  overloading is allowed for both declarations and they have the
            --  same parameter and result type profile.

            --  GHDL: here we are in the case when both declarations are
            --  overloadable.  Also, always follow the LRM08 rules as they fix
            --  issues.
            --  GHDL: Special case for a second declaration with the same
            --  designator and that denotes the same named entity than a
            --  previous one (that would be an alias): according to the LRM,
            --  they are both visible and there are no ambiguity as they
            --  denotes the same named entity.  In GHDL, the new one hides the
            --  previous one.  The behaviour should be the same.

            --  Find an homograph of this declaration (and also keep the
            --  interpretation just before it in the chain).
            Homograph := Current_Inter;
            Prev_Homograph := No_Name_Interpretation;
            while Homograph /= No_Name_Interpretation loop
               Current_Decl := Get_Declaration (Homograph);
               Hash := Get_Hash_Non_Alias (Current_Decl);
               exit when Decl_Hash = Hash
                 and then Is_Same_Profile (Decl, Current_Decl);
               Prev_Homograph := Homograph;
               Homograph := Get_Next_Interpretation (Homograph);
            end loop;

            if Homograph = No_Name_Interpretation then
               --  Simple case: no homograph.
               Add_New_Interpretation (False);
               return;
            end if;

            --  There is an homograph (or the named entity is the same).
            if Potentially then
               --  Added DECL would be made potentially visible.

               --  LRM93 10.4 1) / LRM08 12.4 a) Use Clauses
               --  1. A potentially visible declaration is not made
               --     directly visible if the place considered is within the
               --     immediate scope of a homograph of the declaration.
               if not Is_Potentially_Visible (Homograph) then
                  return;
               end if;

               --  LRM08 12.4 Use Clauses
               --  b) If two potentially visible declarations are homograph
               --     and one is explicitly declared and the other is
               --     implicitly declared, then the implicit declaration is
               --     not made directly visible.
               if (Flags.Flag_Explicit or else Flags.Vhdl_Std >= Vhdl_08)
                 and then Is_Potentially_Visible (Homograph)
               then
                  declare
                     Implicit_Current_Decl : constant Boolean :=
                       Is_Implicit_Declaration (Current_Decl);
                     Implicit_Decl : constant Boolean :=
                       Is_Implicit_Declaration (Decl);
                  begin
                     if Implicit_Current_Decl and then not Implicit_Decl then
                        if Is_In_Current_Declarative_Region (Homograph) then
                           Replace_Homograph;
                        else
                           --  Insert DECL and hide homograph.
                           Add_New_Interpretation (False);
                           Hide_Homograph;
                        end if;
                        return;
                     elsif not Implicit_Current_Decl and then Implicit_Decl
                     then
                        --  Discard decl.
                        return;
                     elsif Strip_Non_Object_Alias (Decl)
                       = Strip_Non_Object_Alias (Current_Decl)
                     then
                        --  This rule is not written clearly in the LRM, but
                        --  if two designators denote the same named entity,
                        --  no need to make both visible.
                        return;
                     end if;
                  end;
               end if;

               --  GHDL: if the homograph is in the same declarative
               --  region than DECL, it must be an implicit declaration
               --  to be hidden.
               --  FIXME: this rule is not in the LRM93, but it is necessary
               --  so that explicit declaration hides the implicit one.
               if Flags.Vhdl_Std < Vhdl_08
                 and then not Flags.Flag_Explicit
                 and then Get_Parent (Decl) = Get_Parent (Current_Decl)
               then
                  declare
                     Implicit_Current_Decl : constant Boolean :=
                       Is_Implicit_Subprogram (Current_Decl);
                     Implicit_Decl : constant Boolean :=
                       Is_Implicit_Subprogram (Decl);
                  begin
                     if Implicit_Current_Decl and not Implicit_Decl then
                        --  Note: no need to save previous interpretation, as
                        --  it is in the same declarative region.
                        --  Replace the previous homograph with DECL.
                        Replace_Homograph;
                        return;
                     elsif not Implicit_Current_Decl and Implicit_Decl then
                        --  As we have replaced the homograph, it is possible
                        --  than the implicit declaration is re-added (by
                        --  a new use clause).  Discard it.
                        return;
                     end if;
                  end;
               end if;

               --  The homograph was made visible in an outer declarative
               --  region.  Therefore, it must not be hidden.
               Add_New_Interpretation (False);

               return;
            else
               --  Added DECL would be made directly visible.

               if not Is_Potentially_Visible (Homograph) then
                  --  The homograph was also declared in that declarative
                  --  region or in an inner one.
                  if Is_In_Current_Declarative_Region (Homograph) then
                     --  ... and was declared in the same region

                     --  To sum up: at this point both DECL and CURRENT_DECL
                     --  are overloadable, have the same profile (but may be
                     --  aliases) and are declared in the same declarative
                     --  region.

                     --  LRM08 12.3 Visibility
                     --  LRM93 10.3 Visibility
                     --  Two declarations that occur immediately within
                     --  the same declarative regions [...] shall not be
                     --  homograph, unless exactely one of them is the
                     --  implicit declaration of a predefined operation,

                     --  LRM08 12.3 Visibility
                     --  or is an implicit alias of such implicit declaration.
                     --
                     --  GHDL: FIXME: 'implicit alias'

                     --  LRM08 12.3 Visibility
                     --  LRM93 10.3 Visibility
                     --  Each of two declarations is said to be a
                     --  homograph of the other if and only if both
                     --  declarations have the same designator, [...]
                     --
                     --  LRM08 12.3 Visibility
                     --  [...] and they denote different named entities,
                     --  and [...]
                     declare
                        Is_Decl_Implicit : Boolean;
                        Is_Current_Decl_Implicit : Boolean;
                     begin
                        if Flags.Vhdl_Std >= Vhdl_08 then
                           Is_Current_Decl_Implicit :=
                             Is_Implicit_Subprogram (Current_Decl)
                             or else Is_Implicit_Alias (Current_Decl);
                           Is_Decl_Implicit := Is_Implicit_Subprogram (Decl)
                             or else Is_Implicit_Alias (Decl);

                           --  If they denote the same entity, they aren't
                           --  homograph.
                           if Strip_Non_Object_Alias (Decl)
                             = Strip_Non_Object_Alias (Current_Decl)
                           then
                              if Is_Current_Decl_Implicit
                                and then not Is_Decl_Implicit
                              then
                                 --  They aren't homograph but DECL is stronger
                                 --  (at it is not an implicit declaration)
                                 --  than CURRENT_DECL
                                 Replace_Homograph;
                              end if;

                              return;
                           end if;

                           if Is_Decl_Implicit
                             and then not Is_Current_Decl_Implicit
                           then
                              --  Re-declaration of an implicit subprogram via
                              --  an implicit alias is simply discarded.
                              return;
                           end if;
                        else
                           --  Can an implicit subprogram declaration appears
                           --  after an explicit one in vhdl 93?  I don't
                           --  think so.
                           Is_Decl_Implicit := Is_Implicit_Subprogram (Decl);
                           Is_Current_Decl_Implicit :=
                             Is_Implicit_Subprogram (Current_Decl);
                        end if;

                        if not (Is_Decl_Implicit xor Is_Current_Decl_Implicit)
                        then
                           Error_Msg_Sem
                             (+Decl, "redeclaration of %n defined at %l",
                              (+Current_Decl, +Current_Decl));
                           return;
                        end if;

                        if not Is_Decl_Implicit and Is_Current_Decl_Implicit
                        then
                           --  DECL 'overrides' the predefined current
                           --  declaration.

                           --  LRM93 10.3 Visibility
                           --  In such cases, a predefined operation is always
                           --  hidden by the other homograph.  Where hidden in
                           --  this manner, an implicit declaration is hidden
                           --  within the entire scope of the other declaration
                           --  (regardless of which declaration occurs first);
                           --  the implicit declaration is visible neither by
                           --  selection nor directly.
                           Set_Visible_Flag (Current_Decl, False);
                           if Get_Kind (Decl)
                             in Iir_Kinds_Subprogram_Declaration
                           then
                              Set_Hide_Implicit_Flag (Decl, True);
                           end if;
                        end if;
                     end;
                  else
                     --  GHDL: hide directly visible declaration declared in
                     --  an outer region.
                     null;
                  end if;
               else
                  --  LRM 10.4 Use Clauses
                  --  1. A potentially visible declaration is not made
                  --  directly visible if the place considered is within the
                  --  immediate scope of a homograph of the declaration.

                  --  GHDL: hide the potentially visible declaration.
                  null;
               end if;
               Add_New_Interpretation (False);

               Hide_Homograph;
               return;
            end if;
         end;
      end if;

      --  The current interpretation and the new one aren't overloadable, ie
      --  they are homograph (well almost).

      if Is_Potentially_Visible (Current_Inter) then
         if Potentially then
            --  LRM93 10.4 2) / LRM08 12.4 c) Use clauses
            --  Potentially visible declarations that have the same
            --  designator are not made directly visible unless each of
            --  them is either an enumeration literal specification or
            --  the declaration of a subprogram.
            if Decl = Get_Declaration (Current_Inter) then
               -- The rule applies only for distinct declaration.
               -- This handles 'use p.all; use P.all;'.
               -- FIXME: this should have been handled at the start of
               -- this subprogram.
               raise Internal_Error;
               return;
            end if;

            --  LRM08 12.3 Visibility
            --  Each of two declarations is said to be a homograph of the
            --  other if and only if both declarations have the same
            --  designator; and they denote different named entities, [...]
            if Flags.Vhdl_Std >= Vhdl_08 then
               if Strip_Non_Object_Alias (Decl)
                 = Strip_Non_Object_Alias (Current_Decl)
               then
                  return;
               end if;
            end if;

            --  Conflict.
            Add_New_Interpretation (True, Null_Iir);
            return;
         else
            --  LRM93 10.4 item #1
            --  A potentially visible declaration is not made directly
            --  visible if the place considered is within the immediate
            --  scope of a homograph of the declaration.
            --  GHDL: Could directly replace the previous interpretation
            --  (added in same scope), but don't do that for entity
            --  declarations, since it is used to find default binding.
            Add_New_Interpretation (True);
            return;
         end if;
      else
         --  There is already a declaration in the current scope.
         if Potentially then
            -- LRM93 10.4 item #1
            -- Discard the new and potentially visible declaration.
            -- However, add the type.
            -- FIXME: Add_In_Visible_List (Ident, Decl);
            return;
         else
            if Is_In_Current_Declarative_Region (Current_Inter) then
               --  They are perhaps visible in the same declarative region.

               if Get_Kind (Current_Decl) = Iir_Kind_Library_Declaration then
                  --  LRM93 11.2
                  --  If two or more logical names having the same
                  --  identifier appear in library clauses in the same
                  --  context, the second and subsequent occurences of the
                  --  logical name have no effect.  The same is true of
                  --  logical names appearing both in the context clause
                  --  of a primary unit and in the context clause of a
                  --  corresponding secondary unit.
                  --  GHDL: we apply this rule with VHDL-87, because of
                  --  implicit library clauses STD and WORK.
                  if Get_Kind (Decl) = Iir_Kind_Library_Declaration then
                     return;
                  end if;

                  if Flag_Relaxed_Rules
                    and then Get_Kind (Decl) in Iir_Kinds_Library_Unit
                  then
                     Warning_Msg_Sem
                       (Warnid_Hide, +Decl,
                        "unit %i hides library %i", (+Decl, +Decl));
                     Interpretations.Table (Current_Inter).Decl := Decl;
                     return;
                  end if;
               end if;

               -- None of the two declarations are potentially visible, ie
               -- both are visible.
               -- LRM 10.3:
               --  Two declarations that occur immediately within the same
               --  declarative region must not be homographs,
               -- FIXME: unless one of them is the implicit declaration of a
               --  predefined operation.
               Report_Start_Group;
               Error_Msg_Sem
                 (+Decl, "identifier %i already used for a declaration",
                  +Ident);
               Error_Msg_Sem
                 (+Current_Decl, "previous declaration: %n", +Current_Decl);
               Report_End_Group;
               return;
            else
               --  Homograph, not in the same scope.
               --  LRM93 10.3:
               --  A declaration is said to be hidden within (part of) an inner
               --  declarative region if the inner region contains an homograph
               --  of this declaration; the outer declaration is the hidden
               --  within the immediate scope of the inner homograph.
               if Is_Warning_Enabled (Warnid_Hide)
                 and then not Is_Potentially_Visible (Current_Inter)
               then
                  Warning_Hide (Decl, Current_Decl);
               end if;

               Add_New_Interpretation (True);
               return;
            end if;
         end if;
      end if;
   end Add_Name;

   procedure Add_Name (Decl: Iir) is
   begin
      Add_Name (Decl, Get_Identifier (Decl), False);
   end Add_Name;

   procedure Replace_Name (Id: Name_Id; Old : Iir; Decl: Iir)
   is
      Inter : Name_Interpretation_Type;
   begin
      Inter := Get_Interpretation (Id);
      loop
         exit when Get_Declaration (Inter) = Old;
         Inter := Get_Next_Interpretation (Inter);
         pragma Assert (Valid_Interpretation (Inter));
      end loop;
      Interpretations.Table (Inter).Decl := Decl;
      pragma Assert (Get_Next_Interpretation (Inter) = No_Name_Interpretation);
   end Replace_Name;

   procedure Name_Visible (Decl : Iir) is
   begin
      --  A name can be made visible only once.
      pragma Assert (not Get_Visible_Flag (Decl));
      Set_Visible_Flag (Decl, True);
   end Name_Visible;

   procedure Iterator_Decl (Decl : Iir; Arg : Arg_Type) is
   begin
      case Get_Kind (Decl) is
         when Iir_Kind_Subtype_Declaration
           | Iir_Kind_Enumeration_Literal --  By use clause
           | Iir_Kind_Constant_Declaration
           | Iir_Kind_Signal_Declaration
           | Iir_Kind_Variable_Declaration
           | Iir_Kind_File_Declaration
           | Iir_Kind_Object_Alias_Declaration
           | Iir_Kind_Non_Object_Alias_Declaration
           | Iir_Kinds_Interface_Object_Declaration
           | Iir_Kind_Interface_Package_Declaration
           | Iir_Kinds_Interface_Subprogram_Declaration
           | Iir_Kind_Component_Declaration
           | Iir_Kind_Attribute_Declaration
           | Iir_Kind_Group_Template_Declaration
           | Iir_Kind_Group_Declaration
           | Iir_Kind_Nature_Declaration
           | Iir_Kind_Subnature_Declaration
           | Iir_Kinds_Quantity_Declaration
           | Iir_Kind_Terminal_Declaration
           | Iir_Kind_Entity_Declaration
           | Iir_Kind_Package_Declaration
           | Iir_Kind_Package_Instantiation_Declaration
           | Iir_Kind_Configuration_Declaration
           | Iir_Kind_Context_Declaration
           | Iir_Kinds_Concurrent_Statement
           | Iir_Kinds_Sequential_Statement =>
            Handle_Decl (Decl, Arg);
         when Iir_Kind_Procedure_Declaration
           | Iir_Kind_Function_Declaration =>
            if not Is_Second_Subprogram_Specification (Decl) then
               Handle_Decl (Decl, Arg);
            end if;
         when Iir_Kind_Type_Declaration =>
            declare
               Def : constant Iir := Get_Type_Definition (Decl);
               List : Iir_Flist;
               El : Iir;
            begin
               -- Handle incomplete type declaration.
               if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
                  return;
               end if;

               Handle_Decl (Decl, Arg);

               if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition then
                  List := Get_Enumeration_Literal_List (Def);
                  for I in Flist_First .. Flist_Last (List) loop
                     El := Get_Nth_Element (List, I);
                     Handle_Decl (El, Arg);
                  end loop;
               end if;
            end;
         when Iir_Kind_Anonymous_Type_Declaration =>
            Handle_Decl (Decl, Arg);

            declare
               Def : constant Iir := Get_Type_Definition (Decl);
               El : Iir;
            begin
               if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then
                  El := Get_Unit_Chain (Def);
                  while El /= Null_Iir loop
                     Handle_Decl (El, Arg);
                     El := Get_Chain (El);
                  end loop;
               end if;
            end;
         when Iir_Kind_Interface_Type_Declaration =>
            Handle_Decl (Decl, Arg);
            declare
               El : Iir;
            begin
               El := Get_Interface_Type_Subprograms (Decl);
               while El /= Null_Iir loop
                  Handle_Decl (El, Arg);
                  El := Get_Chain (El);
               end loop;
            end;
         when Iir_Kind_Use_Clause
           | Iir_Kind_Context_Reference =>
            Handle_Decl (Decl, Arg);
         when Iir_Kind_Library_Clause =>
            Handle_Decl (Decl, Arg);
--             El := Get_Library_Declaration (Decl);
--             if El /= Null_Iir then
--                --  May be empty.
--                Handle_Decl (El, Arg);
--             end if;

         when Iir_Kind_Procedure_Body
           | Iir_Kind_Function_Body =>
            null;

         when Iir_Kind_Package_Body =>
            null;

         when Iir_Kind_Attribute_Specification
           | Iir_Kind_Configuration_Specification
           | Iir_Kind_Disconnection_Specification =>
            null;
         when Iir_Kinds_Signal_Attribute
           | Iir_Kind_Attribute_Implicit_Declaration =>
            null;

         when Iir_Kind_Protected_Type_Body
           | Iir_Kind_Suspend_State_Declaration =>
            --  FIXME: allowed only in debugger (if the current scope is
            --  within a package body) ?
            null;

         when others =>
            Error_Kind ("iterator_decl", Decl);
      end case;
   end Iterator_Decl;

   --  Handle context_clause of context reference CTXT.
   procedure Add_One_Context_Reference (Ctxt : Iir)
   is
      Name : constant Iir := Get_Selected_Name (Ctxt);
      Ent : constant Iir := Get_Named_Entity (Name);
      Item : Iir;
   begin
      if Ent = Null_Iir or else Is_Error (Ent) then
         --  Stop now in case of error.
         return;
      end if;
      pragma Assert (Get_Kind (Ent) = Iir_Kind_Context_Declaration);

      Item := Get_Context_Items (Ent);
      while Item /= Null_Iir loop
         case Get_Kind (Item) is
            when Iir_Kind_Use_Clause =>
               Add_Use_Clause (Item);
            when Iir_Kind_Library_Clause =>
               Add_Name (Get_Library_Declaration (Item),
                         Get_Identifier (Item), False);
            when Iir_Kind_Context_Reference =>
               Add_Context_Reference (Item);
            when others =>
               Error_Kind ("add_context_reference", Item);
         end case;
         Item := Get_Chain (Item);
      end loop;
   end Add_One_Context_Reference;

   procedure Add_Context_Reference (Ref : Iir)
   is
      Ctxt : Iir;
   begin
      Ctxt := Ref;
      loop
         Add_One_Context_Reference (Ctxt);
         Ctxt := Get_Context_Reference_Chain (Ctxt);
         exit when Ctxt = Null_Iir;
      end loop;
   end Add_Context_Reference;

   --  Make POTENTIALLY (or not) visible DECL.
   procedure Add_Name_Decl (Decl : Iir; Potentially : Boolean) is
   begin
      case Get_Kind (Decl) is
         when Iir_Kind_Use_Clause =>
            if not Potentially then
               Add_Use_Clause (Decl);
            end if;
         when Iir_Kind_Context_Reference =>
            pragma Assert (not Potentially);
            Add_Context_Reference (Decl);
         when Iir_Kind_Library_Clause =>
            Add_Name (Get_Library_Declaration (Decl),
                      Get_Identifier (Decl), Potentially);
         when Iir_Kind_Anonymous_Type_Declaration =>
            null;
         when others =>
            Add_Name (Decl, Get_Identifier (Decl), Potentially);
      end case;
   end Add_Name_Decl;

   procedure Add_Declaration is
      new Iterator_Decl (Arg_Type => Boolean, Handle_Decl => Add_Name_Decl);

   procedure Iterator_Decl_List (Decl_List : Iir_List; Arg : Arg_Type)
   is
      Decl : Iir;
      It : List_Iterator;
   begin
      if Decl_List = Null_Iir_List then
         return;
      end if;
      It := List_Iterate (Decl_List);
      while Is_Valid (It) loop
         Decl := Get_Element (It);
         Handle_Decl (Decl, Arg);
         Next (It);
      end loop;
   end Iterator_Decl_List;

   procedure Iterator_Decl_Chain (Chain_First : Iir; Arg : Arg_Type)
   is
      Decl: Iir;
   begin
      Decl := Chain_First;
      while Decl /= Null_Iir loop
         Handle_Decl (Decl, Arg);
         Decl := Get_Chain (Decl);
      end loop;
   end Iterator_Decl_Chain;

   procedure Add_Declarations_1 is new Iterator_Decl_Chain
     (Arg_Type => Boolean, Handle_Decl => Add_Declaration);

   procedure Add_Declarations (Chain : Iir; Potentially : Boolean := False)
     renames Add_Declarations_1;

   procedure Add_Declarations_List is new Iterator_Decl_List
     (Arg_Type => Boolean, Handle_Decl => Add_Declaration);

   procedure Add_Declarations_From_Interface_Chain
     (Chain : Iir; Potentially : Boolean)
   is
      Inter : Iir;
      Assoc : Iir;
      Id : Name_Id;
   begin
      Inter := Chain;
      while Inter /= Null_Iir loop
         Id := Get_Identifier (Inter);

         --  The chain may be from an implicitely declared subprograms, with
         --  anonymous identifiers.  In that case, all interfaces are
         --  anonymous and there is no need to iterate.
         exit when Id = Null_Identifier;

         --  Not very different from Add_Declaration, except for interface
         --  subprograms.
         case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
            when Iir_Kinds_Interface_Object_Declaration
              | Iir_Kind_Interface_Package_Declaration
              | Iir_Kind_Interface_Terminal_Declaration =>
               Add_Name (Inter, Id, Potentially);
            when Iir_Kinds_Interface_Subprogram_Declaration =>
               if Potentially then
                  --  The normal case: an interface subprogram in a package
                  --  is visible through a use clause.  But in fact it refer
                  --  to the associated subprogram.
                  Assoc := Get_Associated_Subprogram (Inter);
                  pragma Assert (Assoc /= Null_Iir);
                  Add_Name (Assoc, Id, Potentially);
               else
                  --  Called only when resolving associations (the identifiers
                  --  of the interfaces are put in the name table).
                  --  TODO: add a flag or create a different procedure ?
                  Add_Name (Inter, Id, Potentially);
               end if;
            when Iir_Kind_Interface_Type_Declaration =>
               Add_Name (Inter, Id, Potentially);
               declare
                  El : Iir;
               begin
                  El := Get_Interface_Type_Subprograms (Inter);
                  while El /= Null_Iir loop
                     Add_Name (El, Get_Identifier (El), Potentially);
                     El := Get_Chain (El);
                  end loop;
               end;
         end case;

         Inter := Get_Chain (Inter);
      end loop;
   end Add_Declarations_From_Interface_Chain;

   procedure Add_Declarations_Of_Concurrent_Statement (Parent : Iir)
   is
      El: Iir;
      Label: Name_Id;
   begin
      El := Get_Concurrent_Statement_Chain (Parent);
      while El /= Null_Iir loop
         case Get_Kind (El) is
            when Iir_Kind_Psl_Default_Clock =>
               --  Not a statement with label.
               null;
            when others =>
               Label := Get_Label (El);
               if Label /= Null_Identifier then
                  Add_Name (El, Get_Identifier (El), False);
               end if;
         end case;
         El := Get_Chain (El);
      end loop;
   end Add_Declarations_Of_Concurrent_Statement;

   procedure Add_Context_Clauses (Unit : Iir_Design_Unit) is
   begin
      Add_Declarations (Get_Context_Items (Unit), False);
   end Add_Context_Clauses;

   -- Add declarations from an entity into the current declarative region.
   -- This is needed when an architecture is analysed.
   procedure Add_Entity_Declarations (Entity : Iir_Entity_Declaration)
   is
      Prev_Hide : constant Boolean := Is_Warning_Enabled (Warnid_Hide);
   begin
      --  Temporarly disable hide warning to avoid spurious messages.
      Enable_Warning (Warnid_Hide, False);

      Add_Declarations_From_Interface_Chain
        (Get_Generic_Chain (Entity), False);
      Add_Declarations_From_Interface_Chain
        (Get_Port_Chain (Entity), False);
      Add_Declarations (Get_Declaration_Chain (Entity), False);
      Add_Declarations_Of_Concurrent_Statement (Entity);

      --  Restore
      Enable_Warning (Warnid_Hide, Prev_Hide);
   end Add_Entity_Declarations;

   --  Add declarations from a package into the current declarative region.
   --  (for a use clause or when a package body is analyzed)
   procedure Add_Package_Declarations
     (Decl: Iir_Package_Declaration; Potentially : Boolean)
   is
      Header : constant Iir := Get_Package_Header (Decl);
   begin
      --  LRM08 12.1 Declarative region
      --  d) A package declaration together with the corresponding body
      --
      --  GHDL: the formal generic declarations are considered to be in the
      --  same declarative region as the package declarations (and therefore
      --  in the same scope), even if they don't occur immediately within a
      --  package declaration.
      if Header /= Null_Iir then
         Add_Declarations (Get_Generic_Chain (Header), Potentially);
      end if;

      Add_Declarations (Get_Declaration_Chain (Decl), Potentially);
   end Add_Package_Declarations;

   procedure Add_Package_Instantiation_Declarations
     (Decl: Iir; Potentially : Boolean) is
   begin
      --  LRM08 4.9 Package instantiation declarations
      --  The package instantiation declaration is equivalent to declaration of
      --  a generic-mapped package, consisting of a package declaration [...]
      Add_Declarations_From_Interface_Chain
        (Get_Generic_Chain (Decl), Potentially);
      Add_Declarations (Get_Declaration_Chain (Decl), Potentially);
   end Add_Package_Instantiation_Declarations;

   --  Add declarations from a package into the current declarative region.
   --  This is needed when a package body is analysed.
   procedure Add_Package_Declarations (Decl: Iir_Package_Declaration) is
   begin
      Add_Package_Declarations (Decl, False);
   end Add_Package_Declarations;

   procedure Add_Component_Declarations
     (Component: Iir_Component_Declaration) is
   begin
      Add_Declarations_From_Interface_Chain
        (Get_Generic_Chain (Component), False);
      Add_Declarations_From_Interface_Chain
        (Get_Port_Chain (Component), False);
   end Add_Component_Declarations;

   procedure Add_Protected_Type_Declarations
     (Decl : Iir_Protected_Type_Declaration) is
   begin
      Add_Declarations (Get_Declaration_Chain (Decl), False);
   end Add_Protected_Type_Declarations;

   procedure Extend_Scope_Of_Block_Declarations (Decl : Iir) is
   begin
      case Get_Kind (Decl) is
         when Iir_Kind_Architecture_Body =>
            Add_Context_Clauses (Get_Design_Unit (Decl));
         when Iir_Kind_Block_Statement
           | Iir_Kind_Generate_Statement_Body =>
            --  FIXME: formal, iterator ?
            null;
         when others =>
            Error_Kind ("extend_scope_of_block_declarations", Decl);
      end case;
      Add_Declarations (Get_Declaration_Chain (Decl), False);
      Add_Declarations_Of_Concurrent_Statement (Decl);
   end Extend_Scope_Of_Block_Declarations;

   procedure Use_Library_All (Library : Iir_Library_Declaration)
   is
      Design_File : Iir_Design_File;
      Design_Unit : Iir_Design_Unit;
      Library_Unit : Iir;
   begin
      Design_File := Get_Design_File_Chain (Library);
      while Design_File /= Null_Iir loop
         Design_Unit := Get_First_Design_Unit (Design_File);
         while Design_Unit /= Null_Iir loop
            Library_Unit := Get_Library_Unit (Design_Unit);
            if Get_Kind (Library_Unit) /= Iir_Kind_Package_Body then
               Add_Name (Design_Unit, Get_Identifier (Design_Unit), True);
            end if;
            Design_Unit := Get_Chain (Design_Unit);
         end loop;
         Design_File := Get_Chain (Design_File);
      end loop;
   end Use_Library_All;

   procedure Potentially_Add_Name (Name : Iir) is
   begin
      Add_Name (Name, Get_Identifier (Name), True);
   end Potentially_Add_Name;

   --  LRM08 12.4 Use clauses
   --  Moreover, the following declarations, if any, that occurs immediately
   --  within the package denoted by the prefix of the selected name, are also
   --  identifier:
   procedure Use_Selected_Type_Name (Name : Iir)
   is
      Type_Def : constant Iir := Get_Type (Name);
      Base_Type : constant Iir := Get_Base_Type (Type_Def);
   begin
      case Get_Kind (Base_Type) is
         when Iir_Kind_Enumeration_Type_Definition =>
            --  LRM08 12.4 Use clauses
            --  - If the type mark denotes an enumeration type of a subtype of
            --    an enumeration type, the enumeration literals of the base
            --    type
            declare
               List : constant Iir_Flist :=
                 Get_Enumeration_Literal_List (Base_Type);
               El : Iir;
            begin
               for I in Flist_First .. Flist_Last (List) loop
                  El := Get_Nth_Element (List, I);
                  Potentially_Add_Name (El);
               end loop;
            end;
         when Iir_Kind_Physical_Type_Definition =>
            --  LRM08 12.4 Use clauses
            --  - If the type mark denotes a subtype of a physical type, the
            --    units of the base type
            declare
               El : Iir;
            begin
               El := Get_Unit_Chain (Base_Type);
               while El /= Null_Iir loop
                  Potentially_Add_Name (El);
                  El := Get_Chain (El);
               end loop;
            end;
         when others =>
            null;
      end case;

      --  LRM08 12.4 Use clauses
      --  - The implicit declarations of predefined operations for the type
      --    that are not hidden by homographs explicitly declared immediately
      --    within the package denoted by the prefix of the selected name
      --  - The declarations of homographs, explicitly declared immediately
      --    within the package denotes by the prefix of the selected name,
      --    that hide implicit declarations of predefined operations for the
      --    type
      declare
         Type_Decl : constant Iir := Get_Type_Declarator (Base_Type);
         El : Iir;
         Has_Override : Boolean;
      begin
         Has_Override := False;
         El := Get_Chain (Type_Decl);
         while El /= Null_Iir loop
            if Is_Implicit_Subprogram (El)
              and then Is_Operation_For_Type (El, Base_Type)
            then
               if Get_Visible_Flag (El) then
                  --  Implicit declaration EL was overriden by a user
                  --  declaration.  Don't make it visible.
                  Potentially_Add_Name (El);
               else
                  Has_Override := True;
               end if;
               El := Get_Chain (El);
            else
               exit;
            end if;
         end loop;

         --  Explicitly declared homograph.
         if Has_Override then
            while El /= Null_Iir loop
               if Get_Kind (El) in Iir_Kinds_Subprogram_Declaration
                 and then Get_Hide_Implicit_Flag (El)
                 and then Is_Operation_For_Type (El, Base_Type)
               then
                  Potentially_Add_Name (El);
               end if;
               El := Get_Chain (El);
            end loop;
         end if;
      end;
   end Use_Selected_Type_Name;

   --  LRM02 10.4 Use clauses
   --  Each selected name in a use clause identifiers one or more declarations
   --  that will potentially become directly visible. If the suffix of the
   --  selected name is a simple name, a character literal, or operator
   --  symbol, then the selected name identifiers only the declarations(s) of
   --  that simple name, character literal, or operator symbol contained
   --  within the package or library denoted by the prefix of the selected
   --  name.
   procedure Use_Selected_Name (Name : Iir)
   is
      Nname : Iir;
   begin
      if Name = Null_Iir then
         return;
      end if;

      case Get_Kind (Name) is
         when Iir_Kind_Overload_List =>
            Add_Declarations_List (Get_Overload_List (Name), True);
         when Iir_Kind_Error =>
            null;
         when others =>
            Potentially_Add_Name (Name);

            --  LRM08 12.4 Use clauses
            --  If the suffix of the selected name is a type mark, then the
            --  declaration of the type or subtype denoted by the type mark
            --  is identified. Moreover [...]
            if (Vhdl_Std >= Vhdl_08 or else Flag_Relaxed_Rules) then
               Nname := Strip_Non_Object_Alias (Name);
               if Get_Kind (Nname) in Iir_Kinds_Type_Declaration then
                  Use_Selected_Type_Name (Nname);
               end if;
            end if;
      end case;
   end Use_Selected_Name;

   --  LRM93 10.4 Use clauses
   --  If the suffix is the reserved word ALL, then all the selected name
   --  identifies all declaration that are contained within the package or
   --  library denotes by te prefix of the selected name.
   procedure Use_All_Names (Name: Iir) is
   begin
      case Get_Kind (Name) is
         when Iir_Kind_Library_Declaration =>
            Use_Library_All (Name);
         when Iir_Kind_Package_Declaration =>
            Add_Package_Declarations (Name, True);
         when Iir_Kind_Package_Instantiation_Declaration =>
            Add_Package_Instantiation_Declarations (Name, True);
         when Iir_Kind_Interface_Package_Declaration =>
            --  LRM08 6.5.5 Interface package declarations
            --  Within an entity declaration, an architecture body, a
            --  component declaration, or an uninstantiated subprogram or
            --  package declaration that declares a given interface package,
            --  the name of the given interface package denotes an undefined
            --  instance of the uninstantiated package.
            Add_Package_Instantiation_Declarations (Name, True);
         when Iir_Kind_Error =>
            null;
         when others =>
            raise Internal_Error;
      end case;
   end Use_All_Names;

   procedure Add_Use_Clause (Clause : Iir_Use_Clause)
   is
      Name : Iir;
      Cl : Iir_Use_Clause;
   begin
      Cl := Clause;
      loop
         Name := Get_Selected_Name (Cl);
         if Name = Null_Iir then
            pragma Assert (Flags.Flag_Force_Analysis);
            null;
         else
            if Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then
               Name := Get_Prefix (Name);
               if not Is_Error (Name) then
                  Use_All_Names (Get_Named_Entity (Name));
               end if;
            else
               if not Is_Error (Name) then
                  Use_Selected_Name (Get_Named_Entity (Name));
               end if;
            end if;
         end if;
         Cl := Get_Use_Clause_Chain (Cl);
         exit when Cl = Null_Iir;
      end loop;
   end Add_Use_Clause;

   procedure Add_Inherit_Spec (Spec : Iir)
   is
      Name : constant Iir := Get_Name (Spec);
      Unit : Iir;
      Item : Iir;
   begin
      if Name = Null_Iir then
         return;
      end if;
      Unit := Get_Named_Entity (Name);
      Item := Get_Vunit_Item_Chain (Unit);
      while Item /= Null_Iir loop
         case Get_Kind (Item) is
            when Iir_Kind_Psl_Declaration =>
               Potentially_Add_Name (Item);
            when others =>
               Error_Kind ("add_inherit_spec", Item);
         end case;
         Item := Get_Chain (Item);
      end loop;
   end Add_Inherit_Spec;

   --  Debugging subprograms.
   procedure Disp_All_Names;
   pragma Unreferenced (Disp_All_Names);

   procedure Disp_Scopes;
   pragma Unreferenced (Disp_Scopes);

   procedure Disp_Detailed_Interpretations (Ident : Name_Id);
   pragma Unreferenced (Disp_Detailed_Interpretations);

   procedure Dump_Current_Scope;
   pragma Unreferenced (Dump_Current_Scope);

   procedure Disp_Detailed_Interpretations (Ident : Name_Id)
   is
      Inter: Name_Interpretation_Type;
      Decl : Iir;
   begin
      Log (Name_Table.Image (Ident));
      Log_Line (":");

      Inter := Get_Interpretation (Ident);
      while Valid_Interpretation (Inter) loop
         Log (Name_Interpretation_Type'Image (Inter));
         if Is_Potentially_Visible (Inter) then
            Log (" (use)");
         end if;
         Log (":");
         Decl := Get_Declaration (Inter);
         Log (Iir'Image (Decl));
         Log (":");
         Log (Iir_Kind'Image (Get_Kind (Decl)));
         Log_Line (", loc: " & Image (Get_Location (Decl)));
         if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then
            Log_Line ("   " & Disp_Subprg (Decl));
         end if;
         Inter := Get_Next_Interpretation (Inter);
      end loop;
   end Disp_Detailed_Interpretations;

   procedure Disp_All_Interpretations
     (Interpretation : Name_Interpretation_Type)
   is
      Inter: Name_Interpretation_Type;
   begin
      Inter := Interpretation;
      while Valid_Interpretation (Inter) loop
         Log (Name_Interpretation_Type'Image (Inter));
         Log (".");
         Log (Iir_Kind'Image (Get_Kind (Get_Declaration (Inter))));
         Inter := Get_Next_Interpretation (Inter);
      end loop;
      Log_Line;
   end Disp_All_Interpretations;

   procedure Disp_All_Names
   is
      Inter: Name_Interpretation_Type;
   begin
      for I in 0 .. Name_Table.Last_Name_Id loop
         Inter := Get_Interpretation (I);
         if Valid_Interpretation (Inter) then
            Log (Name_Table.Image (I));
            Log (Name_Id'Image (I));
            Log (":");
            Disp_All_Interpretations (Inter);
         end if;
      end loop;
      Log_Line ("interprations.last = "
                & Name_Interpretation_Type'Image (Interpretations.Last));
      Log_Line ("current_region_start ="
                & Name_Interpretation_Type'Image (Current_Region_Start));
   end Disp_All_Names;

   procedure Dump_Interpretation (Inter : Name_Interpretation_Type)
   is
      Decl : Iir;
   begin
      Log (Name_Interpretation_Type'Image (Inter));
      if Is_Potentially_Visible (Inter) then
         Log (" (use)");
      end if;
      Log (": ");
      Decl := Get_Declaration (Inter);
      if Decl = Null_Iir then
         Log_Line ("null: conflict");
      else
         Log (Iir_Kind'Image (Get_Kind (Decl)));
         Log_Line (", loc: " & Image (Get_Location (Decl)));
         if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then
            Log_Line ("   " & Disp_Subprg (Decl));
         end if;
      end if;
   end Dump_Interpretation;

   procedure Dump_A_Scope (First, Last : Name_Interpretation_Type) is
   begin
      if First > Last then
         Log_Line ("scope is empty");
         return;
      end if;

      for Inter in reverse First .. Last loop
         declare
            Cell : Interpretation_Cell renames Interpretations.Table (Inter);
         begin
            Dump_Interpretation (Inter);
            if Cell.Prev_Hidden then
               Log ("  [prev:");
               Log (Name_Interpretation_Type'Image (Cell.Prev));
               if Cell.Prev_Hidden then
                  Log (" hidden");
               end if;
               Log_Line ("]");
            else
               if Cell.Prev < First then
                  Log_Line (" [last in scope]");
               end if;
            end if;
         end;
      end loop;
   end Dump_A_Scope;

   procedure Dump_Current_Scope is
   begin
      Dump_A_Scope (Current_Region_Start, Interpretations.Last);
   end Dump_Current_Scope;

   procedure Disp_Scopes is
   begin
      for I in reverse Scopes.First .. Scopes.Last loop
         declare
            S : Scope_Cell renames Scopes.Table (I);
         begin
            case S.Kind is
               when Scope_Start =>
                  Log ("scope_start at");
               when Scope_Region =>
                  Log ("scope_region at");
            end case;
            Log_Line (Name_Interpretation_Type'Image (S.Saved_Region_Start));
         end;
      end loop;
   end Disp_Scopes;
end Vhdl.Sem_Scopes;