openwrt/em-br6478acv2/master-187ad058 - openwrt master 187ad058

--  Semantic analysis.
--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
--
--  GHDL 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, or (at your option) any later
--  version.
--
--  GHDL 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 GHDL; see the file COPYING.  If not, write to the Free
--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--  02111-1307, USA.
with Errorout; use Errorout;
with Types; use Types;
with Std_Names;
with Vhdl.Tokens;
with Flags; use Flags;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Sem; use Vhdl.Sem;
with Vhdl.Sem_Utils; use Vhdl.Sem_Utils;
with Vhdl.Sem_Expr; use Vhdl.Sem_Expr;
with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes;
with Vhdl.Sem_Names; use Vhdl.Sem_Names;
with Vhdl.Sem_Specs; use Vhdl.Sem_Specs;
with Vhdl.Sem_Types; use Vhdl.Sem_Types;
with Vhdl.Sem_Psl;
with Vhdl.Sem_Inst;
with Vhdl.Xrefs; use Vhdl.Xrefs;

package body Vhdl.Sem_Decls is
   --  Region that can declare signals.  Used to add implicit declarations.
   Current_Signals_Region : Implicit_Signal_Declaration_Type :=
     (Null_Iir, Null_Iir, Null_Iir, False, Null_Iir);

   procedure Push_Signals_Declarative_Part
     (Cell: out Implicit_Signal_Declaration_Type; Decls_Parent : Iir) is
   begin
      Cell := Current_Signals_Region;
      Current_Signals_Region :=
        (Decls_Parent, Null_Iir, Null_Iir, False, Null_Iir);
   end Push_Signals_Declarative_Part;

   procedure Pop_Signals_Declarative_Part
     (Cell: in Implicit_Signal_Declaration_Type) is
   begin
      Current_Signals_Region := Cell;
   end Pop_Signals_Declarative_Part;

   --  Insert the implicit signal declaration after LAST_DECL.
   procedure Insert_Implicit_Signal (Last_Decl : Iir) is
   begin
      if Last_Decl = Null_Iir then
         Set_Declaration_Chain (Current_Signals_Region.Decls_Parent,
                                Current_Signals_Region.Implicit_Decl);
      else
         Set_Chain (Last_Decl, Current_Signals_Region.Implicit_Decl);
      end if;
   end Insert_Implicit_Signal;

   --  Add SIG as an implicit declaration in the current region.
   procedure Add_Declaration_For_Implicit_Signal (Sig : Iir)
   is
      Decl : Iir;
   begin
      --  We deal only with signal attribute.
      pragma Assert (Get_Kind (Sig) in Iir_Kinds_Signal_Attribute);

      --  There must be a declarative part for implicit signals.
      pragma Assert (Current_Signals_Region.Decls_Parent /= Null_Iir);

      --  Attr_Chain must be empty.
      pragma Assert (Get_Attr_Chain (Sig) = Null_Iir);

      if Current_Signals_Region.Implicit_Decl = Null_Iir then
         --  Create the signal_attribute_declaration to hold all the implicit
         --  signals.
         Decl := Create_Iir (Iir_Kind_Signal_Attribute_Declaration);
         Location_Copy (Decl, Sig);
         Set_Parent (Decl, Current_Signals_Region.Decls_Parent);

         --  Save the implicit declaration.
         Current_Signals_Region.Implicit_Decl := Decl;

         --  Append SIG (this is the first one).
         Set_Signal_Attribute_Chain (Decl, Sig);

         if Current_Signals_Region.Decls_Analyzed then
            --  Declarative region was completely analyzed.  Just append DECL
            --  at the end of declarations.
            Insert_Implicit_Signal (Current_Signals_Region.Last_Decl);
         end if;
      else
         --  Append SIG.
         Set_Attr_Chain (Current_Signals_Region.Last_Attribute_Signal, Sig);
      end if;
      Current_Signals_Region.Last_Attribute_Signal := Sig;

      Set_Signal_Attribute_Declaration
        (Sig, Current_Signals_Region.Implicit_Decl);
   end Add_Declaration_For_Implicit_Signal;

   --  Insert pending implicit declarations after the last analyzed LAST_DECL,
   --  and update it.  Then the caller has to insert the declaration which
   --  created the implicit declarations.
   procedure Insert_Pending_Implicit_Declarations
     (Parent : Iir; Last_Decl : in out Iir) is
   begin
      if Current_Signals_Region.Decls_Parent = Parent
        and then Current_Signals_Region.Implicit_Decl /= Null_Iir
      then
         --  There are pending implicit declarations.  Can happen only
         --  during analysis of declarations, therefore when declarations are
         --  not fully analyzed.
         pragma Assert (not Current_Signals_Region.Decls_Analyzed);

         --  Add pending implicit declarations before the current one.
         Insert_Implicit_Signal (Last_Decl);
         Last_Decl := Current_Signals_Region.Implicit_Decl;

         --  Detach the implicit declaration.
         Current_Signals_Region.Implicit_Decl := Null_Iir;
         Current_Signals_Region.Last_Attribute_Signal := Null_Iir;
      end if;
   end Insert_Pending_Implicit_Declarations;

   procedure Add_Implicit_Declaration (Sig : Iir) is
   begin
      --  Only for anonymous signals, which appear in instantiations (so
      --  once the declarations have been analyzed).
      pragma Assert (Get_Kind (Sig) = Iir_Kind_Anonymous_Signal_Declaration);
      pragma Assert (Current_Signals_Region.Decls_Analyzed);

      if Current_Signals_Region.Last_Decl = Null_Iir then
         Set_Declaration_Chain (Current_Signals_Region.Decls_Parent, Sig);
      else
         Set_Chain (Current_Signals_Region.Last_Decl, Sig);
      end if;
      Current_Signals_Region.Last_Decl := Sig;
      Set_Parent (Sig, Current_Signals_Region.Decls_Parent);
   end Add_Implicit_Declaration;

   --  Mark the end of declaration analysis.  New implicit declarations will
   --  simply be appended to the last declaration.
   procedure End_Of_Declarations_For_Implicit_Declarations
     (Parent : Iir; Last_Decl : Iir) is
   begin
      if Current_Signals_Region.Decls_Parent = Parent then
         pragma Assert (not Current_Signals_Region.Decls_Analyzed);

         --  All declarations have been analyzed, new implicit declarations
         --  will be appended.
         Current_Signals_Region.Decls_Analyzed := True;
         Current_Signals_Region.Last_Decl := Last_Decl;
      end if;
   end End_Of_Declarations_For_Implicit_Declarations;

   procedure Mark_Subprogram_Used (Subprg : Iir)
   is
      N : Iir;
   begin
      N := Subprg;
      loop
         exit when Get_Use_Flag (N);
         Set_Use_Flag (N, True);
         N := Sem_Inst.Get_Origin (N);
         --  The origin may also be an instance.
         exit when N = Null_Iir;
      end loop;
   end Mark_Subprogram_Used;

   --  Emit an error if the type of DECL is a file type, access type,
   --  protected type or if a subelement of DECL is an access type.
   procedure Check_Signal_Type (Decl : Iir)
   is
      Decl_Type : constant Iir := Get_Type (Decl);
   begin
      if Get_Signal_Type_Flag (Decl_Type) then
         return;
      end if;

      if Is_Error (Decl_Type) then
         return;
      end if;

      Error_Msg_Sem (+Decl, "type of %n cannot be %n", (+Decl, +Decl_Type));
      case Get_Kind (Decl_Type) is
         when Iir_Kind_File_Type_Definition =>
            null;
         when Iir_Kind_Protected_Type_Declaration =>
            null;
         when Iir_Kind_Interface_Type_Definition =>
            null;
         when Iir_Kind_Access_Type_Definition
           | Iir_Kind_Access_Subtype_Definition =>
            null;
         when Iir_Kinds_Array_Type_Definition
           | Iir_Kind_Record_Type_Definition
           | Iir_Kind_Record_Subtype_Definition =>
            Error_Msg_Sem (+Decl, "(%n has an access subelement)", +Decl_Type);
         when others =>
            Error_Kind ("check_signal_type", Decl_Type);
      end case;
   end Check_Signal_Type;

   procedure Check_Nature_Type (Decl : Iir)
   is
      Decl_Type : constant Iir := Get_Type (Decl);
   begin
      if not Is_Nature_Type (Decl_Type) then
         Error_Msg_Sem (+Decl, "type of %n must only have float", +Decl);
      end if;
   end Check_Nature_Type;

   procedure Sem_Interface_Object_Declaration
     (Inter, Last : Iir; Interface_Kind : Interface_Kind_Type)
   is
      A_Type: Iir;
      Default_Value: Iir;
   begin
      --  Avoid the reanalysed duplicated types.
      --  This is not an optimization, since the unanalysed type must have
      --  been freed.
      A_Type := Get_Subtype_Indication (Inter);
      if A_Type = Null_Iir then
         if Last = Null_Iir or else not Get_Has_Identifier_List (Last) then
            --  Subtype indication was not parsed.
            A_Type := Create_Error_Type (Null_Iir);
            Set_Subtype_Indication (Inter, A_Type);
         else
            A_Type := Get_Type (Last);
            Default_Value := Get_Default_Value (Last);
         end if;
      else
         A_Type := Sem_Subtype_Indication (A_Type);
         Set_Subtype_Indication (Inter, A_Type);
         A_Type := Get_Type_Of_Subtype_Indication (A_Type);

         Default_Value := Get_Default_Value (Inter);
         if Default_Value /= Null_Iir and then not Is_Error (A_Type) then
            Deferred_Constant_Allowed := True;
            Default_Value := Sem_Expression (Default_Value, A_Type);
            Default_Value :=
              Eval_Expr_Check_If_Static (Default_Value, A_Type);
            Deferred_Constant_Allowed := False;
            Check_Read (Default_Value);
         end if;
      end if;

      Set_Name_Staticness (Inter, Locally);
      Xref_Decl (Inter);

      if not Is_Error (A_Type) then
         Set_Type (Inter, A_Type);

         if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then
            if Get_Guarded_Signal_Flag (Inter) then
               case Get_Signal_Kind (Inter) is
                  when Iir_Bus_Kind =>
                     --  LRM93 4.3.1.2
                     --  It is also an error if a guarded signal of a scalar
                     --  type is neither a resolved signal nor a subelement of
                     --  a resolved signal.
                     if not Get_Resolved_Flag (A_Type) then
                        Error_Msg_Sem
                          (+Inter, "%n of guarded %n is not resolved",
                           (+A_Type, +Inter));
                     end if;

                     --  LRM 2.1.1.2  Signal parameter
                     --  It is an error if the declaration of a formal signal
                     --  parameter includes the reserved word BUS.
                     if Flags.Vhdl_Std >= Vhdl_93
                       and then Interface_Kind in Parameter_Interface_List
                     then
                        Error_Msg_Sem
                          (+Inter, "signal parameter can't be of kind bus");
                     end if;
                  when Iir_Register_Kind =>
                     --  LRM93 4.3.2 Interface declarations
                     --  Grammar for interface_signal_declaration.
                     Error_Msg_Sem
                       (+Inter, "interface signal can't be of kind register");
               end case;
            end if;
            Set_Type_Has_Signal (A_Type);
         end if;

         case Get_Kind (Inter) is
            when Iir_Kind_Interface_Constant_Declaration
              | Iir_Kind_Interface_Signal_Declaration =>
               --  LRM 4.3.2  Interface declarations
               --  For an interface constant declaration or an interface
               --  signal declaration, the subtype indication must define
               --  a subtype that is neither a file type, an access type,
               --  nor a protected type.  Moreover, the subtype indication
               --  must not denote a composite type with a subelement that
               --  is a file type, an access type, or a protected type.
               Check_Signal_Type (Inter);
            when Iir_Kind_Interface_Variable_Declaration =>
               case Get_Kind (Get_Base_Type (A_Type)) is
                  when Iir_Kind_File_Type_Definition =>
                     if Flags.Vhdl_Std >= Vhdl_93 then
                        Error_Msg_Sem
                          (+Inter,
                           "variable formal can't be a file (vhdl 93)");
                     end if;
                  when Iir_Kind_Protected_Type_Declaration =>
                     --  LRM 2.1.1.1  Constant and variable parameters
                     --  It is an error if the mode of the parameter is
                     --  other that INOUT.
                     if Get_Mode (Inter) /= Iir_Inout_Mode then
                        Error_Msg_Sem
                          (+Inter,
                           "parameter of protected type must be inout");
                     end if;
                  when others =>
                     null;
               end case;
            when Iir_Kind_Interface_File_Declaration =>
               if Get_Kind (Get_Base_Type (A_Type))
                 /= Iir_Kind_File_Type_Definition
               then
                  Error_Msg_Sem
                    (+Inter, "file formal type must be a file type");
               end if;
            when Iir_Kind_Interface_Quantity_Declaration =>
               Check_Nature_Type (Inter);
            when others =>
               --  Inter is not an interface.
               raise Internal_Error;
         end case;

         if Default_Value /= Null_Iir then
            Set_Default_Value (Inter, Default_Value);

            --  LRM 4.3.2  Interface declarations.
            --  It is an error if a default expression appears in an
            --  interface declaration and any of the following conditions
            --  hold:
            --   -  The mode is linkage
            --   -  The interface object is a formal signal parameter
            --   -  The interface object is a formal variable parameter of
            --      mode other than in
            --   -  The subtype indication of the interface declaration
            --      denotes a protected type.
            case Get_Kind (Inter) is
               when Iir_Kind_Interface_Constant_Declaration =>
                  null;
               when Iir_Kind_Interface_Signal_Declaration =>
                  if Get_Mode (Inter) = Iir_Linkage_Mode then
                     Error_Msg_Sem
                       (+Inter,
                        "default expression not allowed for linkage port");
                  elsif Interface_Kind in Parameter_Interface_List then
                     Error_Msg_Sem
                       (+Inter,
                        "default expression not allowed for signal parameter");
                  end if;
               when Iir_Kind_Interface_Variable_Declaration =>
                  if Get_Mode (Inter) /= Iir_In_Mode then
                     Error_Msg_Sem
                       (+Inter, "default expression not allowed for"
                          & " out or inout variable parameter");
                  elsif Get_Kind (A_Type) = Iir_Kind_Protected_Type_Declaration
                  then
                     Error_Msg_Sem
                       (+Inter, "default expression not allowed for"
                          & " variable parameter of protected type");
                  end if;
               when Iir_Kind_Interface_File_Declaration =>
                  raise Internal_Error;
               when others =>
                  null;
            end case;
         end if;
      else
         Set_Type (Inter, Error_Type);
      end if;

      Sem_Scopes.Add_Name (Inter);

      --  By default, interface are not static.
      --  This may be changed just below.
      Set_Expr_Staticness (Inter, None);

      case Interface_Kind is
         when Generic_Interface_List =>
            --  LRM93 1.1.1
            --  The generic list in the formal generic clause defines
            --  generic constants whose values may be determined by the
            --  environment.
            if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then
               Error_Msg_Sem (+Inter, "generic %n must be a constant", +Inter);
            else
               --   LRM93 7.4.2 (Globally static primaries)
               --   3. a generic constant.
               Set_Expr_Staticness (Inter, Globally);
            end if;
         when Port_Interface_List =>
            case Get_Kind (Inter) is
               when Iir_Kind_Interface_Signal_Declaration
                 | Iir_Kind_Interface_Terminal_Declaration
                 | Iir_Kind_Interface_Quantity_Declaration =>
                  null;
               when others =>
                  if AMS_Vhdl then
                     Error_Msg_Sem
                       (+Inter,
                        "port %n must be a signal, a terminal or a quantity",
                        +Inter);
                  else
                     Error_Msg_Sem
                       (+Inter, "port %n must be a signal", +Inter);
                  end if;
            end case;
         when Parameter_Interface_List =>
            if Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration
              and then Interface_Kind = Function_Parameter_Interface_List
            then
               Error_Msg_Sem (+Inter, "variable interface parameter are not "
                                & "allowed for a function (use a constant)");
            end if;

            --  By default, we suppose a subprogram read the activity of
            --  a signal.
            --  This will be adjusted when the body is analyzed.
            if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration
              and then Get_Mode (Inter) in Iir_In_Modes
            then
               Set_Has_Active_Flag (Inter, True);
            end if;

            case Get_Mode (Inter) is
               when Iir_Unknown_Mode =>
                  raise Internal_Error;
               when Iir_In_Mode =>
                  null;
               when Iir_Inout_Mode
                 | Iir_Out_Mode =>
                  if Interface_Kind = Function_Parameter_Interface_List
                    and then
                    Get_Kind (Inter) /= Iir_Kind_Interface_File_Declaration
                  then
                     Error_Msg_Sem
                       (+Inter,
                        "mode of a function parameter cannot be inout or out");
                  end if;
               when Iir_Buffer_Mode
                 | Iir_Linkage_Mode =>
                  Error_Msg_Sem
                    (+Inter, "buffer or linkage mode is not allowed "
                       & "for a subprogram parameter");
            end case;
      end case;
   end Sem_Interface_Object_Declaration;

   procedure Sem_Interface_Terminal_Declaration (Inter, Last : Iir)
   is
      Nature: Iir;
   begin
      --  Avoid the reanalysed duplicated natures.
      Nature := Get_Subnature_Indication (Inter);
      if Nature = Null_Iir then
         if Last = Null_Iir or else not Get_Has_Identifier_List (Last) then
            --  Subnature indication was not parsed.
            Nature := Create_Error (Null_Iir);
            Set_Subtype_Indication (Inter, Nature);
         else
            Nature := Get_Nature (Last);
         end if;
      else
         Nature := Sem_Subnature_Indication (Nature);
         Set_Subnature_Indication (Inter, Nature);
         Nature := Get_Nature_Of_Subnature_Indication (Nature);
      end if;

      Set_Name_Staticness (Inter, Locally);
      Xref_Decl (Inter);

      Set_Nature (Inter, Nature);

      Sem_Scopes.Add_Name (Inter);
   end Sem_Interface_Terminal_Declaration;

   procedure Sem_Interface_Package_Declaration (Inter : Iir)
   is
      Pkg : Iir;
   begin
      --  LRM08 6.5.5 Interface package declarations
      --  the uninstantiated_package_name shall denote an uninstantiated
      --  package declared in a package declaration.
      Pkg := Sem_Uninstantiated_Package_Name (Inter);
      if Pkg = Null_Iir then
         return;
      end if;

      if Get_Generic_Map_Aspect_Chain (Inter) /= Null_Iir then
         Sem_Generic_Association_Chain (Get_Package_Header (Pkg), Inter);
         --  Not yet fully supported - need to check the instance.
      end if;

      Sem_Inst.Instantiate_Package_Declaration (Inter, Pkg);

      Sem_Scopes.Add_Name (Inter);
      Set_Is_Within_Flag (Inter, True);
      Xref_Decl (Inter);
   end Sem_Interface_Package_Declaration;

   function Create_Implicit_Interface_Function (Name : Name_Id;
                                                Decl : Iir;
                                                Interface_Chain : Iir;
                                                Return_Type : Iir)
                                               return Iir
   is
      Operation : Iir_Function_Declaration;
   begin
      Operation := Create_Iir (Iir_Kind_Interface_Function_Declaration);
      Location_Copy (Operation, Decl);
      Set_Parent (Operation, Get_Parent (Decl));
      Set_Interface_Declaration_Chain (Operation, Interface_Chain);
      Set_Return_Type (Operation, Return_Type);
      Set_Identifier (Operation, Name);
      Set_Visible_Flag (Operation, True);
      Set_Pure_Flag (Operation, True);
      Compute_Subprogram_Hash (Operation);
      return Operation;
   end Create_Implicit_Interface_Function;

   procedure Sem_Interface_Type_Declaration (Inter : Iir)
   is
      Def : Iir;
      Finters : Iir;
      Op_Eq, Op_Neq : Iir;
   begin
      --  Create type definition.
      Def := Create_Iir (Iir_Kind_Interface_Type_Definition);
      Set_Location (Def, Get_Location (Inter));
      Set_Type_Declarator (Def, Inter);
      Set_Type (Inter, Def);
      Set_Base_Type (Def, Def);
      Set_Type_Staticness (Def, None);
      Set_Resolved_Flag (Def, False);
      Set_Signal_Type_Flag (Def, True);
      Set_Has_Signal_Flag (Def, False);

      --  Create operations for the interface type.
      Finters := Create_Anonymous_Interface (Def);
      Set_Chain (Finters, Create_Anonymous_Interface (Def));

      Op_Eq := Create_Implicit_Interface_Function
        (Std_Names.Name_Op_Equality,
         Inter, Finters, Std_Package.Boolean_Type_Definition);

      Op_Neq := Create_Implicit_Interface_Function
        (Std_Names.Name_Op_Inequality,
         Inter, Finters, Std_Package.Boolean_Type_Definition);

      Set_Interface_Type_Subprograms (Inter, Op_Eq);
      Set_Chain (Op_Eq, Op_Neq);

      Sem_Scopes.Add_Name (Inter);
      Sem_Scopes.Add_Name (Op_Eq);
      Sem_Scopes.Add_Name (Op_Neq);
      Xref_Decl (Inter);
   end Sem_Interface_Type_Declaration;

   procedure Sem_Interface_Subprogram_Declaration (Inter : Iir) is
   begin
      Sem_Subprogram_Specification (Inter);
      Sem_Scopes.Add_Name (Inter);
      Xref_Decl (Inter);
   end Sem_Interface_Subprogram_Declaration;

   procedure Sem_Interface_Chain (Interface_Chain: Iir;
                                  Interface_Kind : Interface_Kind_Type)
   is
      --  Control visibility of interface object.  See below for its use.
      Immediately_Visible : constant Boolean :=
        Interface_Kind = Generic_Interface_List
        and then Flags.Vhdl_Std >= Vhdl_08;

      Inter : Iir;

      --  LAST is the last interface declaration that has a type.  This is
      --  used to set type and default value for the following declarations
      --  that appeared in a list of identifiers.
      Last : Iir;
   begin
      Last := Null_Iir;

      Inter := Interface_Chain;
      while Inter /= Null_Iir loop
         case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
            when Iir_Kinds_Interface_Object_Declaration =>
               Sem_Interface_Object_Declaration (Inter, Last, Interface_Kind);
               Last := Inter;
            when Iir_Kind_Interface_Terminal_Declaration =>
               Sem_Interface_Terminal_Declaration (Inter, Last);
               Last := Inter;
            when Iir_Kind_Interface_Package_Declaration =>
               Sem_Interface_Package_Declaration (Inter);
            when Iir_Kind_Interface_Type_Declaration =>
               Sem_Interface_Type_Declaration (Inter);
            when Iir_Kinds_Interface_Subprogram_Declaration =>
               Sem_Interface_Subprogram_Declaration (Inter);
         end case;

         --  LRM08 6.5.6 Interface lists
         --  A name that denotes an interface object declared in a port
         --  interface list of a prameter interface list shall not appear in
         --  any interface declaration within the interface list containing the
         --  denoted interface object expect to declare this object.
         --  A name that denotes an interface declaration in a generic
         --  interface list may appear in an interface declaration within the
         --  interface list containing the denoted interface declaration.
         if Immediately_Visible then
            Name_Visible (Inter);
         end if;

         Inter := Get_Chain (Inter);
      end loop;

      --  LRM 10.3  Visibility
      --  A declaration is visible only within a certain part of its scope;
      --  this starts at the end of the declaration [...]

      --  LRM 4.3.2.1  Interface List
      --  A name that denotes an interface object must not appear in any
      --  interface declaration within the interface list containing the
      --  denotes interface except to declare this object.

      --  GHDL: this is achieved by making the interface object visible after
      --   having analyzed the interface list.
      if not Immediately_Visible then
         Inter := Interface_Chain;
         while Inter /= Null_Iir loop
            Name_Visible (Inter);
            Inter := Get_Chain (Inter);
         end loop;
      end if;
   end Sem_Interface_Chain;

   --  Analyze a type or an anonymous type declaration.
   procedure Sem_Type_Declaration (Decl: Iir; Is_Global : Boolean)
   is
      Def: Iir;
      Inter : Name_Interpretation_Type;
      Old_Decl : Iir;
      St_Decl : Iir_Subtype_Declaration;
      Bt_Def : Iir;
   begin
      --  Check if DECL complete a previous incomplete type declaration.
      Inter := Get_Interpretation (Get_Identifier (Decl));
      if Valid_Interpretation (Inter)
        and then Is_In_Current_Declarative_Region (Inter)
      then
         Old_Decl := Get_Declaration (Inter);
         if Get_Kind (Old_Decl) /= Iir_Kind_Type_Declaration
           or else (Get_Kind (Get_Type_Definition (Old_Decl)) /=
                      Iir_Kind_Incomplete_Type_Definition)
         then
            Old_Decl := Null_Iir;
         else
            Set_Incomplete_Type_Declaration (Decl, Old_Decl);
         end if;
      else
         Old_Decl := Null_Iir;
      end if;

      if Old_Decl = Null_Iir then
         if Get_Kind (Decl) = Iir_Kind_Type_Declaration then
            --  This is necessary at least for enumeration type definition.
            --  Type declaration for anonymous types don't have name, only
            --  their subtype have names.  Those are added later.
            Sem_Scopes.Add_Name (Decl);
         end if;
      else
         --  This is a way to prevent:
         --    type a;
         --    type a is access a;
         --  which is non-sense.
         Set_Visible_Flag (Old_Decl, False);
      end if;

      -- Check the definition of the type.
      Def := Get_Type_Definition (Decl);
      if Def = Null_Iir then
         --  Incomplete type declaration
         Def := Create_Iir (Iir_Kind_Incomplete_Type_Definition);
         Location_Copy (Def, Decl);
         Set_Type_Definition (Decl, Def);
         Set_Base_Type (Def, Def);
         Set_Signal_Type_Flag (Def, True);
         Set_Type_Declarator (Def, Decl);
         Set_Visible_Flag (Decl, True);
         Xref_Decl (Decl);

         return;

      end if;

      --  A complete type declaration.
      if Old_Decl = Null_Iir then
         Xref_Decl (Decl);
      else
         Xref_Body (Decl, Old_Decl);
      end if;

      Def := Sem_Type_Definition (Def, Decl);
      if Def = Null_Iir then
         return;
      end if;

      case Get_Kind (Def) is
         when Iir_Kind_Integer_Subtype_Definition
           | Iir_Kind_Floating_Subtype_Definition
           | Iir_Kind_Physical_Subtype_Definition
           | Iir_Kind_Array_Subtype_Definition =>
            --  Some type declaration are in fact subtype declarations.
            St_Decl := Create_Iir (Iir_Kind_Subtype_Declaration);
            Location_Copy (St_Decl, Decl);
            Set_Identifier (St_Decl, Get_Identifier (Decl));
            Set_Parent (St_Decl, Get_Parent (Decl));
            Set_Type (St_Decl, Def);
            Set_Subtype_Indication (St_Decl, Def);
            Set_Type_Declarator (Def, St_Decl);
            Set_Chain (St_Decl, Get_Chain (Decl));
            Set_Chain (Decl, St_Decl);

            --  The type declaration declares the base type.
            Bt_Def := Get_Base_Type (Def);
            Set_Type_Definition (Decl, Bt_Def);
            Set_Type_Declarator (Bt_Def, Decl);
            Set_Subtype_Definition (Decl, Def);

            if Old_Decl = Null_Iir then
               Sem_Scopes.Add_Name (St_Decl);
            end if;

            Sem_Scopes.Name_Visible (St_Decl);

            --  The implicit subprogram will be added in the
            -- scope just after.
            Create_Implicit_Operations (Decl, False);

         when Iir_Kind_Enumeration_Type_Definition
           | Iir_Kind_Array_Type_Definition
           | Iir_Kind_Record_Type_Definition
           | Iir_Kind_Access_Type_Definition
           | Iir_Kind_File_Type_Definition =>
            St_Decl := Null_Iir;
            Set_Type_Declarator (Def, Decl);

            Sem_Scopes.Name_Visible (Decl);

            --  The implicit subprogram will be added in the
            -- scope just after.
            Create_Implicit_Operations (Decl, False);

         when Iir_Kind_Protected_Type_Declaration =>
            Set_Type_Declarator (Def, Decl);
            St_Decl := Null_Iir;
            --  No implicit subprograms.

         when others =>
            Error_Kind ("sem_type_declaration", Def);
      end case;

      if Old_Decl /= Null_Iir then
         --  Complete the type definition.
         declare
            Old_Def : constant Iir := Get_Type_Definition (Old_Decl);
            Ref : Iir;
         begin
            Set_Signal_Type_Flag (Old_Def, Get_Signal_Type_Flag (Def));
            Ref := Get_Incomplete_Type_Ref_Chain (Old_Def);
            while Is_Valid (Ref) loop
               pragma Assert
                 (Get_Kind (Ref) = Iir_Kind_Access_Type_Definition);
               Set_Designated_Type (Ref, Def);
               Ref := Get_Incomplete_Type_Ref_Chain (Ref);
            end loop;
            Set_Complete_Type_Definition (Old_Def, Def);

            --  The identifier now designates the complete type declaration.
            if St_Decl = Null_Iir then
               Replace_Name (Get_Identifier (Decl), Old_Decl, Decl);
            else
               Replace_Name (Get_Identifier (Decl), Old_Decl, St_Decl);
            end if;
         end;
      end if;

      if Is_Global then
         Set_Type_Has_Signal (Def);
      end if;
   end Sem_Type_Declaration;

   procedure Sem_Subtype_Declaration (Decl: Iir; Is_Global : Boolean)
   is
      Def: Iir;
      Ind : Iir;
   begin
      --  Real hack to skip subtype declarations of anonymous type decls.
      if Get_Visible_Flag (Decl) then
         return;
      end if;

      Sem_Scopes.Add_Name (Decl);
      Xref_Decl (Decl);

      --  Analyze the definition of the type.
      Ind := Get_Subtype_Indication (Decl);
      Ind := Sem_Subtype_Indication (Ind);
      Set_Subtype_Indication (Decl, Ind);
      Def := Get_Type_Of_Subtype_Indication (Ind);
      if Def = Null_Iir or else Is_Error (Def) then
         return;
      end if;

      if not Is_Anonymous_Type_Definition (Def) then
         --  There is no added constraints and therefore the subtype
         --  declaration is in fact an alias of the type.  Create a copy so
         --  that it has its own type declarator.
         Def := Copy_Subtype_Indication (Def);
         Location_Copy (Def, Decl);
         Set_Subtype_Type_Mark (Def, Ind);
         Set_Subtype_Indication (Decl, Def);
      end if;

      Set_Type (Decl, Def);
      Set_Type_Declarator (Def, Decl);
      Name_Visible (Decl);
      if Is_Global then
         Set_Type_Has_Signal (Def);
      end if;
   end Sem_Subtype_Declaration;

   --  If DECL is a constant declaration, and there is already a incomplete
   --  constant declaration in the current scope with the same name, then
   --  return it. Otherwise, return NULL.
   function Get_Deferred_Constant (Decl : Iir) return Iir
   is
      Deferred_Const : Iir;
      Interp : Name_Interpretation_Type;
   begin
      if Get_Kind (Decl) /= Iir_Kind_Constant_Declaration then
         return Null_Iir;
      end if;
      Interp := Get_Interpretation (Get_Identifier (Decl));
      if not Valid_Interpretation (Interp) then
         return Null_Iir;
      end if;

      if not Is_In_Current_Declarative_Region (Interp)
        or else Is_Potentially_Visible (Interp)
      then
         --  Deferred and full declarations must be declared in the same
         --  declarative region.
         return Null_Iir;
      end if;

      Deferred_Const := Get_Declaration (Interp);
      if Get_Kind (Deferred_Const) /= Iir_Kind_Constant_Declaration then
         return Null_Iir;
      end if;
      if not Get_Deferred_Declaration_Flag (Deferred_Const) then
         --  Just a 'normal' duplicate declaration
         return Null_Iir;
      end if;
      --  LRM93 4.3.1.1
      --  The corresponding full constant declaration, which defines the value
      --  of the constant, must appear in the body of the package.
      if Get_Kind (Get_Library_Unit (Get_Current_Design_Unit))
        /= Iir_Kind_Package_Body
      then
         Error_Msg_Sem
           (+Decl, "full constant declaration must appear in package body");
      end if;
      return Deferred_Const;
   end Get_Deferred_Constant;

   procedure Sem_Object_Type_From_Value (Decl : Iir; Value : Iir)
   is
      Atype : constant Iir := Get_Type (Decl);
      Value_Type : constant Iir := Get_Type (Value);
   begin
      if not Is_Fully_Constrained_Type (Atype)
        and then not Is_Error (Value_Type)
      then
         if Get_Type_Staticness (Value_Type) >= Globally then
            Set_Type (Decl, Value_Type);
         end if;
      end if;
   end Sem_Object_Type_From_Value;

   --  LAST_DECL is set only if DECL is part of a list of declarations (they
   --  share the same type and the same default value).
   procedure Sem_Object_Declaration (Decl: Iir; Last_Decl : Iir)
   is
      Deferred_Const : constant Iir := Get_Deferred_Constant (Decl);
      Atype: Iir;
      Default_Value : Iir;
      Staticness : Iir_Staticness;
   begin
      --  LRM08 12.2 Scope of declarations
      --  Then scope of a declaration [...] extends from the beginning of the
      --  declaration [...]
      if Deferred_Const = Null_Iir then
         Sem_Scopes.Add_Name (Decl);
         Xref_Decl (Decl);
      else
         Xref_Ref (Decl, Deferred_Const);
      end if;

      --  Analyze type and default value:
      Atype := Get_Subtype_Indication (Decl);
      if Atype /= Null_Iir then
         Atype := Sem_Subtype_Indication (Atype);
         Set_Subtype_Indication (Decl, Atype);
         Atype := Get_Type_Of_Subtype_Indication (Atype);
         if Atype = Null_Iir then
            Atype := Create_Error_Type (Get_Type (Decl));
         end if;

         Default_Value := Get_Default_Value (Decl);
         if Default_Value /= Null_Iir then
            Default_Value := Sem_Expression (Default_Value, Atype);
            if Default_Value = Null_Iir then
               Default_Value :=
                 Create_Error_Expr (Get_Default_Value (Decl), Atype);
            end if;
            Check_Read (Default_Value);
            Default_Value := Eval_Expr_Check_If_Static (Default_Value, Atype);
         end if;
      else
         pragma Assert (Get_Kind (Last_Decl) = Get_Kind (Decl));
         pragma Assert (Get_Has_Identifier_List (Last_Decl));
         Default_Value := Get_Default_Value (Last_Decl);
         if Is_Valid (Default_Value) then
            Set_Is_Ref (Decl, True);
         end if;
         Atype := Get_Type (Last_Decl);
      end if;

      Set_Type (Decl, Atype);
      Set_Default_Value (Decl, Default_Value);
      Set_Name_Staticness (Decl, Locally);
      Set_Visible_Flag (Decl, True);

      --  LRM93 2.6
      --  The subtype indication given in the full declaration of the deferred
      --  constant must conform to that given in the deferred constant
      --  declaration.
      if Deferred_Const /= Null_Iir
        and then not Are_Trees_Equal (Get_Type (Decl),
                                      Get_Type (Deferred_Const))
      then
         Error_Msg_Sem
           (+Decl,
            "subtype indication doesn't conform with the deferred constant");
      end if;

      --  LRM93 4.3.1.3
      --  It is an error if a variable declaration declares a variable that is
      --  of a file type.
      --
      --  LRM93 4.3.1.1
      --  It is an error if a constant declaration declares a constant that is
      --  of a file type, or an access type, or a composite type which has
      --  subelement that is a file type of an access type.
      --
      --  LRM93 4.3.1.2
      --  It is an error if a signal declaration declares a signal that is of
      --  a file type [or an access type].
      case Get_Kind (Atype) is
         when Iir_Kind_File_Type_Definition =>
            Error_Msg_Sem (+Decl, "%n cannot be of type file", +Decl);
         when Iir_Kind_Error =>
            null;
         when others =>
            if Get_Kind (Decl) /= Iir_Kind_Variable_Declaration then
               Check_Signal_Type (Decl);
            end if;
      end case;

      if Is_Valid (Default_Value)
        and then not Eval_Is_In_Bound (Default_Value, Atype)
        and then Get_Kind (Default_Value) /= Iir_Kind_Overflow_Literal
      then
         Warning_Msg_Sem
           (Warnid_Runtime_Error, +Decl,
            "default value constraints don't match object type ones");
         Default_Value := Build_Overflow (Default_Value, Atype);
         Set_Default_Value (Decl, Default_Value);
      end if;

      case Get_Kind (Decl) is
         when Iir_Kind_Constant_Declaration =>
            --  LRM93 4.3.1.1
            --  If the assignment symbol ":=" followed by an expression is not
            --  present in a constant declaration, then the declaration
            --  declares a deferred constant.
            --  Such a constant declaration may only appear in a package
            --  declaration.
            if Deferred_Const /= Null_Iir then
               Set_Deferred_Declaration (Decl, Deferred_Const);
               Set_Deferred_Declaration (Deferred_Const, Decl);
            end if;
            if Default_Value = Null_Iir then
               if Deferred_Const /= Null_Iir then
                  Error_Msg_Sem
                    (+Decl,
                     "full constant declaration must have a default value");
               else
                  Set_Deferred_Declaration_Flag (Decl, True);
               end if;
               if Get_Kind (Get_Parent (Decl)) /= Iir_Kind_Package_Declaration
               then
                  Error_Msg_Sem
                    (+Decl, "a constant must have a default value");
               end if;
               Set_Expr_Staticness (Decl, Globally);
            else
               --  LRM93 7.4.1: a locally static primary is defined:
               --  A constant (other than deferred constant) explicitly
               --  declared by a constant declaration and initialized
               --  with a locally static expression.
               --  Note: the staticness of the full declaration may be locally.
               if False and Deferred_Const /= Null_Iir then
                  --  This is a deferred constant.
                  Staticness := Globally;
               else
                  Staticness := Min (Get_Expr_Staticness (Default_Value),
                                     Get_Type_Staticness (Atype));
                  --  What about expr staticness of c in:
                  --    constant c : bit_vector (a to b) := "01";
                  --  where a and b are not locally static ?
                  --Staticness := Get_Expr_Staticness (Default_Value);

                  --  LRM 7.4.2 (Globally static primaries)
                  --  5. a constant
                  if Staticness < Globally then
                     Staticness := Globally;
                  end if;
               end if;
               Set_Expr_Staticness (Decl, Staticness);
            end if;

         when Iir_Kind_Signal_Declaration =>
            --  LRM93 4.3.1.2
            --  It is also an error if a guarded signal of a scalar type is
            --  neither a resolved signal nor a subelement of a resolved
            --  signal.
            if Get_Guarded_Signal_Flag (Decl)
              and then not Get_Resolved_Flag (Atype)
            then
               Error_Msg_Sem (+Decl, "guarded %n must be resolved", +Decl);
            end if;
            Set_Expr_Staticness (Decl, None);
            Set_Has_Disconnect_Flag (Decl, False);
            Set_Type_Has_Signal (Atype);

         when Iir_Kind_Variable_Declaration =>
            --  GHDL: restriction for shared variables are checked during
            --  parse.
            if Flags.Vhdl_Std >= Vhdl_00 then
               declare
                  Parent : constant Iir := Get_Parent (Decl);
                  Base_Type : constant Iir := Get_Base_Type (Atype);
                  Is_Protected : constant Boolean :=
                    Get_Kind (Base_Type) = Iir_Kind_Protected_Type_Declaration;
               begin
                  --  LRM00 4.3.1.3
                  --  The base type of the subtype indication of a
                  --  shared variable declaration must be a protected type.
                  if Get_Shared_Flag (Decl) and not Is_Protected then
                     Error_Msg_Sem_Relaxed
                       (Decl, Warnid_Shared,
                        "type of a shared variable must be a protected type");
                  end if;

                  --  LRM00 4.3.1.3  Variable declarations
                  --  If a given variable appears (directly or indirectly)
                  --  within a protected type body, then the base type
                  --  denoted by the subtype indication of the variable
                  --  declarations must not be a protected type defined by
                  --  the protected type body.
                  --  FIXME: indirectly ?
                  if Is_Protected
                    and then Get_Kind (Parent) = Iir_Kind_Protected_Type_Body
                    and then Base_Type
                    = Get_Protected_Type_Declaration (Parent)
                  then
                     Error_Msg_Sem (+Decl, "variable type must not be of the "
                                      & "protected type body");
                  end if;
               end;
            end if;
            Set_Expr_Staticness (Decl, None);
         when Iir_Kind_Free_Quantity_Declaration =>
            Check_Nature_Type (Decl);
            Set_Expr_Staticness (Decl, None);
         when others =>
            Error_Kind ("sem_object_declaration", Decl);
      end case;

      case Get_Kind (Decl) is
         when Iir_Kind_Constant_Declaration =>
            --  LRM93 3.2.1.1
            --  For a constant declared by an object declaration, the index
            --  ranges are defined by the initial value, if the subtype of the
            --  constant is unconstrained; otherwise they are defined by this
            --  subtype.
            if Default_Value /= Null_Iir then
               Sem_Object_Type_From_Value (Decl, Default_Value);
            end if;

         when Iir_Kind_Variable_Declaration
           | Iir_Kind_Signal_Declaration
           | Iir_Kind_Free_Quantity_Declaration =>
            --  LRM93 3.2.1.1 / LRM08 5.3.2.2
            --  For a variable or signal declared by an object declaration, the
            --  subtype indication of the corresponding object declaration
            --  must define a constrained array subtype.
            if not Is_Fully_Constrained_Type (Atype) then
               Error_Msg_Sem
                 (+Decl,
                  "declaration of %n with unconstrained %n is not allowed",
                  (+Decl, +Atype));
               if Default_Value /= Null_Iir then
                  Error_Msg_Sem (+Decl, "(even with a default value)");
               end if;
            end if;

         when others =>
            Error_Kind ("sem_object_declaration(2)", Decl);
      end case;
   end Sem_Object_Declaration;

   procedure Sem_File_Declaration (Decl: Iir_File_Declaration; Last_Decl : Iir)
   is
      Atype: Iir;
      Logical_Name: Iir;
      Open_Kind : Iir;
   begin
      Sem_Scopes.Add_Name (Decl);
      Set_Expr_Staticness (Decl, None);
      Xref_Decl (Decl);

      -- Try to find a type.
      Atype := Get_Subtype_Indication (Decl);
      if Atype /= Null_Iir then
         Atype := Sem_Subtype_Indication (Atype);
         Set_Subtype_Indication (Decl, Atype);
         Atype := Get_Type_Of_Subtype_Indication (Atype);
         if Atype = Null_Iir then
            Atype := Create_Error_Type (Get_Type (Decl));
         end if;
      else
         Atype := Get_Type (Last_Decl);
      end if;
      Set_Type (Decl, Atype);

      --  LRM93 4.3.1.4
      --  The subtype indication of a file declaration must define a file
      --  subtype.
      if Get_Kind (Atype) /= Iir_Kind_File_Type_Definition then
         Error_Msg_Sem (+Decl, "file subtype expected for a file declaration");
         return;
      end if;

      Logical_Name := Get_File_Logical_Name (Decl);
      --  LRM93 4.3.1.4
      --  The file logical name must be an expression of predefined type
      --  STRING.
      if Logical_Name /= Null_Iir then
         Logical_Name := Sem_Expression (Logical_Name, String_Type_Definition);
         if Logical_Name /= Null_Iir then
            Check_Read (Logical_Name);
            Set_File_Logical_Name (Decl, Logical_Name);
         end if;
      end if;

      Open_Kind := Get_File_Open_Kind (Decl);
      if Open_Kind /= Null_Iir then
         Open_Kind :=
           Sem_Expression (Open_Kind, File_Open_Kind_Type_Definition);
         if Open_Kind /= Null_Iir then
            Check_Read (Open_Kind);
            Set_File_Open_Kind (Decl, Open_Kind);
         end if;
      else
         --  LRM93 4.3.1.4
         --  If a file open kind expression is not included in the file open
         --  information of a given file declaration, then the default value
         --  of READ_MODE is used during elaboration of the file declaration.
         --
         --  LRM87 4.3.1.4
         --  The default mode is IN, if no mode is specified.
         if Get_Mode (Decl) = Iir_Unknown_Mode then
            if Flags.Vhdl_Std = Vhdl_87 then
               Set_Mode (Decl, Iir_In_Mode);
            else
               null;
               --  Set_File_Open_Kind (Decl, File_Open_Kind_Read_Mode);
            end if;
         end if;
      end if;
      Name_Visible (Decl);

      --  LRM 93 2.2
      --  If a pure function is the parent of a given procedure, then
      --  that procedure must not contain a reference to an explicitly
      --  declared file object [...]
      --
      --  A pure function must not contain a reference to an explicitly
      --  declared file.

      --  Note: this check is also performed when a file is referenced.
      --    But a file can be declared without being explicitly referenced.
      declare
         Parent : constant Iir := Get_Parent (Decl);
         Spec : Iir;
      begin
         case Get_Kind (Parent) is
            when Iir_Kind_Function_Body =>
               Spec := Get_Subprogram_Specification (Parent);
               if Get_Pure_Flag (Spec) then
                  Error_Msg_Sem_Relaxed
                    (Decl, Warnid_Pure,
                     "cannot declare a file in a pure function");
               end if;
            when Iir_Kind_Procedure_Body =>
               Spec := Get_Subprogram_Specification (Parent);
               Set_Purity_State (Spec, Impure);
               Set_Impure_Depth (Parent, Iir_Depth_Impure);
            when Iir_Kind_Function_Declaration
              | Iir_Kind_Procedure_Declaration =>
               Error_Kind ("sem_file_declaration", Parent);
            when others =>
               null;
         end case;
      end;
   end Sem_File_Declaration;

   procedure Sem_Source_Quantity_Declaration (Decl : Iir; Last_Decl : Iir)
   is
      Atype: Iir;
      Expr : Iir;
   begin
      Sem_Scopes.Add_Name (Decl);
      Set_Expr_Staticness (Decl, None);
      Xref_Decl (Decl);

      -- Try to find a type.
      Atype := Get_Subtype_Indication (Decl);
      if Atype /= Null_Iir then
         Atype := Sem_Subtype_Indication (Atype);
         Set_Subtype_Indication (Decl, Atype);
         Atype := Get_Type_Of_Subtype_Indication (Atype);
         if Atype = Null_Iir then
            Atype := Create_Error_Type (Get_Type (Decl));
         elsif not Is_Nature_Type (Atype) then
            Error_Msg_Sem
              (+Decl, "type of %n must only have float types", +Decl);
         end if;
      else
         Atype := Get_Type (Last_Decl);
      end if;
      Set_Type (Decl, Atype);

      --  AMS-LRM17 6.4.2.7 Quantity declarations
      --  The type of the magnitude simple expression, phase simple expression,
      --  and power simple expression in a source aspect shall be that of the
      --  source quantity.
      case Iir_Kinds_Source_Quantity_Declaration (Get_Kind (Decl)) is
         when Iir_Kind_Spectrum_Quantity_Declaration =>
            Expr := Get_Magnitude_Expression (Decl);
            if Expr /= Null_Iir then
               Expr := Sem_Expression (Expr, Atype);
               Set_Magnitude_Expression (Decl, Expr);
            end if;
            Expr := Get_Phase_Expression (Decl);
            if Expr /= Null_Iir then
               Expr := Sem_Expression (Expr, Atype);
               Set_Phase_Expression (Decl, Expr);
            end if;
         when Iir_Kind_Noise_Quantity_Declaration =>
            Expr := Get_Power_Expression (Decl);
            if Expr /= Null_Iir then
               Expr := Sem_Expression (Expr, Atype);
               Set_Power_Expression (Decl, Expr);
            end if;
      end case;

      --  TODO: It is an error if the name of a source quantity appears in an
      --  expression in a source aspect.

      Name_Visible (Decl);
   end Sem_Source_Quantity_Declaration;

   procedure Sem_Attribute_Declaration (Decl: Iir_Attribute_Declaration)
   is
      A_Type : Iir;
      Ident : Name_Id;
   begin
      --  LRM93 4.4
      --  The identifier is said to be the designator of the attribute.
      Ident := Get_Identifier (Decl);
      if Ident in Std_Names.Name_Id_Attributes
        or else (Flags.Vhdl_Std = Vhdl_87
                 and then Ident in Std_Names.Name_Id_Vhdl87_Attributes)
        or else (Flags.Vhdl_Std > Vhdl_87
                 and then Ident in Std_Names.Name_Id_Vhdl93_Attributes)
      then
         Error_Msg_Sem (+Decl, "predefined attribute %i overriden", +Decl);
      end if;
      Sem_Scopes.Add_Name (Decl);
      Xref_Decl (Decl);

      A_Type := Sem_Type_Mark (Get_Type_Mark (Decl));
      Set_Type_Mark (Decl, A_Type);
      A_Type := Get_Type (A_Type);
      Set_Type (Decl, A_Type);

      --  LRM93 4.4  Attribute declarations.
      --  It is an error if the type mark denotes an access type, a file type,
      --  a protected type, or a composite type with a subelement that is
      --  an access type, a file type, or a protected type.
      --  The subtype need not be constrained.
      Check_Signal_Type (Decl);
      Name_Visible (Decl);
   end Sem_Attribute_Declaration;

   procedure Sem_Component_Declaration (Component: Iir_Component_Declaration)
   is
   begin
      Sem_Scopes.Add_Name (Component);
      Xref_Decl (Component);

      --  LRM 10.1 Declarative region
      --  6. A component declaration.
      Open_Declarative_Region;

      Sem_Interface_Chain
        (Get_Generic_Chain (Component), Generic_Interface_List);
      Sem_Interface_Chain
        (Get_Port_Chain (Component), Port_Interface_List);

      Close_Declarative_Region;

      Name_Visible (Component);
   end Sem_Component_Declaration;

   procedure Sem_Object_Alias_Declaration (Alias: Iir_Object_Alias_Declaration)
   is
      N_Name: constant Iir := Get_Name (Alias);
      N_Type: Iir;
      Name_Type : Iir;
   begin
      --  LRM93 4.3.3.1 Object Aliases.
      --  1. A signature may not appear in a declaration of an object alias.
      -- FIXME: todo.
      --
      --  2. The name must be a static name that denotes an object.
      if Get_Name_Staticness (N_Name) < Globally then
         Error_Msg_Sem (+Alias, "aliased name must be a static name");
      end if;

      --  LRM93 4.3.3.1
      --  The base type of the name specified in an alias declaration must be
      --  the same as the base type of the type mark in the subtype indication
      --  (if the subtype indication is present);
      Name_Type := Get_Type (N_Name);
      N_Type := Get_Subtype_Indication (Alias);
      if N_Type = Null_Iir then
         Set_Type (Alias, Name_Type);
         N_Type := Name_Type;
      else
         --  FIXME: must be analyzed before calling Name_Visibility.
         N_Type := Sem_Subtype_Indication (N_Type);
         Set_Subtype_Indication (Alias, N_Type);
         N_Type := Get_Type_Of_Subtype_Indication (N_Type);
         if N_Type /= Null_Iir then
            Set_Type (Alias, N_Type);
            if Get_Base_Type (N_Type) /= Get_Base_Type (Name_Type) then
               Error_Msg_Sem
                 (+Alias, "base type of aliased name and name mismatch");
            end if;
         end if;

         --  LRM08 6.6.2 Object aliases
         --  The following rules apply yo object aliases:
         --  b) If the name is an external name, a subtype indication shall not
         --     appear in the alias declaration.
         if Get_Kind (N_Name) in Iir_Kinds_External_Name then
            Error_Msg_Sem
              (+Alias,
               "subtype indication not allowed in alias of external name");
         end if;
      end if;

      --  LRM93 4.3.3.1
      --  This type must not be a multi-dimensional array type.
      if Get_Kind (N_Type) in Iir_Kinds_Array_Type_Definition then
         if not Is_One_Dimensional_Array_Type (N_Type) then
            Error_Msg_Sem
              (+Alias,
               "aliased name must not be a multi-dimensional array type");
         end if;
         if Get_Type_Staticness (N_Type) = Locally
           and then Get_Type_Staticness (Name_Type) = Locally
           and then Eval_Discrete_Type_Length
           (Get_Nth_Element (Get_Index_Subtype_List (N_Type), 0))
           /= Eval_Discrete_Type_Length
           (Get_Nth_Element (Get_Index_Subtype_List (Name_Type), 0))
         then
            Error_Msg_Sem
              (+Alias, "number of elements not matching in type and name");
         end if;
      end if;

      Set_Name_Staticness (Alias, Get_Name_Staticness (N_Name));
      Set_Expr_Staticness (Alias, Get_Expr_Staticness (N_Name));
      if Is_Signal_Object (N_Name) then
         Set_Type_Has_Signal (N_Type);
      end if;
   end Sem_Object_Alias_Declaration;

   function Signature_Match (N_Entity : Iir; Sig : Iir_Signature)
                            return Boolean
   is
      List : constant Iir_Flist := Get_Type_Marks_List (Sig);
      Inter : Iir;
      El : Iir;
   begin
      case Get_Kind (N_Entity) is
         when Iir_Kind_Enumeration_Literal =>
            --  LRM93 2.3.2  Signatures
            --  * Similarly, a signature is said to match the parameter and
            --    result type profile of a given enumeration literal if
            --    the signature matches the parameter and result type profile
            --    of the subprogram equivalent to the enumeration literal,
            --    defined in Section 3.1.1
            if Get_Return_Type_Mark (Sig) = Null_Iir then
               return False;
            end if;
            return List = Null_Iir_Flist
              and then (Get_Type (N_Entity)
                          = Get_Type (Get_Return_Type_Mark (Sig)));
         when Iir_Kind_Function_Declaration
           | Iir_Kind_Interface_Function_Declaration =>
            --  LRM93 2.3.2  Signatures
            --  * if the reserved word RETURN is present, the subprogram is
            --    a function and the base type of the type mark following
            --    the reserved word in the signature is the same as the base
            --    type of the return type of the function, [...]
            if Get_Return_Type_Mark (Sig) = Null_Iir then
               return False;
            end if;
            if Get_Type (Get_Return_Type_Mark (Sig)) /=
              Get_Base_Type (Get_Return_Type (N_Entity))
            then
               return False;
            end if;
         when Iir_Kind_Procedure_Declaration
           | Iir_Kind_Interface_Procedure_Declaration =>
            --  LRM93 2.3.2  Signatures
            --  * [...] or the reserved word RETURN is absent and the
            --    subprogram is a procedure.
            if Get_Return_Type_Mark (Sig) /= Null_Iir then
               return False;
            end if;
         when others =>
            --  LRM93 2.3.2  Signatures
            --  A signature distinguishes between overloaded subprograms and
            --  overloaded enumeration literals based on their parameter
            --  and result type profiles.
            return False;
      end case;

      --  LRM93 2.3.2  Signature
      --  * the number of type marks prior the reserved word RETURN, if any,
      --    matches the number of formal parameters of the subprogram;
      --  * at each parameter position, the base type denoted by the type
      --    mark of the signature is the same as the base type of the
      --    corresponding formal parameter of the subprogram; [and finally, ]
      Inter := Get_Interface_Declaration_Chain (N_Entity);
      if List = Null_Iir_Flist then
         return Inter = Null_Iir;
      end if;
      for I in Flist_First .. Flist_Last (List) loop
         El := Get_Nth_Element (List, I);
         if Inter = Null_Iir then
            --  More type marks in the signature than in the interface.
            return False;
         end if;
         if Get_Base_Type (Get_Type (Inter)) /= Get_Type (El) then
            return False;
         end if;
         Inter := Get_Chain (Inter);
      end loop;
      --  Match only if the number of type marks is the same.
      return Inter = Null_Iir;
   end Signature_Match;

   --  Extract from NAME the named entity whose profile matches with SIG.
   function Sem_Signature (Name : Iir; Sig : Iir_Signature) return Iir
   is
      List : constant Iir_Flist := Get_Type_Marks_List (Sig);
      Res : Iir;
      El : Iir;
      Error : Boolean;
      Ov_List : Iir_List;
      Ov_It : List_Iterator;
   begin
      --  Sem signature.
      if List /= Null_Iir_Flist then
         for I in Flist_First .. Flist_Last (List) loop
            El := Get_Nth_Element (List, I);
            El := Sem_Type_Mark (El);
            Set_Nth_Element (List, I, El);

            --  Reuse the Type field of the name for the base type.  This is
            --  a deviation from the use of Type in a name, but restricted to
            --  analysis of signatures.
            Set_Type (El, Get_Base_Type (Get_Type (El)));
         end loop;
      end if;
      El := Get_Return_Type_Mark (Sig);
      if El /= Null_Iir then
         El := Sem_Type_Mark (El);
         Set_Return_Type_Mark (Sig, El);
         --  Likewise.
         Set_Type (El, Get_Base_Type (Get_Type (El)));
      end if;

      --  FIXME: what to do in case of error ?
      Res := Null_Iir;
      Error := False;
      if Is_Overload_List (Name) then
         Ov_List := Get_Overload_List (Name);
         Ov_It := List_Iterate (Ov_List);
         while Is_Valid (Ov_It) loop
            El := Get_Element (Ov_It);
            if Signature_Match (El, Sig) then
               if Res = Null_Iir then
                  Res := El;
               else
                  Error := True;
                  Report_Start_Group;
                  Error_Msg_Sem
                    (+Sig,
                     "cannot resolve signature, many matching subprograms:");
                  Error_Msg_Sem (+Res, "found: %n", +Res);
               end if;
               if Error then
                  Error_Msg_Sem (+El, "found: %n", +El);
               end if;
            end if;
            Next (Ov_It);
         end loop;
         if Error then
            Report_End_Group;
         end if;

         --  Free the overload list (with a workaround as only variables can
         --  be free).
         declare
            Name_Ov : Iir;
         begin
            Name_Ov := Name;
            Free_Overload_List (Name_Ov);
         end;
      else
         if Signature_Match (Name, Sig) then
            Res := Name;
         end if;
      end if;

      if Error then
         return Null_Iir;
      end if;
      if Res = Null_Iir then
         Error_Msg_Sem
           (+Sig, "cannot resolve signature, no matching subprogram");
      end if;

      return Res;
   end Sem_Signature;

   --  Create implicit aliases for an alias ALIAS of a type or of a subtype.
   procedure Add_Aliases_For_Type_Alias (Alias : Iir)
   is
      N_Entity : constant Iir := Get_Named_Entity (Get_Name (Alias));
      Def : constant Iir := Get_Base_Type (Get_Type (N_Entity));
      Type_Decl : constant Iir := Get_Type_Declarator (Def);
      Last : Iir;
      El : Iir;
      Enum_List : Iir_Flist;

      --  Append an implicit alias
      procedure Add_Implicit_Alias (Decl : Iir)
      is
         N_Alias : constant Iir_Non_Object_Alias_Declaration :=
           Create_Iir (Iir_Kind_Non_Object_Alias_Declaration);
         N_Name : constant Iir := Create_Iir (Iir_Kind_Simple_Name);
      begin
         --  Create the name (can be in fact a character literal or a symbol
         --  operator).
         Location_Copy (N_Name, Alias);
         Set_Identifier (N_Name, Get_Identifier (Decl));
         Set_Named_Entity (N_Name, Decl);

         Location_Copy (N_Alias, Alias);
         Set_Identifier (N_Alias, Get_Identifier (Decl));
         Set_Name (N_Alias, N_Name);
         Set_Parent (N_Alias, Get_Parent (Alias));
         Set_Implicit_Alias_Flag (N_Alias, True);

         Sem_Scopes.Add_Name (N_Alias);
         Set_Visible_Flag (N_Alias, True);

         --  Append in the declaration chain.
         Set_Chain (N_Alias, Get_Chain (Last));
         Set_Chain (Last, N_Alias);
         Last := N_Alias;
      end Add_Implicit_Alias;
   begin
      Last := Alias;

      if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition then
         --  LRM93 4.3.3.2  Non-Object Aliases
         --  3.  If the name denotes an enumeration type, then one
         --      implicit alias declaration for each of the
         --      literals of the type immediatly follows the alias
         --      declaration for the enumeration type; [...]
         --
         --  LRM08 6.6.3 Nonobject aliases
         --  c)  If the name denotes an enumeration type or a subtype of an
         --      enumeration type, then one implicit alias declaration for each
         --      of the literals of the base type immediately follows the
         --      alias declaration for the enumeration type; [...]
         Enum_List := Get_Enumeration_Literal_List (Def);
         for I in Flist_First .. Flist_Last (Enum_List) loop
            El := Get_Nth_Element (Enum_List, I);
            --  LRM93 4.3.3.2  Non-Object Aliases
            --      [...] each such implicit declaration has, as its alias
            --      designator, the simple name or character literal of the
            --      literal, and has, as its name, a name constructed by taking
            --      the name of the alias for the enumeration type and
            --      substituting the simple name or character literal being
            --      aliased for the simple name of the type.  Each implicit
            --      alias has a signature that matches the parameter and result
            --      type profile of the literal being aliased.
            --
            --  LRM08 6.6.3 Nonobject aliases
            --      [...] each such implicit declaration has, as its alias
            --      designator, the simple name or character literal of the
            --      literal and has, as its name, a name constructed by taking
            --      the name of the alias for the enumeration type or subtype
            --      and substituing the simple name or character literal being
            --      aliased for the simple name of the type or subtype.  Each
            --      implicit alias has a signature that matches the parameter
            --      and result type profile of the literal being aliased.
            Add_Implicit_Alias (El);
         end loop;
      end if;

      --  LRM93 4.3.3.2  Non-Object Aliases
      --  4.  Alternatively, if the name denotes a physical type
      --      [...]
      --  GHDL: this is not possible, since a physical type is
      --  anonymous (LRM93 is buggy on this point).
      --
      --  LRM08 6.6.3 Nonobject aliases
      --  d)  Alternatively, if the name denotes a subtype of a physical type,
      --      [...]
      if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then
         --  LRM08 6.3.3 Nonobject aliases
         --      [...] then one implicit alias declaration for each of the
         --      units of the base type immediately follows the alias
         --      declaration for the physical type; each such implicit
         --      declaration has, as its alias designator, the simple name of
         --      the unit and has, as its name, a name constructed by taking
         --      the name of the alias for the subtype of the physical type
         --      and substituting the simple name of the unit being aliased for
         --      the simple name of the subtype.
         El := Get_Unit_Chain (Def);
         while El /= Null_Iir loop
            Add_Implicit_Alias (El);
            El := Get_Chain (El);
         end loop;
      end if;

      --  LRM93 4.3.3.2  Non-Object Aliases
      --  5.  Finally, if the name denotes a type, then implicit
      --      alias declarations for each predefined operator
      --      for the type immediatly follow the explicit alias
      --      declaration for the type, and if present, any
      --      implicit alias declarations for literals or units
      --      of the type.
      --      Each implicit alias has a signature that matches the
      --      parameter and result type profule of the implicit
      --      operator being aliased.
      --
      --  LRM08 6.6.3 Nonobject aliases
      --  e)  Finally, if the name denotes a type of a subtype, then implicit
      --      alias declarations for each predefined operation for the type
      --      immediately follow the explicit alias declaration for the type or
      --      subtype and, if present, any implicit alias declarations for
      --      literals or units of the type.  Each implicit alias has a
      --      signature that matches the parameter and result type profile of
      --      the implicit operation being aliased.
      El := Get_Chain (Type_Decl);
      while El /= Null_Iir loop
         if Is_Implicit_Subprogram (El)
           and then Is_Operation_For_Type (El, Def)
         then
            Add_Implicit_Alias (El);
            El := Get_Chain (El);
         else
            exit;
         end if;
      end loop;
   end Add_Aliases_For_Type_Alias;

   procedure Sem_Non_Object_Alias_Declaration
     (Alias : Iir_Non_Object_Alias_Declaration)
   is
      use Std_Names;
      N_Entity : constant Iir := Get_Named_Entity (Get_Name (Alias));
      Id : Name_Id;
   begin
      case Get_Kind (N_Entity) is
         when Iir_Kinds_Subprogram_Declaration
           | Iir_Kinds_Interface_Subprogram_Declaration =>
            --  LRM93 4.3.3.2  Non-Object Aliases
            --  2.  A signature is required if the name denotes a subprogram
            --      (including an operator) or enumeration literal.
            if Get_Alias_Signature (Alias) = Null_Iir then
               Error_Msg_Sem (+Alias, "signature required for subprogram");
            end if;
         when Iir_Kind_Enumeration_Literal =>
            if Get_Alias_Signature (Alias) = Null_Iir then
               Error_Msg_Sem
                 (+Alias, "signature required for enumeration literal");
            end if;
         when Iir_Kind_Type_Declaration =>
            Add_Aliases_For_Type_Alias (Alias);
         when Iir_Kind_Subtype_Declaration =>
            --  LRM08 6.6.3 Nonobject aliases
            --  ... or a subtype ...
            if Flags.Vhdl_Std >= Vhdl_08 then
               Add_Aliases_For_Type_Alias (Alias);
            end if;
         when Iir_Kind_Nature_Declaration =>
            null;
         when Iir_Kinds_Object_Declaration =>
            raise Internal_Error;
         when Iir_Kind_Attribute_Declaration
           | Iir_Kind_Component_Declaration =>
            null;
         when Iir_Kind_Terminal_Declaration =>
            --  TODO: should have Sem_Terminal_Alias_Declaration.
            null;
         when Iir_Kind_Library_Declaration =>
            --  Not explicitly allowed before vhdl-08.
            null;
         when Iir_Kind_Base_Attribute =>
            Error_Msg_Sem (+Alias, "base attribute not allowed in alias");
            return;
         when others =>
            Error_Kind ("sem_non_object_alias_declaration", N_Entity);
      end case;

      Id := Get_Identifier (Alias);

      case Id is
         when Name_Characters =>
            --  LRM 4.3.3  Alias declarations
            --  If the alias designator is a character literal, the
            --  name must denote an enumeration literal.
            if Get_Kind (N_Entity) /= Iir_Kind_Enumeration_Literal then
               Error_Msg_Sem
                 (+Alias,
                  "alias of a character must denote an enumeration literal");
               return;
            end if;
         when Name_Id_Operators
           | Name_Shift_Operators
           | Name_Word_Operators =>
            --  LRM 4.3.3  Alias declarations
            --  If the alias designator is an operator symbol, the
            --  name must denote a function, and that function then
            --  overloads the operator symbol.  In this latter case,
            --  the operator symbol and the function both must meet the
            --  requirements of 2.3.1.
            if Get_Kind (N_Entity) /= Iir_Kind_Function_Declaration then
               Error_Msg_Sem
                 (+Alias, "alias of an operator must denote a function");
               return;
            end if;
            Check_Operator_Requirements (Id, N_Entity);
         when others =>
            null;
      end case;
   end Sem_Non_Object_Alias_Declaration;

   function Sem_Alias_Declaration (Alias : Iir) return Iir
   is
      Name : Iir;
      Sig : Iir_Signature;
      N_Entity : Iir;
      Res : Iir;
   begin
      Xref_Decl (Alias);

      Name := Get_Name (Alias);
      case Get_Kind (Name) is
         when Iir_Kind_Signature =>
            Sig := Name;
            Name := Get_Signature_Prefix (Sig);
            Sem_Name (Name);
            Set_Signature_Prefix (Sig, Name);
         when Iir_Kind_Error =>
            pragma Assert (Flags.Flag_Force_Analysis);
            return Alias;
         when others =>
            Sem_Name (Name);
            Sig := Null_Iir;
      end case;

      N_Entity := Get_Named_Entity (Name);
      if N_Entity = Error_Mark then
         return Alias;
      end if;

      if Is_Overload_List (N_Entity) then
         if Sig = Null_Iir then
            Error_Msg_Sem
              (+Alias, "signature required for alias of a subprogram");
            return Alias;
         end if;
      end if;

      if Sig /= Null_Iir then
         N_Entity := Sem_Signature (N_Entity, Sig);
      end if;
      if N_Entity = Null_Iir then
         return Alias;
      end if;

      Set_Named_Entity (Name, N_Entity);
      Name := Finish_Sem_Name (Name);
      Set_Name (Alias, Name);

      if Is_Object_Name (N_Entity) then
         --  Object alias declaration.

         Sem_Scopes.Add_Name (Alias);
         Name_Visible (Alias);

         if Sig /= Null_Iir then
            Error_Msg_Sem (+Sig, "signature not allowed for object alias");
         end if;
         Sem_Object_Alias_Declaration (Alias);
         return Alias;
      else
         --  Non object alias declaration.

         if Get_Subtype_Indication (Alias) /= Null_Iir then
            Error_Msg_Sem
              (+Alias,
               "subtype indication shall not appear in a nonobject alias");
         end if;

         Res := Create_Iir (Iir_Kind_Non_Object_Alias_Declaration);
         Location_Copy (Res, Alias);
         Set_Parent (Res, Get_Parent (Alias));
         Set_Chain (Res, Get_Chain (Alias));
         Set_Identifier (Res, Get_Identifier (Alias));
         Set_Name (Res, Get_Name (Alias));
         Set_Alias_Signature (Res, Sig);

         if Is_Valid (Sig) then
            --  The prefix is owned by the non_object_alias_declaration.
            Set_Signature_Prefix (Sig, Null_Iir);
         end if;

         Sem_Scopes.Add_Name (Res);
         Name_Visible (Res);

         Free_Iir (Alias);

         if Get_Kind (Name) in Iir_Kinds_Denoting_And_External_Name then
            Sem_Non_Object_Alias_Declaration (Res);
         else
            Error_Msg_Sem
              (+Name, "name of nonobject alias is not a name");

            --  Create a simple name to an error node.
            N_Entity := Create_Error (Name);
            Name := Create_Iir (Iir_Kind_Simple_Name);
            Location_Copy (Name, N_Entity);
            Set_Identifier (Name, Get_Identifier (Res));  --  Better idea ?
            Set_Named_Entity (Name, N_Entity);
            Set_Base_Name (Name, Name);
            Set_Name (Res, Name);
         end if;

         return Res;
      end if;
   end Sem_Alias_Declaration;

   procedure Sem_Group_Template_Declaration
     (Decl : Iir_Group_Template_Declaration) is
   begin
      Sem_Scopes.Add_Name (Decl);
      Sem_Scopes.Name_Visible (Decl);
      Xref_Decl (Decl);
   end Sem_Group_Template_Declaration;

   procedure Sem_Group_Declaration (Group : Iir_Group_Declaration)
   is
      use Vhdl.Tokens;

      Constituent_List : Iir_Flist;
      Template : Iir_Group_Template_Declaration;
      Template_Name : Iir;
      Class, Prev_Class : Token_Type;
      El : Iir;
      El_Name : Iir;
      El_Entity : Iir_Entity_Class;
   begin
      Sem_Scopes.Add_Name (Group);
      Xref_Decl (Group);

      Template_Name := Sem_Denoting_Name (Get_Group_Template_Name (Group));
      Set_Group_Template_Name (Group, Template_Name);
      Template := Get_Named_Entity (Template_Name);
      if Get_Kind (Template) /= Iir_Kind_Group_Template_Declaration then
         Error_Class_Match (Template_Name, "group template");
         return;
      end if;
      Constituent_List := Get_Group_Constituent_List (Group);
      El_Entity := Get_Entity_Class_Entry_Chain (Template);
      Prev_Class := Tok_Eof;
      for I in Flist_First .. Flist_Last (Constituent_List) loop
         El := Get_Nth_Element (Constituent_List, I);

         Sem_Name (El);

         if El_Entity = Null_Iir then
            Error_Msg_Sem
              (+Group, "too many elements in group constituent list");
            exit;
         end if;

         Class := Get_Entity_Class (El_Entity);
         if Class = Tok_Box then
            --  LRM93 4.6
            --  An entity class entry that includes a box (<>) allows zero
            --  or more group constituents to appear in this position in the
            --  corresponding group declaration.
            Class := Prev_Class;
         else
            Prev_Class := Class;
            El_Entity := Get_Chain (El_Entity);
         end if;

         El_Name := Get_Named_Entity (El);
         if Is_Error (El_Name) then
            null;
         elsif Is_Overload_List (El_Name) then
            Error_Overload (El_Name);
         else
            El := Finish_Sem_Name (El);
            Set_Nth_Element (Constituent_List, I, El);
            El_Name := Get_Named_Entity (El);

            --  Statements are textually afer the group declaration.  To avoid
            --  adding a flag on each node with a base_name, this field is
            --  cleared, as we don't care about base name.
            if Class = Tok_Label then
               Set_Is_Forward_Ref (El, True);
            end if;
            Set_Base_Name (El, Null_Iir);

            --  LRM93 4.7
            --  It is an error if the class of any group constituent in the
            --  group constituent list is not the same as the class specified
            --  by the corresponding entity class entry in the entity class
            --  entry list of the group template.
            if Get_Entity_Class_Kind (El_Name) /= Class then
               Error_Msg_Sem (+El, "constituent not of class %t", +Class);
            end if;
         end if;
      end loop;

      --  End of entity_class list reached or zero or more constituent allowed.
      if not (El_Entity = Null_Iir
              or else Get_Entity_Class (El_Entity) = Tok_Box)
      then
         Error_Msg_Sem
           (+Group, "not enough elements in group constituent list");
      end if;
      Set_Visible_Flag (Group, True);
   end Sem_Group_Declaration;

   procedure Sem_Nature_Declaration (Decl : Iir)
   is
      Def : Iir;
   begin
      Def := Get_Nature (Decl);
      if Def /= Null_Iir then
         Sem_Scopes.Add_Name (Decl);
         Xref_Decl (Decl);

         Def := Sem_Nature_Definition (Def, Decl);
         if Def /= Null_Iir then
            Set_Nature_Declarator (Def, Decl);
            Sem_Scopes.Name_Visible (Decl);
         end if;
      end if;
   end Sem_Nature_Declaration;

   procedure Sem_Subnature_Declaration (Decl: Iir)
   is
      Def: Iir;
      Ind : Iir;
   begin
      Sem_Scopes.Add_Name (Decl);
      Xref_Decl (Decl);

      --  Analyze the definition of the type.
      Ind := Get_Subnature_Indication (Decl);
      Ind := Sem_Subnature_Indication (Ind);
      Set_Subnature_Indication (Decl, Ind);
      Def := Get_Nature_Of_Subnature_Indication (Ind);
      if Def = Null_Iir or else Is_Error (Def) then
         return;
      end if;

      if not Is_Anonymous_Nature_Definition (Def) then
         --  There is no added constraints and therefore the subtype
         --  declaration is in fact an alias of the type.  Create a copy so
         --  that it has its own type declarator.
         raise Internal_Error;
      end if;

      Set_Nature (Decl, Def);
      Set_Nature_Declarator (Def, Decl);
      Name_Visible (Decl);
   end Sem_Subnature_Declaration;

   procedure Sem_Terminal_Declaration (Decl : Iir; Last_Decl : Iir)
   is
      Def, Nature : Iir;
   begin
      Sem_Scopes.Add_Name (Decl);
      Xref_Decl (Decl);

      Set_Name_Staticness (Decl, Locally);

      Def := Get_Subnature_Indication (Decl);
      if Def = Null_Iir then
         Nature := Get_Nature (Last_Decl);
      else
         Nature := Sem_Subnature_Indication (Def);
         if Nature /= Null_Iir then
            Set_Subnature_Indication (Decl, Nature);
            Nature := Get_Nature_Of_Subnature_Indication (Nature);
         end if;
      end if;

      if Nature /= Null_Iir then
         Set_Nature (Decl, Nature);
         Sem_Scopes.Name_Visible (Decl);
      end if;
   end Sem_Terminal_Declaration;

   procedure Sem_Branch_Quantity_Declaration (Decl : Iir; Prev_Decl : Iir)
   is
      Plus_Name : Iir;
      Minus_Name : Iir;
      Branch_Type : Iir;
      Value : Iir;
      Is_Second : Boolean;
      Nat : Iir;
   begin
      Sem_Scopes.Add_Name (Decl);
      Xref_Decl (Decl);

      Plus_Name := Get_Plus_Terminal_Name (Decl);
      if Plus_Name = Null_Iir then
         --  List of identifier.
         Is_Second := True;
         Plus_Name := Get_Plus_Terminal (Prev_Decl);
         Minus_Name := Get_Minus_Terminal (Prev_Decl);
         if Get_Kind (Decl) = Get_Kind (Prev_Decl) then
            --  Keep the same default value for all across and all through.
            Value := Get_Default_Value (Prev_Decl);
         else
            --  But do not use the across default value for through quantity.
            Value := Get_Default_Value (Decl);
         end if;
      else
         Is_Second := False;
         Plus_Name := Sem_Terminal_Name (Plus_Name);
         Set_Plus_Terminal_Name (Decl, Plus_Name);
         Plus_Name := Strip_Denoting_Name (Plus_Name);
         Minus_Name := Get_Minus_Terminal_Name (Decl);
         if Minus_Name /= Null_Iir then
            Minus_Name := Sem_Terminal_Name (Minus_Name);
            Set_Minus_Terminal_Name (Decl, Minus_Name);
            Minus_Name := Strip_Denoting_Name (Minus_Name);
         else
            --  AMS-LRM17 6.4.2.7 Quantity declarations
            --  A terminal aspect that does not include an explicit minus
            --  terminal name is equivalent to a terminal aspect with the
            --  given plus terminal name and the name of the reference
            --  terminal of the simple nature of its nature as the minus
            --  terminal name.
            --
            --  GHDL: FIXME: isn't it self-referential with the definition of
            --  the terminal nature ?
            if Is_Error (Plus_Name) then
               Minus_Name := Error_Mark;
            else
               Minus_Name := Get_Reference
                 (Get_Nature_Simple_Nature (Get_Nature (Plus_Name)));
            end if;
         end if;
         Value := Get_Default_Value (Decl);
      end if;
      Set_Plus_Terminal (Decl, Plus_Name);
      Set_Minus_Terminal (Decl, Minus_Name);

      if not Is_Error (Plus_Name) and then not Is_Error (Minus_Name) then
         declare
            Plus_Nature : constant Iir := Get_Nature (Plus_Name);
            Minus_Nature : constant Iir := Get_Nature (Minus_Name);
            Plus_Composite : constant Boolean :=
              Is_Composite_Nature (Plus_Nature);
            Minus_Composite : constant Boolean :=
              Is_Composite_Nature (Minus_Nature);
         begin
            --  AMS-LRM17 6.4.2.7 Quantity declarations
            --  If the terminals denoted by the terminal names of a terminal
            --  aspect are both of composite natures, then they shall be of the
            --  same nature, [and for each element of the plus terminal there
            --  shall be a matching element of the minus terminal.]
            --  If one terminal is a terminal of a composite nature and the
            --  other of a scalar nature, then the scalar nature nature shall
            --  be the nature of the scalar subelements of the composite
            --  terminal.
            if (Plus_Composite and Minus_Composite)
              or else (not Plus_Composite and not Minus_Composite)
            then
               if (Get_Base_Nature (Plus_Nature)
                     /= Get_Base_Nature (Minus_Nature))
               then
                  Error_Msg_Sem
                    (+Decl, "terminals must be of the same nature");
               end if;
               Nat := Plus_Nature;
            elsif Plus_Composite then
               pragma Assert (not Minus_Composite);
               if (Get_Nature_Simple_Nature (Plus_Nature)
                     /= Get_Base_Nature (Minus_Nature))
               then
                  Error_Msg_Sem
                    (+Decl, "minus terminal must be of the nature of "
                       & "plus subelements");
               end if;
               Nat := Plus_Nature;
            else
               pragma Assert (Minus_Composite and not Plus_Composite);
               if (Get_Nature_Simple_Nature (Minus_Nature)
                     /= Get_Base_Nature (Plus_Nature))
               then
                  Error_Msg_Sem
                    (+Decl, "plus terminal must be of the nature of "
                       & "minus subelements");
               end if;
               Nat := Minus_Nature;
            end if;
         end;

         case Iir_Kinds_Branch_Quantity_Declaration (Get_Kind (Decl)) is
            when Iir_Kind_Across_Quantity_Declaration =>
               Branch_Type := Get_Across_Type (Nat);
            when Iir_Kind_Through_Quantity_Declaration =>
               Branch_Type := Get_Through_Type (Nat);
         end case;
         pragma Assert (Branch_Type /= Null_Iir);
      else
         Branch_Type := Error_Mark;
      end if;
      Set_Type (Decl, Branch_Type);

      Set_Name_Staticness (Decl, Locally);
      Set_Expr_Staticness (Decl, None);

      if not Is_Second and then Value /= Null_Iir then
         Value := Sem_Expression (Value, Branch_Type);
      end if;
      Set_Default_Value (Decl, Value);

      --  TODO: tolerance

      Sem_Scopes.Name_Visible (Decl);
   end Sem_Branch_Quantity_Declaration;

   --  Analyze declaration DECL.
   --  PREV_DECL is the previous one (used for declaration like
   --    signal a, b : mytype; ) to get type and default value from the
   --  previous declaration.
   --  IS_GLOBAL must be true when the declaration can be used by an external
   --   file (so for package and entities).
   --  ATTR_SPEC_CHAIN is the chain of attribute specifications, used to
   --   handle the 'others' case.
   procedure Sem_Declaration (Decl : in out Iir;
                              Prev_Decl : in out Iir;
                              Is_Global : Boolean;
                              Attr_Spec_Chain : in out Iir) is
   begin
      case Get_Kind (Decl) is
         when Iir_Kind_Type_Declaration
           | Iir_Kind_Anonymous_Type_Declaration =>
            Sem_Type_Declaration (Decl, Is_Global);
         when Iir_Kind_Subtype_Declaration =>
            Sem_Subtype_Declaration (Decl, Is_Global);
         when Iir_Kind_Signal_Declaration
           | Iir_Kind_Constant_Declaration
           | Iir_Kind_Variable_Declaration
           | Iir_Kind_Free_Quantity_Declaration =>
            Sem_Object_Declaration (Decl, Prev_Decl);
         when Iir_Kind_File_Declaration =>
            Sem_File_Declaration (Decl, Prev_Decl);
         when Iir_Kinds_Source_Quantity_Declaration =>
            Sem_Source_Quantity_Declaration (Decl, Prev_Decl);
         when Iir_Kind_Attribute_Declaration =>
            Sem_Attribute_Declaration (Decl);
         when Iir_Kind_Attribute_Specification =>
            Sem_Attribute_Specification (Decl);
            if Get_Entity_Name_List (Decl) in Iir_Flists_All_Others then
               Set_Attribute_Specification_Chain (Decl, Attr_Spec_Chain);
               Attr_Spec_Chain := Decl;
            end if;
         when Iir_Kind_Component_Declaration =>
            Sem_Component_Declaration (Decl);
         when Iir_Kind_Function_Declaration
           | Iir_Kind_Procedure_Declaration =>
            if Is_Implicit_Subprogram (Decl) then
               Sem_Scopes.Add_Name (Decl);
               --  Implicit subprogram are already visible.
            else
               Sem_Subprogram_Declaration (Decl);
               if Is_Global
                 and then Get_Kind (Decl) = Iir_Kind_Function_Declaration
                 and then Is_A_Resolution_Function (Decl, Null_Iir)
               then
                  Set_Resolution_Function_Flag (Decl, True);
               end if;
            end if;
         when Iir_Kind_Function_Body
           | Iir_Kind_Procedure_Body =>
            Sem_Subprogram_Body (Decl);
         when Iir_Kind_Non_Object_Alias_Declaration =>
            --  Added by Sem_Alias_Declaration.  Need to check that no
            --  existing attribute specification apply to them.
            null;
         when Iir_Kind_Object_Alias_Declaration =>
            Decl := Sem_Alias_Declaration (Decl);
            --  An alias may add new alias declarations. Do not skip
            --  them: check that no existing attribute specifications
            --  apply to them.
         when Iir_Kind_Use_Clause =>
            Sem_Use_Clause (Decl);
         when Iir_Kind_Configuration_Specification =>
            null;
         when Iir_Kind_Disconnection_Specification =>
            Sem_Disconnection_Specification (Decl);
         when Iir_Kind_Step_Limit_Specification =>
            Sem_Step_Limit_Specification (Decl);
         when Iir_Kind_Group_Template_Declaration =>
            Sem_Group_Template_Declaration (Decl);
         when Iir_Kind_Group_Declaration =>
            Sem_Group_Declaration (Decl);
         when Iir_Kinds_Signal_Attribute =>
            --  Added by sem, so nothing to do.
            null;
         when Iir_Kind_Protected_Type_Body =>
            Sem_Protected_Type_Body (Decl);

         when Iir_Kind_Package_Declaration =>
            Sem_Package_Declaration (Decl);
         when Iir_Kind_Package_Body =>
            Sem_Package_Body (Decl);
         when Iir_Kind_Package_Instantiation_Declaration =>
            Sem_Package_Instantiation_Declaration (Decl);

         when Iir_Kind_Nature_Declaration =>
            Sem_Nature_Declaration (Decl);
         when Iir_Kind_Subnature_Declaration =>
            Sem_Subnature_Declaration (Decl);
         when Iir_Kind_Terminal_Declaration =>
            Sem_Terminal_Declaration (Decl, Prev_Decl);
         when Iir_Kind_Across_Quantity_Declaration
           | Iir_Kind_Through_Quantity_Declaration =>
            Sem_Branch_Quantity_Declaration (Decl, Prev_Decl);

         when Iir_Kind_Psl_Declaration =>
            Sem_Psl.Sem_Psl_Declaration (Decl);
         when Iir_Kind_Psl_Default_Clock =>
            Sem_Psl.Sem_Psl_Default_Clock (Decl);

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

      if Attr_Spec_Chain /= Null_Iir then
         Check_Post_Attribute_Specification (Attr_Spec_Chain, Decl);
      end if;

      --  Insert *before* DECL pending implicit signal declarations created
      --  for DECL after LAST_DECL.  This updates LAST_DECL.
      Insert_Pending_Implicit_Declarations (Get_Parent (Decl), Prev_Decl);
   end Sem_Declaration;

   procedure Sem_Declaration_Chain (Parent : Iir)
   is
      Decl : Iir;
      --  Chain of attribute specifications, to check that no declaration
      --  appears after an 'others' entity_name_list.
      Attr_Spec_Chain : Iir;

      --  New declaration chain (declarations like implicit signals may be
      --  added, some like aliases may mutate).
      Last_Decl : Iir;

      --  If IS_GLOBAL is set, then declarations may be seen outside of unit.
      --  This must be set for entities and packages (except when
      --   Flags.Flag_Whole_Analyze is set).
      --  This controls whether a type is used for a signal.
      --  When Flag_Whole_Analyze is false, we are conservative and assume
      --  that any global type is used for a signal (when allowed).
      Is_Global : Boolean;
   begin
      case Get_Kind (Parent) is
         when Iir_Kind_Entity_Declaration
           | Iir_Kind_Package_Declaration =>
            Is_Global := not Flags.Flag_Whole_Analyze;
         when others =>
            Is_Global := False;
      end case;

      --  Due to implicit declarations, the list can grow during sem.
      Decl := Get_Declaration_Chain (Parent);
      Last_Decl := Null_Iir;
      Attr_Spec_Chain := Null_Iir;

      while Decl /= Null_Iir loop

         Sem_Declaration (Decl, Last_Decl, Is_Global, Attr_Spec_Chain);

         if Last_Decl = Null_Iir then
            --  Append now to handle expand names.
            Set_Declaration_Chain (Parent, Decl);
         else
            Set_Chain (Last_Decl, Decl);
         end if;
         Last_Decl := Decl;
         Decl := Get_Chain (Decl);
      end loop;

      --  Keep the point of insertion for implicit signal declarations.
      End_Of_Declarations_For_Implicit_Declarations (Parent, Last_Decl);
   end Sem_Declaration_Chain;

   procedure Check_Full_Declaration (Decls_Parent : Iir; Decl: Iir)
   is
      El: Iir;

      --  If set, emit a warning if a declaration is not used.
      Check_Unused : Boolean;
   begin
      --  LRM 3.5 Protected types.
      --  Each protected type declaration appearing immediatly within a given
      --  declaration region must have exactly one corresponding protected type
      --  body appearing immediatly within the same declarative region and
      --  textually subsequent to the protected type declaration.

      --  LRM 3.3.1 Incomplete type declarations
      --  For each incomplete type declaration, there must be a corresponding
      --  full type declaration with the same identifier.  This full type
      --  declaration must occur later and immediatly within the same
      --  declarative part as the incomplete type declaration to which it
      --  correspinds.

      --  LRM 4.3.1.1 Constant declarations
      --  If the assignment symbol ":=" followed by an expression is not
      --  present in a constant declaration, then the declaration declares a
      --  deferred constant.  Such a constant declaration must appear in a
      --  package declaration.  The corresponding full constant declaration,
      --  which defines the value of the constant, must appear in the body of
      --  the package (see 2.6).

      --  LRM 2.2 Subprogram bodies
      --  If both a declaration and a body are given, [...].  Furthermore,
      --  both the declaration and the body must occur immediatly within the
      --  same declaration region.

      --  Set Check_Unused.
      Check_Unused := False;
      if Is_Warning_Enabled (Warnid_Unused) then
         case Get_Kind (Decl) is
            when Iir_Kind_Entity_Declaration =>
               --  May be used in architecture.
               null;
            when Iir_Kind_Architecture_Body
              | Iir_Kind_Block_Statement =>
               --  Might be used in a configuration.
               Check_Unused := True;
            when  Iir_Kind_Generate_Statement_Body =>
               --  Might be used in a configuration.
               Check_Unused := True;
            when Iir_Kind_Package_Body
              | Iir_Kind_Protected_Type_Body =>
               --  Check only for declarations of the body.
               if Decls_Parent = Decl then
                  Check_Unused := True;
               end if;
            when Iir_Kind_Function_Body
              | Iir_Kind_Procedure_Body
              | Iir_Kind_Process_Statement
              | Iir_Kind_Sensitized_Process_Statement =>
               Check_Unused := True;
            when others =>
               --  Note: Check_Full_Declaration is not called
               --   for package declarations or protected type declarations.
               Error_Kind ("check_full_declaration", Decl);
         end case;
      end if;

      El := Get_Declaration_Chain (Decls_Parent);
      while El /= Null_Iir loop
         case Get_Kind (El) is
            when Iir_Kind_Constant_Declaration =>
               if Get_Deferred_Declaration_Flag (El) then
                  if Get_Deferred_Declaration (El) = Null_Iir then
                     Error_Msg_Sem
                       (+Decl,
                        "missing value for constant declared at %l", +El);
                  end if;
               end if;
            when Iir_Kind_Function_Declaration
              | Iir_Kind_Procedure_Declaration =>
               if not Is_Implicit_Subprogram (El)
                 and then Get_Subprogram_Body (El) = Null_Iir
               then
                  Error_Msg_Sem
                    (+Decl, "missing body for %n declared at %l", (+El, +El));
               end if;
            when Iir_Kind_Type_Declaration =>
               declare
                  Def : constant Iir := Get_Type_Definition (El);
               begin
                  if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition
                    and then Is_Null (Get_Complete_Type_Definition (Def))
                  then
                     Error_Msg_Sem
                       (+El, "missing full type declaration for %n", +El);
                  elsif Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration
                    and then Get_Protected_Type_Body (Def) = Null_Iir
                  then
                     Error_Msg_Sem
                       (+El, "missing protected type body for %n", +El);
                  end if;
               end;
            when Iir_Kind_Package_Declaration =>
               if Is_Null (Get_Package_Origin (El))
                 and then Get_Need_Body (El)
                 and then Get_Package_Body (El) = Null_Iir
               then
                  Error_Msg_Sem (+El, "missing package body for %n", +El);
               end if;
            when others =>
               null;
         end case;

         if Check_Unused then
            --  All subprograms declared in the specification (package or
            --  protected type) have only their *body* in the body.
            --  Therefore, they don't appear as declaration in body.
            --  Only private subprograms appears as declarations.
            case Get_Kind (El) is
               when Iir_Kind_Function_Declaration
                 | Iir_Kind_Procedure_Declaration =>
                  if not Get_Use_Flag (El)
                    and then not Is_Implicit_Subprogram (El)
                    and then not Is_Second_Subprogram_Specification (El)
                  then
                     Warning_Msg_Sem (Warnid_Unused, +El,
                                      "%n is never referenced", +El);
                  end if;
               when Iir_Kind_Signal_Declaration
                 | Iir_Kind_Variable_Declaration =>
                  if not Get_Use_Flag (El) then
                     Warning_Msg_Sem (Warnid_Unused, +El,
                                      "%n is never referenced", +El);
                  end if;
               when others =>
                  null;
            end case;
         end if;

         El := Get_Chain (El);
      end loop;
   end Check_Full_Declaration;

   procedure Sem_Iterator (Iterator : Iir_Iterator_Declaration;
                           Staticness : Iir_Staticness)
   is
      It_Range: constant Iir := Get_Discrete_Range (Iterator);
      It_Type : Iir;
      A_Range: Iir;
   begin
      Xref_Decl (Iterator);

      A_Range := Sem_Discrete_Range_Integer (It_Range);
      if A_Range = Null_Iir then
         Set_Type (Iterator, Create_Error_Type (It_Range));
         return;
      end if;

      Set_Discrete_Range (Iterator, Null_Iir);

      It_Type := Range_To_Subtype_Indication (A_Range);
      Set_Subtype_Indication (Iterator, It_Type);
      Set_Type (Iterator, Get_Type_Of_Subtype_Indication (It_Type));

      Set_Expr_Staticness (Iterator, Staticness);
   end Sem_Iterator;
end Vhdl.Sem_Decls;
Mode	Name	Size
-rw-r--r--	.gitattributes	8	log stats plain
-rw-r--r--	.gitignore	204	log stats plain
-rw-r--r--	BSDmakefile	179	log stats plain
-rw-r--r--	Config.in	13904	log stats plain
-rw-r--r--	LICENSE	17992	log stats plain
-rw-r--r--	Makefile	3337	log stats plain
-rw-r--r--	README	1220	log stats plain
d---------	docs	601	log stats plain
-rw-r--r--	feeds.conf.default	567	log stats plain
d---------	include	1383	log stats plain
d---------	package	4529	log stats plain
-rw-r--r--	rules.mk	9281	log stats plain
d---------	scripts	1524	log stats plain
d---------	target	210	log stats plain
d---------	toolchain	409	log stats plain
d---------	tools	1563	log stats plain