[Ada] Enhance constraints propagation to ease the work of optimizers

This patch recognizes additional object declarations whose defining
identifier is known statically to be valid. This allows additional
optimizations to be performed by the front-end.

Executing:

   gcc -c -gnatDG p.ads

On the following sources:

----
with G;
With Q;

package P is

  Val : constant Positive := Q.Config_Value ("Size");

  package My_G is new G (Val);

end P;
----
generic

  Num : Natural := 0;

package G is

  Multi : constant Boolean := Num > 0;

  type Info is array (True .. Multi) of Integer;

  type Arr is array (Natural range <>) of Boolean;

  type Rec (D : Natural) is record
    C : character;
    I : Info;
    E : Arr (0 .. D);
  end record;

end G;
----
package Q is

  function Config_Value (S : String) return Integer;

end Q;
----

Must yield (note that variable Multi has been statically optimized to
true):

----
with g;
with q;
p_E : short_integer := 0;

package p is
   p__R2s : constant integer := q.q__config_value ("Size");
   [constraint_error when
     not (p__R2s >= 1)
     "range check failed"]
   p__val : constant positive := p__R2s;

   package p__my_g is
      p__my_g__num : constant natural := p__val;
      package p__my_g__g renames p__my_g;
      package p__my_g__gGH renames p__my_g__g;
      p__my_g__multi : constant boolean := true;
      type p__my_g__info is array (true .. p__my_g__multi) of integer;
      type p__my_g__arr is array (0 .. 16#7FFF_FFFF# range <>) of
        boolean;
      type p__my_g__rec (d : natural) is record
         c : character;
         i : p__my_g__info;
         e : p__my_g__arr (0 .. d);
      end record;
      [type p__my_g__TinfoB is array (true .. p__my_g__multi range <>) of
        integer]
      freeze p__my_g__TinfoB [
         procedure p__my_g__TinfoBIP (_init : in out p__my_g__TinfoB) is
         begin
            null;
            return;
         end p__my_g__TinfoBIP;
      ]
      freeze p__my_g__info []
      freeze p__my_g__arr [
         procedure p__my_g__arrIP (_init : in out p__my_g__arr) is
         begin
            null;
            return;
         end p__my_g__arrIP;
      ]
      freeze p__my_g__rec [
         procedure p__my_g__recIP (_init : in out p__my_g__rec; d :
           natural) is
         begin
            _init.d := d;
            null;
            return;
         end p__my_g__recIP;
      ]
   end p__my_g;

   package my_g is new g (p__val);
end p;

freeze_generic info
[subtype TinfoD1 is boolean range true .. multi]
freeze_generic TinfoD1
[type TinfoB is array (true .. multi range <>) of integer]
freeze_generic TinfoB
freeze_generic arr
freeze_generic rec
----

2018-11-14  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch3.adb (Analyze_Object_Declaration): Use the
	Actual_Subtype to preserve information about a constant
	initialized with a non-static entity that is known to be valid,
	when the type of the entity has a narrower range than that of
	the nominal subtype of the constant.
	* checks.adb (Determine_Range): If the expression is a constant
	entity that is known-valid and has a defined Actual_Subtype, use
	it to determine the actual bounds of the value, to enable
	additional optimizations.

From-SVN: r266123

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c407793a0a665b4d026a8376386a52abc6a2462b..3af78024531b00731ada21d3405648b100100fb7 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2018-11-14  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Analyze_Object_Declaration): Use the
+       Actual_Subtype to preserve information about a constant
+       initialized with a non-static entity that is known to be valid,
+       when the type of the entity has a narrower range than that of
+       the nominal subtype of the constant.
+       * checks.adb (Determine_Range): If the expression is a constant
+       entity that is known-valid and has a defined Actual_Subtype, use
+       it to determine the actual bounds of the value, to enable
+       additional optimizations.
+
 2018-11-14  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * back_end.adb, checks.adb, exp_ch3.adb, exp_ch4.adb,

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 6b9e6541f86f47d4b50365ff5ba8e72504a93d04..89f26fa0770bb313ea4585758cfee39633aed411 100644 (file)
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -722,7 +722,7 @@ package body Checks is
       --  Generate a check to raise PE if alignment may be inappropriate
 
       else
-         --  If the original expression is a non-static constant, use the name
+         --  If the original expression is a nonstatic constant, use the name
          --  of the constant itself rather than duplicating its initialization
          --  expression, which was extracted above.
 
@@ -4563,6 +4563,17 @@ package body Checks is
         or else Assume_No_Invalid_Values
         or else Assume_Valid
       then
