synth: preliminary work for package instantiation. For #1159

3 files changed, 91 insertions, 48 deletions

diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index fe764f50b..f83ec1bbd 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -570,10 +570,10 @@ package body Synth.Decls is
          Get_Value (Syn_Inst, Universal_Real_Type_Definition));
    end Synth_Convertible_Declarations;
 
-   procedure Synth_Package_Declaration
-     (Parent_Inst : Synth_Instance_Acc; Pkg : Node)
+   function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc;
+                                     Pkg : Node)
+                                    return Synth_Instance_Acc
    is
-      pragma Assert (not Is_Uninstantiated_Package (Pkg));
       Syn_Inst : Synth_Instance_Acc;
       Val : Value_Acc;
    begin
@@ -586,6 +586,21 @@ package body Synth.Decls is
          --  Local package: check elaboration order.
          Create_Object (Parent_Inst, Pkg, Val);
       end if;
+      return Syn_Inst;
+   end Create_Package_Instance;
+
+   procedure Synth_Package_Declaration
+     (Parent_Inst : Synth_Instance_Acc; Pkg : Node)
+   is
+      Syn_Inst : Synth_Instance_Acc;
+   begin
+      if Is_Uninstantiated_Package (Pkg) then
+         --  Nothing to do (yet) for uninstantiated packages.
+         return;
+      end if;
+
+      Syn_Inst := Create_Package_Instance (Parent_Inst, Pkg);
+
       Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg));
       if Pkg = Vhdl.Std_Package.Standard_Package then
          Synth_Convertible_Declarations (Syn_Inst);
@@ -597,15 +612,79 @@ package body Synth.Decls is
    is
       Val : Value_Acc;
    begin
+      if Is_Uninstantiated_Package (Pkg) then
+         --  Nothing to do (yet) for uninstantiated packages.
+         return;
+      end if;
+
       if Get_Kind (Get_Parent (Pkg)) = Iir_Kind_Design_Unit then
          Val := Get_Package_Object (Parent_Inst, Pkg);
       else
          Val := Get_Value (Parent_Inst, Pkg);
       end if;
+
       Synth_Declarations (Get_Value_Instance (Val.Instance),
                           Get_Declaration_Chain (Bod));
    end Synth_Package_Body;
 
+   procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc;
+                                         Syn_Inst : Synth_Instance_Acc;
+                                         Inter_Chain : Node;
+                                         Assoc_Chain : Node)
+   is
+      Inter : Node;
+      Inter_Type : Type_Acc;
+      Assoc : Node;
+      Assoc_Inter : Node;
+      Actual : Node;
+      Val : Value_Acc;
+   begin
+      Assoc := Assoc_Chain;
+      Assoc_Inter := Inter_Chain;
+      while Is_Valid (Assoc) loop
+         Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+
+         Synth_Declaration_Type (Sub_Inst, Inter);
+         Inter_Type := Get_Value_Type (Sub_Inst, Get_Type (Inter));
+
+         pragma Assert (Iir_Parameter_Modes (Get_Mode (Inter)) = Iir_In_Mode);
+         case Get_Kind (Assoc) is
+            when Iir_Kind_Association_Element_Open =>
+               Actual := Get_Default_Value (Inter);
+               Val := Synth_Expression_With_Type
+                 (Sub_Inst, Actual, Inter_Type);
+            when Iir_Kind_Association_Element_By_Expression =>
+               Actual := Get_Actual (Assoc);
+               Val := Synth_Expression_With_Type
+                 (Syn_Inst, Actual, Inter_Type);
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc);
+
+         pragma Assert (Is_Static (Val));
+
+         Create_Object (Sub_Inst, Inter, Val);
+
+         Next_Association_Interface (Assoc, Assoc_Inter);
+      end loop;
+   end Synth_Generics_Association;
+
+   procedure Synth_Package_Instantiation
+     (Parent_Inst : Synth_Instance_Acc; Pkg : Node)
+   is
+      Sub_Inst : Synth_Instance_Acc;
+   begin
+      Sub_Inst := Create_Package_Instance (Parent_Inst, Pkg);
+
+      Synth_Generics_Association
+        (Sub_Inst, Parent_Inst,
+         Get_Generic_Chain (Pkg), Get_Generic_Map_Aspect_Chain (Pkg));
+
+      Synth_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg));
+   end Synth_Package_Instantiation;
+
    procedure Synth_Variable
      (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean)
    is
diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads
index 7fd104280..66e961cf6 100644
--- a/src/synth/synth-decls.ads
+++ b/src/synth/synth-decls.ads
@@ -55,4 +55,12 @@ package Synth.Decls is
      (Parent_Inst : Synth_Instance_Acc; Pkg : Node);
    procedure Synth_Package_Body
      (Parent_Inst : Synth_Instance_Acc; Pkg : Node; Bod : Node);
+
+   procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc;
+                                         Syn_Inst : Synth_Instance_Acc;
+                                         Inter_Chain : Node;
+                                         Assoc_Chain : Node);
+
+   procedure Synth_Package_Instantiation
+     (Parent_Inst : Synth_Instance_Acc; Pkg : Node);
 end Synth.Decls;
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index fae1a5a65..18c23b8bb 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -751,50 +751,6 @@ package body Synth.Insts is
       end loop;
    end Synth_Instantiate_Module;
 
-   procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc;
-                                         Syn_Inst : Synth_Instance_Acc;
-                                         Inter_Chain : Node;
-                                         Assoc_Chain : Node)
-   is
-      Inter : Node;
-      Inter_Type : Type_Acc;
-      Assoc : Node;
-      Assoc_Inter : Node;
-      Actual : Node;
-      Val : Value_Acc;
-   begin
-      Assoc := Assoc_Chain;
-      Assoc_Inter := Inter_Chain;
-      while Is_Valid (Assoc) loop
-         Inter := Get_Association_Interface (Assoc, Assoc_Inter);
-
-         Synth_Declaration_Type (Sub_Inst, Inter);
-         Inter_Type := Get_Value_Type (Sub_Inst, Get_Type (Inter));
-
-         pragma Assert (Iir_Parameter_Modes (Get_Mode (Inter)) = Iir_In_Mode);
-         case Get_Kind (Assoc) is
-            when Iir_Kind_Association_Element_Open =>
-               Actual := Get_Default_Value (Inter);
-               Val := Synth_Expression_With_Type
-                 (Sub_Inst, Actual, Inter_Type);
-            when Iir_Kind_Association_Element_By_Expression =>
-               Actual := Get_Actual (Assoc);
-               Val := Synth_Expression_With_Type
-                 (Syn_Inst, Actual, Inter_Type);
-            when others =>
-               raise Internal_Error;
-         end case;
-
-         Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc);
-
-         pragma Assert (Is_Static (Val));
-
-         Create_Object (Sub_Inst, Inter, Val);
-
-         Next_Association_Interface (Assoc, Assoc_Inter);
-      end loop;
-   end Synth_Generics_Association;
-
    --  Return the type of EXPR without evaluating it.
    --  FIXME: how dubious is it ?
    function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
@@ -1199,7 +1155,7 @@ package body Synth.Insts is
                      end if;
                   end;
                when Iir_Kind_Package_Instantiation_Declaration =>
-                  null;
+                  Synth_Package_Instantiation (Parent_Inst, Dep_Unit);
                when Iir_Kind_Package_Body =>
                   null;
                when Iir_Kind_Architecture_Body =>