sem_expr: refactoring for choices, add reorder_choices.

4 files changed, 81 insertions, 50 deletions

diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index 33b1f33b1..8cc5fbf74 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -876,7 +876,7 @@ package body Sem_Assocs is
    begin
       Chain := Get_Individual_Association_Chain (Assoc);
       Sem_Check_Continuous_Choices
-        (Chain, Index_Type, False, Get_Location (Assoc), Low, High);
+        (Chain, Index_Type, Low, High, Get_Location (Assoc), False, False);
       Set_Individual_Association_Chain (Assoc, Chain);
       if Dim < Nbr_Dims then
          El := Chain;
@@ -909,7 +909,7 @@ package body Sem_Assocs is
       end if;
       Chain := Get_Individual_Association_Chain (Assoc);
       Sem_Choices_Range
-        (Chain, Base_Index, True, False, Get_Location (Assoc), Low, High);
+        (Chain, Base_Index, Low, High, Get_Location (Assoc), True, False);
       Set_Individual_Association_Chain (Assoc, Chain);
       if Actual_Index = Null_Iir then
          declare
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 700a11ade..9a0aded79 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -2427,13 +2427,13 @@ package body Sem_Expr is
       Disc_Heap_Sort (Info.Nbr_Choices);
    end Sort_Discrete_Choices;
 
-   procedure Sem_Check_Continuous_Choices
-     (Choice_Chain : Iir;
-      Sub_Type : Iir;
-      Is_Sub_Range : Boolean;
-      Loc : Location_Type;
-      Low : out Iir;
-      High : out Iir)
+   procedure Sem_Check_Continuous_Choices (Choice_Chain : in out Iir;
+                                           Choice_Type : Iir;
+                                           Low : out Iir;
+                                           High : out Iir;
+                                           Loc : Location_Type;
+                                           Is_Sub_Range : Boolean;
+                                           Reorder_Choices : Boolean)
    is
       --  Nodes that can appear.
       Info : Choice_Info_Type;
@@ -2441,7 +2441,7 @@ package body Sem_Expr is
       Type_Has_Bounds : Boolean;
    begin
       --  Set TYPE_HAS_BOUNDS
-      case Get_Kind (Sub_Type) is
+      case Get_Kind (Choice_Type) is
          when Iir_Kind_Enumeration_Type_Definition
            | Iir_Kind_Enumeration_Subtype_Definition
            | Iir_Kind_Integer_Subtype_Definition =>
@@ -2449,12 +2449,12 @@ package body Sem_Expr is
          when Iir_Kind_Integer_Type_Definition =>
             Type_Has_Bounds := False;
          when others =>
-            Error_Kind ("sem_check_continuous_choices(3)", Sub_Type);
+            Error_Kind ("sem_check_continuous_choices(3)", Choice_Type);
       end case;
 
       --  Check the choices are within the bounds.
       if Type_Has_Bounds
-        and then Get_Type_Staticness (Sub_Type) = Locally
+        and then Get_Type_Staticness (Choice_Type) = Locally
       then
          declare
             Choice : Iir;
@@ -2470,12 +2470,12 @@ package body Sem_Expr is
                   when Iir_Kind_Choice_By_Expression =>
                      Expr := Get_Choice_Expression (Choice);
                      if Get_Expr_Staticness (Expr) = Locally then
-                        Ok := Eval_Is_In_Bound (Expr, Sub_Type);
+                        Ok := Eval_Is_In_Bound (Expr, Choice_Type);
                      end if;
                   when Iir_Kind_Choice_By_Range =>
                      Expr := Get_Choice_Range (Choice);
                      if Get_Expr_Staticness (Expr) = Locally then
-                        Ok := Eval_Is_Range_In_Bound (Expr, Sub_Type, True);
+                        Ok := Eval_Is_Range_In_Bound (Expr, Choice_Type, True);
                      end if;
                   when Iir_Kind_Choice_By_Others =>
                      null;
@@ -2537,13 +2537,13 @@ package body Sem_Expr is
          Pos_Max : Iir_Int64;
          E_Pos : Iir_Int64;
 
-         Bt : constant Iir := Get_Base_Type (Sub_Type);
+         Bt : constant Iir := Get_Base_Type (Choice_Type);
       begin
          if not Is_Sub_Range
-           and then Get_Type_Staticness (Sub_Type) = Locally
+           and then Get_Type_Staticness (Choice_Type) = Locally
            and then Type_Has_Bounds
          then
