diff mbox

[Ada] Clean up of index usage in string literal subtypes

Message ID 20120426095358.GA8395@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet April 26, 2012, 9:53 a.m. UTC 
This patch adds code to retrieve the index type of a string literal. Since
string literals do not use attribute First_Index, the proper index type is
obtained from their low bound. No changes in compiler behavior.

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-04-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb, einfo.ads: Remove synthesized attribute
	Proper_First_Index along with its associations in various nodes.
	(Proper_First_Index): Removed.
	* sem_ch4.adb (Analyze_Slice): Alphabetize constants. Add new
	local variable Index_Type. The index type of a string literal
	subtype is that of the stored low bound.
	* sem_eval (Get_Static_Length): Remove the use of Proper_First_Index.
	* sem_res.adb (Resolve_Slice): Alphabetize constants. Add
	new local variable Index_Type. The index type of a
	string literal subtype is that of the stored low bound.
	(Set_String_Literal_Subtype): Code reformatting.
diff mbox

Patch

Index: einfo.adb
===================================================================
--- einfo.adb	(revision 186866)
+++ einfo.adb	(working copy)
@@ -6456,26 +6456,6 @@ 
                 and then Present (Prival_Link (Id)));
    end Is_Prival;
 
-   ------------------------
-   -- Proper_First_Index --
-   ------------------------
-
-   function Proper_First_Index (Id : E) return E is
-      Typ : Entity_Id;
-
-   begin
-      Typ := Id;
-
-      --  The First_Index field is always empty for string literals, use the
-      --  base type instead.
-
-      if Ekind (Typ) = E_String_Literal_Subtype then
-         Typ := Base_Type (Typ);
-      end if;
-
-      return First_Index (Typ);
-   end Proper_First_Index;
-
    ----------------------------
    -- Is_Protected_Component --
    ----------------------------
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 186866)
+++ einfo.ads	(working copy)
@@ -3393,11 +3393,6 @@ 
 --       in the shadow entity, it points to the proper location in which to
 --       restore the private view saved in the shadow.
 
---    Proper_First_Index (synthesized)
---       Applies to array types and subtypes. Returns the First_Index of the
---       type unless it is a string literal. In that case, the First_Index is
---       obtained from the base type.
-
 --    Protected_Formal (Node22)
 --       Present in formal parameters (in, in out and out parameters). Used
 --       only for formals of protected operations. References corresponding
@@ -5031,7 +5026,6 @@ 
    --    Is_Constrained                      (Flag12)
    --    Next_Index                          (synth)
    --    Number_Dimensions                   (synth)
-   --    Proper_First_Index                  (synth)
    --    (plus type attributes)
 
    --  E_Block
@@ -5694,7 +5688,6 @@ 
    --    Is_Constrained                      (Flag12)
    --    Next_Index                          (synth)
    --    Number_Dimensions                   (synth)
-   --    Proper_First_Index                  (synth)
    --    (plus type attributes)
 
    --  E_String_Literal_Subtype
@@ -5702,7 +5695,6 @@ 
    --    String_Literal_Length               (Uint16)
    --    First_Index                         (Node17)   (always Empty)
    --    Packed_Array_Type                   (Node23)
-   --    Proper_First_Index                  (synth)
    --    (plus type attributes)
 
    --  E_Subprogram_Body
@@ -6540,7 +6532,6 @@ 
    function Number_Formals                      (Id : E) return Pos;
    function Parameter_Mode                      (Id : E) return Formal_Kind;
    function Primitive_Operations                (Id : E) return L;
-   function Proper_First_Index                  (Id : E) return E;
    function Root_Type                           (Id : E) return E;
    function Safe_Emax_Value                     (Id : E) return U;
    function Safe_First_Value                    (Id : E) return R;
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 186860)
+++ sem_res.adb	(working copy)
@@ -8880,10 +8880,10 @@ 
    -------------------
 
    procedure Resolve_Slice (N : Node_Id; Typ : Entity_Id) is
+      Drange     : constant Node_Id := Discrete_Range (N);
       Name       : constant Node_Id := Prefix (N);
-      Drange     : constant Node_Id := Discrete_Range (N);
       Array_Type : Entity_Id        := Empty;
-      Index      : Node_Id;
+      Index_Type : Entity_Id;
 
    begin
       if Is_Overloaded (Name) then
@@ -9003,9 +9003,14 @@ 
       --  necessary. Else resolve the bounds, and apply needed checks.
 
       if not Is_Entity_Name (Drange) then
-         Index := Proper_First_Index (Array_Type);
-         Resolve (Drange, Base_Type (Etype (Index)));
+         if Ekind (Array_Type) = E_String_Literal_Subtype then
+            Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
+         else
+            Index_Type := Etype (First_Index (Array_Type));
+         end if;
 
+         Resolve (Drange, Base_Type (Index_Type));
+
          if Nkind (Drange) = N_Range then
 
             --  Ensure that side effects in the bounds are properly handled
