Parse case generate statement.

6 files changed, 269 insertions, 79 deletions

diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 9728fae20..0da1dc166 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -716,6 +716,8 @@ package body Errorout is
          when Iir_Kind_If_Generate_Statement
            | Iir_Kind_If_Generate_Else_Clause =>
             return "if generate statement";
+         when Iir_Kind_Case_Generate_Statement =>
+            return "case generate statement";
          when Iir_Kind_Generate_Statement_Body =>
             return "generate statement";
 
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index 34170bf04..e9dc2dbe3 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -391,6 +391,7 @@ package body Iirs is
            | Iir_Kind_Concurrent_Procedure_Call_Statement
            | Iir_Kind_If_Generate_Statement
            | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_Generate_Statement_Body
            | Iir_Kind_If_Generate_Else_Clause
            | Iir_Kind_Simple_Signal_Assignment_Statement
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 47b4e59d4..7ecdcafc1 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -2746,6 +2746,28 @@ package Iirs is
    --
    --   Get/Set_End_Has_Identifier (Flag9)
 
+   -- Iir_Kind_Case_Generate_Statement (Short)
+   --
+   --   Get/Set_Parent (Field0)
+   --
+   --  Chain is composed of Iir_Kind_Choice_By_XXX.
+   --   Get/Set_Case_Statement_Alternative_Chain (Field1)
+   --
+   --   Get/Set_Chain (Field2)
+   --
+   --   Get/Set_Label (Field3)
+   --   Get/Set_Identifier (Alias Field3)
+   --
+   --   Get/Set_Expression (Field5)
+   --
+   --   Get/Set_Visible_Flag (Flag4)
+   --
+   --   Get/Set_Is_Within_Flag (Flag5)
+   --
+   --   Get/Set_End_Has_Reserved_Id (Flag8)
+   --
+   --   Get/Set_End_Has_Identifier (Flag9)
+
    -- Iir_Kind_Simple_Simultaneous_Statement (Medium)
    --
    --   Get/Set_Parent (Field0)
@@ -3843,6 +3865,7 @@ package Iirs is
       Iir_Kind_Block_Statement,
       Iir_Kind_If_Generate_Statement,
       Iir_Kind_For_Generate_Statement,
+      Iir_Kind_Case_Generate_Statement,
       Iir_Kind_Component_Instantiation_Statement,
 
       Iir_Kind_Simple_Simultaneous_Statement,
@@ -4788,6 +4811,7 @@ package Iirs is
    --Iir_Kind_Block_Statement
    --Iir_Kind_If_Generate_Statement
    --Iir_Kind_For_Generate_Statement
+   --Iir_Kind_Case_Generate_Statement
      Iir_Kind_Component_Instantiation_Statement;
 
    subtype Iir_Kinds_Concurrent_Signal_Assignment is Iir_Kind range
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 2635072cd..7f846dbda 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -1311,6 +1311,8 @@ package body Nodes_Meta is
             return "if_generate_statement";
          when Iir_Kind_For_Generate_Statement =>
             return "for_generate_statement";
+         when Iir_Kind_Case_Generate_Statement =>
+            return "case_generate_statement";
          when Iir_Kind_Component_Instantiation_Statement =>
             return "component_instantiation_statement";
          when Iir_Kind_Simple_Simultaneous_Statement =>
@@ -3562,6 +3564,16 @@ package body Nodes_Meta is
       Field_Chain,
       Field_Generate_Statement_Body,
       Field_Parent,
+      --  Iir_Kind_Case_Generate_Statement
+      Field_Label,
+      Field_Visible_Flag,
+      Field_Is_Within_Flag,
+      Field_End_Has_Reserved_Id,
+      Field_End_Has_Identifier,
+      Field_Case_Statement_Alternative_Chain,
+      Field_Chain,
+      Field_Expression,
+      Field_Parent,
       --  Iir_Kind_Component_Instantiation_Statement
       Field_Label,
       Field_Visible_Flag,