+         --  If this is a known valid constant with a nonstatic value, it may
+         --  have inherited a narrower subtype from its initial value; use this
+         --  saved subtype (see sem_ch3.adb).
+
+         if Is_Entity_Name (N)
+           and then Ekind (Entity (N)) = E_Constant
+           and then Present (Actual_Subtype (Entity (N)))
+         then
+            Typ := Actual_Subtype (Entity (N));
+         end if;
+
          null;
       else
          Typ := Underlying_Type (Base_Type (Typ));

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 32797d88f9e06ae9671bd771dc47c727efe476c7..fae1d5dc66a1b7c8546c7d808674568f1bbe006a 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3657,7 +3657,7 @@ package body Sem_Ch3 is
       Prev_Entity : Entity_Id := Empty;
 
       procedure Check_Dynamic_Object (Typ : Entity_Id);
-      --  A library-level object with non-static discriminant constraints may
+      --  A library-level object with nonstatic discriminant constraints may
       --  require dynamic allocation. The declaration is illegal if the
       --  profile includes the restriction No_Implicit_Heap_Allocations.
 
@@ -3672,7 +3672,7 @@ package body Sem_Ch3 is
       --  This function is called when a non-generic library level object of a
       --  task type is declared. Its function is to count the static number of
       --  tasks declared within the type (it is only called if Has_Task is set
-      --  for T). As a side effect, if an array of tasks with non-static bounds
+      --  for T). As a side effect, if an array of tasks with nonstatic bounds
       --  or a variant record type is encountered, Check_Restriction is called
       --  indicating the count is unknown.
 
@@ -4357,8 +4357,24 @@ package body Sem_Ch3 is
                Set_Current_Value (Id, E);
             end if;
 
-         elsif Is_Scalar_Type (T) and then Is_OK_Static_Expression (E) then
+         elsif Is_Scalar_Type (T)
+            and then Is_OK_Static_Expression (E)
+         then
+            Set_Is_Known_Valid (Id);
+
+         --  If it is a constant initialized with a valid nonstatic entity,
+         --  the constant is known valid as well, and can inherit the subtype
+         --  of the entity if it is a subtype of the given type. This info
+         --  is preserved on the actual subtype of the constant.
+
+         elsif Is_Scalar_Type (T)
+           and then Is_Entity_Name (E)
+           and then Is_Known_Valid (Entity (E))
+           and then In_Subrange_Of (Etype (Entity (E)), T)
+         then
             Set_Is_Known_Valid (Id);
+            Set_Ekind (Id, E_Constant);
+            Set_Actual_Subtype (Id, Etype (Entity (E)));
          end if;
 
          --  Deal with setting of null flags
@@ -5399,7 +5415,7 @@ package body Sem_Ch3 is
                        ("subtype mark required", One_Cstr);
 
                   --  String subtype must have a lower bound of 1 in SPARK.
-                  --  Note that we do not need to test for the non-static case
+                  --  Note that we do not need to test for the nonstatic case
                   --  here, since that was already taken care of in
                   --  Process_Range_Expr_In_Decl.
 
@@ -12471,7 +12487,7 @@ package body Sem_Ch3 is
       end if;
 
       --  It is unsafe to share the bounds of a scalar type, because the Itype
-      --  is elaborated on demand, and if a bound is non-static then different
+      --  is elaborated on demand, and if a bound is nonstatic, then different
       --  orders of elaboration in different units will lead to different
       --  external symbols.
 
@@ -16421,7 +16437,7 @@ package body Sem_Ch3 is
 
       --  Because the implicit base is used in the conversion of the bounds, we
       --  have to freeze it now. This is similar to what is done for numeric
-      --  types, and it equally suspicious, but otherwise a non-static bound
+      --  types, and it equally suspicious, but otherwise a nonstatic bound
       --  will have a reference to an unfrozen type, which is rejected by Gigi
       --  (???). This requires specific care for definition of stream
       --  attributes. For details, see comments at the end of
@@ -19343,8 +19359,8 @@ package body Sem_Ch3 is
          end if;
 
          --  In the subtype indication case, if the immediate parent of the
-         --  new subtype is non-static, then the subtype we create is non-
-         --  static, even if its bounds are static.
+         --  new subtype is nonstatic, then the subtype we create is nonstatic,
+         --  even if its bounds are static.
 
          if Nkind (N) = N_Subtype_Indication
            and then not Is_OK_Static_Subtype (Entity (Subtype_Mark (N)))