@@ -9026,7 +9031,7 @@ 
                   and then Entity (Selector_Name (Prefix (N))) =
                                          RTE_Record_Component (RE_Prims_Ptr))
             then
-               Apply_Range_Check (Drange, Etype (Index));
+               Apply_Range_Check (Drange, Index_Type);
             end if;
          end if;
       end if;
@@ -10119,26 +10124,24 @@ 
       Set_Is_Constrained (Subtype_Id);
       Set_Etype          (N, Subtype_Id);
 
-      if Is_OK_Static_Expression (Low_Bound) then
-
       --  The low bound is set from the low bound of the corresponding index
       --  type. Note that we do not store the high bound in the string literal
       --  subtype, but it can be deduced if necessary from the length and the
       --  low bound.
 
+      if Is_OK_Static_Expression (Low_Bound) then
          Set_String_Literal_Low_Bound (Subtype_Id, Low_Bound);
 
+      --  If the lower bound is not static we create a range for the string
+      --  literal, using the index type and the known length of the literal.
+      --  The index type is not necessarily Positive, so the upper bound is
+      --  computed as T'Val (T'Pos (Low_Bound) + L - 1).
+
       else
-         --  If the lower bound is not static we create a range for the string
-         --  literal, using the index type and the known length of the literal.
-         --  The index type is not necessarily Positive, so the upper bound is
-         --  computed as  T'Val (T'Pos (Low_Bound) + L - 1)
-
          declare
-            Index_List    : constant List_Id    := New_List;
-            Index_Type    : constant Entity_Id := Etype (First_Index (Typ));
-
-            High_Bound : constant Node_Id :=
+            Index_List : constant List_Id   := New_List;
+            Index_Type : constant Entity_Id := Etype (First_Index (Typ));
+            High_Bound : constant Node_Id   :=
                            Make_Attribute_Reference (Loc,
                              Attribute_Name => Name_Val,
                              Prefix         =>
@@ -10157,9 +10160,9 @@ 
                                      String_Length (Strval (N)) - 1))));
 
             Array_Subtype : Entity_Id;
-            Index_Subtype : Entity_Id;
             Drange        : Node_Id;
             Index         : Node_Id;
+            Index_Subtype : Entity_Id;
 
          begin
             if Is_Integer_Type (Index_Type) then
@@ -10214,7 +10217,7 @@ 
             Rewrite (N,
               Make_Unchecked_Type_Conversion (Loc,
                 Subtype_Mark => New_Occurrence_Of (Array_Subtype, Loc),
-                Expression => Relocate_Node (N)));
+                Expression   => Relocate_Node (N)));
             Set_Etype (N, Array_Subtype);
          end;
       end if;
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 186860)
+++ sem_ch4.adb	(working copy)
@@ -4440,9 +4440,10 @@ 
    -------------------
 
    procedure Analyze_Slice (N : Node_Id) is
+      D          : constant Node_Id := Discrete_Range (N);
       P          : constant Node_Id := Prefix (N);
-      D          : constant Node_Id := Discrete_Range (N);
       Array_Type : Entity_Id;
+      Index_Type : Entity_Id;
 
       procedure Analyze_Overloaded_Slice;
       --  If the prefix is overloaded, select those interpretations that
@@ -4513,13 +4514,18 @@ 
             Error_Msg_N
               ("type is not one-dimensional array in slice prefix", N);
 
-         elsif not
-           Has_Compatible_Type (D, Etype (Proper_First_Index (Array_Type)))
-         then
-            Wrong_Type (D, Etype (Proper_First_Index (Array_Type)));
+         else
+            if Ekind (Array_Type) = E_String_Literal_Subtype then
+               Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
+            else
+               Index_Type := Etype (First_Index (Array_Type));
+            end if;
 
-         else
-            Set_Etype (N, Array_Type);
+            if not Has_Compatible_Type (D, Index_Type) then
+               Wrong_Type (D, Index_Type);
+            else
+               Set_Etype (N, Array_Type);
+            end if;
          end if;
       end if;
    end Analyze_Slice;
Index: sem_eval.adb
===================================================================
--- sem_eval.adb	(revision 186860)
+++ sem_eval.adb	(working copy)
@@ -554,7 +554,7 @@ 
                if Attribute_Name (N) = Name_First then
                   return String_Literal_Low_Bound (Xtyp);
 
-               else         -- Attribute_Name (N) = Name_Last
+               else
                   return Make_Integer_Literal (Sloc (N),
                     Intval => Intval (String_Literal_Low_Bound (Xtyp))
                                 + String_Literal_Length (Xtyp));
@@ -2747,7 +2747,7 @@ 
 
                --  General case
 
-               T := Etype (Proper_First_Index (Etype (Op)));
+               T := Etype (First_Index (Etype (Op)));
 
                --  The simple case, both bounds are known at compile time