@@ -4259,79 +4271,80 @@ package body Nodes_Meta is
       Iir_Kind_Block_Statement => 1284,
       Iir_Kind_If_Generate_Statement => 1294,
       Iir_Kind_For_Generate_Statement => 1303,
-      Iir_Kind_Component_Instantiation_Statement => 1313,
-      Iir_Kind_Simple_Simultaneous_Statement => 1320,
-      Iir_Kind_Generate_Statement_Body => 1331,
-      Iir_Kind_If_Generate_Else_Clause => 1336,
-      Iir_Kind_Simple_Signal_Assignment_Statement => 1345,
-      Iir_Kind_Conditional_Signal_Assignment_Statement => 1354,
-      Iir_Kind_Null_Statement => 1358,
-      Iir_Kind_Assertion_Statement => 1365,
-      Iir_Kind_Report_Statement => 1371,
-      Iir_Kind_Wait_Statement => 1378,
-      Iir_Kind_Variable_Assignment_Statement => 1384,
-      Iir_Kind_Conditional_Variable_Assignment_Statement => 1390,
-      Iir_Kind_Return_Statement => 1396,
-      Iir_Kind_For_Loop_Statement => 1405,
-      Iir_Kind_While_Loop_Statement => 1413,
-      Iir_Kind_Next_Statement => 1419,
-      Iir_Kind_Exit_Statement => 1425,
-      Iir_Kind_Case_Statement => 1433,
-      Iir_Kind_Procedure_Call_Statement => 1439,
-      Iir_Kind_If_Statement => 1448,
-      Iir_Kind_Elsif => 1453,
-      Iir_Kind_Character_Literal => 1460,
-      Iir_Kind_Simple_Name => 1467,
-      Iir_Kind_Selected_Name => 1475,
-      Iir_Kind_Operator_Symbol => 1480,
-      Iir_Kind_Selected_By_All_Name => 1485,
-      Iir_Kind_Parenthesis_Name => 1489,
-      Iir_Kind_External_Constant_Name => 1498,
-      Iir_Kind_External_Signal_Name => 1507,
-      Iir_Kind_External_Variable_Name => 1516,
-      Iir_Kind_Package_Pathname => 1519,
-      Iir_Kind_Absolute_Pathname => 1520,
-      Iir_Kind_Relative_Pathname => 1521,
-      Iir_Kind_Pathname_Element => 1525,
-      Iir_Kind_Base_Attribute => 1527,
-      Iir_Kind_Left_Type_Attribute => 1532,
-      Iir_Kind_Right_Type_Attribute => 1537,
-      Iir_Kind_High_Type_Attribute => 1542,
-      Iir_Kind_Low_Type_Attribute => 1547,
-      Iir_Kind_Ascending_Type_Attribute => 1552,
-      Iir_Kind_Image_Attribute => 1558,
-      Iir_Kind_Value_Attribute => 1564,
-      Iir_Kind_Pos_Attribute => 1570,
-      Iir_Kind_Val_Attribute => 1576,
-      Iir_Kind_Succ_Attribute => 1582,
-      Iir_Kind_Pred_Attribute => 1588,
-      Iir_Kind_Leftof_Attribute => 1594,
-      Iir_Kind_Rightof_Attribute => 1600,
-      Iir_Kind_Delayed_Attribute => 1608,
-      Iir_Kind_Stable_Attribute => 1616,
-      Iir_Kind_Quiet_Attribute => 1624,
-      Iir_Kind_Transaction_Attribute => 1632,
-      Iir_Kind_Event_Attribute => 1636,
-      Iir_Kind_Active_Attribute => 1640,
-      Iir_Kind_Last_Event_Attribute => 1644,
-      Iir_Kind_Last_Active_Attribute => 1648,
-      Iir_Kind_Last_Value_Attribute => 1652,
-      Iir_Kind_Driving_Attribute => 1656,
-      Iir_Kind_Driving_Value_Attribute => 1660,
-      Iir_Kind_Behavior_Attribute => 1660,
-      Iir_Kind_Structure_Attribute => 1660,
-      Iir_Kind_Simple_Name_Attribute => 1667,
-      Iir_Kind_Instance_Name_Attribute => 1672,
-      Iir_Kind_Path_Name_Attribute => 1677,
-      Iir_Kind_Left_Array_Attribute => 1684,
-      Iir_Kind_Right_Array_Attribute => 1691,
-      Iir_Kind_High_Array_Attribute => 1698,
-      Iir_Kind_Low_Array_Attribute => 1705,
-      Iir_Kind_Length_Array_Attribute => 1712,
-      Iir_Kind_Ascending_Array_Attribute => 1719,
-      Iir_Kind_Range_Array_Attribute => 1726,
-      Iir_Kind_Reverse_Range_Array_Attribute => 1733,
-      Iir_Kind_Attribute_Name => 1741
+      Iir_Kind_Case_Generate_Statement => 1312,
+      Iir_Kind_Component_Instantiation_Statement => 1322,
+      Iir_Kind_Simple_Simultaneous_Statement => 1329,
+      Iir_Kind_Generate_Statement_Body => 1340,
+      Iir_Kind_If_Generate_Else_Clause => 1345,
+      Iir_Kind_Simple_Signal_Assignment_Statement => 1354,
+      Iir_Kind_Conditional_Signal_Assignment_Statement => 1363,
+      Iir_Kind_Null_Statement => 1367,
+      Iir_Kind_Assertion_Statement => 1374,
+      Iir_Kind_Report_Statement => 1380,
+      Iir_Kind_Wait_Statement => 1387,
+      Iir_Kind_Variable_Assignment_Statement => 1393,
+      Iir_Kind_Conditional_Variable_Assignment_Statement => 1399,
+      Iir_Kind_Return_Statement => 1405,
+      Iir_Kind_For_Loop_Statement => 1414,
+      Iir_Kind_While_Loop_Statement => 1422,
+      Iir_Kind_Next_Statement => 1428,
+      Iir_Kind_Exit_Statement => 1434,
+      Iir_Kind_Case_Statement => 1442,
+      Iir_Kind_Procedure_Call_Statement => 1448,
+      Iir_Kind_If_Statement => 1457,
+      Iir_Kind_Elsif => 1462,
+      Iir_Kind_Character_Literal => 1469,
+      Iir_Kind_Simple_Name => 1476,
+      Iir_Kind_Selected_Name => 1484,
+      Iir_Kind_Operator_Symbol => 1489,
+      Iir_Kind_Selected_By_All_Name => 1494,
+      Iir_Kind_Parenthesis_Name => 1498,
+      Iir_Kind_External_Constant_Name => 1507,
+      Iir_Kind_External_Signal_Name => 1516,
+      Iir_Kind_External_Variable_Name => 1525,
+      Iir_Kind_Package_Pathname => 1528,
+      Iir_Kind_Absolute_Pathname => 1529,
+      Iir_Kind_Relative_Pathname => 1530,
+      Iir_Kind_Pathname_Element => 1534,
+      Iir_Kind_Base_Attribute => 1536,
+      Iir_Kind_Left_Type_Attribute => 1541,
+      Iir_Kind_Right_Type_Attribute => 1546,
+      Iir_Kind_High_Type_Attribute => 1551,
+      Iir_Kind_Low_Type_Attribute => 1556,
+      Iir_Kind_Ascending_Type_Attribute => 1561,
+      Iir_Kind_Image_Attribute => 1567,
+      Iir_Kind_Value_Attribute => 1573,
+      Iir_Kind_Pos_Attribute => 1579,
+      Iir_Kind_Val_Attribute => 1585,
+      Iir_Kind_Succ_Attribute => 1591,
+      Iir_Kind_Pred_Attribute => 1597,
+      Iir_Kind_Leftof_Attribute => 1603,
+      Iir_Kind_Rightof_Attribute => 1609,
+      Iir_Kind_Delayed_Attribute => 1617,
+      Iir_Kind_Stable_Attribute => 1625,
+      Iir_Kind_Quiet_Attribute => 1633,
+      Iir_Kind_Transaction_Attribute => 1641,
+      Iir_Kind_Event_Attribute => 1645,
+      Iir_Kind_Active_Attribute => 1649,
+      Iir_Kind_Last_Event_Attribute => 1653,
+      Iir_Kind_Last_Active_Attribute => 1657,
+      Iir_Kind_Last_Value_Attribute => 1661,
+      Iir_Kind_Driving_Attribute => 1665,
+      Iir_Kind_Driving_Value_Attribute => 1669,
+      Iir_Kind_Behavior_Attribute => 1669,
+      Iir_Kind_Structure_Attribute => 1669,
+      Iir_Kind_Simple_Name_Attribute => 1676,
+      Iir_Kind_Instance_Name_Attribute => 1681,
+      Iir_Kind_Path_Name_Attribute => 1686,
+      Iir_Kind_Left_Array_Attribute => 1693,
+      Iir_Kind_Right_Array_Attribute => 1700,
+      Iir_Kind_High_Array_Attribute => 1707,
+      Iir_Kind_Low_Array_Attribute => 1714,
+      Iir_Kind_Length_Array_Attribute => 1721,
+      Iir_Kind_Ascending_Array_Attribute => 1728,
+      Iir_Kind_Range_Array_Attribute => 1735,
+      Iir_Kind_Reverse_Range_Array_Attribute => 1742,
+      Iir_Kind_Attribute_Name => 1750
      );
 
    function Get_Fields (K : Iir_Kind) return Fields_Array
