gcc/fortran/

2010-08-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * gcc/fortran/intrinsic.c (add_functions): Add norm2 and parity.
        * gcc/fortran/intrinsic.h (gfc_check_norm2, gfc_check_parity):
        gfc_simplify_norm2, gfc_simplify_parity, gfc_resolve_norm2,
        gfc_resolve_parity): New prototypes.
        * gcc/fortran/gfortran.h (gfc_isym_id): New enum items
        GFC_ISYM_NORM2 and GFC_ISYM_PARITY.
        * gcc/fortran/iresolve.c (gfc_resolve_norm2,
        gfc_resolve_parity): New functions.
        * gcc/fortran/check.c (gfc_check_norm2, gfc_check_parity):
        New functions.
        * gcc/fortran/trans-intrinsic.c (gfc_conv_intrinsic_arith,
        gfc_conv_intrinsic_function): Handle NORM2 and PARITY.
        * gcc/fortran/intrinsic.texi (NORM2, PARITY): Add.
        * gcc/fortran/simplify.c (simplify_transformation_to_array):
        Add post-processing opterator.
        (gfc_simplify_all, gfc_simplify_any, gfc_simplify_count,
        gfc_simplify_product, gfc_simplify_sum): Update call.
        (add_squared, do_sqrt, gfc_simplify_norm2, do_xor,
        gfc_simplify_parity): New functions.

gcc/testsuite/
2010-08-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * gcc/testsuite/gfortran.dg/norm2_1.f90: New.
        * gcc/testsuite/gfortran.dg/norm2_2.f90: New.
        * gcc/testsuite/gfortran.dg/norm2_3.f90: New.
        * gcc/testsuite/gfortran.dg/norm2_4.f90: New.
        * gcc/testsuite/gfortran.dg/parity_1.f90: New.
        * gcc/testsuite/gfortran.dg/parity_2.f90: New.
        * gcc/testsuite/gfortran.dg/parity_3.f90: New.

