Patchwork [fortran,4.9] Improve efficiency of array constructor operators

login
register
mail settings
Submitter Thomas Koenig
Date March 17, 2013, 9:33 a.m.
Message ID <51458DD6.8000200@netcologne.de>
Download mbox | patch
Permalink /patch/228288/
State New
Headers show

Comments

Thomas Koenig - March 17, 2013, 9:33 a.m.
Hello world,

this patch finally makes the idiom

    if (any([a,b,c] < eps)) then

equivalent to

    if (a<eps .or. b<eps .or. c<eps) then

so that there is no loss in efficiency through generating
temporary arrays.

OK for trunk?

	Thomas

2013-03-17  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/55806
         * frontend-passes.c (optimize_code):  Keep track of
         current code to make code insertion possible.
         (combine_array_constructor):  New function.
         (optimize_op):  Call it.

2013-03-17  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/55806
         * gfortran.dg/array_constructor_43.f90:  New test.
Tobias Burnus - March 26, 2013, 3:35 p.m.
Thomas Koenig wrote:
> this patch finally makes the idiom
>    if (any([a,b,c] < eps)) then
> equivalent to
>    if (a<eps .or. b<eps .or. c<eps) then
> so that there is no loss in efficiency through generating
> temporary arrays.

I have not yet looked at the patch, but I wonder whether that causes 
invalid code for
   if (any([a,b,c] < f()))
by evaluating f() multiple times.

Another question is: Why do we generate a temporary array for ANY/ALL? A 
scalar should be sufficient, i.e.

res = .false.
do i = 1, n
   res = res .or. (array(i) < eps)
end do
if (res)

In the scalar case with known array size, the middle-end should also be 
able to fully unroll the loop.

I do not really see in how far such a patch would replace your patch - 
or whether it should be done additionally.

Tobias
Thomas Koenig - March 26, 2013, 5:17 p.m.
Hi Tobias,

> I have not yet looked at the patch, but I wonder whether that causes
> invalid code for
>    if (any([a,b,c] < f()))
> by evaluating f() multiple times.

This is avoided by this part of the patch:

+  if (op2->expr_type == EXPR_CONSTANT)
+    scalar = gfc_copy_expr (op2);
+  else
+    scalar = create_var (gfc_copy_expr (op2));

