synth: improve support of interface package. For #1460

3 files changed, 105 insertions, 66 deletions

diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index 309fa1dd7..fadbdfd13 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -257,6 +257,18 @@ package body Synth.Context is
                                            I_Inst => Inst);
    end Create_Package_Object;
 
+   procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc;
+                                       Decl     : Node;
+                                       Inst     : Synth_Instance_Acc)
+   is
+      Info : constant Sim_Info_Acc := Get_Info (Decl);
+   begin
+      pragma Assert (Syn_Inst.Up_Block /= null);
+      Create_Object (Syn_Inst, Info.Pkg_Slot, 1);
+      Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance,
+                                           I_Inst => Inst);
+   end Create_Package_Interface;
+
    function Get_Package_Object
      (Syn_Inst : Synth_Instance_Acc; Info : Sim_Info_Acc)
      return Synth_Instance_Acc
diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads
index 02b51c8c8..9e571feb4 100644
--- a/src/synth/synth-context.ads
+++ b/src/synth/synth-context.ads
@@ -93,6 +93,10 @@ package Synth.Context is
                                     Inst : Synth_Instance_Acc;
                                     Is_Global : Boolean);
 
+   procedure Create_Package_Interface (Syn_Inst : Synth_Instance_Acc;
+                                       Decl     : Node;
+                                       Inst     : Synth_Instance_Acc);
+
    procedure Create_Subtype_Object
      (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc);
 
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 40c2fe5f2..9fabb7a49 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -538,59 +538,59 @@ package body Synth.Decls is
          Create_Object (Syn_Inst, Decl, No_Valtyp);
       end if;
       --  Initialize the value (except for a deferred declaration).
+      if Get_Deferred_Declaration_Flag (Decl) then
+         return;
+      end if;
       if Deferred_Decl = Null_Node then
          --  A normal constant declaration
          First_Decl := Decl;
-      elsif not Get_Deferred_Declaration_Flag (Decl) then
+      else
          --  The full declaration of a deferred constant.
          First_Decl := Deferred_Decl;
-      else
-         --  The first declaration of a deferred constant.
-         First_Decl := Null_Node;
       end if;
-      if First_Decl /= Null_Node then
-         --  Use the type of the declaration.  The type of the constant may
-         --  be derived from the value.
-         --  FIXME: what about multiple declarations ?
-         Decl_Type := Get_Subtype_Indication (Decl);
-         if Decl_Type = Null_Node then
-            Decl_Type := Last_Type;
-         else
-            if Get_Kind (Decl_Type) in Iir_Kinds_Denoting_Name then
-               --  Type mark.
-               Decl_Type := Get_Type (Get_Named_Entity (Decl_Type));
-            end if;
-            Last_Type := Decl_Type;
-         end if;
-         Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type);
-         Val := Synth_Expression_With_Type
-           (Syn_Inst, Get_Default_Value (Decl), Obj_Type);
-         if Val = No_Valtyp then
-            Set_Error (Syn_Inst);
-            return;
+      pragma Assert (First_Decl /= Null_Node);
+
+      --  Use the type of the declaration.  The type of the constant may
+      --  be derived from the value.
+      --  FIXME: what about multiple declarations ?
+      Decl_Type := Get_Subtype_Indication (Decl);
+      if Decl_Type = Null_Node then
+         Decl_Type := Last_Type;
+      else
+         if Get_Kind (Decl_Type) in Iir_Kinds_Denoting_Name then
+            --  Type mark.
+            Decl_Type := Get_Type (Get_Named_Entity (Decl_Type));
          end if;
