vhdl: handle subtype indication (with range) in discrete_range.

For #877

7 files changed, 105 insertions, 63 deletions

diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 8fbd8d105..521e639e7 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -1758,6 +1758,7 @@ package body Trans.Chap8 is
                H, L : Iir;
             begin
                Expr := Get_Choice_Range (Choice);
+               Expr := Get_Range_From_Discrete_Range (Expr);
                Get_Low_High_Limit (Expr, L, H);
                New_Range_Choice
                  (Blk,
diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb
index 491d14b85..7e15589df 100644
--- a/src/vhdl/vhdl-parse.adb
+++ b/src/vhdl/vhdl-parse.adb
@@ -5152,6 +5152,9 @@ package body Vhdl.Parse is
       elsif Current_Token = Tok_To or else Current_Token = Tok_Downto then
          A_Choice := Create_Iir (Iir_Kind_Choice_By_Range);
          Set_Choice_Range (A_Choice, Parse_Range_Expression (Expr1));
+      elsif Current_Token = Tok_Range then
+         A_Choice := Create_Iir (Iir_Kind_Choice_By_Range);
+         Set_Choice_Range (A_Choice, Parse_Subtype_Indication (Expr1));
       else
          A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression);
          Set_Choice_Expression (A_Choice, Expr1);
diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb
index f706ccb86..83e08ee1c 100644
--- a/src/vhdl/vhdl-prints.adb
+++ b/src/vhdl/vhdl-prints.adb
@@ -3599,6 +3599,8 @@ package body Vhdl.Prints is
 
          when Iir_Kind_Range_Expression =>
             Disp_Range (Ctxt, Expr);
+         when Iir_Kind_Subtype_Definition =>
+            Disp_Subtype_Indication (Ctxt, Expr);
 
          when Iir_Kind_Selected_By_All_Name
            | Iir_Kind_Dereference =>
diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb
index 90db825b5..418d3534f 100644
--- a/src/vhdl/vhdl-sem_expr.adb
+++ b/src/vhdl/vhdl-sem_expr.adb
@@ -2150,7 +2150,6 @@ package body Vhdl.Sem_Expr is
                             Choice_Chain : Iir)
    is
       Choice : Iir;
