diff mbox series

[Ada] Remove redundant predicate checks

Message ID 20190711080345.GA95221@adacore.com
State New
Headers show
Series [Ada] Remove redundant predicate checks | expand

Commit Message

Pierre-Marie de Rodat July 11, 2019, 8:03 a.m. UTC 
This patch removes redundant dynamic predicate checks generated by type
conversions in various contexts. The patch also recognizes additional
such checks that can be evaluated statically when applied to constant
values.

No simple test available.

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

2019-07-11  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_ch4.adb (Expand_N_Type_Conversion): If a predicate check
	is generated, analyze it with range check suppressed, because
	that check has been previously applied.
	* exp_ch5.adb (Expand_N_Assignment_Statement): If the RHS is a
	type conversion to the type of the LHS, do not apply a predicate
	check to the RHS because it will have been generated already
	during its expansion.
	* exp_ch6.adb (Can_Fold_Predicate_Call): Extend processing to
	handle a predicate check on a constant entity whose value is
	static.
diff mbox series

Patch

--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -12050,10 +12050,13 @@  package body Exp_Ch4 is
 
          begin
             --  Avoid infinite recursion on the subsequent expansion of
-            --  of the copy of the original type conversion.
+            --  of the copy of the original type conversion. When needed,
+            --  a range check has already been applied to the expression.
 
             Set_Comes_From_Source (New_Expr, False);
-            Insert_Action (N, Make_Predicate_Check (Target_Type, New_Expr));
+            Insert_Action (N,
+               Make_Predicate_Check (Target_Type, New_Expr),
+               Suppress => Range_Check);
          end;
       end if;
    end Expand_N_Type_Conversion;

--- gcc/ada/exp_ch5.adb
+++ gcc/ada/exp_ch5.adb
@@ -2021,15 +2021,21 @@  package body Exp_Ch5 is
 
       if not Suppress_Assignment_Checks (N) then
 
-         --  First deal with generation of range check if required
+         --  First deal with generation of range check if required,
+         --  and then predicate checks if the type carries a predicate.
+         --  If the Rhs is an expression these tests may have been applied
+         --  already. This is the case if the RHS is a type conversion.
+         --  Other such redundant checks could be removed ???
+
+         if Nkind (Rhs) /= N_Type_Conversion
+           or else Entity (Subtype_Mark (Rhs)) /= Typ
+         then
+            if Do_Range_Check (Rhs) then
+               Generate_Range_Check (Rhs, Typ, CE_Range_Check_Failed);
+            end if;
 
-         if Do_Range_Check (Rhs) then
-            Generate_Range_Check (Rhs, Typ, CE_Range_Check_Failed);
+            Apply_Predicate_Check (Rhs, Typ);
          end if;
-
-         --  Then generate predicate check if required
-
-         Apply_Predicate_Check (Rhs, Typ);
       end if;
 
       --  Check for a special case where a high level transformation is

--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -2479,8 +2479,7 @@  package body Exp_Ch6 is
       -----------------------------
 
       function Can_Fold_Predicate_Call (P : Entity_Id) return Boolean is
-         Actual : constant Node_Id :=
-                    First (Parameter_Associations (Call_Node));
+         Actual : Node_Id;
 
          function May_Fold (N : Node_Id) return Traverse_Result;
          --  The predicate expression is foldable if it only contains operators
@@ -2533,10 +2532,11 @@  package body Exp_Ch6 is
 
          function Try_Fold is new Traverse_Func (May_Fold);
 
-         --  Local variables
+         --  Other lLocal variables
 
-         Subt : constant Entity_Id := Etype (First_Entity (P));
-         Pred : Node_Id;
+         Subt   : constant Entity_Id := Etype (First_Entity (P));
+         Aspect : Node_Id;
+         Pred   : Node_Id;
 
       --  Start of processing for Can_Fold_Predicate_Call
 
@@ -2545,8 +2545,21 @@  package body Exp_Ch6 is
          --  has a Dynamic_Predicate aspect. For CodePeer we preserve the
          --  function call.
 
-         if Nkind (Actual) /= N_Integer_Literal
+         Actual := First (Parameter_Associations (Call_Node));
+         Aspect := Find_Aspect (Subt, Aspect_Dynamic_Predicate);
+
+         --  If actual is a declared constant, retrieve its value
+
+         if Is_Entity_Name (Actual)
+           and then Ekind (Entity (Actual)) = E_Constant
+         then
+            Actual := Constant_Value (Entity (Actual));
+         end if;
+
+         if No (Actual)
+           or else Nkind (Actual) /= N_Integer_Literal
            or else not Has_Dynamic_Predicate_Aspect (Subt)
+           or else No (Aspect)
            or else CodePeer_Mode
          then
             return False;
@@ -2554,9 +2567,7 @@  package body Exp_Ch6 is
 
          --  Retrieve the analyzed expression for the predicate
 
-         Pred :=
-           New_Copy_Tree
-             (Expression (Find_Aspect (Subt, Aspect_Dynamic_Predicate)));
+         Pred := New_Copy_Tree (Expression (Aspect));
 
          if Try_Fold (Pred) = OK then
             Rewrite (Call_Node, Pred);