libgfortran/
2010-08-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33197
        * libgfortran/m4/ifunction.m4 (FINISH_ARRAY_FUNCTION,
        ARRAY_FUNCTION): Allow expression after loop.
        * libgfortran/m4/norm2.m4: New for _gfortran_norm2_r{4,8,10,16}.
        * libgfortran/m4/parity.m4: New for
        * _gfortran_parity_l{1,2,4,8,16}.
        * libgfortran/gfortran.map: Add new functions.
        * libgfortran/Makefile.am: Ditto.
        * libgfortran/m4/minloc1.m4: Add empty argument for
        * ARRAY_FUNCTION.
        * libgfortran/m4/maxloc1.m4: Ditto.
        * libgfortran/m4/all.m4: Ditto.
        * libgfortran/m4/minval.m4: Ditto.
        * libgfortran/m4/maxval.m4: Ditto.
        * libgfortran/m4/count.m4: Ditto.
        * libgfortran/m4/product.m4: Ditto.
        * libgfortran/m4/any.m4: Ditto.
        * Makefile.in: Regenerated.
        * generated/minval_r8.c: Regenerated.
        * generated/maxloc1_4_r8.c: Regenerated.
        * generated/minloc1_16_r16.c: Regenerated.
        * generated/norm2_r4.c: Regenerated.
        * generated/sum_i8.c: Regenerated.
        * generated/parity_l2.c: Regenerated.
        * generated/any_l16.c: Regenerated.
        * generated/maxval_i2.c: Regenerated.
        * generated/any_l2.c: Regenerated.
        * generated/product_r4.c: Regenerated.
        * generated/maxloc1_8_i4.c: Regenerated.
        * generated/parity_l16.c: Regenerated.
        * generated/all_l1.c: Regenerated.
        * generated/product_i2.c: Regenerated.
        * generated/minloc1_8_r16.c: Regenerated.
        * generated/maxloc1_8_r16.c: Regenerated.
        * generated/sum_r16.c: Regenerated.
        * generated/sum_i1.c: Regenerated.
        * generated/minloc1_4_r8.c: Regenerated.
        * generated/maxloc1_16_r16.c: Regenerated.
        * generated/minloc1_16_i4.c: Regenerated.
        * generated/maxloc1_16_i4.c: Regenerated.
        * generated/maxval_r16.c: Regenerated.
        * generated/product_c10.c: Regenerated.
        * generated/minloc1_8_i4.c: Regenerated.
        * generated/all_l2.c: Regenerated.
        * generated/product_c4.c: Regenerated.
        * generated/sum_r4.c: Regenerated.
        * generated/all_l16.c: Regenerated.
        * generated/minloc1_16_r10.c: Regenerated.
        * generated/sum_i2.c: Regenerated.
        * generated/maxloc1_8_r8.c: Regenerated.
        * generated/minval_i16.c: Regenerated.
        * generated/parity_l4.c: Regenerated.
        * generated/maxval_i4.c: Regenerated.
        * generated/any_l4.c: Regenerated.
        * generated/minval_i8.c: Regenerated.
        * generated/maxloc1_4_i8.c: Regenerated.
        * generated/minloc1_4_i16.c: Regenerated.
        * generated/maxloc1_4_i16.c: Regenerated.
        * generated/minloc1_8_r10.c: Regenerated.
        * generated/product_i4.c: Regenerated.
        * generated/maxloc1_8_r10.c: Regenerated.
        * generated/sum_c16.c: Regenerated.
        * generated/minloc1_16_r8.c: Regenerated.
        * generated/maxloc1_16_r8.c: Regenerated.
        * generated/count_4_l.c: Regenerated.
        * generated/sum_r10.c: Regenerated.
        * generated/count_8_l.c: Regenerated.
        * generated/sum_c4.c: Regenerated.
        * generated/maxloc1_16_r10.c: Regenerated.
        * generated/minloc1_8_r8.c: Regenerated.
        * generated/maxval_r10.c: Regenerated.
        * generated/minval_i1.c: Regenerated.
        * generated/maxloc1_4_i1.c: Regenerated.
        * generated/minloc1_4_i8.c: Regenerated.
        * generated/product_i16.c: Regenerated.
        * generated/all_l4.c: Regenerated.
        * generated/norm2_r16.c: Regenerated.
        * generated/minval_r4.c: Regenerated.
        * generated/maxloc1_4_r4.c: Regenerated.
        * generated/sum_i4.c: Regenerated.
        * generated/maxval_r8.c: Regenerated.
        * generated/norm2_r8.c: Regenerated.
        * generated/minloc1_4_i1.c: Regenerated.
        * generated/minval_r16.c: Regenerated.
        * generated/minval_i2.c: Regenerated.
        * generated/maxloc1_4_i2.c: Regenerated.
        * generated/product_r8.c: Regenerated.
        * generated/maxloc1_8_i8.c: Regenerated.
        * generated/sum_c10.c: Regenerated.
        * generated/minloc1_4_r16.c: Regenerated.
        * generated/maxloc1_4_r16.c: Regenerated.
        * generated/count_1_l.c: Regenerated.
        * generated/minloc1_4_r4.c: Regenerated.
        * generated/minloc1_16_i8.c: Regenerated.
        * generated/maxloc1_16_i8.c: Regenerated.
        * generated/minloc1_4_i2.c: Regenerated.
        * generated/maxloc1_8_i1.c: Regenerated.
        * generated/minloc1_8_i8.c: Regenerated.
        * generated/product_r16.c: Regenerated.
        * generated/product_c8.c: Regenerated.
        * generated/sum_r8.c: Regenerated.
        * generated/norm2_r10.c: Regenerated.
        * generated/minloc1_16_i16.c: Regenerated.
        * generated/maxloc1_8_r4.c: Regenerated.
        * generated/minloc1_16_i1.c: Regenerated.
        * generated/maxloc1_16_i1.c: Regenerated.
        * generated/minval_r10.c: Regenerated.
        * generated/count_16_l.c: Regenerated.
        * generated/parity_l8.c: Regenerated.
        * generated/minloc1_8_i1.c: Regenerated.
        * generated/minval_i4.c: Regenerated.
        * generated/maxloc1_4_i4.c: Regenerated.
        * generated/maxloc1_8_i2.c: Regenerated.
        * generated/maxval_i8.c: Regenerated.
        * generated/any_l8.c: Regenerated.
        * generated/minloc1_4_r10.c: Regenerated.
        * generated/minloc1_8_i16.c: Regenerated.
        * generated/maxloc1_4_r10.c: Regenerated.
        * generated/maxloc1_8_i16.c: Regenerated.
        * generated/minloc1_16_r4.c: Regenerated.
        * generated/maxloc1_16_r4.c: Regenerated.
        * generated/product_i8.c: Regenerated.
        * generated/sum_i16.c: Regenerated.
        * generated/count_2_l.c: Regenerated.
        * generated/maxloc1_16_i16.c: Regenerated.
        * generated/minloc1_8_r4.c: Regenerated.
        * generated/sum_c8.c: Regenerated.
        * generated/minloc1_16_i2.c: Regenerated.
        * generated/maxloc1_16_i2.c: Regenerated.
        * generated/parity_l1.c: Regenerated.
        * generated/maxval_i16.c: Regenerated.
        * generated/maxval_i1.c: Regenerated.
        * generated/minloc1_4_i4.c: Regenerated.
        * generated/any_l1.c: Regenerated.
        * generated/minloc1_8_i2.c: Regenerated.
        * generated/product_c16.c: Regenerated.
        * generated/product_r10.c: Regenerated.
        * generated/product_i1.c: Regenerated.
        * generated/all_l8.c: Regenerated.
        * generated/maxval_r4.c: Regenerated.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@163595 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 102 insertions, 8 deletions

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 4cb29fbfc67..98955bb0a3e 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -488,11 +488,12 @@ simplify_transformation_to_scalar (gfc_expr *result, gfc_expr *array, gfc_expr *
      REAL, PARAMETER :: array(n, m) = ...
      REAL, PARAMETER :: s(n) = PROD(array, DIM=1)
 
-  where OP == gfc_multiply().  */
+  where OP == gfc_multiply(). The result might be post processed using post_op. */ 
 
 static gfc_expr *
 simplify_transformation_to_array (gfc_expr *result, gfc_expr *array, gfc_expr *dim,
-				  gfc_expr *mask, transformational_op op)
+				  gfc_expr *mask, transformational_op op,
+				  transformational_op post_op)
 {
   mpz_t size;
   int done, i, n, arraysize, resultsize, dim_index, dim_extent, dim_stride;
@@ -606,7 +607,10 @@ simplify_transformation_to_array (gfc_expr *result, gfc_expr *array, gfc_expr *d
   result_ctor = gfc_constructor_first (result->value.constructor);
   for (i = 0; i < resultsize; ++i)
     {
-      result_ctor->expr = resultvec[i];
+      if (post_op)
+	result_ctor->expr = post_op (result_ctor->expr, resultvec[i]);
+      else
+	result_ctor->expr = resultvec[i];
       result_ctor = gfc_constructor_next (result_ctor);
     }
 
@@ -896,7 +900,7 @@ gfc_simplify_all (gfc_expr *mask, gfc_expr *dim)
 
   return !dim || mask->rank == 1 ?
     simplify_transformation_to_scalar (result, mask, NULL, gfc_and) :
-    simplify_transformation_to_array (result, mask, dim, NULL, gfc_and);
+    simplify_transformation_to_array (result, mask, dim, NULL, gfc_and, NULL);
 }
 
 
@@ -982,7 +986,7 @@ gfc_simplify_any (gfc_expr *mask, gfc_expr *dim)
 
   return !dim || mask->rank == 1 ?
     simplify_transformation_to_scalar (result, mask, NULL, gfc_or) :
-    simplify_transformation_to_array (result, mask, dim, NULL, gfc_or);
+    simplify_transformation_to_array (result, mask, dim, NULL, gfc_or, NULL);
 }
 
 