-      S : Iir_Staticness;
    begin
       Info := (Nbr_Choices => 0,
                Nbr_Alternatives => 0,
@@ -2160,16 +2159,9 @@ package body Vhdl.Sem_Expr is
       Choice := Choice_Chain;
       while Is_Valid (Choice) loop
          case Iir_Kinds_Case_Choice (Get_Kind (Choice)) is
-            when Iir_Kind_Choice_By_Expression =>
-               S := Get_Expr_Staticness (Get_Choice_Expression (Choice));
-               pragma Assert (S = Get_Choice_Staticness (Choice));
-               if S = Locally then
-                  Info.Nbr_Choices := Info.Nbr_Choices + 1;
-               end if;
-            when Iir_Kind_Choice_By_Range =>
-               S := Get_Expr_Staticness (Get_Choice_Range (Choice));
-               pragma Assert (S = Get_Choice_Staticness (Choice));
-               if S = Locally then
+            when Iir_Kind_Choice_By_Expression
+              | Iir_Kind_Choice_By_Range =>
+               if Get_Choice_Staticness (Choice) = Locally then
                   Info.Nbr_Choices := Info.Nbr_Choices + 1;
                end if;
             when Iir_Kind_Choice_By_Others =>
@@ -2200,6 +2192,7 @@ package body Vhdl.Sem_Expr is
                Expr := Get_Choice_Expression (Choice);
             when Iir_Kind_Choice_By_Range =>
                Expr := Get_Choice_Range (Choice);
+               Expr := Get_Range_From_Discrete_Range (Expr);
             when Iir_Kind_Choice_By_Others =>
                Expr := Null_Iir;
          end case;
@@ -2452,6 +2445,7 @@ package body Vhdl.Sem_Expr is
             return Get_Choice_Expression (Assoc);
          when Iir_Kind_Choice_By_Range =>
             Expr := Get_Choice_Range (Assoc);
+            Expr := Get_Range_From_Discrete_Range (Expr);
             case Get_Kind (Expr) is
                when Iir_Kind_Range_Expression =>
                   return Get_Low_Limit (Expr);
@@ -2472,6 +2466,7 @@ package body Vhdl.Sem_Expr is
             return Get_Choice_Expression (Assoc);
          when Iir_Kind_Choice_By_Range =>
             Expr := Get_Choice_Range (Assoc);
+            Expr := Get_Range_From_Discrete_Range (Expr);
             case Get_Kind (Expr) is
                when Iir_Kind_Range_Expression =>
                   return Get_High_Limit (Expr);
@@ -2550,6 +2545,7 @@ package body Vhdl.Sem_Expr is
                      end if;
                   when Iir_Kind_Choice_By_Range =>
                      Expr := Get_Choice_Range (Choice);
+                     Expr := Get_Range_From_Discrete_Range (Expr);
                      if Get_Expr_Staticness (Expr) = Locally then
                         Ok := Eval_Is_Range_In_Bound (Expr, Choice_Type, True);
                      end if;
@@ -2778,7 +2774,17 @@ package body Vhdl.Sem_Expr is
             if Expr = Null_Iir then
                return False;
             end if;
-            Expr := Eval_Range_If_Static (Expr);
+            case Get_Kind (Expr) is
+               when Iir_Kind_Range_Expression
+                 | Iir_Kinds_Range_Attribute
+                 | Iir_Kinds_Denoting_Name =>
+                  Expr := Eval_Range_If_Static (Expr);
+                  Set_Choice_Staticness (El, Get_Expr_Staticness (Expr));
+               when Iir_Kinds_Scalar_Subtype_Definition =>
+                  Set_Choice_Staticness (El, Get_Type_Staticness (Expr));
+               when others =>
+                  Error_Kind ("sem_sime_choice(1)", Expr);
+            end case;
             Set_Choice_Range (El, Expr);
          else
             Expr := Get_Choice_Expression (El);
@@ -2820,8 +2826,8 @@ package body Vhdl.Sem_Expr is
             end if;
             Expr := Eval_Expr_If_Static (Expr);
             Set_Choice_Expression (El, Expr);
+            Set_Choice_Staticness (El, Get_Expr_Staticness (Expr));
          end if;
-         Set_Choice_Staticness (El, Get_Expr_Staticness (Expr));
          return True;
       end Sem_Simple_Choice;
    begin
diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb
index 6cbea6f83..034a9f5f3 100644
--- a/src/vhdl/vhdl-sem_names.adb
+++ b/src/vhdl/vhdl-sem_names.adb
@@ -753,10 +753,8 @@ package body Vhdl.Sem_Names is
       case Get_Kind (Suffix) is
          when Iir_Kind_Simple_Name
            | Iir_Kind_Selected_Name =>
-            --  FIXME: what about the name ?
-            Suffix := Get_Type (Suffix);
-            Staticness := Get_Type_Staticness (Suffix);
-            Suffix_Rng := Get_Range_Constraint (Suffix);
+            Staticness := Get_Type_Staticness (Get_Type (Suffix));
+            Suffix_Rng := Get_Range_Constraint (Get_Type (Suffix));
          when Iir_Kinds_Scalar_Subtype_Definition =>
             Staticness := Get_Type_Staticness (Suffix);
             Suffix_Rng := Get_Range_Constraint (Suffix);
@@ -799,37 +797,47 @@ package body Vhdl.Sem_Names is
       Set_Name_Staticness
         (Name, Min (Staticness, Get_Name_Staticness (Prefix)));
 
+      Expr_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition);
+      Set_Location (Expr_Type, Get_Location (Suffix));
+
       --  The type of the slice is a subtype of the base type whose
       --  range contraint is the slice itself.
