re PR fortran/57071 (Optimize (-1)**k to 1 - 2 * mod(K, 2))

2013-04-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/57071
	* frontend-passes (optimize_power):  New function.
	(optimize_op):  Use it.

2013-04-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/57071
	* gfortran.dg/power_3.f90:  New test.
	* gfortran.dg/power_4.f90:  New test.

From-SVN: r198369

5 files changed, 142 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7d85d9d..9debee4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-04-28  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/57071
+	* frontend-passes (optimize_power):  New function.
+	(optimize_op):  Use it.
+
 2013-04-25  Janne Blomqvist  <jb@gcc.gnu.org>
 
         PR bootstrap/57028
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 0618aed..63efb9f 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -1091,6 +1091,65 @@ combine_array_constructor (gfc_expr *e)
   return true;
 }
 
+/* Change (-1)**k into 1-ishift(iand(k,1),1) and
+ 2**k into ishift(1,k) */
+
+static bool
+optimize_power (gfc_expr *e)
+{
+  gfc_expr *op1, *op2;
+  gfc_expr *iand, *ishft;
+
+  if (e->ts.type != BT_INTEGER)
+    return false;
+
+  op1 = e->value.op.op1;
+
+  if (op1 == NULL || op1->expr_type != EXPR_CONSTANT)
+    return false;
+
+  if (mpz_cmp_si (op1->value.integer, -1L) == 0)
+    {
+      gfc_free_expr (op1);
+
+      op2 = e->value.op.op2;
+
+      if (op2 == NULL)
+	return false;
+
+      iand = gfc_build_intrinsic_call (current_ns, GFC_ISYM_IAND,
+				       "_internal_iand", e->where, 2, op2,
+				       gfc_get_int_expr (e->ts.kind,
+							 &e->where, 1));
+				   
+      ishft = gfc_build_intrinsic_call (current_ns, GFC_ISYM_ISHFT,
+					"_internal_ishft", e->where, 2, iand,
+					gfc_get_int_expr (e->ts.kind,
+							  &e->where, 1));
+
+      e->value.op.op = INTRINSIC_MINUS;
+      e->value.op.op1 = gfc_get_int_expr (e->ts.kind, &e->where, 1);
+      e->value.op.op2 = ishft;
+      return true;
+    }
+  else if (mpz_cmp_si (op1->value.integer, 2L) == 0)
+    {
+      gfc_free_expr (op1);
+
+      op2 = e->value.op.op2;
+      if (op2 == NULL)
+	return false;
+
+      ishft = gfc_build_intrinsic_call (current_ns, GFC_ISYM_ISHFT,
+					"_internal_ishft", e->where, 2,
+					gfc_get_int_expr (e->ts.kind,
+							  &e->where, 1),
+					op2);
+      *e = *ishft;
+      return true;
+    }
+  return false;
+}
 
 /* Recursive optimization of operators.  */
 
@@ -1152,6 +1211,10 @@ optimize_op (gfc_expr *e)
     case INTRINSIC_DIVIDE:
       return combine_array_constructor (e) || changed;
 
+    case INTRINSIC_POWER:
+      return optimize_power (e);
+      break;
+
     default:
       break;
     }
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5777334..41b155c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2013-04-28  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/57071
+	* frontend-passes (optimize_power):  New function.
+	(optimize_op):  Use it.
+
 2013-04-27  Jakub Jelinek  <jakub@redhat.com>
 
 	PR target/56866
diff --git a/gcc/testsuite/gfortran.dg/power_3.f90 b/gcc/testsuite/gfortran.dg/power_3.f90
new file mode 100644
index 0000000..381c5d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/power_3.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-options "-ffrontend-optimize -fdump-tree-original" }
+! PR 57071 - Check that (-1)**k is transformed into 1-2*iand(k,1).
+program main
+  implicit none
+  integer, parameter :: n = 3
+  integer(kind=8), dimension(-n:n) :: a, b
+  integer, dimension(-n:n) :: c, d, e
+  integer :: m
+  integer :: i, v
+  integer (kind=2) :: i2
+
+  m = n
+  v = -1
+  ! Test in scalar expressions
+  do i=-n,n
+     if (v**i /= (-1)**i) call abort
+  end do
+
+  ! Test in array constructors
+  a(-m:m) = [ ((-1)**i, i= -m, m) ]
+  b(-m:m) = [ (   v**i, i= -m, m) ]
+  if (any(a .ne. b)) call abort
+
+  ! Test in array expressions
+  c = [ ( i, i = -n , n ) ]
+  d = (-1)**c
+  e = v**c
+  if (any(d .ne. e)) call abort
+
+  ! Test in different kind expressions
+  do i2=-n,n
+     if (v**i2 /= (-1)**i2) call abort
+  end do
+
+end program main
+! { dg-final { scan-tree-dump-times "_gfortran_pow_i4_i4" 4 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/power_4.f90 b/gcc/testsuite/gfortran.dg/power_4.f90
new file mode 100644
index 0000000..1d53259
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/power_4.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-ffrontend-optimize -fdump-tree-original" }
+! PR 57071 - Check that 2**k is transformed into ishift(1,k).
+program main
+  implicit none
+  integer :: i,m,v
+  integer, parameter :: n=30
+  integer, dimension(-n:n) :: a,b,c,d,e
+  m = n
+
+  v = 2
+  ! Test scalar expressions.
+  do i=-n,n
+     if (2**i /= v**i) call abort
+  end do
+
+  ! Test array constructors
+  b = [(2**i,i=-m,m)]
+  c = [(v**i,i=-m,m)]
+  if (any(b /= c)) call abort
+
+  ! Test array expressions
+  a = [(i,i=-m,m)]
+  d = 2**a
+  e = v**a
+  if (any(d /= e)) call abort
+end program main
+! { dg-final { scan-tree-dump-times "_gfortran_pow_i4_i4" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }