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 <tkoe...@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 <tkoe...@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;
! { dg-do compile }
! { dg-options "-O -fdump-tree-original" }
program main
integer, parameter :: n=100
real, parameter :: pi=4*atan(1.)
real, parameter :: tmax=20.
real, parameter :: dt = tmax/(2*pi)/real(n)
real, parameter :: t0 = dt/30.
integer :: i
interface
pure function purefunc(x)
real :: purefunc
real, intent(in) :: x
end function purefunc
end interface
real :: a(n)
do i=1,n
a(i) = purefunc(dt*i + t0) * 3. + 2 * purefunc(t0 + i*dt)
end do
print *,a
end program main
! { dg-final { scan-tree-dump-times "purefunc" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