@@ -6789,6 +6802,7 @@ package body Nodes_Meta is
            | Iir_Kind_Block_Statement
            | Iir_Kind_If_Generate_Statement
            | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_Component_Instantiation_Statement
            | Iir_Kind_Simple_Simultaneous_Statement
            | Iir_Kind_Simple_Signal_Assignment_Statement
@@ -7520,6 +7534,7 @@ package body Nodes_Meta is
            | Iir_Kind_Block_Statement
            | Iir_Kind_If_Generate_Statement
            | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_Component_Instantiation_Statement
            | Iir_Kind_Simple_Simultaneous_Statement
            | Iir_Kind_Generate_Statement_Body
@@ -7568,6 +7583,7 @@ package body Nodes_Meta is
            | Iir_Kind_Block_Statement
            | Iir_Kind_If_Generate_Statement
            | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_Component_Instantiation_Statement
            | Iir_Kind_Simple_Simultaneous_Statement
            | Iir_Kind_Simple_Signal_Assignment_Statement
@@ -7647,6 +7663,7 @@ package body Nodes_Meta is
            | Iir_Kind_Block_Statement
            | Iir_Kind_If_Generate_Statement
            | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_Component_Instantiation_Statement
            | Iir_Kind_Simple_Simultaneous_Statement
            | Iir_Kind_If_Generate_Else_Clause