@@ -1679,7 +1683,7 @@ gfc_simplify_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
      Whenever gfc_count is called, '1' is added to the result.  */
   return !dim || mask->rank == 1 ?
     simplify_transformation_to_scalar (result, mask, mask, gfc_count) :
-    simplify_transformation_to_array (result, mask, dim, mask, gfc_count);
+    simplify_transformation_to_array (result, mask, dim, mask, gfc_count, NULL);
 }
 
 
@@ -4048,6 +4052,65 @@ gfc_simplify_idnint (gfc_expr *e)
 }
 
 
+static gfc_expr *
+add_squared (gfc_expr *result, gfc_expr *e)
+{
+  mpfr_t tmp;
+
+  gcc_assert (e->ts.type == BT_REAL && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_REAL
+	      && result->expr_type == EXPR_CONSTANT);
+
+  gfc_set_model_kind (result->ts.kind);
+  mpfr_init (tmp);
+  mpfr_pow_ui (tmp, e->value.real, 2, GFC_RND_MODE);
+  mpfr_add (result->value.real, result->value.real, tmp,
+	    GFC_RND_MODE);
+  mpfr_clear (tmp);
+
+  return result;
+}
+
+
+static gfc_expr *
+do_sqrt (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_REAL && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_REAL
+	      && result->expr_type == EXPR_CONSTANT);
+
+  mpfr_set (result->value.real, e->value.real, GFC_RND_MODE);
+  mpfr_sqrt (result->value.real, result->value.real, GFC_RND_MODE);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_norm2 (gfc_expr *e, gfc_expr *dim)
+{
+  gfc_expr *result;
+
+  if (!is_constant_array_expr (e)
+      || (dim != NULL && !gfc_is_constant_expr (dim)))
+    return NULL;
+
+  result = transformational_result (e, dim, e->ts.type, e->ts.kind, &e->where);
+  init_result_expr (result, 0, NULL);
+
+  if (!dim || e->rank == 1)
+    {
+      result = simplify_transformation_to_scalar (result, e, NULL,
+						  add_squared);
+      mpfr_sqrt (result->value.real, result->value.real, GFC_RND_MODE);
+    }
+  else
+    result = simplify_transformation_to_array (result, e, dim, NULL,
+					       add_squared, &do_sqrt);
+
+  return result;
+}
+
+
 gfc_expr *
 gfc_simplify_not (gfc_expr *e)
 {
@@ -4198,6 +4261,37 @@ gfc_simplify_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
 }
 
 
