vhdl-sem_inst: add instantiate_component_declaration.

For #2264

4 files changed, 139 insertions, 5 deletions

diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb
index b07fb7d7c..95f531cf8 100644
--- a/src/vhdl/vhdl-canon.adb
+++ b/src/vhdl/vhdl-canon.adb
@@ -2321,18 +2321,22 @@ package body Vhdl.Canon is
          when Iir_Kind_Component_Instantiation_Statement =>
             declare
                Inst : Iir;
+               Hdr : Iir;
                Assoc_Chain : Iir;
             begin
-               Inst := Get_Instantiated_Unit (Stmt);
-               Inst := Get_Entity_From_Entity_Aspect (Inst);
+               Hdr := Get_Instantiated_Header (Stmt);
+               if True or Hdr = Null_Iir then
+                  Inst := Get_Instantiated_Unit (Stmt);
+                  Hdr := Get_Entity_From_Entity_Aspect (Inst);
+               end if;
                Assoc_Chain := Canon_Association_Chain_And_Actuals
-                 (Get_Generic_Chain (Inst),
+                 (Get_Generic_Chain (Hdr),
                   Get_Generic_Map_Aspect_Chain (Stmt),
                   Stmt);
                Set_Generic_Map_Aspect_Chain (Stmt, Assoc_Chain);
 
                Assoc_Chain := Canon_Association_Chain_And_Actuals
-                 (Get_Port_Chain (Inst),
+                 (Get_Port_Chain (Hdr),
                   Get_Port_Map_Aspect_Chain (Stmt),
                   Stmt);
                Set_Port_Map_Aspect_Chain (Stmt, Assoc_Chain);
diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb
index 4b0ca0279..0a4f4387e 100644
--- a/src/vhdl/vhdl-sem_inst.adb
+++ b/src/vhdl/vhdl-sem_inst.adb
@@ -1300,6 +1300,54 @@ package body Vhdl.Sem_Inst is
       return Res;
    end Instantiate_Package_Body;
 
+   function Instantiate_Component_Declaration (Comp : Iir; Map : Iir)
+                                              return Iir
+   is
+      Prev_Instance_File : constant Source_File_Entry := Instance_File;
+      Mark : constant Instance_Index_Type := Prev_Instance_Table.Last;
+      Prev_Orig : Iir;
+      Inst : Iir;
+   begin
+      --  Create the component/entity.
+      Inst := Create_Iir (Get_Kind (Comp));
+
+      --  Build and set the new location.
+      Create_Relocation (Map, Comp);
+      Set_Location (Inst, Relocate (Get_Location (Comp)));
+
+      --  Be sure Get_Origin_Priv can be called on existing nodes.
+      Expand_Origin_Table;
+
+      --  For Parent: the instance of PKG is INST.
+      Prev_Orig := Get_Origin (Comp);
+      Set_Origin (Comp, Inst);
+
+      --  Instantiate generics
+      Set_Generic_Chain
+        (Inst,
+         Instantiate_Generic_Chain (Inst, Get_Generic_Chain (Comp), True));
+
+      declare
+         Assoc, Inter : Iir;
+      begin
+         Assoc := Get_Generic_Map_Aspect_Chain (Map);
+         Inter := Get_Generic_Chain (Inst);
+         while Is_Valid (Assoc) loop
+            Instantiate_Generic_Map (Assoc, Inter);
+            Next_Association_Interface (Assoc, Inter);
+         end loop;
+      end;
+
+      Set_Port_Chain
+        (Inst, Instantiate_Iir_Chain (Get_Port_Chain (Comp)));
+
+      Set_Origin (Comp, Prev_Orig);
+
+      Instance_File := Prev_Instance_File;
+      Restore_Origin (Mark);
+      return Inst;
+   end Instantiate_Component_Declaration;
+
    procedure Substitute_On_Iir_List (L : Iir_List; E : Iir; Rep : Iir);
 
    procedure Substitute_On_Iir (N : Iir; E : Iir; Rep : Iir) is
diff --git a/src/vhdl/vhdl-sem_inst.ads b/src/vhdl/vhdl-sem_inst.ads
index c9585d0c7..dea437837 100644
--- a/src/vhdl/vhdl-sem_inst.ads
+++ b/src/vhdl/vhdl-sem_inst.ads
@@ -40,6 +40,9 @@ package Vhdl.Sem_Inst is
    --  body.  INST has the form of a generic-mapped package.
    function Instantiate_Package_Body (Inst : Iir) return Iir;
 
+   function Instantiate_Component_Declaration (Comp : Iir; Map : Iir)
+                                              return Iir;
+
    --  In CHAIN, substitute all references to E by REP.
    procedure Substitute_On_Chain (Chain : Iir; E : Iir; Rep : Iir);
 
diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb
index 74409ccab..c1c2431e1 100644
--- a/src/vhdl/vhdl-sem_stmts.adb
+++ b/src/vhdl/vhdl-sem_stmts.adb
@@ -25,6 +25,7 @@ with Vhdl.Sem_Expr; use Vhdl.Sem_Expr;
 with Vhdl.Sem_Names; use Vhdl.Sem_Names;
 with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes;
 with Vhdl.Sem_Types;
+with Vhdl.Sem_Inst;
 with Vhdl.Sem_Psl;
 with Std_Names;
 with Vhdl.Evaluation; use Vhdl.Evaluation;
@@ -1945,10 +1946,79 @@ package body Vhdl.Sem_Stmts is
       end if;
    end Sem_Instantiated_Unit;
 
+   function Component_Need_Instance (Comp : Iir) return Boolean
+   is
+      Inter : Iir;
+      Inter_Type, Type_Name : Iir;
+      Has_Type_Gen : Boolean;
+   begin
+      Has_Type_Gen := False;
+      Inter := Get_Generic_Chain (Comp);
+      while Inter /= Null_Iir loop
+         case Get_Kind (Inter) is
+            when Iir_Kind_Interface_Package_Declaration
+              | Iir_Kind_Interface_Type_Declaration =>
+               Has_Type_Gen := True;
+            when others =>
+               null;
+         end case;
+         Inter := Get_Chain (Inter);
+      end loop;
+
+      --  If neither interface package nor interface type, no need to check
+      --  ports.
+      if not Has_Type_Gen then
+         return False;
+      end if;
+
+      --  Check if a type from an interface package or a generic type is used.
+      Inter := Get_Port_Chain (Comp);
+      while Inter /= Null_Iir loop
+         Inter_Type := Get_Subtype_Indication (Inter);
+         if Inter_Type /= Null_Iir then
+            --  Maybe to ad-hoc ?
+            Type_Name := Get_Base_Name (Inter_Type);
+            case Get_Kind (Type_Name) is
+               when Iir_Kind_Interface_Package_Declaration
+                 | Iir_Kind_Interface_Type_Declaration =>
+                  return True;
+               when others =>
+                  null;
+            end case;
+         end if;
+         Inter := Get_Chain (Inter);
+      end loop;
+
+      return False;
+   end Component_Need_Instance;
+
+   procedure Reassoc_Association_Chain (Chain : Iir)
+   is
+      Assoc : Iir;
+      Formal : Iir;
+      Ent : Iir;
+   begin
+      Assoc := Chain;
+      while Assoc /= Null_Iir loop
+         Formal := Get_Formal (Assoc);
+         if Formal /= Null_Iir then
+            if Get_Kind (Formal) = Iir_Kind_Simple_Name then
+               Ent := Get_Named_Entity (Formal);
+               Ent := Sem_Inst.Get_Origin (Ent);
+               Set_Named_Entity (Formal, Ent);
+            else
+               raise Internal_Error;
+            end if;
+         end if;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+   end Reassoc_Association_Chain;
+
    procedure Sem_Component_Instantiation_Statement
      (Stmt: Iir_Component_Instantiation_Statement; Is_Passive : Boolean)
    is
       Decl : Iir;
+      Decl_Inst : Iir;
       Entity_Unit : Iir_Design_Unit;
       Bind : Iir_Binding_Indication;
    begin
@@ -1972,7 +2042,16 @@ package body Vhdl.Sem_Stmts is
 
       --  The associations
       Sem_Generic_Association_Chain (Decl, Stmt);
-      Sem_Port_Association_Chain (Decl, Stmt);
+      if Component_Need_Instance (Decl) then
+         Decl_Inst := Sem_Inst.Instantiate_Component_Declaration (Decl, Stmt);
+         Set_Instantiated_Header (Stmt, Decl_Inst);
+         Sem_Port_Association_Chain (Decl_Inst, Stmt);
+         --  Re-associate formals with the non-instantiated interfaces.
+         Reassoc_Association_Chain (Get_Generic_Map_Aspect_Chain (Stmt));
+         Reassoc_Association_Chain (Get_Port_Map_Aspect_Chain (Stmt));
+      else
+         Sem_Port_Association_Chain (Decl, Stmt);
+      end if;
 
       --  FIXME: add sources for signals, in order to detect multiple sources
       --  to unresolved signals.