parser: add Has_Component for component instantiation.

6 files changed, 136 insertions, 81 deletions

diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb
index 90810c4ac..80013702e 100644
--- a/src/vhdl/disp_vhdl.adb
+++ b/src/vhdl/disp_vhdl.adb
@@ -2491,6 +2491,10 @@ package body Disp_Vhdl is
    begin
       Disp_Label (Stmt);
       if Get_Kind (Component) in Iir_Kinds_Denoting_Name then
+         if Get_Has_Component (Stmt) then
+            Put ("component");
+            Put (" ");
+         end if;
          Disp_Name (Component);
       else
          Disp_Entity_Aspect (Component);
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index 929395b2d..c6b926bc4 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -5535,6 +5535,22 @@ package body Iirs is
       Set_Flag10 (Decl, Flag);
    end Set_Has_Parameter;
 
+   function Get_Has_Component (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Component (Get_Kind (Decl)),
+                     "no field Has_Component");
+      return Get_Flag5 (Decl);
+   end Get_Has_Component;
+
+   procedure Set_Has_Component (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Has_Component (Get_Kind (Decl)),
+                     "no field Has_Component");
+      Set_Flag5 (Decl, Flag);
+   end Set_Has_Component;
+
    function Get_Has_Identifier_List (Decl : Iir) return Boolean is
    begin
       pragma Assert (Decl /= Null_Iir);
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 763106c3c..52f8b94e2 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -2901,6 +2901,8 @@ package Iirs is
    --   Get/Set_Component_Configuration (Field6)
    --
    --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Has_Component (Flag5)
 
    -- Iir_Kind_Block_Statement (Medium)
    --
@@ -7312,6 +7314,11 @@ package Iirs is
    function Get_Has_Parameter (Decl : Iir) return Boolean;
    procedure Set_Has_Parameter (Decl : Iir; Flag : Boolean);
 
+   --  Layout flag: true if 'component' reserved identifier is present.
+   --  Field: Flag5
+   function Get_Has_Component (Decl : Iir) return Boolean;
+   procedure Set_Has_Component (Decl : Iir; Flag : Boolean);
+
    --  Layout flag for object declaration.  If True, the identifier of this
    --  declaration is followed by an identifier (and separated by a comma).
    --  This flag is set on all but the last declarations.
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 4a32af931..e7f784146 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -326,6 +326,7 @@ package body Nodes_Meta is
       Field_Has_Pure => Type_Boolean,
       Field_Has_Body => Type_Boolean,
       Field_Has_Parameter => Type_Boolean,
+      Field_Has_Component => Type_Boolean,
       Field_Has_Identifier_List => Type_Boolean,
       Field_Has_Mode => Type_Boolean,
       Field_Has_Class => Type_Boolean,
@@ -966,6 +967,8 @@ package body Nodes_Meta is
             return "has_body";
          when Field_Has_Parameter =>
             return "has_parameter";
+         when Field_Has_Component =>
+            return "has_component";
          when Field_Has_Identifier_List =>
             return "has_identifier_list";
          when Field_Has_Mode =>
@@ -2160,6 +2163,8 @@ package body Nodes_Meta is
             return Attr_None;
          when Field_Has_Parameter =>
             return Attr_None;
+         when Field_Has_Component =>
+            return Attr_None;
          when Field_Has_Identifier_List =>
             return Attr_None;
          when Field_Has_Mode =>
@@ -3807,6 +3812,7 @@ package body Nodes_Meta is
       --  Iir_Kind_Component_Instantiation_Statement
       Field_Label,
       Field_Visible_Flag,
+      Field_Has_Component,
       Field_Parent,
       Field_Instantiated_Unit,
       Field_Chain,
@@ -4563,84 +4569,84 @@ package body Nodes_Meta is
       Iir_Kind_If_Generate_Statement => 1398,
       Iir_Kind_Case_Generate_Statement => 1407,
       Iir_Kind_For_Generate_Statement => 1416,
-      Iir_Kind_Component_Instantiation_Statement => 1426,
-      Iir_Kind_Psl_Default_Clock => 1430,
-      Iir_Kind_Simple_Simultaneous_Statement => 1437,
-      Iir_Kind_Generate_Statement_Body => 1448,
-      Iir_Kind_If_Generate_Else_Clause => 1454,
-      Iir_Kind_Simple_Signal_Assignment_Statement => 1464,
-      Iir_Kind_Conditional_Signal_Assignment_Statement => 1474,
-      Iir_Kind_Selected_Waveform_Assignment_Statement => 1485,
-      Iir_Kind_Null_Statement => 1489,
-      Iir_Kind_Assertion_Statement => 1496,
-      Iir_Kind_Report_Statement => 1502,
-      Iir_Kind_Wait_Statement => 1510,
-      Iir_Kind_Variable_Assignment_Statement => 1517,
-      Iir_Kind_Conditional_Variable_Assignment_Statement => 1524,
-      Iir_Kind_Return_Statement => 1530,
-      Iir_Kind_For_Loop_Statement => 1539,
-      Iir_Kind_While_Loop_Statement => 1548,
-      Iir_Kind_Next_Statement => 1555,
-      Iir_Kind_Exit_Statement => 1562,
-      Iir_Kind_Case_Statement => 1570,
-      Iir_Kind_Procedure_Call_Statement => 1576,
-      Iir_Kind_If_Statement => 1586,
-      Iir_Kind_Elsif => 1592,
-      Iir_Kind_Character_Literal => 1600,
-      Iir_Kind_Simple_Name => 1608,
-      Iir_Kind_Selected_Name => 1617,
-      Iir_Kind_Operator_Symbol => 1623,
-      Iir_Kind_Reference_Name => 1626,
-      Iir_Kind_Selected_By_All_Name => 1632,
-      Iir_Kind_Parenthesis_Name => 1637,
-      Iir_Kind_External_Constant_Name => 1645,
-      Iir_Kind_External_Signal_Name => 1653,
-      Iir_Kind_External_Variable_Name => 1661,
-      Iir_Kind_Package_Pathname => 1665,
-      Iir_Kind_Absolute_Pathname => 1666,
-      Iir_Kind_Relative_Pathname => 1667,
-      Iir_Kind_Pathname_Element => 1672,
-      Iir_Kind_Base_Attribute => 1674,
-      Iir_Kind_Subtype_Attribute => 1679,
-      Iir_Kind_Element_Attribute => 1684,
-      Iir_Kind_Left_Type_Attribute => 1689,
-      Iir_Kind_Right_Type_Attribute => 1694,
-      Iir_Kind_High_Type_Attribute => 1699,
-      Iir_Kind_Low_Type_Attribute => 1704,
-      Iir_Kind_Ascending_Type_Attribute => 1709,
-      Iir_Kind_Image_Attribute => 1715,
-      Iir_Kind_Value_Attribute => 1721,
-      Iir_Kind_Pos_Attribute => 1727,
-      Iir_Kind_Val_Attribute => 1733,
-      Iir_Kind_Succ_Attribute => 1739,
-      Iir_Kind_Pred_Attribute => 1745,
-      Iir_Kind_Leftof_Attribute => 1751,
-      Iir_Kind_Rightof_Attribute => 1757,
-      Iir_Kind_Delayed_Attribute => 1766,
-      Iir_Kind_Stable_Attribute => 1775,
-      Iir_Kind_Quiet_Attribute => 1784,
-      Iir_Kind_Transaction_Attribute => 1793,
-      Iir_Kind_Event_Attribute => 1797,
-      Iir_Kind_Active_Attribute => 1801,
-      Iir_Kind_Last_Event_Attribute => 1805,
-      Iir_Kind_Last_Active_Attribute => 1809,
-      Iir_Kind_Last_Value_Attribute => 1813,
-      Iir_Kind_Driving_Attribute => 1817,
-      Iir_Kind_Driving_Value_Attribute => 1821,
-      Iir_Kind_Behavior_Attribute => 1821,
-      Iir_Kind_Structure_Attribute => 1821,
-      Iir_Kind_Simple_Name_Attribute => 1828,
-      Iir_Kind_Instance_Name_Attribute => 1833,
-      Iir_Kind_Path_Name_Attribute => 1838,
-      Iir_Kind_Left_Array_Attribute => 1845,
-      Iir_Kind_Right_Array_Attribute => 1852,
-      Iir_Kind_High_Array_Attribute => 1859,
-      Iir_Kind_Low_Array_Attribute => 1866,
-      Iir_Kind_Length_Array_Attribute => 1873,
-      Iir_Kind_Ascending_Array_Attribute => 1880,
-      Iir_Kind_Range_Array_Attribute => 1887,
-      Iir_Kind_Reverse_Range_Array_Attribute => 1894,
-      Iir_Kind_Attribute_Name => 1903
+      Iir_Kind_Component_Instantiation_Statement => 1427,
+      Iir_Kind_Psl_Default_Clock => 1431,
+      Iir_Kind_Simple_Simultaneous_Statement => 1438,
+      Iir_Kind_Generate_Statement_Body => 1449,
+      Iir_Kind_If_Generate_Else_Clause => 1455,
+      Iir_Kind_Simple_Signal_Assignment_Statement => 1465,
+      Iir_Kind_Conditional_Signal_Assignment_Statement => 1475,
+      Iir_Kind_Selected_Waveform_Assignment_Statement => 1486,
+      Iir_Kind_Null_Statement => 1490,
+      Iir_Kind_Assertion_Statement => 1497,
+      Iir_Kind_Report_Statement => 1503,
+      Iir_Kind_Wait_Statement => 1511,
+      Iir_Kind_Variable_Assignment_Statement => 1518,
+      Iir_Kind_Conditional_Variable_Assignment_Statement => 1525,
+      Iir_Kind_Return_Statement => 1531,
+      Iir_Kind_For_Loop_Statement => 1540,
+      Iir_Kind_While_Loop_Statement => 1549,
+      Iir_Kind_Next_Statement => 1556,
+      Iir_Kind_Exit_Statement => 1563,
+      Iir_Kind_Case_Statement => 1571,
+      Iir_Kind_Procedure_Call_Statement => 1577,
+      Iir_Kind_If_Statement => 1587,
+      Iir_Kind_Elsif => 1593,
+      Iir_Kind_Character_Literal => 1601,
+      Iir_Kind_Simple_Name => 1609,
+      Iir_Kind_Selected_Name => 1618,
+      Iir_Kind_Operator_Symbol => 1624,
+      Iir_Kind_Reference_Name => 1627,
+      Iir_Kind_Selected_By_All_Name => 1633,
+      Iir_Kind_Parenthesis_Name => 1638,
+      Iir_Kind_External_Constant_Name => 1646,
+      Iir_Kind_External_Signal_Name => 1654,
+      Iir_Kind_External_Variable_Name => 1662,
+      Iir_Kind_Package_Pathname => 1666,
+      Iir_Kind_Absolute_Pathname => 1667,
+      Iir_Kind_Relative_Pathname => 1668,
+      Iir_Kind_Pathname_Element => 1673,
+      Iir_Kind_Base_Attribute => 1675,
+      Iir_Kind_Subtype_Attribute => 1680,
+      Iir_Kind_Element_Attribute => 1685,
+      Iir_Kind_Left_Type_Attribute => 1690,
+      Iir_Kind_Right_Type_Attribute => 1695,
+      Iir_Kind_High_Type_Attribute => 1700,
+      Iir_Kind_Low_Type_Attribute => 1705,
+      Iir_Kind_Ascending_Type_Attribute => 1710,
+      Iir_Kind_Image_Attribute => 1716,
+      Iir_Kind_Value_Attribute => 1722,
+      Iir_Kind_Pos_Attribute => 1728,
+      Iir_Kind_Val_Attribute => 1734,
+      Iir_Kind_Succ_Attribute => 1740,
+      Iir_Kind_Pred_Attribute => 1746,
+      Iir_Kind_Leftof_Attribute => 1752,
+      Iir_Kind_Rightof_Attribute => 1758,
+      Iir_Kind_Delayed_Attribute => 1767,
+      Iir_Kind_Stable_Attribute => 1776,
+      Iir_Kind_Quiet_Attribute => 1785,
+      Iir_Kind_Transaction_Attribute => 1794,
+      Iir_Kind_Event_Attribute => 1798,
+      Iir_Kind_Active_Attribute => 1802,
+      Iir_Kind_Last_Event_Attribute => 1806,
+      Iir_Kind_Last_Active_Attribute => 1810,
+      Iir_Kind_Last_Value_Attribute => 1814,
+      Iir_Kind_Driving_Attribute => 1818,
+      Iir_Kind_Driving_Value_Attribute => 1822,
+      Iir_Kind_Behavior_Attribute => 1822,
+      Iir_Kind_Structure_Attribute => 1822,
+      Iir_Kind_Simple_Name_Attribute => 1829,
+      Iir_Kind_Instance_Name_Attribute => 1834,
+      Iir_Kind_Path_Name_Attribute => 1839,
+      Iir_Kind_Left_Array_Attribute => 1846,
+      Iir_Kind_Right_Array_Attribute => 1853,
+      Iir_Kind_High_Array_Attribute => 1860,
+      Iir_Kind_Low_Array_Attribute => 1867,
+      Iir_Kind_Length_Array_Attribute => 1874,
+      Iir_Kind_Ascending_Array_Attribute => 1881,
+      Iir_Kind_Range_Array_Attribute => 1888,
+      Iir_Kind_Reverse_Range_Array_Attribute => 1895,
+      Iir_Kind_Attribute_Name => 1904
      );
 
    function Get_Fields_First (K : Iir_Kind) return Fields_Index is
