[Patch, fortran] Improve common function elimination

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

here is the reworked patch for improving function elimination.
It turned out to be much simpler than the original one.

Because real constants (and complex) constants are compared
for equality only, it should be pretty safe.

OK for trunk?

	Thomas

2011-12-17  Thomas Koenig  <tkoenig@gcc.gnu.org>

        * dependency.c (gfc_dep_compare_functions):  Document
        new behavior for REALs and complex.  Add comment to cases
        where only INTEGERs are handled.  Compare REAL and COMPLEX
        constants, returning 0 and -2 only.  Add assert to make
        sure that only integer constants are compared.

2011-12-17  Thomas Koenig  <tkoenig@gcc.gnu.org>

        * gfortran.dg/function_optimize_9.f90:  New test.
Index: dependency.c
===================================================================
--- dependency.c	(Revision 182430)
+++ dependency.c	(Arbeitskopie)
@@ -245,7 +245,9 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr
    * 0 if e1 == e2
    * -1 if e1 < e2
    * -2 if the relationship could not be determined
-   * -3 if e1 /= e2, but we cannot tell which one is larger.  */
+   * -3 if e1 /= e2, but we cannot tell which one is larger.
+   REAL and COMPLEX constants are only compared for equality
+   or inequality; if they are unequal, -2 is returned in all cases.  */
 
 int
 gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
@@ -303,7 +305,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 
   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
     {
-      /* Compare X+C vs. X.  */
+      /* Compare X+C vs. X, for INTEGER only.  */
       if (e1->value.op.op2->expr_type == EXPR_CONSTANT
 	  && e1->value.op.op2->ts.type == BT_INTEGER
 	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
@@ -342,7 +344,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 	}
     }
 
-  /* Compare X vs. X+C.  */
+  /* Compare X vs. X+C, for INTEGER only.  */
   if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
     {
       if (e2->value.op.op2->expr_type == EXPR_CONSTANT
@@ -351,7 +353,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 	return -mpz_sgn (e2->value.op.op2->value.integer);
     }
 
-  /* Compare X-C vs. X.  */
+  /* Compare X-C vs. X, for INTEGER only.  */
   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
     {
       if (e1->value.op.op2->expr_type == EXPR_CONSTANT
@@ -415,7 +417,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 	}
     }
 
-  /* Compare X vs. X-C.  */
+  /* Compare X vs. X-C, for INTEGER only.  */
   if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
     {
       if (e2->value.op.op2->expr_type == EXPR_CONSTANT
@@ -434,9 +436,34 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       if (e1->ts.type == BT_CHARACTER && e2->ts.type == BT_CHARACTER)
 	return gfc_compare_string (e1, e2);
 
+      /* Compare REAL and COMPLEX constants.  Because of the
+	 traps and pitfalls associated with comparing
+	 a + 1.0 with a + 0.5, check for equality only.  */
+      if (e2->expr_type == EXPR_CONSTANT)
+	{
+	  if (e1->ts.type == BT_REAL && e2->ts.type == BT_REAL)
+	    {
+	      if (mpfr_cmp (e1->value.real, e2->value.real) == 0)
+		return 0;
+	      else
+		return -2;
+	    }
+	  else if (e1->ts.type == BT_COMPLEX && e2->ts.type == BT_COMPLEX)
+	    {
+	      if (mpc_cmp (e1->value.complex, e2->value.complex) == 0)
+		return 0;
+	      else
+		return -2;
+	    }
+	}
+
       if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
 	return -2;
 
+      /* For INTEGER, all cases where e2 is not constant should have
+	 been filtered out above.  */
+      gcc_assert (e2->expr_type == EXPR_CONSTANT);
+
       i = mpz_cmp (e1->value.integer, e2->value.integer);
       if (i == 0)
 	return 0;
@@ -465,7 +492,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       else if (e1->value.op.op == INTRINSIC_TIMES
 	       && gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2) == 0
 	       && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1) == 0)
-	/* Commutativity of multiplication.  */
+	/* Commutativity of multiplication; addition is handled above.  */
 	return 0;
 
       return -2;

Attachment: function_optimize_9.f90
Description: Text document