which results in code like this:

     __var_1 = f ();
     if ((a > __var_1 || b > __var_1) || c > __var_1)
       {
         {

> Another question is: Why do we generate a temporary array for ANY/ALL?

The straightforward way of evaluating

    if (any([a,b,c] > 0.)) then

is to

- create a temporary array [a,b,c]
- to create a second logical array and fill it with the
   logical expressions,
- call a library function for ANY on it.

This was the original code and was not really efficient ;-)

Since Mikael's patch some time ago, we

- create a temporary array [a,b,c]
- loop over it, exiting early if a true value was found

With this patch (and my previous patch, which is already in),
with front-end optimization enabled, we now

- convert the expression into if (any[a>0, b>0, c>0])
- convert this into a>0 || b>0 || c>0 (effect of my previous patch)

>A
> scalar should be sufficient, i.e.
>
> res = .false.
> do i = 1, n
>    res = res .or. (array(i) < eps)
> end do
> if (res)

We have been doing that since Mikael's patch some years ago.

Regards

	Thomas
Thomas Koenig - March 28, 2013, 4:11 p.m.
Am 26.03.2013 18:17, schrieb Thomas Koenig:
> Hi Tobias,
>
>> I have not yet looked at the patch, but I wonder whether that causes
>> invalid code for
>>    if (any([a,b,c] < f()))
>> by evaluating f() multiple times.
>
> This is avoided by this part of the patch:
>
> +  if (op2->expr_type == EXPR_CONSTANT)
> +    scalar = gfc_copy_expr (op2);
> +  else
> +    scalar = create_var (gfc_copy_expr (op2));
>
> which results in code like this:
>
>      __var_1 = f ();
>      if ((a > __var_1 || b > __var_1) || c > __var_1)
>        {
>          {
>

Are there any other concerns, or can I commit this?

Regards

	Thomas

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 195319)
+++ frontend-passes.c	(Arbeitskopie)
@@ -135,6 +135,10 @@  optimize_code (gfc_code **c, int *walk_subtrees AT
   else
     count_arglist = 0;
 
+  current_code = c;
+  inserted_block = NULL;
+  changed_statement = NULL;
+
   if (op == EXEC_ASSIGN)
     optimize_assignment (*c);
   return 0;
@@ -991,13 +995,92 @@  optimize_lexical_comparison (gfc_expr *e)
   return false;
 }
 
+/* Combine stuff like [a]>b into [a>b], for easier optimization later.  Do not
+   do CHARACTER because of possible pessimization involving character lengths.  */
+
+static bool
+combine_array_constructor (gfc_expr *e)
+{
+
+  gfc_expr *op1, *op2; /* Shut up warnings.  */
+  gfc_expr *scalar;
+  gfc_expr *new_expr;
+  gfc_constructor *c;
+  gfc_constructor_base oldbase, newbase;
+  bool scalar_first;
+
+  /* Array constructors have rank one.  */
+  if (e->rank != 1)
+    return false;
+
+  op1 = e->value.op.op1;
+  op2 = e->value.op.op2;
+
+  if (op1->expr_type == EXPR_ARRAY && op2->rank == 0)
+    scalar_first = false;
+  else if (op2->expr_type == EXPR_ARRAY && op1->rank == 0)
+    {
+      scalar_first = true;
+      op1 = e->value.op.op2;
+      op2 = e->value.op.op1;
+    }
+  else
+    return false;
+
+  if (op2->ts.type == BT_CHARACTER)
+    return false;
+
+  if (op2->expr_type == EXPR_CONSTANT)
+    scalar = gfc_copy_expr (op2);
+  else
+    scalar = create_var (gfc_copy_expr (op2));
+
+  oldbase = op1->value.constructor;
+  newbase = NULL;
+  e->expr_type = EXPR_ARRAY;
+
+  for (c = gfc_constructor_first (oldbase); c;
+       c = gfc_constructor_next (c))
+    {
+      new_expr = gfc_get_expr ();
+      new_expr->ts = e->ts;
+      new_expr->expr_type = EXPR_OP;
+      new_expr->rank = c->expr->rank;
+      new_expr->where = c->where;
+      new_expr->value.op.op = e->value.op.op;
+
+      if (scalar_first)
+	{
+	  new_expr->value.op.op1 = gfc_copy_expr (scalar);
+	  new_expr->value.op.op2 = gfc_copy_expr (c->expr);
+	}
+      else
+	{
+	  new_expr->value.op.op1 = gfc_copy_expr (c->expr);
+	  new_expr->value.op.op2 = gfc_copy_expr (scalar);
+	}
+
+      gfc_constructor_append_expr (&newbase, new_expr, &(e->where));
+    }
+
+  gfc_free_expr (op1);
+  gfc_free_expr (op2);
+
+  e->value.constructor = newbase;
+  return true;
+}
+
 /* Recursive optimization of operators.  */
 
 static bool
 optimize_op (gfc_expr *e)
 {
+  bool changed;
+
   gfc_intrinsic_op op = e->value.op.op;
 
+  changed = false;
+
   /* Only use new-style comparisons.  */
   switch(op)
     {
@@ -1037,8 +1120,16 @@  optimize_op (gfc_expr *e)
     case INTRINSIC_NE:
     case INTRINSIC_GT:
     case INTRINSIC_LT:
-      return optimize_comparison (e, op);
+      changed = optimize_comparison (e, op);
 
+      /* Fall through */
+      /* Look at array constructors.  */
+    case INTRINSIC_PLUS:
+    case INTRINSIC_MINUS:
+    case INTRINSIC_TIMES:
+    case INTRINSIC_DIVIDE:
+      return combine_array_constructor (e) || changed;
+
     default:
       break;
     }