From 9e22ebad3dbc1065e13ccc56dfbb3418839b1002 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Fri, 31 Oct 2014 06:02:24 +0100
Subject: Add display of interface package.

---
 disp_vhdl.adb | 75 +++++++++++++++++++++++++++++++++++++++++------------------
 iirs.ads      | 11 +++++++++
 2 files changed, 64 insertions(+), 22 deletions(-)

diff --git a/disp_vhdl.adb b/disp_vhdl.adb
index eb7a44b16..73a8e420f 100644
--- a/disp_vhdl.adb
+++ b/disp_vhdl.adb
@@ -1081,15 +1081,39 @@ package body Disp_Vhdl is
       loop
          Next_Inter := Get_Chain (Inter);
          Set_Col (Start);
-         Disp_Interface_Class (Inter);
-         Disp_Name_Of (Inter);
-         while (Get_Lexical_Layout (Inter) and Iir_Lexical_Has_Type) = 0 loop
-            Put (", ");
-            Inter := Next_Inter;
-            Next_Inter := Get_Chain (Inter);
-            Disp_Name_Of (Inter);
-         end loop;
-         Disp_Interface_Mode_And_Type (Inter);
+
+         case Get_Kind (Inter) is
+            when Iir_Kinds_Interface_Object_Declaration =>
+               Disp_Interface_Class (Inter);
+               Disp_Name_Of (Inter);
+               while (Get_Lexical_Layout (Inter) and Iir_Lexical_Has_Type) = 0
+               loop
+                  Put (", ");
+                  Inter := Next_Inter;
+                  Next_Inter := Get_Chain (Inter);
+                  Disp_Name_Of (Inter);
+               end loop;
+               Disp_Interface_Mode_And_Type (Inter);
+            when Iir_Kind_Interface_Package_Declaration =>
+               Put ("package ");
+               Disp_Identifier (Inter);
+               Put (" is new ");
+               Disp_Name (Get_Uninstantiated_Package_Name (Inter));
+               Put (" generic map ");
+               declare
+                  Assoc_Chain : constant Iir :=
+                    Get_Generic_Map_Aspect_Chain (Inter);
+               begin
+                  if Assoc_Chain = Null_Iir then
+                     Put ("(<>)");
+                  else
+                     Disp_Association_Chain (Assoc_Chain);
+                  end if;
+               end;
+            when others =>
+               Error_Kind ("disp_interface_chain", Inter);
+         end case;
+
          if Next_Inter /= Null_Iir then
             Put (";");
             if Comment_Col /= 0 then
@@ -1102,6 +1126,7 @@ package body Disp_Vhdl is
             Put (End_Str);
             exit;
          end if;
+
          Inter := Next_Inter;
          Next_Inter := Get_Chain (Inter);
       end loop;
@@ -2183,6 +2208,8 @@ package body Disp_Vhdl is
             if Need_Comma then
                Put (", ");
             end if;
+
+            --  Formal part.
             if Get_Kind (El) = Iir_Kind_Association_Element_By_Expression then
                Conv := Get_Out_Conversion (El);
                if Conv /= Null_Iir then
@@ -2200,19 +2227,23 @@ package body Disp_Vhdl is
                end if;
                Put (" => ");
             end if;
-            if Get_Kind (El) = Iir_Kind_Association_Element_Open then
-               Put ("open");
-            else
-               Conv := Get_In_Conversion (El);
-               if Conv /= Null_Iir then
-                  Disp_Conversion (Conv);
-                  Put (" (");
-               end if;
-               Disp_Expression (Get_Actual (El));
-               if Conv /= Null_Iir then
-                  Put (")");
-               end if;
-            end if;
+
+            case Get_Kind (El) is
+               when Iir_Kind_Association_Element_Open =>
+                  Put ("open");
+               when Iir_Kind_Association_Element_Package =>
+                  Disp_Name (Get_Actual (El));
+               when others =>
+                  Conv := Get_In_Conversion (El);
+                  if Conv /= Null_Iir then
+                     Disp_Conversion (Conv);
+                     Put (" (");
+                  end if;
+                  Disp_Expression (Get_Actual (El));
+                  if Conv /= Null_Iir then
+                     Put (")");
+                  end if;
+            end case;
             Need_Comma := True;
          end if;
          El := Get_Chain (El);
diff --git a/iirs.ads b/iirs.ads
index 0261beec5..cd58daa56 100644
--- a/iirs.ads
+++ b/iirs.ads
@@ -1133,6 +1133,17 @@ package Iirs is
 
    -- Iir_Kind_Interface_Package_Declaration (Medium)
    --
+   --  LRM08 6.5.5 Interface package declarations
+   --
+   --  interface_package_declaration ::=
+   --     PACKAGE identifier IS NEW /uninstantiated_package/_name
+   --        interface_package_generic_map_aspect
+   --
+   --  interface_package_generic_map_aspect ::=
+   --       generic_map_aspect
+   --     | GENERIC MAP ( <> )                  --  Represented by Null_Iir
+   --     | GENERIC MAP ( DEFAULT )             --  Not yet implemented
+   --
    --   Get/Set_Parent (Field0)
    --
    --   Get/Set_Declaration_Chain (Field1)
-- 
cgit v1.2.3