-         Val := Synth_Subtype_Conversion (Ctxt, Val, Obj_Type, True, Decl);
-         --  For constant functions, the value must be constant.
-         pragma Assert (not Get_Instance_Const (Syn_Inst)
-                          or else Is_Static (Val.Val));
-         case Val.Val.Kind is
-            when Value_Const
-              | Value_Alias =>
-               Cst := Val;
-            when others =>
-               if Is_Static (Val.Val) then
-                  Cst := Create_Value_Const (Val, Decl);
-               else
-                  if not Is_Subprg then
-                     Error_Msg_Synth
-                       (+Decl, "signals cannot be used in default value "
-                          & "of this constant");
-                  end if;
-                  Cst := Val;
-               end if;
-         end case;
-         Create_Object_Force (Syn_Inst, First_Decl, Cst);
+         Last_Type := Decl_Type;
+      end if;
+      Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type);
+      Val := Synth_Expression_With_Type
+        (Syn_Inst, Get_Default_Value (Decl), Obj_Type);
+      if Val = No_Valtyp then
+         Set_Error (Syn_Inst);
+         return;
       end if;
+      Val := Synth_Subtype_Conversion (Ctxt, Val, Obj_Type, True, Decl);
+      --  For constant functions, the value must be constant.
+      pragma Assert (not Get_Instance_Const (Syn_Inst)
+                     or else Is_Static (Val.Val));
+      case Val.Val.Kind is
+         when Value_Const
+            | Value_Alias =>
+            Cst := Val;
+         when others =>
+            if Is_Static (Val.Val) then
+               Cst := Create_Value_Const (Val, Decl);
+            else
+               if not Is_Subprg then
+                  Error_Msg_Synth
+                    (+Decl, "signals cannot be used in default value "
+                     & "of this constant");
+               end if;
+               Cst := Val;
+            end if;
+      end case;
+      Create_Object_Force (Syn_Inst, First_Decl, Cst);
    end Synth_Constant_Declaration;
 
    procedure Synth_Attribute_Object (Syn_Inst : Synth_Instance_Acc;
@@ -770,29 +770,52 @@ package body Synth.Decls is
       Assoc_Inter := Inter_Chain;
       while Is_Valid (Assoc) loop
          Inter := Get_Association_Interface (Assoc, Assoc_Inter);
+         case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
+            when Iir_Kind_Interface_Constant_Declaration =>
+               Synth_Declaration_Type (Sub_Inst, Inter);
+               Inter_Type := Get_Subtype_Object (Sub_Inst, Get_Type (Inter));
+
+               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
+                 (Ctxt, Val, Inter_Type, True, Assoc);
+
+               pragma Assert (Is_Static (Val.Val));
+
+               Create_Object (Sub_Inst, Inter, Val);
+
+            when Iir_Kind_Interface_Package_Declaration =>
+               declare
+                  Actual : constant Iir :=
+                    Strip_Denoting_Name (Get_Actual (Assoc));
+                  Pkg_Inst : Synth_Instance_Acc;
+               begin
+                  Pkg_Inst := Get_Package_Object (Sub_Inst, Actual);
+                  Create_Package_Interface (Sub_Inst, Inter, Pkg_Inst);
+               end;
 
-         Synth_Declaration_Type (Sub_Inst, Inter);
-         Inter_Type := Get_Subtype_Object (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 =>
+            when Iir_Kind_Interface_Variable_Declaration
+               | Iir_Kind_Interface_File_Declaration
+               | Iir_Kind_Interface_Signal_Declaration
+               | Iir_Kind_Interface_Quantity_Declaration
+               | Iir_Kind_Interface_Terminal_Declaration =>
                raise Internal_Error;
-         end case;
 
-         Val := Synth_Subtype_Conversion (Ctxt, Val, Inter_Type, True, Assoc);
-
-         pragma Assert (Is_Static (Val.Val));
-
-         Create_Object (Sub_Inst, Inter, Val);
+            when Iir_Kinds_Interface_Subprogram_Declaration
+               | Iir_Kind_Interface_Type_Declaration =>
+               raise Internal_Error;
+         end case;
 
          Next_Association_Interface (Assoc, Assoc_Inter);
       end loop;
@@ -813,7 +836,7 @@ package body Synth.Decls is
       Synth_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg));
 
       if Bod /= Null_Node then
-         --  Macro expended package instantiation.
+         --  Macro expanded package instantiation.
          raise Internal_Error;
       else
          --  Shared body