@@ -4781,6 +4787,8 @@ package body Nodes_Meta is
             return Get_Has_Body (N);
          when Field_Has_Parameter =>
             return Get_Has_Parameter (N);
+         when Field_Has_Component =>
+            return Get_Has_Component (N);
          when Field_Has_Identifier_List =>
             return Get_Has_Identifier_List (N);
          when Field_Has_Mode =>
@@ -4911,6 +4919,8 @@ package body Nodes_Meta is
             Set_Has_Body (N, V);
          when Field_Has_Parameter =>
             Set_Has_Parameter (N, V);
+         when Field_Has_Component =>
+            Set_Has_Component (N, V);
          when Field_Has_Identifier_List =>
             Set_Has_Identifier_List (N, V);
          when Field_Has_Mode =>
@@ -10404,6 +10414,11 @@ package body Nodes_Meta is
       end case;
    end Has_Has_Parameter;
 
+   function Has_Has_Component (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Component_Instantiation_Statement;
+   end Has_Has_Component;
+
    function Has_Has_Identifier_List (K : Iir_Kind) return Boolean is
    begin
       case K is
diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads
index e749dc670..89f8aa6a5 100644
--- a/src/vhdl/nodes_meta.ads
+++ b/src/vhdl/nodes_meta.ads
@@ -365,6 +365,7 @@ package Nodes_Meta is
       Field_Has_Pure,
       Field_Has_Body,
       Field_Has_Parameter,
+      Field_Has_Component,
       Field_Has_Identifier_List,
       Field_Has_Mode,
       Field_Has_Class,
@@ -885,6 +886,7 @@ package Nodes_Meta is
    function Has_Has_Pure (K : Iir_Kind) return Boolean;
    function Has_Has_Body (K : Iir_Kind) return Boolean;
    function Has_Has_Parameter (K : Iir_Kind) return Boolean;
+   function Has_Has_Component (K : Iir_Kind) return Boolean;
    function Has_Has_Identifier_List (K : Iir_Kind) return Boolean;
    function Has_Has_Mode (K : Iir_Kind) return Boolean;
    function Has_Has_Class (K : Iir_Kind) return Boolean;
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 1092cc490..d624a4563 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -7100,9 +7100,9 @@ package body Parse is
    --  postcond : next_token
    --
    --  instantiated_unit ::=
-   --      [ COMPONENT ] component_name
-   --      ENTITY entity_name [ ( architecture_identifier ) ]
-   --      CONFIGURATION configuration_name
+   --        [ COMPONENT ] component_name
+   --      | ENTITY entity_name [ ( architecture_identifier ) ]
+   --      | CONFIGURATION configuration_name
    function Parse_Instantiated_Unit return Iir
    is
       Res : Iir;
@@ -7116,12 +7116,18 @@ package body Parse is
 
       case Current_Token is
          when Tok_Component =>
+            --  Eat 'component'.
             Scan;
+
             return Parse_Name (False);
+
          when Tok_Entity =>
             Res := Create_Iir (Iir_Kind_Entity_Aspect_Entity);
             Set_Location (Res);
+
+            --  Eat 'entity'.
             Scan;
+
             Set_Entity_Name (Res, Parse_Name (False));
             if Current_Token = Tok_Left_Paren then
                Scan_Expect (Tok_Identifier);
@@ -7130,12 +7136,14 @@ package body Parse is
                Scan;
             end if;
             return Res;
+
          when Tok_Configuration =>
             Res := Create_Iir (Iir_Kind_Entity_Aspect_Configuration);
             Set_Location (Res);
             Scan_Expect (Tok_Identifier);
             Set_Configuration_Name (Res, Parse_Name (False));
             return Res;
+
          when others =>
             raise Internal_Error;
       end case;
@@ -8034,9 +8042,12 @@ package body Parse is
                Postponed_Not_Allowed;
                declare
                   Unit : Iir;
+                  Has_Component : constant Boolean :=
+                    Current_Token = Tok_Component;
                begin
                   Unit := Parse_Instantiated_Unit;
                   Stmt := Parse_Component_Instantiation (Unit);
+                  Set_Has_Component (Stmt, Has_Component);
                end;
             when Tok_Psl_Default =>
                Postponed_Not_Allowed;