[patch, fortran] PR 57071, some power optimizations

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

the attached patch does some optimization on
power using ishft and iand, as discussed in the PR.

I have left out handling real numbers, that should be left
to the middle-end (PR 57073).

Regression-tested.  OK for trunk?

	Thomas

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.

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 198340)
+++ frontend-passes.c	(Arbeitskopie)
@@ -1091,7 +1091,66 @@ 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.  */
 
 static bool
@@ -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;
     }

! { 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" } }

! { 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" } }