path: root/src/vhdl/sem_assocs.adb

--  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 Evaluation; use Evaluation;
with Errorout; use Errorout;
with Flags; use Flags;
with Types; use Types;
with Iirs_Utils; use Iirs_Utils;
with Parse;
with Std_Names;
with Sem_Names; use Sem_Names;
with Sem_Types;
with Std_Package;
with Sem_Scopes;
with Iir_Chains; use Iir_Chains;
with Xrefs;

package body Sem_Assocs is
   function Rewrite_Non_Object_Association (Assoc : Iir; Inter : Iir)
                                           return Iir
   is
      N_Assoc : Iir;
      Actual : Iir;
   begin
      Actual := Get_Actual (Assoc);
      case Get_Kind (Inter) is
         when Iir_Kind_Interface_Package_Declaration =>
            N_Assoc := Create_Iir (Iir_Kind_Association_Element_Package);
         when Iir_Kind_Interface_Type_Declaration =>
            N_Assoc := Create_Iir (Iir_Kind_Association_Element_Type);
            if Get_Kind (Actual) = Iir_Kind_Parenthesis_Name then
               --  Convert parenthesis name to array subtype.
               declare
                  N_Actual : Iir;
                  Sub_Assoc : Iir;
                  Indexes : Iir_List;
                  Old : Iir;
               begin
                  N_Actual := Create_Iir (Iir_Kind_Array_Subtype_Definition);
                  Location_Copy (N_Actual, Actual);
                  Set_Subtype_Type_Mark (N_Actual, Get_Prefix (Actual));
                  Sub_Assoc := Get_Association_Chain (Actual);
                  Indexes := Create_Iir_List;
                  while Is_Valid (Sub_Assoc) loop
                     if Get_Kind (Sub_Assoc)
                       /= Iir_Kind_Association_Element_By_Expression
                     then
                        Error_Msg_Sem
                          (+Sub_Assoc, "index constraint must be a range");
                     else
                        if Get_Formal (Sub_Assoc) /= Null_Iir then
                           Error_Msg_Sem
                             (+Sub_Assoc, "formal part not allowed");
                        end if;
                        Append_Element (Indexes, Get_Actual (Sub_Assoc));
                     end if;
                     Old := Sub_Assoc;
                     Sub_Assoc := Get_Chain (Sub_Assoc);
                     Free_Iir (Old);
                  end loop;
                  Old := Actual;
                  Free_Iir (Old);
                  Set_Index_Constraint_List
                    (N_Actual, List_To_Flist (Indexes));
                  Actual := N_Actual;
               end;
            end if;
         when Iir_Kinds_Interface_Subprogram_Declaration =>
            N_Assoc := Create_Iir (Iir_Kind_Association_Element_Subprogram);
            if Get_Kind (Actual) = Iir_Kind_String_Literal8 then
               Actual := Parse.String_To_Operator_Symbol (Actual);
            end if;
         when others =>
            Error_Kind ("rewrite_non_object_association", Inter);
      end case;
      Location_Copy (N_Assoc, Assoc);
      Set_Formal (N_Assoc, Get_Formal (Assoc));
      Set_Actual (N_Assoc, Actual);
      Set_Chain (N_Assoc, Get_Chain (Assoc));
      Set_Whole_Association_Flag (N_Assoc, True);
      Free_Iir (Assoc);
      return N_Assoc;
   end Rewrite_Non_Object_Association;

   function Extract_Non_Object_Association
     (Assoc_Chain : Iir; Inter_Chain : Iir) return Iir
   is
      Inter : Iir;
      Assoc : Iir;
      --  N_Assoc : Iir;
      Prev_Assoc : Iir;
      Formal : Iir;
      Res : Iir;
   begin
      Inter := Inter_Chain;
      Assoc := Assoc_Chain;
      Prev_Assoc := Null_Iir;
      Res := Null_Iir;

      --  Common case: only objects in interfaces.
      while Is_Valid (Inter) loop
         exit when Get_Kind (Inter)
           not in Iir_Kinds_Interface_Object_Declaration;
         Inter := Get_Chain (Inter);
      end loop;
      if Is_Null (Inter) then
         --  Only interface object, nothing to to.
         return Assoc_Chain;
      end if;

      Inter := Inter_Chain;
      loop
         --  Don't try to detect errors.
         if Is_Null (Assoc) then
            return Res;
         end if;

         Formal := Get_Formal (Assoc);
         if Formal = Null_Iir then
            --  Positional association.

            if Inter = Null_Iir then
               --  But after a named one.  Be silent on that error.
               null;
            elsif Get_Kind (Inter)
              not in Iir_Kinds_Interface_Object_Declaration
            then
               Assoc := Rewrite_Non_Object_Association (Assoc, Inter);
            end if;
         else
            if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol)
            then
               --  A candidate.  Search the corresponding interface.
               Inter := Find_Name_In_Chain
                 (Inter_Chain, Get_Identifier (Formal));
               if Inter /= Null_Iir
                 and then
                 Get_Kind (Inter) not in Iir_Kinds_Interface_Object_Declaration
               then
                  Assoc := Rewrite_Non_Object_Association (Assoc, Inter);
               end if;
            end if;

            --  No more association by position.
            Inter := Null_Iir;
         end if;

         if Prev_Assoc = Null_Iir then
            Res := Assoc;
         else
            Set_Chain (Prev_Assoc, Assoc);
         end if;
         Prev_Assoc := Assoc;
         Assoc := Get_Chain (Assoc);
         if Is_Valid (Inter) then
            Inter := Get_Chain (Inter);
         end if;
      end loop;
   end Extract_Non_Object_Association;

   --  Analyze all arguments of ASSOC_CHAIN
   --  Return TRUE if no error.
   function Sem_Actual_Of_Association_Chain (Assoc_Chain : Iir)
     return Boolean
   is
      Has_Named : Boolean;
      Ok : Boolean;
      Assoc : Iir;
      Res : Iir;
      Formal : Iir;
   begin
      --  Analyze all arguments.
      --  OK is false if there is an error during semantic of one of the
      --  argument, but continue analyze.
      Has_Named := False;
      Ok := True;
      Assoc := Assoc_Chain;
      while Assoc /= Null_Iir loop
         Formal := Get_Formal (Assoc);
         if Formal /= Null_Iir then
            Has_Named := True;
            --  FIXME: check FORMAL is well composed.
         elsif Has_Named then
            --  FIXME: do the check in parser.
            Error_Msg_Sem (+Assoc, "positional argument after named argument");
            Ok := False;
         end if;
         if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then
            Res := Sem_Expression_Ov (Get_Actual (Assoc), Null_Iir);
            if Res = Null_Iir then
               Ok := False;
            else
               Set_Actual (Assoc, Res);
            end if;
         end if;
         Assoc := Get_Chain (Assoc);
      end loop;
      return Ok;
   end Sem_Actual_Of_Association_Chain;

   procedure Check_Parameter_Association_Restriction
     (Inter : Iir; Base_Actual : Iir; Loc : Iir) is
   begin
      case Iir_Parameter_Modes (Get_Mode (Inter)) is
         when Iir_In_Mode =>
            if Can_Interface_Be_Read (Base_Actual) then
               return;
            end if;
         when Iir_Out_Mode =>
            if Can_Interface_Be_Updated (Base_Actual) then
               return;
            end if;
         when Iir_Inout_Mode =>
            if Can_Interface_Be_Read (Base_Actual)
              and then Can_Interface_Be_Updated (Base_Actual)
            then
               return;
            end if;
      end case;
      Error_Msg_Sem
        (+Loc, "cannot associate an " & Get_Mode_Name (Get_Mode (Base_Actual))
           & " object with " & Get_Mode_Name (Get_Mode (Inter)) & " %n",
         +Inter);
   end Check_Parameter_Association_Restriction;

   procedure Check_Subprogram_Associations
     (Inter_Chain : Iir; Assoc_Chain : Iir)
   is
      Assoc : Iir;
      Formal_Inter : Iir;
      Actual : Iir;
      Prefix : Iir;
      Object : Iir;
      Inter : Iir;
   begin
      Assoc := Assoc_Chain;
      Inter := Inter_Chain;
      while Assoc /= Null_Iir loop
         Formal_Inter := Get_Association_Interface (Assoc, Inter);
         case Get_Kind (Assoc) is
            when Iir_Kind_Association_Element_Open =>
               if Get_Default_Value (Formal_Inter) = Null_Iir then
                  Error_Msg_Sem
                    (+Assoc, "no parameter for %n", +Formal_Inter);
               end if;
            when Iir_Kind_Association_Element_By_Expression =>
               Actual := Get_Actual (Assoc);
               Object := Name_To_Object (Actual);
               if Object /= Null_Iir then
                  Prefix := Get_Object_Prefix (Object);
               else
                  Prefix := Actual;
               end if;

               case Get_Kind (Formal_Inter) is
                  when Iir_Kind_Interface_Signal_Declaration =>
                     --  LRM93 2.1.1
                     --  In a subprogram call, the actual designator
                     --  associated with a formal parameter of class
                     --  signal must be a signal.
                     case Get_Kind (Prefix) is
                        when Iir_Kind_Interface_Signal_Declaration
                          | Iir_Kind_Signal_Declaration
                          | Iir_Kind_Guard_Signal_Declaration
                          | Iir_Kinds_Signal_Attribute =>
                           --  LRM93 2.1.1.2
                           --  If an actual signal is associated with
                           --  a signal parameter of any mode, the actual
                           --  must be denoted by a static signal name.
                           if Get_Name_Staticness (Object) < Globally then
                              Error_Msg_Sem
                                (+Actual,
                                 "actual signal must be a static name");
                           else
                              --  Inherit has_active_flag.
                              Set_Has_Active_Flag
                                (Prefix, Get_Has_Active_Flag (Formal_Inter));
                           end if;
                        when others =>
                           Error_Msg_Sem
                             (+Assoc,
                              "signal parameter requires a signal expression");
                     end case;

                     case Get_Kind (Prefix) is
                        when Iir_Kind_Interface_Signal_Declaration =>
                           Check_Parameter_Association_Restriction
                             (Formal_Inter, Prefix, Assoc);
                        when Iir_Kind_Guard_Signal_Declaration =>
                           if Get_Mode (Formal_Inter) /= Iir_In_Mode then
                              Error_Msg_Sem
                                (+Assoc,
                                 "cannot associate a guard signal with "
                                 & Get_Mode_Name (Get_Mode (Formal_Inter))
                                 & " %n", +Formal_Inter);
                           end if;
                        when Iir_Kinds_Signal_Attribute =>
                           if Get_Mode (Formal_Inter) /= Iir_In_Mode then
                              Error_Msg_Sem
                                (+Assoc,
                                 "cannot associate a signal attribute with "
                                 & Get_Mode_Name (Get_Mode (Formal_Inter))
                                 & " %n", +Formal_Inter);
                           end if;
                        when others =>
                           null;
                     end case;

                     --  LRM 2.1.1.2  Signal parameters
                     --  It is an error if a conversion function or type
                     --  conversion appears in either the formal part or the
                     --  actual part of an association element that associates
                     --  an actual signal with a formal signal parameter.
                     if Get_Actual_Conversion (Assoc) /= Null_Iir
                       or Get_Formal_Conversion (Assoc) /= Null_Iir
                     then
                        Error_Msg_Sem
                          (+Assoc,
                           "conversion are not allowed for signal parameters");
                     end if;
                  when Iir_Kind_Interface_Variable_Declaration =>
                     --  LRM93 2.1.1
                     --  The actual designator associated with a formal of
                     --  class variable must be a variable.
                     case Get_Kind (Prefix) is
                        when Iir_Kind_Interface_Variable_Declaration =>
                           Check_Parameter_Association_Restriction
                             (Formal_Inter, Prefix, Assoc);
                        when Iir_Kind_Variable_Declaration
                          | Iir_Kind_Dereference
                          | Iir_Kind_Implicit_Dereference =>
                           null;
                        when Iir_Kind_Interface_File_Declaration
                          | Iir_Kind_File_Declaration =>
                           --  LRM87 4.3.1.4
                           --  Such an object is a member of the variable
                           --  class of objects;
                           if Flags.Vhdl_Std >= Vhdl_93 then
                              Error_Msg_Sem
                                (+Assoc, "variable parameter cannot be a "
                                   & "file (vhdl93)");
                           end if;
                        when others =>
                           Error_Msg_Sem
                             (+Assoc, "variable parameter must be a variable");
                     end case;
                  when Iir_Kind_Interface_File_Declaration =>
                     --  LRM93 2.1.1
                     --  The actual designator associated with a formal
                     --  of class file must be a file.
                     case Get_Kind (Prefix) is
                        when Iir_Kind_Interface_File_Declaration
                          | Iir_Kind_File_Declaration =>
                           null;
                        when Iir_Kind_Variable_Declaration
                          | Iir_Kind_Interface_Variable_Declaration =>
                           if Flags.Vhdl_Std >= Vhdl_93 then
                              Error_Msg_Sem (+Assoc, "file parameter "
                                               & "must be a file (vhdl93)");
                           end if;
                        when others =>
                           Error_Msg_Sem
                             (+Assoc, "file parameter must be a file");
                     end case;

                     --  LRM 2.1.1.3  File parameters
                     --  It is an error if an association element associates
                     --  an actual with a formal parameter of a file type and
                     --  that association element contains a conversion
                     --  function or type conversion.
                     if Get_Actual_Conversion (Assoc) /= Null_Iir
                       or Get_Formal_Conversion (Assoc) /= Null_Iir
                     then
                        Error_Msg_Sem (+Assoc, "conversion are not allowed "
                                         & "for file parameters");
                     end if;
                  when Iir_Kind_Interface_Constant_Declaration =>
                     --  LRM93 2.1.1
                     --  The actual designator associated with a formal of
                     --  class constant must be an expression.
                     --  GHDL: unless this is in a formal_part.
                     if not Get_In_Formal_Flag (Assoc) then
                        Check_Read (Actual);
                     end if;
                  when others =>
                     Error_Kind
                       ("check_subprogram_association(3)", Formal_Inter);
               end case;
            when Iir_Kind_Association_Element_By_Individual =>
               null;
            when others =>
               Error_Kind ("check_subprogram_associations", Assoc);
         end case;
         Next_Association_Interface (Assoc, Inter);
      end loop;
   end Check_Subprogram_Associations;

   --  Assocs_Right_Map (FORMAL_MODE, ACTUAL_MODE) is true iff it is allowed
   --  to associate a formal port of mode FORMAL_MODE with an actual port of
   --  mode ACTUAL_MODE.
   subtype Iir_Known_Mode is Iir_Mode range Iir_Linkage_Mode .. Iir_In_Mode;
   type Assocs_Right_Map is array (Iir_Known_Mode, Iir_Known_Mode) of Boolean;

   --  LRM93 1.1.1.2 Ports
   Vhdl93_Assocs_Map : constant Assocs_Right_Map :=
     (Iir_In_Mode =>
        (Iir_In_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
         others => False),
      Iir_Out_Mode =>
        (Iir_Out_Mode | Iir_Inout_Mode => True,
         others => False),
      Iir_Inout_Mode =>
        (Iir_Inout_Mode => True,
         others => False),
      Iir_Buffer_Mode =>
        (Iir_Buffer_Mode => True, others => False),
      Iir_Linkage_Mode =>
        (others => True));

   --  LRM02 1.1.1.2 Ports
   Vhdl02_Assocs_Map : constant Assocs_Right_Map :=
     (Iir_In_Mode =>
        (Iir_In_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
         others => False),
      Iir_Out_Mode =>
        (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
         others => False),
      Iir_Inout_Mode =>
        (Iir_Inout_Mode | Iir_Buffer_Mode => True,
         others => False),
      Iir_Buffer_Mode =>
        (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
         others => False),
      Iir_Linkage_Mode =>
        (others => True));

   --  LRM08 6.5.6.3 Port clauses
   Vhdl08_Assocs_Map : constant Assocs_Right_Map :=
     (Iir_In_Mode =>
        (Iir_In_Mode | Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
         others => False),
      Iir_Out_Mode =>
        (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
         others => False),
      Iir_Inout_Mode =>
        (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
         others => False),
      Iir_Buffer_Mode =>
        (Iir_Out_Mode | Iir_Inout_Mode | Iir_Buffer_Mode => True,
         others => False),
      Iir_Linkage_Mode => (others => True));

   --  Check for restrictions in LRM 1.1.1.2
   --  Return FALSE in case of error.
   function Check_Port_Association_Mode_Restrictions
     (Formal : Iir_Interface_Signal_Declaration;
      Actual : Iir_Interface_Signal_Declaration;
      Assoc : Iir)
     return Boolean
   is
      Fmode : constant Iir_Mode := Get_Mode (Formal);
      Amode : constant Iir_Mode := Get_Mode (Actual);
   begin
      pragma Assert (Fmode /= Iir_Unknown_Mode);
      pragma Assert (Amode /= Iir_Unknown_Mode);

      case Flags.Vhdl_Std is
         when Vhdl_87 | Vhdl_93c | Vhdl_93 | Vhdl_00 =>
            if Vhdl93_Assocs_Map (Fmode, Amode) then
               return True;
            end if;
         when Vhdl_02 =>
            if Vhdl02_Assocs_Map (Fmode, Amode) then
               return True;
            end if;
         when Vhdl_08 =>
            if Vhdl08_Assocs_Map (Fmode, Amode) then
               return True;
            end if;
      end case;

      if Assoc /= Null_Iir then
         Error_Msg_Sem
           (+Assoc, "cannot associate " & Get_Mode_Name (Fmode) & " %n"
              & " with actual port of mode "
              & Get_Mode_Name (Amode), +Formal);
      end if;
      return False;
   end Check_Port_Association_Mode_Restrictions;

   --  Check restrictions of LRM02 12.2.4
   procedure Check_Port_Association_Bounds_Restrictions
     (Formal : Iir; Actual : Iir; Assoc : Iir)
   is
      Inter : constant Iir := Get_Object_Prefix (Formal, False);

      function Is_Scalar_Type_Compatible (Src : Iir; Dest : Iir)
                                         return Boolean
      is
         Src_Range : Iir;
         Dst_Range : Iir;
      begin
         if Get_Kind (Src) not in Iir_Kinds_Scalar_Type_And_Subtype_Definition
         then
            return True;
         end if;

         Src_Range := Get_Range_Constraint (Src);
         Dst_Range := Get_Range_Constraint (Dest);
         if Get_Expr_Staticness (Src_Range) /= Locally
           or else Get_Expr_Staticness (Dst_Range) /= Locally
         then
            return True;
         end if;

         --  FIXME: non-static bounds have to be checked at run-time
         --  (during elaboration).

         --  In vhdl08, the subtypes must be compatible.  Use the that rule
         --  for 93c and relaxed rules.
         if Vhdl_Std >= Vhdl_08
           or else Vhdl_Std = Vhdl_93c
           or else Flag_Relaxed_Rules
         then
            return Eval_Is_Range_In_Bound (Src, Dest, True);
         end if;

         --  Prior vhdl08, the subtypes must be identical.
         if not Eval_Is_Eq (Get_Left_Limit (Src_Range),
                            Get_Left_Limit (Dst_Range))
           or else not Eval_Is_Eq (Get_Right_Limit (Src_Range),
                                      Get_Right_Limit (Dst_Range))
           or else Get_Direction (Src_Range) /= Get_Direction (Dst_Range)
         then
            return False;
         end if;

         return True;
      end Is_Scalar_Type_Compatible;

      procedure Error_Msg
      is
         Id : Msgid_Type;
         Orig : Report_Origin;
      begin
         if Flag_Elaborate then
            Id := Msgid_Error;
            Orig := Elaboration;
         else
            Id := Warnid_Port_Bounds;
            Orig := Semantic;
         end if;
         Report_Msg
           (Id, Orig, +Assoc,
            "bounds or direction of actual don't match with %n",
            (1 => +Inter));
      end Error_Msg;

      Ftype : constant Iir := Get_Type (Formal);
      Atype : constant Iir := Get_Type (Actual);
      F_Conv : constant Iir := Get_Formal_Conversion (Assoc);
      A_Conv : constant Iir := Get_Actual_Conversion (Assoc);
      F2a_Type : Iir;
      A2f_Type : Iir;
   begin
      --  LRM02 12.2.4 The port map aspect
      --  If an actual signal is associated with a port of any mode, and if
      --  the type of the formal is a scalar type, then it is an error if
      --  (after applying any conversion function or type conversion
      --  expression present in the actual part) the bounds and direction of
      --  the subtype denoted by the subtype indication of the formal are not
      --  identical to the bounds and direction of the subtype denoted by the
      --  subtype indication of the actual.

      --  LRM08 14.3.5 Port map aspect
      --  If an actual signal is associated with a port of mode IN or INOUT,
      --  and if the type of the formal is a scalar type, then it is an error
      --  if (after applying any conversion function or type conversion
      --  expression present in the actual part) the subtype of the actual is
      --  not compatible with the subtype of the formal.  [...]
      --
      --  Similarly, if an actual signal is associated with a port of mode
      --  OUT, INOUT, or BUFFER, and the type of the actual is a scalar type,
      --  then it is an error if (after applying any conversion function or
      --  type conversion expression present in the formal part) the subtype
      --  or the formal is not compatible with the subtype of the actual.
      if Is_Valid (F_Conv) then
         F2a_Type := Get_Type (F_Conv);
      else
         F2a_Type := Ftype;
      end if;
      if Is_Valid (A_Conv) then
         A2f_Type := Get_Type (A_Conv);
      else
         A2f_Type := Atype;
      end if;
      if Get_Mode (Inter) in Iir_In_Modes
        and then not Is_Scalar_Type_Compatible (A2f_Type, Ftype)
      then
         Error_Msg;
      end if;
      if Get_Mode (Inter) in Iir_Out_Modes
        and then not Is_Scalar_Type_Compatible (F2a_Type, Atype)
      then
         Error_Msg;
      end if;
   end Check_Port_Association_Bounds_Restrictions;

   --  Handle indexed name
   --  FORMAL is the formal name to be handled.
   --  BASE_ASSOC is an association_by_individual in which the formal will be
   --   inserted.
   procedure Add_Individual_Assoc_Indexed_Name
     (Choice : out Iir; Base_Assoc : Iir; Formal : Iir)
   is
      Index_List : constant Iir_Flist := Get_Index_List (Formal);
      Nbr : constant Natural := Get_Nbr_Elements (Index_List);
      Last_Choice : Iir;
      Index : Iir;
      Staticness : Iir_Staticness;
      Sub_Assoc : Iir;
   begin
      --  Find element.
      Sub_Assoc := Base_Assoc;
      for I in 0 .. Nbr - 1 loop
         Index := Get_Nth_Element (Index_List, I);

         --  Evaluate index.
         Staticness := Get_Expr_Staticness (Index);
         if Staticness = Locally then
            Index := Eval_Expr (Index);
            Set_Nth_Element (Index_List, I, Index);
         else
            Error_Msg_Sem (+Index, "index expression must be locally static");
            Set_Choice_Staticness (Base_Assoc, None);
         end if;

         --  Find index in choice list.
         Last_Choice := Null_Iir;
         Choice := Get_Individual_Association_Chain (Sub_Assoc);
         while Choice /= Null_Iir loop
            case Get_Kind (Choice) is
               when Iir_Kind_Choice_By_Expression =>
                  if Eval_Pos (Get_Choice_Expression (Choice))
                    = Eval_Pos (Index)
                  then
                     goto Found;
                  end if;
               when Iir_Kind_Choice_By_Range =>
                  declare
                     Choice_Range : constant Iir := Get_Choice_Range (Choice);
                  begin
                     if Get_Expr_Staticness (Choice_Range) = Locally
                       and then
                       Eval_Int_In_Range (Eval_Pos (Index), Choice_Range)
                     then
                        --  FIXME: overlap.
                        raise Internal_Error;
                     end if;
                  end;
               when others =>
                  Error_Kind ("add_individual_assoc_index_name", Choice);
            end case;
            Last_Choice := Choice;
            Choice := Get_Chain (Choice);
         end loop;

         --  If not found, append it.
         Choice := Create_Iir (Iir_Kind_Choice_By_Expression);
         Set_Choice_Expression (Choice, Index);
         Set_Choice_Staticness (Choice, Staticness);
         Location_Copy (Choice, Formal);
         if Last_Choice = Null_Iir then
            Set_Individual_Association_Chain (Sub_Assoc, Choice);
         else
            Set_Chain (Last_Choice, Choice);
         end if;

         << Found >> null;

         if I < Nbr - 1 then
            --  Create an intermediate assoc by individual.
            Sub_Assoc := Get_Associated_Expr (Choice);
            if Sub_Assoc = Null_Iir then
               Sub_Assoc := Create_Iir
                 (Iir_Kind_Association_Element_By_Individual);
               Location_Copy (Sub_Assoc, Index);
               Set_Associated_Expr (Choice, Sub_Assoc);
               Set_Choice_Staticness (Sub_Assoc, Locally);
            end if;
         end if;
      end loop;
   end Add_Individual_Assoc_Indexed_Name;

   procedure Add_Individual_Assoc_Slice_Name
     (Choice : out Iir; Sub_Assoc : Iir; Formal : Iir)
   is
      Index : Iir;
      Staticness : Iir_Staticness;
   begin
      --  FIXME: handle cases such as param(5 to 6)(5)

      --  Find element.
      Index := Get_Suffix (Formal);

      --  Evaluate index.
      Staticness := Get_Expr_Staticness (Index);
      if Staticness = Locally then
         Index := Eval_Range (Index);
         Set_Suffix (Formal, Index);
      else
         Error_Msg_Sem (+Index, "range expression must be locally static");
         Set_Choice_Staticness (Sub_Assoc, None);
      end if;

      Choice := Create_Iir (Iir_Kind_Choice_By_Range);
      Location_Copy (Choice, Formal);
      Set_Choice_Range (Choice, Index);
      Set_Chain (Choice, Get_Individual_Association_Chain (Sub_Assoc));
      Set_Choice_Staticness (Choice, Staticness);
      Set_Individual_Association_Chain (Sub_Assoc, Choice);
   end Add_Individual_Assoc_Slice_Name;

   procedure Add_Individual_Assoc_Selected_Name
     (Choice : out Iir; Sub_Assoc : Iir; Formal : Iir)
   is
      Element : constant Iir := Get_Selected_Element (Formal);
      Last_Choice : Iir;
   begin
      --  Try to find the existing choice.
      Last_Choice := Null_Iir;
      Choice := Get_Individual_Association_Chain (Sub_Assoc);
      while Choice /= Null_Iir loop
         if Get_Choice_Name (Choice) = Element then
            return;
         end if;
         Last_Choice := Choice;
         Choice := Get_Chain (Choice);
      end loop;

      --  If not found, append it.
      Choice := Create_Iir (Iir_Kind_Choice_By_Name);
      Location_Copy (Choice, Formal);
      Set_Choice_Name (Choice, Element);
      if Last_Choice = Null_Iir then
         Set_Individual_Association_Chain (Sub_Assoc, Choice);
      else
         Set_Chain (Last_Choice, Choice);
      end if;
   end Add_Individual_Assoc_Selected_Name;

   --  Subroutine of Add_Individual_Association.
   --  Search/build the tree of choices for FORMAL, starting for IASSOC.
   --  The root of the tree is an association by individual node.  Each node
   --  points to a chain of choices, whose associated expression is either an
   --  association by individual (and the tree continue) or an association
   --  by expression coming from the initial association (and this is a leaf).
   procedure Add_Individual_Association_1
     (Iassoc : in out Iir; Formal : Iir; Last : Boolean)
   is
      Base_Assoc : constant Iir := Iassoc;
      Formal_Object : constant Iir := Name_To_Object (Formal);
      Sub : Iir;
      Choice : Iir;
   begin
      pragma Assert
        (Get_Kind (Iassoc) = Iir_Kind_Association_Element_By_Individual);

      --  Recurse to start from the basename of the formal.
      case Get_Kind (Formal_Object) is
         when Iir_Kind_Indexed_Name
           | Iir_Kind_Slice_Name
           | Iir_Kind_Selected_Element =>
            Add_Individual_Association_1
              (Iassoc, Get_Prefix (Formal_Object), False);
         when Iir_Kinds_Interface_Object_Declaration =>
            --  At the root of the formal.
            pragma Assert
              (Formal_Object = Get_Named_Entity (Get_Formal (Iassoc)));
            return;
         when others =>
            Error_Kind ("add_individual_association_1", Formal);
      end case;

      --  Add the choices for the indexes/slice/element.
      case Get_Kind (Formal_Object) is
         when Iir_Kind_Indexed_Name =>
            Add_Individual_Assoc_Indexed_Name (Choice, Iassoc, Formal_Object);
         when Iir_Kind_Slice_Name =>
            Add_Individual_Assoc_Slice_Name (Choice, Iassoc, Formal_Object);
         when Iir_Kind_Selected_Element =>
            Add_Individual_Assoc_Selected_Name (Choice, Iassoc, Formal_Object);
         when others =>
            Error_Kind ("add_individual_association_1(3)", Formal);
      end case;

      Sub := Get_Associated_Expr (Choice);
      if Sub = Null_Iir then
         if not Last then
            --  Create the individual association for the choice.
            Sub := Create_Iir (Iir_Kind_Association_Element_By_Individual);
            Location_Copy (Sub, Formal);
            Set_Choice_Staticness (Sub, Locally);
            Set_Formal (Sub, Formal);
            Set_Associated_Expr (Choice, Sub);
         end if;
      else
         if Last
           or else Get_Kind (Sub) /= Iir_Kind_Association_Element_By_Individual
         then
            --  A final association.
            pragma Assert
              (Get_Kind (Sub) = Iir_Kind_Association_Element_By_Expression);
            Error_Msg_Sem
              (+Formal, "individual association of %n"
                 & " conflicts with that at %l",
               (+Get_Interface_Of_Formal (Get_Formal (Iassoc)),
                +Sub));
         else
            if Get_Choice_Staticness (Sub) /= Locally then
               --  Propagate error.
               Set_Choice_Staticness (Base_Assoc, None);
            end if;
         end if;
      end if;

      if Last then
         Iassoc := Choice;
      else
         Iassoc := Sub;
      end if;
   end Add_Individual_Association_1;

   --  Insert ASSOC into the tree of individual assoc rooted by IASSOC.
   --  This is done so that duplicate or missing associations are found (using
   --  the same routine for aggregate/case statement).
   procedure Add_Individual_Association (Iassoc : Iir; Assoc : Iir)
   is
      Formal : constant Iir := Get_Formal (Assoc);
      Res_Iass : Iir;
      Prev : Iir;
   begin
      --  Create the individual association for the formal.
      Res_Iass := Iassoc;
      Add_Individual_Association_1 (Res_Iass, Formal, True);

      Prev := Get_Associated_Expr (Res_Iass);
      if Prev = Null_Iir then
         Set_Associated_Expr (Res_Iass, Assoc);
      end if;
   end Add_Individual_Association;

   procedure Finish_Individual_Assoc_Array_Subtype
     (Assoc : Iir; Atype : Iir; Dim : Positive)
   is
      Index_Tlist : constant Iir_Flist := Get_Index_Subtype_List (Atype);
      Nbr_Dims : constant Natural := Get_Nbr_Elements (Index_Tlist);
      Index_Type : constant Iir := Get_Nth_Element (Index_Tlist, Dim - 1);
      Low, High : Iir;
      Chain : Iir;
      El : Iir;
   begin
      Chain := Get_Individual_Association_Chain (Assoc);
      Sem_Check_Continuous_Choices
        (Chain, Index_Type, False, Get_Location (Assoc), Low, High);
      Set_Individual_Association_Chain (Assoc, Chain);
      if Dim < Nbr_Dims then
         El := Chain;
         while El /= Null_Iir loop
            pragma Assert (Get_Kind (El) = Iir_Kind_Choice_By_Expression);
            Finish_Individual_Assoc_Array_Subtype
              (Get_Associated_Expr (El), Atype, Dim + 1);
            El := Get_Chain (El);
         end loop;
      end if;
   end Finish_Individual_Assoc_Array_Subtype;

   procedure Finish_Individual_Assoc_Array
     (Actual : Iir; Assoc : Iir; Dim : Natural)
   is
      Actual_Type : constant Iir := Get_Actual_Type (Actual);
      Actual_Index : Iir;
      Base_Type : Iir;
      Base_Index : Iir;
      Low, High : Iir;
      Chain : Iir;
   begin
      Actual_Index := Get_Nth_Element (Get_Index_Subtype_List (Actual_Type),
                                       Dim - 1);
      if Actual_Index /= Null_Iir then
         Base_Index := Actual_Index;
      else
         Base_Type := Get_Base_Type (Actual_Type);
         Base_Index := Get_Index_Type (Base_Type, Dim - 1);
      end if;
      Chain := Get_Individual_Association_Chain (Assoc);
      Sem_Choices_Range
        (Chain, Base_Index, True, False, Get_Location (Assoc), Low, High);
      Set_Individual_Association_Chain (Assoc, Chain);
      if Actual_Index = Null_Iir then
         declare
            Index_Constraint : Iir;
            Index_Subtype_Constraint : Iir;
         begin
            --  Create an index subtype.
            case Get_Kind (Base_Index) is
               when Iir_Kind_Integer_Subtype_Definition =>
                  Actual_Index :=
                    Create_Iir (Iir_Kind_Integer_Subtype_Definition);
               when Iir_Kind_Enumeration_Type_Definition
                 | Iir_Kind_Enumeration_Subtype_Definition =>
                  Actual_Index :=
                    Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
               when others =>
                  Error_Kind ("finish_individual_assoc_array", Base_Index);
            end case;
            Location_Copy (Actual_Index, Actual);
            Set_Base_Type (Actual_Index, Get_Base_Type (Base_Index));
            Index_Constraint := Get_Range_Constraint (Base_Index);

            Index_Subtype_Constraint := Create_Iir (Iir_Kind_Range_Expression);
            Location_Copy (Index_Subtype_Constraint, Actual);
            Set_Range_Constraint (Actual_Index, Index_Subtype_Constraint);
            Set_Type_Staticness (Actual_Index, Locally);
            Set_Direction (Index_Subtype_Constraint,
                           Get_Direction (Index_Constraint));

            --  For ownership purpose, the bounds must be copied otherwise
            --  they would be referenced before being defined.  This is non
            --  optimal but it doesn't happen often.
            Low := Copy_Constant (Low);
            High := Copy_Constant (High);

            case Get_Direction (Index_Constraint) is
               when Iir_To =>
                  Set_Left_Limit (Index_Subtype_Constraint, Low);
                  Set_Left_Limit_Expr (Index_Subtype_Constraint, Low);
                  Set_Right_Limit (Index_Subtype_Constraint, High);
                  Set_Right_Limit_Expr (Index_Subtype_Constraint, High);
               when Iir_Downto =>
                  Set_Left_Limit (Index_Subtype_Constraint, High);
                  Set_Left_Limit_Expr (Index_Subtype_Constraint, High);
                  Set_Right_Limit (Index_Subtype_Constraint, Low);
                  Set_Right_Limit_Expr (Index_Subtype_Constraint, Low);
            end case;
            Set_Expr_Staticness (Index_Subtype_Constraint, Locally);
            Set_Nth_Element (Get_Index_Subtype_List (Actual_Type), Dim - 1,
                             Actual_Index);
         end;
      else
         declare
            Act_High, Act_Low : Iir;
         begin
            Get_Low_High_Limit (Get_Range_Constraint (Actual_Type),
                                Act_Low, Act_High);
            if Eval_Pos (Act_Low) /= Eval_Pos (Low)
              or Eval_Pos (Act_High) /= Eval_Pos (High)
            then
               Error_Msg_Sem
                 (+Assoc, "indexes of individual association mismatch");
            end if;
         end;
      end if;
   end Finish_Individual_Assoc_Array;

   procedure Finish_Individual_Assoc_Record (Assoc : Iir; Atype : Iir)
   is
      El_List : constant Iir_Flist := Get_Elements_Declaration_List (Atype);
      Nbr_El : constant Natural := Get_Nbr_Elements (El_List);
      Matches : Iir_Array (0 .. Nbr_El - 1);
      Ch : Iir;
      Pos : Natural;
      Rec_El : Iir;
   begin
      --  Check for duplicate associations.
      Matches := (others => Null_Iir);
      Ch := Get_Individual_Association_Chain (Assoc);
      while Ch /= Null_Iir loop
         Rec_El := Get_Choice_Name (Ch);
         Pos := Natural (Get_Element_Position (Rec_El));
         if Matches (Pos) /= Null_Iir then
            Error_Msg_Sem (+Ch, "individual %n already associated at %l",
                           (+Rec_El, +Matches (Pos)));
         else
            Matches (Pos) := Ch;
         end if;
         Ch := Get_Chain (Ch);
      end loop;

      --  Check for missing associations.
      for I in Matches'Range loop
         Rec_El := Get_Nth_Element (El_List, I);
         if Matches (I) = Null_Iir then
            Error_Msg_Sem (+Assoc, "%n not associated", +Rec_El);
         end if;
      end loop;

      if Get_Constraint_State (Atype) /= Fully_Constrained then
         --  Some (sub-)elements are unbounded, create a bounded subtype.
         declare
            Ntype : Iir;
            Nel_List : Iir_Flist;
            Nrec_El : Iir;
            Rec_El_Type : Iir;
            Staticness : Iir_Staticness;
         begin
            Ntype := Create_Iir (Iir_Kind_Record_Subtype_Definition);
            Location_Copy (Ntype, Assoc);
            Set_Base_Type (Ntype, Get_Base_Type (Atype));
            if Get_Kind (Atype) = Iir_Kind_Record_Subtype_Definition then
               Set_Resolution_Indication
                 (Ntype, Get_Resolution_Indication (Atype));
            end if;
            Nel_List := Create_Iir_Flist (Nbr_El);
            Set_Elements_Declaration_List (Ntype, Nel_List);

            Staticness := Locally;
            for I in Matches'Range loop
               Rec_El := Get_Nth_Element (El_List, I);
               Rec_El_Type := Get_Type (Rec_El);
               if (Get_Kind (Rec_El_Type)
                     not in Iir_Kinds_Composite_Type_Definition)
                 or else
                 Get_Constraint_State (Rec_El_Type) = Fully_Constrained
                 or else
                 Matches (I) = Null_Iir  --  In case of error.
               then
                  Nrec_El := Rec_El;
               else
                  Nrec_El := Create_Iir (Iir_Kind_Record_Element_Constraint);
                  Ch := Matches (I);
                  Location_Copy (Nrec_El, Ch);
                  Set_Parent (Nrec_El, Ntype);
                  Set_Identifier (Nrec_El, Get_Identifier (Rec_El));
                  Set_Base_Element_Declaration
                    (Nrec_El, Get_Base_Element_Declaration (Rec_El));
                  Set_Element_Position
                    (Nrec_El, Get_Element_Position (Rec_El));
                  Ch := Get_Associated_Expr (Ch);
                  Set_Type (Nrec_El, Get_Type (Get_Actual (Ch)));
               end if;
               Staticness := Min (Staticness,
                                  Get_Type_Staticness (Get_Type (Nrec_El)));
               Set_Nth_Element (Nel_List, I, Nrec_El);
            end loop;
            Set_Type_Staticness (Ntype, Staticness);
            Set_Constraint_State (Ntype, Fully_Constrained);

            Set_Actual_Type (Assoc, Ntype);
         end;
      else
         Set_Actual_Type (Assoc, Atype);
      end if;
   end Finish_Individual_Assoc_Record;

   --  Free recursively all the choices of ASSOC.  Once the type is computed
   --  this is not needed anymore.
   procedure Clean_Individual_Association (Assoc : Iir)
   is
      El, N_El : Iir;
      Expr : Iir;
   begin
      El := Get_Individual_Association_Chain (Assoc);
      Set_Individual_Association_Chain (Assoc, Null_Iir);

      while Is_Valid (El) loop
         N_El := Get_Chain (El);

         pragma Assert (Get_Kind (El) in Iir_Kinds_Choice);
         Expr := Get_Associated_Expr (El);
         if Get_Kind (Expr) = Iir_Kind_Association_Element_By_Individual then
            Clean_Individual_Association (Expr);
            Free_Iir (Expr);
         end if;

         Free_Iir (El);
         El := N_El;
      end loop;
   end Clean_Individual_Association;

   --  Called by sem_individual_association to finish the analyze of
   --  individual association ASSOC: compute bounds, detect missing elements.
   procedure Finish_Individual_Association (Assoc : Iir)
   is
      Formal : Iir;
      Atype : Iir;
   begin
      --  Guard.
      if Assoc = Null_Iir or else Get_Choice_Staticness (Assoc) /= Locally then
         return;
      end if;

      Formal := Get_Interface_Of_Formal (Get_Formal (Assoc));
      Atype := Get_Type (Formal);
      Set_Whole_Association_Flag (Assoc, True);

      case Get_Kind (Atype) is
         when Iir_Kind_Array_Subtype_Definition
           | Iir_Kind_Array_Type_Definition =>
            if Get_Constraint_State (Atype) = Fully_Constrained then
               Finish_Individual_Assoc_Array_Subtype (Assoc, Atype, 1);
               Set_Actual_Type (Assoc, Atype);
            else
               Atype := Create_Array_Subtype (Atype, Get_Location (Assoc));
               Set_Index_Constraint_Flag (Atype, True);
               Set_Constraint_State (Atype, Fully_Constrained);
               Set_Actual_Type (Assoc, Atype);
               Set_Actual_Type_Definition (Assoc, Atype);
               Finish_Individual_Assoc_Array (Assoc, Assoc, 1);
            end if;
         when Iir_Kind_Record_Type_Definition
           | Iir_Kind_Record_Subtype_Definition =>
            Finish_Individual_Assoc_Record (Assoc, Atype);
         when others =>
            Error_Kind ("finish_individual_association", Atype);
      end case;

      --  Free the hierarchy, keep only the top individual association.
      Clean_Individual_Association (Assoc);
   end Finish_Individual_Association;

   --  Sem individual associations of ASSOCS:
   --  Add an Iir_Kind_Association_Element_By_Individual before each
   --  group of individual association for the same formal, and call
   --  Finish_Individual_Association with each of these added nodes.
   --
   --  The purpose of By_Individual association is to have the type of the
   --  actual (might be an array subtype), and also to be sure that all
   --  sub-elements are associated.  For that a tree is created.  The tree is
   --  rooted by the top Association_Element_By_Individual, which contains a
   --  chain of choices (like the aggregate).  The child of a choice is either
   --  an Association_Element written by the user, or a new subtree rooted
   --  by another Association_Element_By_Individual.  The tree doesn't
   --  follow all the ownership rules: the formal of sub association_element
   --  are directly set to the association, and the associated_expr of the
   --  choices are directly set to formals.
   --
   --  This tree is temporary (used only during analysis of the individual
   --  association) and removed once the check is done.
   procedure Sem_Individual_Association (Assoc_Chain : in out Iir)
   is
      Assoc : Iir;
      Prev_Assoc : Iir;
      Iassoc : Iir_Association_Element_By_Individual;
      Cur_Iface : Iir;
      Formal : Iir;
   begin
      Iassoc := Null_Iir;
      Cur_Iface := Null_Iir;
      Prev_Assoc := Null_Iir;
      Assoc := Assoc_Chain;
      while Assoc /= Null_Iir loop
         Formal := Get_Formal (Assoc);
         if Formal /= Null_Iir then
            Formal := Get_Object_Prefix (Formal);
         end if;
         if Formal = Null_Iir or else Formal /= Cur_Iface then
            --  New formal name, analyze the current individual association
            --  (if any).
            Finish_Individual_Association (Iassoc);
            Cur_Iface := Formal;
            Iassoc := Null_Iir;
         end if;

         if Get_Whole_Association_Flag (Assoc) = False then
            --  Individual association.
            if Iassoc = Null_Iir then
               --  The first one for the interface: create a new individual
               --  association.
               Iassoc :=
                 Create_Iir (Iir_Kind_Association_Element_By_Individual);
               Location_Copy (Iassoc, Assoc);
               Set_Choice_Staticness (Iassoc, Locally);
               pragma Assert (Cur_Iface /= Null_Iir);
               Set_Formal
                 (Iassoc,
                  Build_Simple_Name (Cur_Iface, Get_Location (Formal)));
               --  Insert IASSOC.
               if Prev_Assoc = Null_Iir then
                  Assoc_Chain := Iassoc;
               else
                  Set_Chain (Prev_Assoc, Iassoc);
               end if;
               Set_Chain (Iassoc, Assoc);
            end if;

            --  Add this individual association to the tree.
            Add_Individual_Association (Iassoc, Assoc);
         end if;
         Prev_Assoc := Assoc;
         Assoc := Get_Chain (Assoc);
      end loop;
      --  There is maybe a remaining iassoc.
      Finish_Individual_Association (Iassoc);
   end Sem_Individual_Association;

   function Is_Conversion_Function (Assoc_Chain : Iir) return Boolean is
   begin
      --  [...] whose single parameter of the function [...]
      if not Is_Chain_Length_One (Assoc_Chain) then
         return False;
      end if;
      if Get_Kind (Assoc_Chain) /= Iir_Kind_Association_Element_By_Expression
      then
         return False;
      end if;
      --  FIXME: unfortunatly, the formal may already be set with the
      --  interface.
--       if Get_Formal (Assoc_Chain) /= Null_Iir then
--          return Null_Iir;
--       end if;
      return True;
   end Is_Conversion_Function;

   function Is_Valid_Conversion
     (Func : Iir; Res_Base_Type : Iir; Param_Base_Type : Iir) return Boolean
   is
      R_Type : Iir;
      P_Type : Iir;
   begin
      case Get_Kind (Func) is
         when Iir_Kind_Function_Declaration =>
            R_Type := Get_Type (Func);
            P_Type := Get_Type (Get_Interface_Declaration_Chain (Func));
            if Get_Base_Type (R_Type) = Res_Base_Type
              and then Get_Base_Type (P_Type) = Param_Base_Type
            then
               return True;
            else
               return False;
            end if;
         when Iir_Kind_Type_Declaration
           | Iir_Kind_Subtype_Declaration =>
            R_Type := Get_Type (Func);
            if Get_Base_Type (R_Type) = Res_Base_Type
              and then Are_Types_Closely_Related (R_Type, Param_Base_Type)
            then
               return True;
            else
               return False;
            end if;
         when Iir_Kind_Function_Call =>
            return Is_Valid_Conversion (Get_Implementation (Func),
                                        Res_Base_Type, Param_Base_Type);
         when Iir_Kind_Type_Conversion =>
            return Is_Valid_Conversion (Get_Type_Mark (Func),
                                        Res_Base_Type, Param_Base_Type);
         when Iir_Kinds_Denoting_Name =>
            return Is_Valid_Conversion (Get_Named_Entity (Func),
                                        Res_Base_Type, Param_Base_Type);
         when others =>
            return False;
      end case;
   end Is_Valid_Conversion;

   function Extract_Conversion
     (Conv : Iir; Res_Type : Iir; Param_Type : Iir; Loc : Iir) return Iir
   is
      List : Iir_List;
      It : List_Iterator;
      Res_Base_Type : Iir;
      Param_Base_Type : Iir;
      El : Iir;
      Res : Iir;
   begin
      Res_Base_Type := Get_Base_Type (Res_Type);
      if Param_Type = Null_Iir then
         --  In case of error.
         return Null_Iir;
      end if;
      Param_Base_Type := Get_Base_Type (Param_Type);
      if Is_Overload_List (Conv) then
         List := Get_Overload_List (Conv);
         Res := Null_Iir;
         It := List_Iterate (List);
         while Is_Valid (It) loop
            El := Get_Element (It);
            if Is_Valid_Conversion (El, Res_Base_Type, Param_Base_Type) then
               if Res /= Null_Iir then
                  raise Internal_Error;
               end if;
               Free_Iir (Conv);
               Res := El;
            end if;
            Next (It);
         end loop;
      else
         if Is_Valid_Conversion (Conv, Res_Base_Type, Param_Base_Type) then
            Res := Conv;
         else
            Res := Null_Iir;
            Error_Msg_Sem (+Loc, "conversion function or type does not match");
         end if;
      end if;
      return Res;
   end Extract_Conversion;

   function Extract_In_Conversion
     (Conv : Iir; Res_Type : Iir; Param_Type : Iir) return Iir
   is
      Func : Iir;
      Assoc : Iir;
   begin
      if Conv = Null_Iir then
         return Null_Iir;
      end if;
      Func := Extract_Conversion (Conv, Res_Type, Param_Type, Conv);
      if Func = Null_Iir then
         return Null_Iir;
      end if;
      case Get_Kind (Func) is
         when Iir_Kind_Function_Call =>
            Assoc := Get_Parameter_Association_Chain (Func);
            Free_Iir (Assoc);
            Set_Parameter_Association_Chain (Func, Null_Iir);
            Name_To_Method_Object (Func, Conv);
            return Func;
         when Iir_Kind_Type_Conversion =>
            return Func;
         when others =>
            Error_Kind ("extract_in_conversion", Func);
      end case;
   end Extract_In_Conversion;

   function Extract_Out_Conversion
     (Conv : Iir; Res_Type : Iir; Param_Type : Iir) return Iir
   is
      Func : Iir;
   begin
      if Conv = Null_Iir then
         return Null_Iir;
      end if;
      Func := Extract_Conversion (Conv, Res_Type, Param_Type, Conv);

      return Func;
   end Extract_Out_Conversion;

   procedure Sem_Association_Open
     (Assoc : Iir;
      Finish : Boolean;
      Match : out Compatibility_Level)
   is
      Formal : Iir;
   begin
      if Finish then
         --  LRM 4.3.3.2  Associations lists
         --  It is an error if an actual of open is associated with a
         --  formal that is associated individually.
         if Get_Whole_Association_Flag (Assoc) = False then
            Error_Msg_Sem
              (+Assoc, "cannot associate individually with open");
         end if;

         Formal := Get_Formal (Assoc);
         if Formal /= Null_Iir then
            Set_Formal (Assoc, Finish_Sem_Name (Formal));
         end if;
      end if;
      Match := Fully_Compatible;
   end Sem_Association_Open;

   procedure Sem_Association_Package_Type_Not_Finish
     (Assoc : Iir;
      Inter : Iir;
      Match : out Compatibility_Level)
   is
      Formal : constant Iir := Get_Formal (Assoc);
   begin
      if Formal = Null_Iir then
         --  Can be associated only once
         Match := Fully_Compatible;
      else
         if Kind_In (Formal, Iir_Kind_Simple_Name, Iir_Kind_Operator_Symbol)
           and then Get_Identifier (Formal) = Get_Identifier (Inter)
         then
            Match := Fully_Compatible;
         else
            Match := Not_Compatible;
         end if;
      end if;
   end Sem_Association_Package_Type_Not_Finish;

   procedure Sem_Association_Package_Type_Finish (Assoc : Iir; Inter : Iir)
   is
      Formal : constant Iir := Get_Formal (Assoc);
   begin
      if Formal /= Null_Iir then
         pragma Assert (Get_Identifier (Formal) = Get_Identifier (Inter));
         pragma Assert (Get_Named_Entity (Formal) = Inter);
         Set_Formal (Assoc, Finish_Sem_Name (Formal));
      end if;
   end Sem_Association_Package_Type_Finish;

   procedure Sem_Association_Package
     (Assoc : Iir;
      Inter : Iir;
      Finish : Boolean;
      Match : out Compatibility_Level)
   is
      Actual : Iir;
      Package_Inter : Iir;
   begin
      if not Finish then
         Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match);
         return;
      end if;

      Match := Not_Compatible;
      Sem_Association_Package_Type_Finish (Assoc, Inter);

      --  Analyze actual.
      Actual := Get_Actual (Assoc);
      Actual := Sem_Denoting_Name (Actual);
      Set_Actual (Assoc, Actual);

      Actual := Get_Named_Entity (Actual);
      if Is_Error (Actual) then
         return;
      end if;

      --  LRM08 6.5.7.2 Generic map aspects
      --  An actual associated with a formal generic package in a
      --  generic map aspect shall be the name that denotes an instance
      --  of the uninstantiated package named in the formal generic
      --  package declaration [...]
      if Get_Kind (Actual) /= Iir_Kind_Package_Instantiation_Declaration then
         Error_Msg_Sem
           (+Assoc, "actual of association is not a package instantiation");
         return;
      end if;

      Package_Inter := Get_Uninstantiated_Package_Decl (Inter);
      if Get_Uninstantiated_Package_Decl (Actual) /= Package_Inter then
         Error_Msg_Sem
           (+Assoc,
            "actual package name is not an instance of interface package");
         return;
      end if;

      --  LRM08 6.5.7.2 Generic map aspects
      --  b) If the formal generic package declaration includes an interface
      --     generic map aspect in the form that includes the box (<>) symbol,
      --     then the instantiaed package denotes by the actual may be any
      --     instance of the uninstantiated package named in the formal
      --     generic package declaration.
      if Get_Generic_Map_Aspect_Chain (Inter) = Null_Iir then
         null;
      else
         --  Other cases not yet handled.
         raise Internal_Error;
      end if;

      Match := Fully_Compatible;

      return;
   end Sem_Association_Package;

   --  Create an implicit association_element_subprogram for the declaration
   --  of function ID for ACTUAL_Type (a type/subtype definition).
   function Sem_Implicit_Operator_Association
     (Id : Name_Id; Actual_Type : Iir; Actual_Name : Iir) return Iir
   is
      use Sem_Scopes;

      --  Return TRUE if DECL is a function declaration with a comparaison
      --  operator profile.
      function Has_Comparaison_Profile (Decl : Iir) return Boolean
      is
         Inter : Iir;
      begin
         --  A function declaration.
         if Get_Kind (Decl) /= Iir_Kind_Function_Declaration then
            return False;
         end if;
         --  That returns a boolean.
         if (Get_Base_Type (Get_Return_Type (Decl))
               /= Std_Package.Boolean_Type_Definition)
         then
            return False;
         end if;

         --  With 2 interfaces of type ATYPE.
         Inter := Get_Interface_Declaration_Chain (Decl);
         for I in 1 .. 2 loop
            if Inter = Null_Iir then
               return False;
            end if;
            if Get_Base_Type (Get_Type (Inter)) /= Get_Base_Type (Actual_Type)
            then
               return False;
            end if;
            Inter := Get_Chain (Inter);
         end loop;
         if Inter /= Null_Iir then
            return False;
         end if;
         return True;
      end Has_Comparaison_Profile;

      Interp : Name_Interpretation_Type;
      Decl : Iir;
      Res : Iir;
   begin
      Interp := Get_Interpretation (Id);
      while Valid_Interpretation (Interp) loop
         Decl := Get_Declaration (Interp);
         if Has_Comparaison_Profile (Decl) then
            Res := Create_Iir (Iir_Kind_Association_Element_Subprogram);
            Location_Copy (Res, Actual_Name);
            Set_Actual
              (Res, Build_Simple_Name (Decl, Get_Location (Actual_Name)));
            Set_Use_Flag (Decl, True);
            return Res;
         end if;
         Interp := Get_Next_Interpretation (Interp);
      end loop;

      Error_Msg_Sem (+Actual_Name, "cannot find a %i declaration for type %i",
                     (+Id, +Actual_Name));
      return Null_Iir;
   end Sem_Implicit_Operator_Association;

   procedure Sem_Association_Type (Assoc : Iir;
                                   Inter : Iir;
                                   Finish : Boolean;
                                   Match : out Compatibility_Level)
   is
      Inter_Def : constant Iir := Get_Type (Inter);
      Actual : Iir;
      Actual_Type : Iir;
      Op_Eq, Op_Neq : Iir;
   begin
      if not Finish then
         Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match);
         return;
      end if;

      Match := Fully_Compatible;
      Sem_Association_Package_Type_Finish (Assoc, Inter);
      Actual := Get_Actual (Assoc);

      --  LRM08 6.5.7.2 Generic map aspects
      --  An actual associated with a formal generic type must be a subtype
      --  indication.
      --  FIXME: ghdl only supports type_mark!
      Actual := Sem_Types.Sem_Subtype_Indication (Actual);
      Set_Actual (Assoc, Actual);

      --  Set type association for analysis of reference to this interface.
      pragma Assert (Is_Null (Get_Associated_Type (Inter_Def)));
      if Get_Kind (Actual) in Iir_Kinds_Subtype_Definition then
         Actual_Type := Actual;
      else
         Actual_Type := Get_Type (Actual);
      end if;
      Set_Actual_Type (Assoc, Actual_Type);
      Set_Associated_Type (Inter_Def, Actual_Type);

      --  FIXME: it is not clear at all from the LRM how the implicit
      --  associations are done...
      Op_Eq := Sem_Implicit_Operator_Association
        (Std_Names.Name_Op_Equality, Actual_Type, Actual);
      if Op_Eq /= Null_Iir then
         Op_Neq := Sem_Implicit_Operator_Association
           (Std_Names.Name_Op_Inequality, Actual_Type, Actual);
         Set_Chain (Op_Eq, Op_Neq);
         Set_Subprogram_Association_Chain (Assoc, Op_Eq);
      end if;
   end Sem_Association_Type;

   function Has_Interface_Subprogram_Profile
     (Inter : Iir;
      Decl : Iir;
      Explain_Loc : Location_Type := No_Location) return Boolean
   is
      --  Handle previous assocation of interface type before full
      --  instantiation.
      function Get_Inter_Type (Inter : Iir) return Iir
      is
         Res : Iir;
      begin
         Res := Get_Type (Inter);
         if Get_Kind (Res) = Iir_Kind_Interface_Type_Definition then
            --  FIXME: recurse ?
            return Get_Associated_Type (Res);
         else
            return Res;
         end if;
      end Get_Inter_Type;

      Explain : constant Boolean := Explain_Loc /= No_Location;
      El_Inter, El_Decl : Iir;
   begin
      case Iir_Kinds_Interface_Subprogram_Declaration (Get_Kind (Inter)) is
         when Iir_Kind_Interface_Function_Declaration =>
            if not Is_Function_Declaration (Decl) then
               if Explain then
                  Error_Msg_Sem (Explain_Loc, " actual is not a function");
               end if;
               return False;
            end if;
            if Get_Base_Type (Get_Inter_Type (Inter))
              /= Get_Base_Type (Get_Type (Decl))
            then
               if Explain then
                  Error_Msg_Sem (Explain_Loc, " return type doesn't match");
               end if;
               return False;
            end if;
         when Iir_Kind_Interface_Procedure_Declaration =>
            if not Is_Procedure_Declaration (Decl) then
               if Explain then
                  Error_Msg_Sem (Explain_Loc, " actual is not a procedure");
               end if;
               return False;
            end if;
      end case;

      El_Inter := Get_Interface_Declaration_Chain (Inter);
      El_Decl := Get_Interface_Declaration_Chain (Decl);
      loop
         exit when Is_Null (El_Inter) and Is_Null (El_Decl);
         if Is_Null (El_Inter) or Is_Null (El_Decl) then
            if Explain then
               Error_Msg_Sem
                 (Explain_Loc, " number of interfaces doesn't match");
            end if;
            return False;
         end if;
         if Get_Base_Type (Get_Inter_Type (El_Inter))
           /= Get_Base_Type (Get_Type (El_Decl))
         then
            if Explain then
               Error_Msg_Sem
                 (Explain_Loc,
                  " type of interface %i doesn't match", +El_Inter);
            end if;
            return False;
         end if;
         El_Inter := Get_Chain (El_Inter);
         El_Decl := Get_Chain (El_Decl);
      end loop;

      return True;
   end Has_Interface_Subprogram_Profile;

   procedure Sem_Association_Subprogram (Assoc : Iir;
                                         Inter : Iir;
                                         Finish : Boolean;
                                         Match : out Compatibility_Level)
   is
      Discard : Boolean;
      pragma Unreferenced (Discard);
      Actual : Iir;
      Res : Iir;
   begin
      if not Finish then
         Sem_Association_Package_Type_Not_Finish (Assoc, Inter, Match);
         return;
      end if;

      Match := Fully_Compatible;
      Sem_Association_Package_Type_Finish (Assoc, Inter);
      Actual := Get_Actual (Assoc);

      --  LRM08 6.5.7.2 Generic map aspects
      --  An actual associated with a formal generic subprogram shall be a name
      --  that denotes a subprogram whose profile conforms to that of the
      --  formal, or the reserved word OPEN.  The actual, if a predefined
      --  attribute name that denotes a function, shall be one of the
      --  predefined attributes 'IMAGE, 'VALUE, 'POS, 'VAL, 'SUCC, 'PREV,
      --  'LEFTOF, or 'RIGHTOF.
      Sem_Name (Actual);
      Res := Get_Named_Entity (Actual);

      if Is_Error (Res) then
         return;
      end if;

      case Get_Kind (Res) is
         when Iir_Kinds_Subprogram_Declaration
           | Iir_Kinds_Interface_Subprogram_Declaration =>
            if not Has_Interface_Subprogram_Profile (Inter, Res) then
               Error_Msg_Sem
                 (+Assoc, "profile of %n doesn't match profile of %n",
                  (+Actual, +Inter));
               --  Explain
               Discard := Has_Interface_Subprogram_Profile
                 (Inter, Res, Get_Location (Assoc));
               return;
            end if;
         when Iir_Kind_Overload_List =>
            declare
               Nbr_Errors : Natural;
               List : Iir_List;
               It : List_Iterator;
               El, R : Iir;
            begin
               Nbr_Errors := 0;
               R := Null_Iir;
               List := Get_Overload_List (Res);
               It := List_Iterate (List);
               while Is_Valid (It) loop
                  El := Get_Element (It);
                  if Has_Interface_Subprogram_Profile (Inter, El) then
                     if Is_Null (R) then
                        R := El;
                     else
                        if Nbr_Errors = 0 then
                           Error_Msg_Sem
                             (+Assoc,
                              "many possible actual subprogram for %n:",
                              +Inter);
                           Error_Msg_Sem
                             (+Assoc, " %n declared at %l", (+R, + R));
                        else
                           Error_Msg_Sem
                             (+Assoc, " %n declared at %l", (+El, +El));
                        end if;
                        Nbr_Errors := Nbr_Errors + 1;
                     end if;
                  end if;
                  Next (It);
               end loop;
               if Is_Null (R) then
                  Error_Msg_Sem
                    (+Assoc, "no matching name for %n", +Inter);
                  if True then
                     Error_Msg_Sem
                       (+Assoc, " these names were incompatible:");
                     It := List_Iterate (List);
                     while Is_Valid (It) loop
                        El := Get_Element (It);
                        Error_Msg_Sem
                          (+Assoc, " %n declared at %l", (+El, +El));
                        Next (It);
                     end loop;
                  end if;
                  return;
               elsif Nbr_Errors > 0 then
                  return;
               end if;
               Free_Overload_List (Res);
               Res := R;
            end;
         when others =>
            Error_Kind ("sem_association_subprogram", Res);
      end case;

      Set_Named_Entity (Actual, Res);
      Xrefs.Xref_Name (Actual);
      Set_Use_Flag (Res, True);
   end Sem_Association_Subprogram;

   --  Associate ASSOC with interface INTERFACE
   --  This sets MATCH.
   procedure Sem_Association_By_Expression
     (Assoc : Iir;
      Inter : Iir;
      Formal_Name : Iir;
      Formal_Conv : Iir;
      Finish : Boolean;
      Match : out Compatibility_Level)
   is
      Formal_Type : Iir;
      Actual: Iir;
      Out_Conv, In_Conv : Iir;
      Expr : Iir;
      Res_Type : Iir;
   begin
      Out_Conv := Formal_Conv;
      if Formal_Name /= Null_Iir then
         Formal_Type := Get_Type (Formal_Name);
      else
         Formal_Type := Get_Type (Inter);
      end if;

      --  Extract conversion from actual.
      --  LRM08 6.5.7.1 Association lists
      Actual := Get_Actual (Assoc);
      In_Conv := Null_Iir;
      if Get_Kind (Inter) /= Iir_Kind_Interface_Constant_Declaration then
         declare
            --  Actual before the extraction of the conversion.
            Prev_Actual : constant Iir := Actual;
         begin
            --  Extract conversion and new actual (conv_expr).
            case Get_Kind (Actual) is
               when Iir_Kind_Function_Call =>
                  Expr := Get_Parameter_Association_Chain (Actual);
                  if Is_Conversion_Function (Expr) then
                     In_Conv := Actual;
                     Actual := Get_Actual (Expr);
                  end if;
               when Iir_Kind_Type_Conversion =>
                  if Flags.Vhdl_Std > Vhdl_87 then
                     In_Conv := Actual;
                     Actual := Get_Expression (Actual);
                  end if;
               when others =>
                  null;
            end case;

            --  There could be an ambiguity between a conversion and a normal
            --  actual expression.  Check if the new actual is an object and
            --  if the object is of the corresponding class.
            if Is_Valid (In_Conv) then
               if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then
                  if not Is_Signal_Object (Actual) then
                     --  Actual is not a signal object.  This is not a
                     --  conversion but a regular association.
                     In_Conv := Null_Iir;
                     Actual := Prev_Actual;
                  end if;
               else
                  --  Variable: let as is.
                  null;
               end if;
            end if;
         end;
      end if;

      --  4 cases: F:out_conv, G:in_conv.
      --    A  => B     type of A = type of B
      --  F(A) => B     type of B = type of F
      --    A  => G(B)  type of A = type of G
      --  F(A) => G(B)  type of B = type of F, type of A = type of G
      if Out_Conv = Null_Iir and then In_Conv = Null_Iir then
         Match := Is_Expr_Compatible (Formal_Type, Actual);
      else
         Match := Fully_Compatible;
         if In_Conv /= Null_Iir then
            Match := Compatibility_Level'Min
              (Match, Is_Expr_Compatible (Formal_Type, In_Conv));
         end if;
         if Out_Conv /= Null_Iir then
            Match := Compatibility_Level'Min
              (Match, Is_Expr_Compatible (Get_Type (Out_Conv), Actual));
         end if;
      end if;

      if Match = Not_Compatible then
         if Finish then
            Error_Msg_Sem (+Assoc, "can't associate %n with %n",
                           (+Actual, +Inter), Cont => True);
            Error_Msg_Sem
              (+Assoc, "(type of %n is " & Disp_Type_Of (Actual) & ")",
               (1 => +Actual), Cont => True);
            Error_Msg_Sem
              (+Inter, "(type of %n is " & Disp_Type_Of (Inter) & ")", +Inter);
         end if;
         return;
      end if;

      if not Finish then
         return;
      end if;

      --  At that point, the analysis is being finished.

      if Out_Conv = Null_Iir and then In_Conv = Null_Iir then
         Res_Type := Formal_Type;
      else
         if Out_Conv /= Null_Iir then
            Res_Type := Search_Compatible_Type (Get_Type (Out_Conv),
                                                Get_Type (Actual));
         else
            Res_Type := Get_Type (Actual);
         end if;

         if In_Conv /= Null_Iir then
            In_Conv := Extract_In_Conversion (In_Conv, Formal_Type, Res_Type);
         end if;
         if Out_Conv /= Null_Iir then
            Out_Conv := Extract_Out_Conversion (Out_Conv,
                                                Res_Type, Formal_Type);
         end if;
      end if;

      if Res_Type = Null_Iir then
         --  In case of error, do not go farther.
         Match := Not_Compatible;
         return;
      end if;

      if Formal_Name /= Null_Iir then
         declare
            Formal : Iir;
            Conv_Assoc : Iir;
         begin
            --  Extract formal from the conversion (and unlink it from the
            --  conversion, as the owner of the formal is the association, not
            --  the conversion).
            Formal := Finish_Sem_Name (Get_Formal (Assoc));
            case Get_Kind (Formal) is
               when Iir_Kind_Function_Call =>
                  pragma Assert (Formal_Conv /= Null_Iir);
                  Set_Formal_Conversion (Assoc, Formal);
                  Conv_Assoc := Get_Parameter_Association_Chain (Formal);
                  Set_Parameter_Association_Chain (Formal, Null_Iir);
                  Formal := Get_Actual (Conv_Assoc);
                  Free_Iir (Conv_Assoc);
                  --  Name_To_Method_Object (Func, Conv);
               when Iir_Kind_Type_Conversion =>
                  pragma Assert (Formal_Conv /= Null_Iir);
                  Conv_Assoc := Formal;
                  Set_Formal_Conversion (Assoc, Formal);
                  Formal := Get_Expression (Formal);
                  Set_Expression (Conv_Assoc, Null_Iir);
               when others =>
                  pragma Assert (Formal_Conv = Null_Iir);
                  null;
            end case;
            Set_Formal (Assoc, Formal);

            --  Use the type of the formal to analyze the actual.  In
            --  particular, the formal may be constrained while the actual is
            --  not.
            Formal_Type := Get_Type (Formal);
            if Out_Conv = Null_Iir and In_Conv = Null_Iir then
               Res_Type := Formal_Type;
            end if;
         end;
      end if;

      --  LRM08 6.5.7 Association lists
      --  The formal part of a named association element may be in the form of
      --  a function call [...] if and only if the formal is an interface
      --  object, the mode of the formal is OUT, INOUT, BUFFER or LINKAGE [...]
      if Out_Conv /= Null_Iir
        and then Get_Mode (Inter) = Iir_In_Mode
      then
         Error_Msg_Sem
           (+Assoc, "can't use an out conversion for an in interface");
      end if;

      --  LRM08 6.5.7 Association lists
      --  The actual part of an association element may be in the form of a
      --  function call [...] if and only if the mode of the format is IN,
      --  INOUT or LINKAGE [...]
      Set_Actual_Conversion (Assoc, In_Conv);
      if In_Conv /= Null_Iir
        and then Get_Mode (Inter) in Iir_Buffer_Mode .. Iir_Out_Mode
      then
         Error_Msg_Sem
           (+Assoc, "can't use an in conversion for an out/buffer interface");
      end if;

      --  LRM08 5.3.2.2 Index constraints and discrete ranges
      --  e) [...]
      --    3) [...]
      --      -- For an interface object or subelement whose mode is IN, INOUT
      --         or LINKAGE, if the actual part includes a conversion function
      --         or a type conversion, then the result type of that function
      --         or the type mark of the type conversion shall define a
      --         constraint for the index range corresponding to the index
      --         range of the objet, [...]
      --      -- For an interface object or subelement whose mode is OUT,
      --         BUFFER, INOUT or LINKAGE, if the formal part includes a
      --         conversion function or a type conversion, then the parameter
      --         subtype of that function or the type mark of the type
      --         conversion shall define a constraint for the index range
      --         corresponding to the index range of the object, [...]
      if not Is_Fully_Constrained_Type (Formal_Type) then
         if (Get_Mode (Inter) in Iir_In_Modes
               or else Get_Mode (Inter) = Iir_Linkage_Mode)
           and then In_Conv /= Null_Iir
           and then not Is_Fully_Constrained_Type (Get_Type (In_Conv))
         then
            Error_Msg_Sem
              (+Assoc, "type of actual conversion must be fully constrained");
         end if;
         if (Get_Mode (Inter) in Iir_Out_Modes
               or else Get_Mode (Inter) = Iir_Linkage_Mode)
           and then Out_Conv /= Null_Iir
           and then not Is_Fully_Constrained_Type (Get_Type (Out_Conv))
         then
            Error_Msg_Sem
              (+Assoc, "type of formal conversion must be fully constrained");
         end if;
      end if;

      --  FIXME: LRM refs
      --  This is somewhat wrong.  A missing conversion is not an error but
      --  may result in a type mismatch.
      if Get_Mode (Inter) = Iir_Inout_Mode then
         if In_Conv = Null_Iir and then Out_Conv /= Null_Iir then
            Error_Msg_Sem
              (+Assoc, "out conversion without corresponding in conversion");
         elsif In_Conv /= Null_Iir and then Out_Conv = Null_Iir then
            Error_Msg_Sem
              (+Assoc, "in conversion without corresponding out conversion");
         end if;
      end if;
      Set_Actual (Assoc, Actual);

      --  Analyze actual.
      Expr := Sem_Expression (Actual, Res_Type);
      if Expr /= Null_Iir then
         Expr := Eval_Expr_Check_If_Static (Expr, Res_Type);
         Set_Actual (Assoc, Expr);
         if In_Conv = Null_Iir and then Out_Conv = Null_Iir then
            if not Eval_Is_In_Bound (Expr, Formal_Type) then
               Error_Msg_Sem
                 (+Assoc, "actual constraints don't match formal ones");
            end if;
         end if;
      end if;
   end Sem_Association_By_Expression;

   --  Associate ASSOC with interface INTERFACE
   --  This sets MATCH.
   procedure Sem_Association (Assoc : Iir;
                              Inter : Iir;
                              Formal : Iir;
                              Formal_Conv : Iir;
                              Finish : Boolean;
                              Match : out Compatibility_Level) is
   begin
      case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
         when Iir_Kinds_Interface_Object_Declaration =>
            if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
               Sem_Association_Open (Assoc, Finish, Match);
            else
               Sem_Association_By_Expression
                 (Assoc, Inter, Formal, Formal_Conv, Finish, Match);
            end if;

         when Iir_Kind_Interface_Package_Declaration =>
            Sem_Association_Package (Assoc, Inter, Finish, Match);

         when Iir_Kind_Interface_Type_Declaration =>
            Sem_Association_Type (Assoc, Inter, Finish, Match);

         when Iir_Kinds_Interface_Subprogram_Declaration =>
            Sem_Association_Subprogram (Assoc, Inter, Finish, Match);
      end case;
   end Sem_Association;

   procedure Sem_Association_Chain
     (Interface_Chain : Iir;
      Assoc_Chain: in out Iir;
      Finish: Boolean;
      Missing : Missing_Type;
      Loc : Iir;
      Match : out Compatibility_Level)
   is
      Assoc : Iir;
      Inter : Iir;

      type Param_Assoc_Type is (None, Open, Individual, Whole);

      type Assoc_Array is array (Natural range <>) of Param_Assoc_Type;
      Nbr_Inter : constant Natural := Get_Chain_Length (Interface_Chain);
      Inter_Matched : Assoc_Array (0 .. Nbr_Inter - 1) := (others => None);

      Last_Individual : Iir;
      Has_Individual : Boolean;
      Pos : Integer;
      Formal : Iir;

      First_Named_Assoc : Iir;
      Last_Named_Assoc : Iir;

      Formal_Name : Iir;
      Formal_Conv : Iir;
   begin
      Match := Fully_Compatible;
      First_Named_Assoc := Null_Iir;
      Has_Individual := False;

      --  Loop on every assoc element, try to match it.
      Inter := Interface_Chain;
      Last_Individual := Null_Iir;
      Pos := 0;

      --  First positional associations
      Assoc := Assoc_Chain;
      while Assoc /= Null_Iir loop
         Formal := Get_Formal (Assoc);
         exit when Formal /= Null_Iir;

         --  Try to match actual of ASSOC with the interface.
         if Inter = Null_Iir then
            if Finish then
               Error_Msg_Sem (+Assoc, "too many actuals for %n", +Loc);
            end if;
            Match := Not_Compatible;
            return;
         end if;
         Set_Whole_Association_Flag (Assoc, True);
         Sem_Association (Assoc, Inter, Null_Iir, Null_Iir, Finish, Match);
         if Match = Not_Compatible then
            return;
         end if;
         if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
            Inter_Matched (Pos) := Open;
         else
            Inter_Matched (Pos) := Whole;
         end if;
         Set_Whole_Association_Flag (Assoc, True);
         Inter := Get_Chain (Inter);

         Pos := Pos + 1;
         Assoc := Get_Chain (Assoc);
      end loop;

      --  Then association by name.
      if Assoc /= Null_Iir then
         --  Make interfaces visible
         --
         --  LRM08 12.3 Visibility
         --  A declaration is visible by selection at places that are defined
         --  as follows:
         --  j) For a formal parameter declaration of a given subprogram
         --     declaration: at the place of the formal part (before the
         --     compound delimiter =>) of a named parameter association
         --     element of a corresponding subprogram call.
         --  k) For a local generic declaration of a given component
         --     declaration ...
         --  l) For a local port declaration of a given component declaration:
         --     ...
         --  m) For a formal generic declaration of a given entity declaration:
         --     ...
         --  n) For a formal port declaration of a given entity declaration:
         --     ...
         --  o) For a formal generic declaration or a formal port declaration
         --     of a given block statement: ...
         --  p) For a formal generic declaration of a given package
         --     declaration: ...
         --  q) For a formal generic declaration of a given subprogram
         --     declarations: ...
         --
         --  At a place in which a given declaration is visible by selection,
         --  every declaration with the same designator as the given
         --  declaration and that would otherwise be directly visible is
         --  hidden.
         Sem_Scopes.Open_Declarative_Region;
         Sem_Scopes.Add_Declarations_From_Interface_Chain (Interface_Chain);

         First_Named_Assoc := Assoc;
         loop
            if Formal = Null_Iir then
               --  Positional after named argument.  Already caught by
               --  Sem_Actual_Of_Association_Chain (because it is called only
               --  once, while sem_association_chain may be called several
               --  times).
               Match := Not_Compatible;
               exit;
            end if;

            --  Last assoc to be cleaned up.
            Last_Named_Assoc := Assoc;

            if Finish then
               Sem_Name (Formal);
            else
               Sem_Name_Soft (Formal);
            end if;
            Formal_Name := Get_Named_Entity (Formal);
            if Is_Error (Formal_Name) then
               if Finish then
                  --  FIXME: display the name of subprg or component/entity.
                  --  FIXME: fetch the interface (for parenthesis_name).
                  Error_Msg_Sem (+Assoc, "no interface for %n in association",
                                 +Get_Formal (Assoc));
               end if;
               Match := Not_Compatible;
               exit;
            end if;

            Assoc := Get_Chain (Assoc);
            exit when Assoc = Null_Iir;
            Formal := Get_Formal (Assoc);
         end loop;

         --  Remove visibility by selection of interfaces.  This is needed
         --  to correctly analyze actuals.
         Sem_Scopes.Close_Declarative_Region;

         if Match /= Not_Compatible then
            Assoc := First_Named_Assoc;
            loop
               Formal := Get_Formal (Assoc);
               Formal_Name := Get_Named_Entity (Formal);

               --  Extract conversion
               Formal_Conv := Null_Iir;
               case Get_Kind (Formal_Name) is
                  when Iir_Kind_Function_Call =>
                     --  Only one actual
                     declare
                        Call_Assoc : constant Iir :=
                          Get_Parameter_Association_Chain (Formal_Name);
                     begin
                        if (Get_Kind (Call_Assoc)
                              /= Iir_Kind_Association_Element_By_Expression)
                          or else Get_Chain (Call_Assoc) /= Null_Iir
                          or else Get_Formal (Call_Assoc) /= Null_Iir
                          or else (Get_Actual_Conversion (Call_Assoc)
                                     /= Null_Iir)
                        then
                           if Finish then
                              Error_Msg_Sem
                                (+Assoc, "ill-formed formal conversion");
                           end if;
                           Match := Not_Compatible;
                           exit;
                        end if;
                        Formal_Conv := Formal_Name;
                        Formal_Name := Get_Actual (Call_Assoc);
                     end;
                  when Iir_Kind_Type_Conversion =>
                     Formal_Conv := Formal_Name;
                     Formal_Name := Get_Expression (Formal_Name);
                  when Iir_Kind_Slice_Name
                    | Iir_Kind_Indexed_Name
                    | Iir_Kind_Selected_Element
                    | Iir_Kind_Simple_Name =>
                     null;
                  when others =>
                     Formal_Name := Formal;
               end case;
               case Get_Kind (Formal_Name) is
                  when Iir_Kind_Selected_Element
                    | Iir_Kind_Slice_Name
                    | Iir_Kind_Indexed_Name =>
                     Inter := Get_Base_Name (Formal_Name);
                     Set_Whole_Association_Flag (Assoc, False);
                  when Iir_Kind_Simple_Name
                    | Iir_Kind_Operator_Symbol =>
                     Inter := Get_Named_Entity (Formal_Name);
                     Formal_Name := Inter;
                     Set_Whole_Association_Flag (Assoc, True);
                  when others =>
                     --  Error
                     if Finish then
                        Error_Msg_Sem (+Assoc, "formal is not a name");
                     end if;
                     Match := Not_Compatible;
                     exit;
               end case;

               --  Simplify overload list (for interface subprogram).
               --  FIXME: Interface must hide previous subprogram declarations,
               --  so there should be no need to filter.
               if Is_Overload_List (Inter) then
                  declare
                     List : constant Iir_List := Get_Overload_List (Inter);
                     It : List_Iterator;
                     Filtered_Inter : Iir;
                     El : Iir;
                  begin
                     Filtered_Inter := Null_Iir;
                     It := List_Iterate (List);
                     while Is_Valid (It) loop
                        El := Get_Element (It);
                        if Get_Kind (El) in Iir_Kinds_Interface_Declaration
                          and then
                          Get_Parent (El) = Get_Parent (Interface_Chain)
                        then
                           Add_Result (Filtered_Inter, El);
                        end if;
                        Next (It);
                     end loop;
                     Free_Overload_List (Inter);
                     Inter := Filtered_Inter;

                     pragma Assert
                       (Get_Kind (Formal) = Iir_Kind_Simple_Name
                          or else
                          Get_Kind (Formal) = Iir_Kind_Operator_Symbol);
                     Set_Named_Entity (Formal, Inter);

                     if Inter = Null_Iir then
                        if Finish then
                           Error_Msg_Sem (+Assoc, "no interface %i for %n",
                                          (+Formal, +Loc));
                        end if;
                        Match := Not_Compatible;
                        exit;
                     end if;

                     if Is_Overload_List (Inter) then
                        if Finish then
                           Error_Msg_Sem (+Assoc, "ambiguous formal name");
                        end if;
                        Match := Not_Compatible;
                        exit;
                     end if;
                  end;
               end if;
               if Get_Kind (Inter) not in Iir_Kinds_Interface_Declaration
                 or else Interface_Chain = Null_Iir
                 or else Get_Parent (Inter) /= Get_Parent (Interface_Chain)
               then
                  if Finish then
                     Error_Msg_Sem
                       (+Assoc, "formal %i is not an interface name", +Inter);
                  end if;
                  Match := Not_Compatible;
                  exit;
               end if;

               --  LRM 4.3.2.2  Association Lists
               --  The formal part of a named element association may be
               --  in the form of a function call, [...], if and only
               --  if the mode of the formal is OUT, INOUT, BUFFER, or
               --  LINKAGE, and the actual is not OPEN.
               if Formal_Conv /= Null_Iir
                 and then (Get_Kind (Inter)
                             not in Iir_Kinds_Interface_Object_Declaration
                             or else Get_Mode (Inter) = Iir_In_Mode)
               then
                  if Finish then
                     Error_Msg_Sem
                       (+Assoc,
                        "formal conversion allowed only for interface object",
                        +Formal_Conv);
                  end if;
                  Match := Not_Compatible;
                  exit;
               end if;

               --  Find the Interface.
               declare
                  Inter1 : Iir;
               begin
                  Inter1 := Interface_Chain;
                  Pos := 0;
                  while Inter1 /= Null_Iir loop
                     exit when Inter = Inter1;
                     Inter1 := Get_Chain (Inter1);
                     Pos := Pos + 1;
                  end loop;
                  if Inter1 = Null_Iir then
                     if Finish then
                        Error_Msg_Sem
                          (+Assoc,
                           "no corresponding interface for %i", +Inter);
                     end if;
                     Match := Not_Compatible;
                     exit;
                  end if;
               end;

               Sem_Association
                 (Assoc, Inter, Formal_Name, Formal_Conv, Finish, Match);
               exit when Match = Not_Compatible;

               if Get_Whole_Association_Flag (Assoc) then
                  --  Whole association.
                  Last_Individual := Null_Iir;
                  if Inter_Matched (Pos) = None then
                     if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open
                     then
                        Inter_Matched (Pos) := Open;
                     else
                        Inter_Matched (Pos) := Whole;
                     end if;
                  else
                     if Finish then
                        Error_Msg_Sem
                          (+Assoc, "%n already associated", +Inter);
                     end if;
                     Match := Not_Compatible;
                     exit;
                  end if;
               else
                  --  Individual association.
                  Has_Individual := True;
                  if Inter_Matched (Pos) /= Whole then
                     if Finish
                       and then Inter_Matched (Pos) = Individual
                       and then Last_Individual /= Inter
                     then
                        Error_Msg_Sem
                          (+Assoc,
                           "non consecutive individual association for %n",
                           +Inter);
                        Match := Not_Compatible;
                        exit;
                     end if;
                     Last_Individual := Inter;
                     Inter_Matched (Pos) := Individual;
                  else
                     if Finish then
                        Error_Msg_Sem
                          (+Assoc, "%n already associated", +Inter);
                        Match := Not_Compatible;
                        exit;
                     end if;
                  end if;
               end if;

               Assoc := Get_Chain (Assoc);
               exit when Assoc = Null_Iir;
            end loop;
         end if;

         if Finish and Has_Individual and Match /= Not_Compatible then
            Sem_Individual_Association (Assoc_Chain);
         end if;

         if not Finish then
            --  Always cleanup if not finishing: there can be other tries in
            --  case of overloading.
            Assoc := First_Named_Assoc;
            while Assoc /= Null_Iir loop
               Formal := Get_Formal (Assoc);
               --  User may have used by position assoc after named
               --  assocs.
               if Is_Valid (Formal) then
                  Sem_Name_Clean (Formal);
               end if;
               exit when Assoc = Last_Named_Assoc;
               Assoc := Get_Chain (Assoc);
            end loop;
         end if;

         if Match = Not_Compatible then
            return;
         end if;
      end if;

      if Missing = Missing_Allowed then
         --  No need to check for missing associations.
         return;
      end if;

      --  LRM93 8.6 Procedure Call Statement
      --  For each formal parameter of a procedure, a procedure call must
      --  specify exactly one corresponding actual parameter.
      --  This actual parameter is specified either explicitly, by an
      --  association element (other than the actual OPEN) in the association
      --  list, or in the absence of such an association element, by a default
      --  expression (see Section 4.3.3.2).

      --  LRM93 7.3.3 Function Calls
      --  For each formal parameter of a function, a function call must
      --  specify exactly one corresponding actual parameter.
      --  This actual parameter is specified either explicitly, by an
      --  association element (other than the actual OPEN) in the association
      --  list, or in the absence of such an association element, by a default
      --  expression (see Section 4.3.3.2).

      --  LRM93 1.1.1.2 / LRM08 6.5.6.3 Port clauses
      --  A port of mode IN may be unconnected or unassociated only if its
      --  declaration includes a default expression.
      --  It is an error if a port of any mode other than IN is unconnected
      --  or unassociated and its type is an unconstrained array type.

      --  LRM08 6.5.6.2 Generic clauses
      --  It is an error if no such actual [instantiated package] is specified
      --  for a given formal generic package (either because the formal generic
      --  is unassociated or because the actual is OPEN).

      Inter := Interface_Chain;
      Pos := 0;
      while Inter /= Null_Iir loop
         if Inter_Matched (Pos) <= Open then
            case Get_Kind (Inter) is
               when Iir_Kinds_Interface_Object_Declaration =>
                  if Get_Default_Value (Inter) = Null_Iir then
                     case Missing is
                        when Missing_Parameter
                          | Missing_Generic =>
                           if Finish then
                              Error_Msg_Sem (+Loc, "no actual for %n", +Inter);
                           end if;
                           Match := Not_Compatible;
                           return;
                        when Missing_Port =>
                           case Get_Mode (Inter) is
                              when Iir_In_Mode =>
                                 --  No overloading for components/entities.
                                 pragma Assert (Finish);
                                 Error_Msg_Sem
                                   (+Loc,
                                    "%n of mode IN must be connected", +Inter);
                                 Match := Not_Compatible;
                                 return;
                              when Iir_Out_Mode
                                | Iir_Linkage_Mode
                                | Iir_Inout_Mode
                                | Iir_Buffer_Mode =>
                                 --  No overloading for components/entities.
                                 pragma Assert (Finish);
                                 if not Is_Fully_Constrained_Type
                                   (Get_Type (Inter))
                                 then
                                    Error_Msg_Sem
                                      (+Loc,
                                       "unconstrained %n must be connected",
                                       +Inter);
                                    Match := Not_Compatible;
                                    return;
                                 end if;
                              when Iir_Unknown_Mode =>
                                 raise Internal_Error;
                           end case;
                        when Missing_Allowed =>
                           null;
                     end case;
                  end if;
               when Iir_Kind_Interface_Package_Declaration
                 | Iir_Kind_Interface_Function_Declaration
                 | Iir_Kind_Interface_Procedure_Declaration =>
                  Error_Msg_Sem (+Loc, "%n must be associated", +Inter);
                  Match := Not_Compatible;
               when others =>
                  Error_Kind ("sem_association_chain", Inter);
            end case;
         end if;

         --  Clear associated type of interface type.
         if Get_Kind (Inter) = Iir_Kind_Interface_Type_Declaration then
            Set_Associated_Type (Get_Type (Inter), Null_Iir);
         end if;

         Inter := Get_Chain (Inter);
         Pos := Pos + 1;
      end loop;
   end Sem_Association_Chain;
end Sem_Assocs;