-            Get_Low_High_Limit (Get_Range_Constraint (Sub_Type), Lb, Hb);
+            Get_Low_High_Limit (Get_Range_Constraint (Choice_Type), Lb, Hb);
          else
             Lb := Low;
             Hb := High;
@@ -2593,16 +2593,43 @@ package body Sem_Expr is
          end if;
       end;
 
+      if Reorder_Choices then
+         --  First, set Associated_Expr and Associated_Chain for nodes with
+         --  the same alternative.
+         declare
+            Assoc_Expr : Iir;
+            Assoc_Chain : Iir;
+            Assoc : Iir;
+         begin
+            Assoc := Choice_Chain;
+            Choice_Chain := Assoc; -- For the warning.
+            Assoc_Expr := Null_Iir;
+            Assoc_Chain := Null_Iir;
+            while Assoc /= Null_Iir loop
+               if Get_Same_Alternative_Flag (Assoc) then
+                  Set_Is_Ref (Assoc, True);
+                  Set_Associated_Expr (Assoc, Assoc_Expr);
+                  Set_Associated_Chain (Assoc, Assoc_Chain);
+               else
+                  Set_Is_Ref (Assoc, False);
+                  Assoc_Expr := Get_Associated_Expr (Assoc);
+                  Assoc_Chain := Get_Associated_Chain (Assoc);
+               end if;
+               Assoc := Get_Chain (Assoc);
+            end loop;
+         end;
+      end if;
+
       Free (Info.Arr);
    end Sem_Check_Continuous_Choices;
 
    procedure Sem_Choices_Range (Choice_Chain : in out Iir;
-                                Sub_Type : Iir;
-                                Is_Sub_Range : Boolean;
-                                Is_Case_Stmt : Boolean;
-                                Loc : Location_Type;
+                                Choice_Type : Iir;
                                 Low : out Iir;
-                                High : out Iir)
+                                High : out Iir;
+                                Loc : Location_Type;
+                                Is_Sub_Range : Boolean;
+                                Is_Case_Stmt : Boolean)
    is
       --  Number of positionnal choice.
       Nbr_Pos : Iir_Int64;
@@ -2631,8 +2658,9 @@ package body Sem_Expr is
          N_Choice : Iir;
          Name1 : Iir;
       begin
-         if Are_Types_Compatible (Range_Type, Sub_Type) = Not_Compatible then
-            Error_Not_Match (Name, Sub_Type);
+         if Are_Types_Compatible (Range_Type, Choice_Type) = Not_Compatible
+         then
+            Error_Not_Match (Name, Choice_Type);
             return False;
          end if;
 
@@ -2666,7 +2694,7 @@ package body Sem_Expr is
       begin
          if Get_Kind (El) = Iir_Kind_Choice_By_Range then
             Expr := Get_Choice_Range (El);
-            Expr := Sem_Discrete_Range_Expression (Expr, Sub_Type, True);
+            Expr := Sem_Discrete_Range_Expression (Expr, Choice_Type, True);
             if Expr = Null_Iir then
                return False;
             end if;
@@ -2701,10 +2729,11 @@ package body Sem_Expr is
                         return Replace_By_Range_Choice (Expr, Ent);
                      when others =>
                         Expr := Name_To_Expression
-                          (Expr, Get_Base_Type (Sub_Type));
+                          (Expr, Get_Base_Type (Choice_Type));
                   end case;
                when others =>
-                  Expr := Sem_Expression_Ov (Expr, Get_Base_Type (Sub_Type));
+                  Expr :=
+                    Sem_Expression_Ov (Expr, Get_Base_Type (Choice_Type));
             end case;
             if Expr = Null_Iir then
                return False;
@@ -2787,10 +2816,10 @@ package body Sem_Expr is
       --  For a positional aggregate.
       if Nbr_Pos > 0 then
          --  Check number of elements match, but only if it is possible.
-         if Get_Type_Staticness (Sub_Type) /= Locally then
+         if Get_Type_Staticness (Choice_Type) /= Locally then
             return;
          end if;
-         Pos_Max := Eval_Discrete_Type_Length (Sub_Type);
+         Pos_Max := Eval_Discrete_Type_Length (Choice_Type);
          if (not Has_Others and not Is_Sub_Range)
            and then Nbr_Pos < Pos_Max
          then
@@ -2825,8 +2854,8 @@ package body Sem_Expr is
          return;
       end if;
 
-      Sem_Check_Continuous_Choices
-        (Choice_Chain, Sub_Type, Is_Sub_Range, Loc, Low, High);
+      Sem_Check_Continuous_Choices (Choice_Chain, Choice_Type, Low, High, Loc,
+                                    Is_Sub_Range, not Is_Case_Stmt);
    end Sem_Choices_Range;
 
    -- Perform semantisation on a (sub)aggregate AGGR, which is of type
@@ -3315,8 +3344,8 @@ package body Sem_Expr is
       case Get_Kind (Aggr) is
          when Iir_Kind_Aggregate =>
             Assoc_Chain := Get_Association_Choices_Chain (Aggr);
-            Sem_Choices_Range (Assoc_Chain, Index_Type, not Constrained, False,
-                               Get_Location (Aggr), Low, High);
+            Sem_Choices_Range (Assoc_Chain, Index_Type, Low, High,
+                               Get_Location (Aggr), not Constrained, False);
             Set_Association_Choices_Chain (Aggr, Assoc_Chain);
 
             --  Update infos.
diff --git a/src/vhdl/sem_expr.ads b/src/vhdl/sem_expr.ads
index 4f1a9d70e..5c976ac72 100644
--- a/src/vhdl/sem_expr.ads
+++ b/src/vhdl/sem_expr.ads
@@ -191,27 +191,27 @@ package Sem_Expr is
    --  TODO:
    --  * be smarter if only positional choices (do not create the list).
    --  * smarter messages.
-   procedure Sem_Choices_Range
-     (Choice_Chain : in out Iir;
-      Sub_Type : Iir;
-      Is_Sub_Range : Boolean;
-      Is_Case_Stmt : Boolean;
-      Loc : Location_Type;
-      Low : out Iir;
-      High : out Iir);
+   procedure Sem_Choices_Range (Choice_Chain : in out Iir;
+                                Choice_Type : Iir;
+                                Low : out Iir;
+                                High : out Iir;
+                                Loc : Location_Type;
+                                Is_Sub_Range : Boolean;
+                                Is_Case_Stmt : Boolean);
 
    --  Check that the values of CHOICE_CHAIN are a continuous range, and
    --  extract the lower LOW and upper HIGH bound (useful to create the
    --  corresponding subtype).  The values must be of type SUB_TYPE, and if
    --  IS_SUB_RANGE True, they must be within SUB_TYPE.
    --  The choices must be locally static.
-   procedure Sem_Check_Continuous_Choices
-     (Choice_Chain : Iir;
-      Sub_Type : Iir;
-      Is_Sub_Range : Boolean;
-      Loc : Location_Type;
-      Low : out Iir;
-      High : out Iir);
+   --  If REORDER_CHOICES is true, CHOICE_CHAIN is ordered.
+   procedure Sem_Check_Continuous_Choices (Choice_Chain : in out Iir;
+                                           Choice_Type : Iir;
+                                           Low : out Iir;
+                                           High : out Iir;
+                                           Loc : Location_Type;
+                                           Is_Sub_Range : Boolean;
+                                           Reorder_Choices : Boolean);
 
    --  Analyze CHOICE_LIST when the choice expression SEL is of a
    --  one-dimensional character array type.
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index 79e5d2e31..1d33ad7fc 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -1067,7 +1067,7 @@ package body Sem_Stmts is
       case Get_Kind (Choice_Type) is
          when Iir_Kinds_Discrete_Type_Definition =>
             Sem_Choices_Range
-              (Chain, Choice_Type, False, True, Loc, Low, High);
+              (Chain, Choice_Type, Low, High, Loc, False, True);
          when Iir_Kind_Array_Subtype_Definition
            | Iir_Kind_Array_Type_Definition =>
             if not Is_One_Dimensional_Array_Type (Choice_Type) then
@@ -1119,7 +1119,9 @@ package body Sem_Stmts is
 
       El := Chain;
       while El /= Null_Iir loop
-         Sem_Sequential_Statements_Internal (Get_Associated_Chain (El));
+         if not Get_Same_Alternative_Flag (El) then
+            Sem_Sequential_Statements_Internal (Get_Associated_Chain (El));
+         end if;
          El := Get_Chain (El);
       end loop;
    end Sem_Case_Statement;