-      if Get_Kind (Suffix) in Iir_Kinds_Discrete_Type_Definition then
-         Slice_Type := Suffix;
-      else
-         case Get_Kind (Get_Base_Type (Index_Type)) is
-            when Iir_Kind_Integer_Type_Definition =>
-               Slice_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition);
-            when Iir_Kind_Enumeration_Type_Definition =>
-               Slice_Type :=
-                 Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
-            when others =>
-               Error_Kind ("sem_expr: slice_name", Get_Base_Type (Index_Type));
-         end case;
-         Set_Range_Constraint (Slice_Type, Suffix);
-         Set_Is_Ref (Slice_Type, True);
-         Set_Type_Staticness (Slice_Type, Staticness);
-         Set_Base_Type (Slice_Type, Get_Base_Type (Index_Type));
-         Set_Location (Slice_Type, Get_Location (Suffix));
-      end if;
+      case Get_Kind (Suffix) is
+         when Iir_Kinds_Denoting_Name =>
+            Slice_Type := Get_Type (Suffix);
+         when Iir_Kinds_Scalar_Subtype_Definition =>
+            Slice_Type := Suffix;
+         when others =>
+            case Get_Kind (Get_Base_Type (Index_Type)) is
+               when Iir_Kind_Integer_Type_Definition =>
+                  Slice_Type :=
+                    Create_Iir (Iir_Kind_Integer_Subtype_Definition);
+               when Iir_Kind_Enumeration_Type_Definition =>
+                  Slice_Type :=
+                    Create_Iir (Iir_Kind_Enumeration_Subtype_Definition);
+               when others =>
+                  Error_Kind
+                    ("sem_expr: slice_name", Get_Base_Type (Index_Type));
+            end case;
+            Set_Range_Constraint (Slice_Type, Suffix_Rng);
+            Set_Is_Ref (Slice_Type, True);
+            Set_Type_Staticness (Slice_Type, Staticness);
+            Set_Base_Type (Slice_Type, Get_Base_Type (Index_Type));
+            Set_Location (Slice_Type, Get_Location (Suffix));
+
+            --  Attach the new index subtype to the array subtype.
+            Index_List := Create_Iir_Flist (1);
+            Set_Index_Constraint_List (Expr_Type, Index_List);
+            Set_Nth_Element (Index_List, 0, Slice_Type);
+      end case;
 
-      Expr_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition);
-      Set_Location (Expr_Type, Get_Location (Suffix));
-      Set_Index_Subtype_List (Expr_Type, Create_Iir_Flist (1));
-      Set_Index_Constraint_List (Expr_Type,
-                                 Get_Index_Subtype_List (Expr_Type));
+      Index_List := Create_Iir_Flist (1);
+      Set_Index_Subtype_List (Expr_Type, Index_List);
+      Set_Nth_Element (Index_List, 0, Slice_Type);
       Prefix_Base_Type := Get_Base_Type (Prefix_Type);
       Set_Base_Type (Expr_Type, Prefix_Base_Type);
       Set_Signal_Type_Flag (Expr_Type,
                             Get_Signal_Type_Flag (Prefix_Base_Type));
-      Set_Nth_Element (Get_Index_Subtype_List (Expr_Type), 0, Slice_Type);
       Set_Element_Subtype (Expr_Type, Get_Element_Subtype (Prefix_Type));
       if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition then
          Set_Resolution_Indication
@@ -2383,6 +2391,9 @@ package body Vhdl.Sem_Names is
             Kind := Slice_Or_Index (Get_Named_Entity (Actual));
             --  FIXME: analyze to be finished.
             --Maybe_Finish_Sem_Name (Actual);
+         when Iir_Kind_Subtype_Definition
+           | Iir_Kind_Range_Expression =>
+            Kind := Iir_Kind_Slice_Name;
          when others =>
             Kind := Slice_Or_Index (Actual);
       end case;
@@ -2406,10 +2417,11 @@ package body Vhdl.Sem_Names is
             if Actual = Null_Iir then
                return Null_Iir;
             end if;
+            Set_Suffix (Res, Actual);
+            Actual := Get_Range_From_Discrete_Range (Actual);
             if Get_Expr_Staticness (Actual) < Globally then
                Error_Msg_Sem (+Name, "index must be a static expression");
             end if;
-            Set_Suffix (Res, Actual);
          when others =>
             raise Internal_Error;
       end case;