@@ -8392,6 +8409,7 @@ package body Nodes_Meta is
            | Iir_Kind_Type_Conversion
            | Iir_Kind_Allocator_By_Expression
            | Iir_Kind_Concurrent_Selected_Signal_Assignment
+           | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_Variable_Assignment_Statement
            | Iir_Kind_Return_Statement
            | Iir_Kind_Case_Statement =>
@@ -8621,6 +8639,7 @@ package body Nodes_Meta is
            | Iir_Kind_Block_Statement
            | Iir_Kind_If_Generate_Statement
            | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_Component_Instantiation_Statement
            | Iir_Kind_Simple_Simultaneous_Statement
            | Iir_Kind_Generate_Statement_Body
@@ -9312,7 +9331,13 @@ package body Nodes_Meta is
    function Has_Case_Statement_Alternative_Chain (K : Iir_Kind)
       return Boolean is
    begin
-      return K = Iir_Kind_Case_Statement;
+      case K is
+         when Iir_Kind_Case_Generate_Statement
+           | Iir_Kind_Case_Statement =>
+            return True;
+         when others =>
+            return False;
+      end case;
    end Has_Case_Statement_Alternative_Chain;
 
    function Has_Choice_Staticness (K : Iir_Kind) return Boolean is
@@ -9511,6 +9536,7 @@ package body Nodes_Meta is
            | Iir_Kind_Block_Statement
            | Iir_Kind_If_Generate_Statement
            | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_Generate_Statement_Body
            | Iir_Kind_For_Loop_Statement =>
             return True;
@@ -9627,7 +9653,8 @@ package body Nodes_Meta is
            | Iir_Kind_Process_Statement
            | Iir_Kind_Block_Statement
            | Iir_Kind_If_Generate_Statement
-           | Iir_Kind_For_Generate_Statement =>
+           | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement =>
             return True;
          when others =>
             return False;
@@ -9656,6 +9683,7 @@ package body Nodes_Meta is
            | Iir_Kind_Block_Statement
            | Iir_Kind_If_Generate_Statement
            | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement
            | Iir_Kind_Generate_Statement_Body
            | Iir_Kind_For_Loop_Statement
            | Iir_Kind_While_Loop_Statement
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 6e0998642..78d151224 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -6541,6 +6541,10 @@ package body Parse is
                if Get_Kind (Parent) = Iir_Kind_If_Generate_Statement then
                   return True;
                end if;
+            when Tok_When =>
+               if Get_Kind (Parent) = Iir_Kind_Case_Generate_Statement then
+                  return True;
+               end if;
             when others =>
                null;
          end case;
@@ -6863,6 +6867,133 @@ package body Parse is
       return Res;
    end Parse_If_Generate_Statement;
 
+   --  precond : WHEN
+   --  postcond: ?
+   --
+   --  [ LRM08 11.8 ]
+   --  case_generate_alternative ::=
+   --     WHEN [ /alternative/_label : ] choices =>
+   --        generate_statement_body
+   function Parse_Case_Generate_Alternative (Parent : Iir) return Iir
+   is
+      Loc : Location_Type;
+      Alt_Label : Name_Id;
+      Assoc : Iir;
+      Expr : Iir;
+   begin
+      Loc := Get_Token_Location;
+
+      --  Eat 'when'
+      Expect (Tok_When);
+      Scan;
+
+      Alt_Label := Null_Identifier;
+      if Current_Token = Tok_Double_Arrow then
+         Error_Msg_Parse ("missing expression in alternative");
+         Assoc := Create_Iir (Iir_Kind_Choice_By_Expression);
+         Set_Location (Assoc);
+      elsif Current_Token = Tok_Others then
+         --  'others' is not an expression!
+         Assoc := Parse_Choices (Null_Iir);
+      else
+         Expr := Parse_Expression;
+
+         if Current_Token = Tok_Colon then
+            if Get_Kind (Expr) = Iir_Kind_Simple_Name then
+               --  In fact the parsed condition was an alternate label.
+               Alt_Label := Get_Identifier (Expr);
+               Loc := Get_Location (Expr);
+               Free_Iir (Expr);
+            else
+               Error_Msg_Parse ("alternative label must be an identifier");
+               Free_Iir (Expr);
+            end if;
+
+            Expr := Null_Iir;
+
+            --  Skip ':'
+            Scan;
+         end if;
+
+         Assoc := Parse_Choices (Expr);
+      end if;
+
+      --  Set location of label (if any, for xref) or location of 'when'.
+      Set_Location (Assoc, Loc);
+
+      --  Eat '=>'
+      Expect (Tok_Double_Arrow);
+      Scan;
+
+      Set_Associated_Chain
+        (Assoc, Parse_Generate_Statement_Body (Parent, Alt_Label));
+
+      return Assoc;
+   end Parse_Case_Generate_Alternative;
+
+   --  precond : CASE
+   --  postcond: ';'
+   --
+   --  [ LRM08 11.8 ]
+   --  case_generate_statement ::=
+   --     /generate/_label :
+   --     CASE expression GENERATE
+   --        case_generate_alternative
+   --      { case_generate_alternative }
+   --     END GENERATE [ /generate/_label ] ;
+   function Parse_Case_Generate_Statement
+     (Label : Name_Id; Loc : Location_Type) return Iir
+   is
+      Res : Iir;
+      Alt : Iir;
+      Last_Alt : Iir;
+   begin
+      if Label = Null_Identifier then
+         Error_Msg_Parse ("a generate statement must have a label");
+      end if;
+      Res := Create_Iir (Iir_Kind_Case_Generate_Statement);
+      Set_Location (Res, Loc);
+      Set_Label (Res, Label);
+
+      --  Skip 'case'.
+      Scan;
+
+      Set_Expression (Res, Parse_Expression);
+
+      Expect (Tok_Generate);
+
+      --  Skip 'generate'
+      Scan;
+
+      if Current_Token = Tok_End then
+         Error_Msg_Parse ("no generate alternative");
+      end if;
+
+      Last_Alt := Null_Iir;
+      while Current_Token = Tok_When loop
+         Alt := Parse_Case_Generate_Alternative (Res);
+         if Last_Alt = Null_Iir then
+            Set_Case_Statement_Alternative_Chain (Res, Alt);
+         else
+            Set_Chain (Last_Alt, Alt);
+         end if;
+         Last_Alt := Alt;
+      end loop;
+
+      Expect (Tok_Generate);
+      Set_End_Has_Reserved_Id (Res, True);
+
+      --  Skip 'generate'
+      Scan;
+
+      --  LRM93 9.7
+      --  If a label appears at the end of a generate statement, it must repeat
+      --  the generate label.
+      Check_End_Name (Res);
+      Expect (Tok_Semi_Colon);
+      return Res;
+   end Parse_Case_Generate_Statement;
+
    --  precond : first token
    --  postcond: END
    --
@@ -7161,12 +7292,15 @@ package body Parse is
             when Tok_Block =>
                Postponed_Not_Allowed;
                Stmt := Parse_Block_Statement (Label, Loc);
+            when Tok_For =>
+               Postponed_Not_Allowed;
+               Stmt := Parse_For_Generate_Statement (Label, Loc);
             when Tok_If =>
                Postponed_Not_Allowed;
                Stmt := Parse_If_Generate_Statement (Label, Loc);
-            when Tok_For =>
+            when Tok_Case =>
                Postponed_Not_Allowed;
-               Stmt := Parse_For_Generate_Statement (Label, Loc);
+               Stmt := Parse_Case_Generate_Statement (Label, Loc);
             when Tok_Eof =>
                Error_Msg_Parse ("unexpected end of file, 'END;' expected");
                return;
diff --git a/src/vhdl/sem_expr.ads b/src/vhdl/sem_expr.ads
index b06ca3de7..04a909378 100644
--- a/src/vhdl/sem_expr.ads
+++ b/src/vhdl/sem_expr.ads
@@ -137,8 +137,9 @@ package Sem_Expr is
    --  literal is created.
    function Sem_Physical_Literal (Lit: Iir) return Iir;
 
-   --  CHOICES_LIST is a list of choices (none, expression, range, list or
-   --    others).
+   --  CHOICES_CHAIN is a chain of choices (none, expression, range or
+   --    others).  It is an in-out as it may be mutated (from expression to
+   --    range).
    --  If IS_SUB_RANGE is true, then SUB_TYPE may not be fully convered,
    --    otherwise, SUB_TYPE must be fully covered.
    --    This is used when the subtype of an aggregate must be determined.