+static gfc_expr *
+do_xor (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_LOGICAL && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_LOGICAL
+	      && result->expr_type == EXPR_CONSTANT);
+
+  result->value.logical = result->value.logical != e->value.logical;
+  return result;
+}
+
+
+
+gfc_expr *
+gfc_simplify_parity (gfc_expr *e, gfc_expr *dim)
+{
+  gfc_expr *result;
+
+  if (!is_constant_array_expr (e)
+      || (dim != NULL && !gfc_is_constant_expr (dim)))
+    return NULL;
+
+  result = transformational_result (e, dim, e->ts.type, e->ts.kind, &e->where);
+  init_result_expr (result, 0, NULL);
+
+  return (!dim || e->rank == 1)
+    ? simplify_transformation_to_scalar (result, e, NULL, do_xor)
+    : simplify_transformation_to_array (result, e, dim, NULL, do_xor, NULL);
+}
+
+
 gfc_expr *
 gfc_simplify_precision (gfc_expr *e)
 {
@@ -4227,7 +4321,7 @@ gfc_simplify_product (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
 
   return !dim || array->rank == 1 ?
     simplify_transformation_to_scalar (result, array, mask, gfc_multiply) :
-    simplify_transformation_to_array (result, array, dim, mask, gfc_multiply);
+    simplify_transformation_to_array (result, array, dim, mask, gfc_multiply, NULL);
 }
 
 
@@ -5390,7 +5484,7 @@ gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
 
   return !dim || array->rank == 1 ?
     simplify_transformation_to_scalar (result, array, mask, gfc_add) :
-    simplify_transformation_to_array (result, array, dim, mask, gfc_add);
+    simplify_transformation_to_array (result, array, dim, mask, gfc_add, NULL);
 }