@@ -2647,27 +2659,26 @@ package body Vhdl.Sem_Names is
       Actual_Expr := Null_Iir;
       if Actual /= Null_Iir then
          --  Only one actual: can be a slice or an index
-         if Get_Kind (Actual) in Iir_Kinds_Name
-           or else Get_Kind (Actual) = Iir_Kind_Attribute_Name
-         then
-            --  Maybe a discrete range name.
-            Sem_Name (Actual);
-            Actual_Expr := Get_Named_Entity (Actual);
-            if Actual_Expr = Error_Mark then
-               Set_Named_Entity (Name, Actual_Expr);
-               return;
-            end if;
-            --  Decides between sliced or indexed name to actual.
-            Slice_Index_Kind := Slice_Or_Index (Actual_Expr);
-         elsif Get_Kind (Actual) = Iir_Kind_Range_Expression
-           or else Get_Kind (Actual) = Iir_Kind_Subtype_Definition
-         then
-            --  This can only be a slice.
-            Slice_Index_Kind := Iir_Kind_Slice_Name;
-         else
-            --  Any other expression: an indexed name.
-            Slice_Index_Kind := Iir_Kind_Indexed_Name;
-         end if;
+         case Get_Kind (Actual) is
+            when Iir_Kinds_Name
+              | Iir_Kind_Attribute_Name =>
+               --  Maybe a discrete range name.
+               Sem_Name (Actual);
+               Actual_Expr := Get_Named_Entity (Actual);
+               if Actual_Expr = Error_Mark then
+                  Set_Named_Entity (Name, Actual_Expr);
+                  return;
+               end if;
+               --  Decides between sliced or indexed name to actual.
+               Slice_Index_Kind := Slice_Or_Index (Actual_Expr);
+            when Iir_Kind_Range_Expression
+              | Iir_Kind_Subtype_Definition =>
+               --  This can only be a slice.
+               Slice_Index_Kind := Iir_Kind_Slice_Name;
+            when others =>
+               --  Any other expression: an indexed name.
+               Slice_Index_Kind := Iir_Kind_Indexed_Name;
+         end case;
       else
          --  More than one actual: an indexed name.
 
diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb
index 1c0a39b4a..6653034a5 100644
--- a/src/vhdl/vhdl-utils.adb
+++ b/src/vhdl/vhdl-utils.adb
@@ -1436,6 +1436,22 @@ package body Vhdl.Utils is
       return Id = Name_Range or Id = Name_Reverse_Range;
    end Is_Range_Attribute_Name;
 
+   function Get_Range_From_Discrete_Range (Rng : Iir) return Iir is
+   begin
+      case Get_Kind (Rng) is
+         when Iir_Kinds_Denoting_Name =>
+            return Get_Range_From_Discrete_Range (Get_Named_Entity (Rng));
+         when Iir_Kinds_Scalar_Subtype_Definition =>
+            return Get_Range_Constraint (Rng);
+         when Iir_Kind_Range_Expression =>
+            return Rng;
+         when Iir_Kinds_Range_Attribute =>
+            return Rng;
+         when others =>
+            Error_Kind ("get_range_from_discrete_range", Rng);
+      end case;
+   end Get_Range_From_Discrete_Range;
+
    function Create_Array_Subtype (Arr_Type : Iir; Loc : Location_Type)
      return Iir_Array_Subtype_Definition
    is
diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads
index e80135f04..af4bc65d1 100644
--- a/src/vhdl/vhdl-utils.ads
+++ b/src/vhdl/vhdl-utils.ads
@@ -310,6 +310,9 @@ package Vhdl.Utils is
    --  Return TRUE iff unanalyzed EXPR is a range attribute.
    function Is_Range_Attribute_Name (Expr : Iir) return Boolean;
 
+   --  Return range_expression or a range attribute from discrete range RNG.
+   function Get_Range_From_Discrete_Range (Rng : Iir) return Iir;
+
    --  Create an array subtype from array_type or array_subtype ARR_TYPE.
    --  All fields of the returned node are filled, except the index_list.
    --  The type_staticness is set with the type staticness of the element