* [patch, Fortran] PR 55806 - Inefficient ANY with array constructors
@ 2013-01-01 20:18 Thomas Koenig
2013-01-06 16:33 ` Thomas Koenig
2013-01-11 19:53 ` Mikael Morin
0 siblings, 2 replies; 8+ messages in thread
From: Thomas Koenig @ 2013-01-01 20:18 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 745 bytes --]
Hello world,
the attached patch replaces ANY(a, b, c) with a .or. b .or c,
leading to reduced execution time. It also handles ALL, PRODUCT
and SUM.
This fixes a bug noted by Michael Metcalf.
Regression-tested. OK for trunk?
Thomas
2013-01-01 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/55806
* frontend-passes.c (optimize_reduction): New function,
including prototype.
(callback_reduction): Likewise.
(gfc_run_passes): Also run optimize_reduction.
(copy_walk_reduction_arg): New function.
(dummy_code_callback): New function.
2013-01-01 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/55806
* gfortran.dg/array_constructor_40.f90: New test.
[-- Attachment #2: array_constructor_40.f90 --]
[-- Type: text/x-fortran, Size: 1053 bytes --]
! { dg-do run }
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
! PR 55806 - replace ANY intrinsic for array
! constructor with .or.
module mymod
implicit none
contains
subroutine bar(a,b,c, lo)
real, dimension(3,3), intent(in) :: a,b
logical, dimension(3,3), intent(in) :: lo
integer, intent(out) :: c
real, parameter :: acc = 1e-4
integer :: i,j
c = 0
do i=1,3
if (any([abs(a(i,1) - b(i,1)) > acc, &
abs(a(i,2) - b(i,2)) > acc, &
abs(a(i,3) - b(i,3)) > acc, lo(i,:), &
(j==i+1,j=3,8)])) cycle
c = c + i
end do
end subroutine bar
end module mymod
program main
use mymod
implicit none
real, dimension(3,3) :: a,b
integer :: c
logical lo(3,3)
data a/1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9/
b = a
b(2,2) = a(2,2) + 0.2
lo = .false.
lo(3,3) = .true.
call bar(a,b,c,lo)
if (c /= 1) call abort
end program main
! { dg-final { scan-tree-dump-times "while" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
[-- Attachment #3: p3.diff --]
[-- Type: text/x-patch, Size: 5937 bytes --]
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 194760)
+++ frontend-passes.c (Arbeitskopie)
@@ -40,6 +40,8 @@ static bool optimize_lexical_comparison (gfc_expr
static void optimize_minmaxloc (gfc_expr **);
static bool is_empty_string (gfc_expr *e);
static void doloop_warn (gfc_namespace *);
+static void optimize_reduction (gfc_namespace *);
+static int callback_reduction (gfc_expr **, int *, void *);
/* How deep we are inside an argument list. */
@@ -107,6 +109,7 @@ gfc_run_passes (gfc_namespace *ns)
expr_array = XNEWVEC(gfc_expr **, expr_size);
optimize_namespace (ns);
+ optimize_reduction (ns);
if (gfc_option.dump_fortran_optimized)
gfc_dump_parse_tree (ns, stdout);
@@ -180,7 +183,172 @@ optimize_expr (gfc_expr **e, int *walk_subtrees AT
return 0;
}
+/* Auxiliary function to handle the arguments to reduction intrnisics.
+ If the function is a scalar, just copy it; otherwise Returns the new
+ element, the old one can be freed. */
+static gfc_expr *
+copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn)
+{
+ gfc_expr *fcn;
+ const char *new_name;
+ gfc_actual_arglist *actual_arglist;
+
+ if (e->rank == 0 || e->expr_type == EXPR_FUNCTION)
+ fcn = gfc_copy_expr (e);
+ else
+ {
+ fcn = gfc_get_expr ();
+ fcn->expr_type = EXPR_FUNCTION;
+ fcn->value.function.isym = fn->value.function.isym;
+ actual_arglist = gfc_get_actual_arglist ();
+ actual_arglist->expr = gfc_copy_expr (e);
+ actual_arglist->next = gfc_get_actual_arglist ();
+ fcn->value.function.actual = actual_arglist;
+ fcn->ts = fn->ts;
+
+ switch (fn->value.function.isym->id)
+ {
+ case GFC_ISYM_SUM:
+ new_name = "__internal_sum";
+ break;
+
+ case GFC_ISYM_PRODUCT:
+ new_name = "__internal_product";
+ break;
+
+ case GFC_ISYM_ANY:
+ new_name = "__internal_any";
+ break;
+
+ case GFC_ISYM_ALL:
+ new_name = "__internal_all";
+ break;
+
+ default:
+ abort ();
+ }
+
+ gfc_get_sym_tree (new_name, current_ns, &fcn->symtree, false);
+ fcn->symtree->n.sym->attr.flavor = FL_PROCEDURE;
+ fcn->symtree->n.sym->attr.function = 1;
+ fcn->symtree->n.sym->attr.elemental = 1;
+ fcn->symtree->n.sym->attr.referenced = 1;
+ fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE;
+ gfc_commit_symbol (fcn->symtree->n.sym);
+ }
+
+ (void) gfc_expr_walker (&fcn, callback_reduction, NULL);
+
+ return fcn;
+}
+
+/* Callback function for optimzation of reductions to scalars. Transform
+ ANY ([f1,f2,f3, ...]) to f1 .or. f2 .or. f3 .or. ..., with ANY,
+ SUM and PRODUCT correspondingly. Handly only the simple cases without
+ MASK and DIM. */
+
+static int
+callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_expr *fn, *arg;
+ gfc_intrinsic_op op;
+ gfc_isym_id id;
+ gfc_actual_arglist *a;
+ gfc_actual_arglist *dim;
+ gfc_constructor *c;
+ gfc_expr *res, *new_expr;
+
+ fn = *e;
+
+ if (fn->rank != 0 || fn->expr_type != EXPR_FUNCTION
+ || fn->value.function.isym == NULL)
+ return 0;
+
+ id = fn->value.function.isym->id;
+
+ if (id != GFC_ISYM_SUM && id != GFC_ISYM_PRODUCT
+ && id != GFC_ISYM_ANY && id != GFC_ISYM_ALL)
+ return 0;
+
+ a = fn->value.function.actual;
+
+ /* Don't handle MASK or DIM. */
+
+ dim = a->next;
+
+ if (dim != NULL)
+ {
+ gfc_actual_arglist *mask;
+
+ if (dim->expr != NULL)
+ return 0;
+
+ mask = dim->next;
+ if (mask != NULL)
+ if ( mask->expr != NULL)
+ return 0;
+ }
+
+ arg = a->expr;
+
+ if (arg->expr_type != EXPR_ARRAY)
+ return 0;
+
+ switch (id)
+ {
+ case GFC_ISYM_SUM:
+ op = INTRINSIC_PLUS;
+ break;
+
+ case GFC_ISYM_PRODUCT:
+ op = INTRINSIC_TIMES;
+ break;
+
+ case GFC_ISYM_ANY:
+ op = INTRINSIC_OR;
+ break;
+
+ case GFC_ISYM_ALL:
+ op = INTRINSIC_AND;
+ break;
+
+ default:
+ return 0;
+ }
+
+ c = gfc_constructor_first (arg->value.constructor);
+
+ if (c == NULL)
+ return 0;
+
+ res = copy_walk_reduction_arg (c->expr, fn);
+
+ c = gfc_constructor_next (c);
+ while (c)
+ {
+ new_expr = gfc_get_expr ();
+ new_expr->ts = fn->ts;
+ new_expr->expr_type = EXPR_OP;
+ new_expr->rank = fn->rank;
+ new_expr->where = fn->where;
+ new_expr->value.op.op = op;
+ new_expr->value.op.op1 = res;
+ new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn);
+ res = new_expr;
+ c = gfc_constructor_next (c);
+ }
+
+ gfc_simplify_expr (res, 0);
+ *e = res;
+ gfc_free_expr (fn);
+
+ /* We changed things from under the expression walker. Walking the
+ old tree would mess up things, so let's not do that. */
+ return 1;
+}
+
/* Callback function for common function elimination, called from cfe_expr_0.
Put all eligible function expressions into expr_array. */
@@ -484,6 +652,16 @@ dummy_expr_callback (gfc_expr **e ATTRIBUTE_UNUSED
return 0;
}
+/* Dummy function for code callback, for use when we really
+ don't want to do anything. */
+static int
+dummy_code_callback (gfc_code **e ATTRIBUTE_UNUSED,
+ int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ return 0;
+}
+
/* Code callback function for converting
do while(a)
end do
@@ -639,6 +817,20 @@ optimize_namespace (gfc_namespace *ns)
}
}
+static void
+optimize_reduction (gfc_namespace *ns)
+{
+ current_ns = ns;
+ gfc_code_walker (&ns->code, dummy_code_callback, callback_reduction, NULL);
+
+/* BLOCKs are handled in the expression walker below. */
+ for (ns = ns->contained; ns; ns = ns->sibling)
+ {
+ if (ns->code == NULL || ns->code->op != EXEC_BLOCK)
+ optimize_reduction (ns);
+ }
+}
+
/* Replace code like
a = matmul(b,c) + d
with
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, Fortran] PR 55806 - Inefficient ANY with array constructors
2013-01-01 20:18 [patch, Fortran] PR 55806 - Inefficient ANY with array constructors Thomas Koenig
@ 2013-01-06 16:33 ` Thomas Koenig
2013-01-08 23:16 ` *ping* " Thomas Koenig
2013-01-11 19:53 ` Mikael Morin
1 sibling, 1 reply; 8+ messages in thread
From: Thomas Koenig @ 2013-01-06 16:33 UTC (permalink / raw)
To: fortran, gcc-patches
Ping?
http://gcc.gnu.org/ml/fortran/2013-01/msg00000.html
> Hello world,
>
> the attached patch replaces ANY(a, b, c) with a .or. b .or c,
> leading to reduced execution time. It also handles ALL, PRODUCT
> and SUM.
>
> This fixes a bug noted by Michael Metcalf.
>
> Regression-tested. OK for trunk?
^ permalink raw reply [flat|nested] 8+ messages in thread
* *ping* [patch, Fortran] PR 55806 - Inefficient ANY with array constructors
2013-01-06 16:33 ` Thomas Koenig
@ 2013-01-08 23:16 ` Thomas Koenig
0 siblings, 0 replies; 8+ messages in thread
From: Thomas Koenig @ 2013-01-08 23:16 UTC (permalink / raw)
To: fortran, gcc-patches
Ping**2?
This was submitted before the review, so I think it should still be OK.
> Ping?
>
>
> http://gcc.gnu.org/ml/fortran/2013-01/msg00000.html
>
>> Hello world,
>>
>> the attached patch replaces ANY(a, b, c) with a .or. b .or c,
>> leading to reduced execution time. It also handles ALL, PRODUCT
>> and SUM.
>>
>> This fixes a bug noted by Michael Metcalf.
>>
>> Regression-tested. OK for trunk?
>
>
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, Fortran] PR 55806 - Inefficient ANY with array constructors
2013-01-01 20:18 [patch, Fortran] PR 55806 - Inefficient ANY with array constructors Thomas Koenig
2013-01-06 16:33 ` Thomas Koenig
@ 2013-01-11 19:53 ` Mikael Morin
2013-01-13 22:14 ` Thomas Koenig
1 sibling, 1 reply; 8+ messages in thread
From: Mikael Morin @ 2013-01-11 19:53 UTC (permalink / raw)
To: Thomas Koenig; +Cc: fortran, gcc-patches
Le 01/01/2013 21:18, Thomas Koenig a écrit :
> Hello world,
>
> the attached patch replaces ANY(a, b, c) with a .or. b .or c,
> leading to reduced execution time. It also handles ALL, PRODUCT
> and SUM.
>
> This fixes a bug noted by Michael Metcalf.
>
> Regression-tested. OK for trunk?
>
A few comments below.
Mikael
> Index: frontend-passes.c
> ===================================================================
> --- frontend-passes.c (Revision 194760)
> +++ frontend-passes.c (Arbeitskopie)
> @@ -180,7 +183,172 @@ optimize_expr (gfc_expr **e, int *walk_subtrees AT
> return 0;
> }
>
> +/* Auxiliary function to handle the arguments to reduction intrnisics.
> + If the function is a scalar, just copy it; otherwise Returns the new
> + element, the old one can be freed. */
>
> +static gfc_expr *
> +copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn)
> +{
> + gfc_expr *fcn;
> + const char *new_name;
> + gfc_actual_arglist *actual_arglist;
> +
> + if (e->rank == 0 || e->expr_type == EXPR_FUNCTION)
> + fcn = gfc_copy_expr (e);
> + else
> + {
> + fcn = gfc_get_expr ();
> + fcn->expr_type = EXPR_FUNCTION;
> + fcn->value.function.isym = fn->value.function.isym;
> + actual_arglist = gfc_get_actual_arglist ();
> + actual_arglist->expr = gfc_copy_expr (e);
> + actual_arglist->next = gfc_get_actual_arglist ();
Another one is needed. I get a segmentation fault with SUM.
[...]
> +
> +/* Callback function for optimzation of reductions to scalars. Transform
> + ANY ([f1,f2,f3, ...]) to f1 .or. f2 .or. f3 .or. ..., with ANY,
> + SUM and PRODUCT correspondingly. Handly only the simple cases without
> + MASK and DIM. */
> +
> +static int
> +callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
> + void *data ATTRIBUTE_UNUSED)
> +{
> + gfc_expr *fn, *arg;
> + gfc_intrinsic_op op;
> + gfc_isym_id id;
> + gfc_actual_arglist *a;
> + gfc_actual_arglist *dim;
> + gfc_constructor *c;
> + gfc_expr *res, *new_expr;
> +
> + fn = *e;
> +
> + if (fn->rank != 0 || fn->expr_type != EXPR_FUNCTION
> + || fn->value.function.isym == NULL)
> + return 0;
> +
> + id = fn->value.function.isym->id;
> +
> + if (id != GFC_ISYM_SUM && id != GFC_ISYM_PRODUCT
> + && id != GFC_ISYM_ANY && id != GFC_ISYM_ALL)
> + return 0;
> +
> + a = fn->value.function.actual;
> +
> + /* Don't handle MASK or DIM. */
> +
> + dim = a->next;
> +
> + if (dim != NULL)
> + {
Minor, but I think you can assume dim != NULL. Same for mask.
> + gfc_actual_arglist *mask;
> +
> + if (dim->expr != NULL)
> + return 0;
> +
> + mask = dim->next;
> + if (mask != NULL)
> + if ( mask->expr != NULL)
> + return 0;
> + }
> +
> + arg = a->expr;
> +
> + if (arg->expr_type != EXPR_ARRAY)
> + return 0;
> +
> + switch (id)
> + {
> + case GFC_ISYM_SUM:
> + op = INTRINSIC_PLUS;
> + break;
> +
> + case GFC_ISYM_PRODUCT:
> + op = INTRINSIC_TIMES;
> + break;
> +
> + case GFC_ISYM_ANY:
> + op = INTRINSIC_OR;
> + break;
> +
> + case GFC_ISYM_ALL:
> + op = INTRINSIC_AND;
> + break;
> +
> + default:
> + return 0;
> + }
> +
> + c = gfc_constructor_first (arg->value.constructor);
> +
> + if (c == NULL)
> + return 0;
> +
> + res = copy_walk_reduction_arg (c->expr, fn);
> +
> + c = gfc_constructor_next (c);
> + while (c)
> + {
> + new_expr = gfc_get_expr ();
> + new_expr->ts = fn->ts;
> + new_expr->expr_type = EXPR_OP;
> + new_expr->rank = fn->rank;
> + new_expr->where = fn->where;
> + new_expr->value.op.op = op;
> + new_expr->value.op.op1 = res;
> + new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn);
> + res = new_expr;
> + c = gfc_constructor_next (c);
> + }
> +
> + gfc_simplify_expr (res, 0);
> + *e = res;
> + gfc_free_expr (fn);
> +
> + /* We changed things from under the expression walker. Walking the
> + old tree would mess up things, so let's not do that. */
> + return 1;
I think this prevents any further reduction optimization. The following
variant of your test case doesn't avoid the temporary:
do i=1,3
if (any([abs(a(i,1) - b(i,1)) > acc, &
(j==i+1,j=3,8)])) cycle
if (any([abs(a(i,2) - b(i,2)) > acc, &
abs(a(i,3) - b(i,3)) > acc, lo(i,:)])) cycle
c = c + i
end do
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, Fortran] PR 55806 - Inefficient ANY with array constructors
2013-01-11 19:53 ` Mikael Morin
@ 2013-01-13 22:14 ` Thomas Koenig
2013-01-14 13:29 ` Mikael Morin
0 siblings, 1 reply; 8+ messages in thread
From: Thomas Koenig @ 2013-01-13 22:14 UTC (permalink / raw)
To: Mikael Morin; +Cc: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1637 bytes --]
Hi Mikael,
thanks a lot for your comments!
>> + actual_arglist->expr = gfc_copy_expr (e);
>> + actual_arglist->next = gfc_get_actual_arglist ();
> Another one is needed. I get a segmentation fault with SUM.
Fixed by using gfc_build_intrisic_call. I have also put SUM
into the test case.
>> + if (dim != NULL)
>> + {
> Minor, but I think you can assume dim != NULL. Same for mask.
Fixed.
>> + /* We changed things from under the expression walker. Walking the
>> + old tree would mess up things, so let's not do that. */
>> + return 1;
> I think this prevents any further reduction optimization. The following
> variant of your test case doesn't avoid the temporary:
You're right; I also could not come up with a test case where this
didn't work.
I have put this
> do i=1,3
> if (any([abs(a(i,1) - b(i,1)) > acc, &
> (j==i+1,j=3,8)])) cycle
> if (any([abs(a(i,2) - b(i,2)) > acc, &
> abs(a(i,3) - b(i,3)) > acc, lo(i,:)])) cycle
> c = c + i
> end do
into the test case.
Updated test case and patch attached.
OK for trunk?
Thomas
2013-01-13 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/55806
* frontend-passes.c (optimize_reduction): New function,
including prototype.
(callback_reduction): Likewise.
(gfc_run_passes): Also run optimize_reduction.
(copy_walk_reduction_arg): New function.
(dummy_code_callback): New function.
2013-01-13 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/55806
* gfortran.dg/array_constructor_40.f90: New test.
[-- Attachment #2: p5.diff --]
[-- Type: text/x-patch, Size: 5242 bytes --]
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 195136)
+++ frontend-passes.c (Arbeitskopie)
@@ -40,6 +40,8 @@ static bool optimize_lexical_comparison (gfc_expr
static void optimize_minmaxloc (gfc_expr **);
static bool is_empty_string (gfc_expr *e);
static void doloop_warn (gfc_namespace *);
+static void optimize_reduction (gfc_namespace *);
+static int callback_reduction (gfc_expr **, int *, void *);
/* How deep we are inside an argument list. */
@@ -107,6 +109,7 @@ gfc_run_passes (gfc_namespace *ns)
expr_array = XNEWVEC(gfc_expr **, expr_size);
optimize_namespace (ns);
+ optimize_reduction (ns);
if (gfc_option.dump_fortran_optimized)
gfc_dump_parse_tree (ns, stdout);
@@ -180,7 +183,144 @@ optimize_expr (gfc_expr **e, int *walk_subtrees AT
return 0;
}
+/* Auxiliary function to handle the arguments to reduction intrnisics. If the
+ function is a scalar, just copy it; otherwise returns the new element, the
+ old one can be freed. */
+static gfc_expr *
+copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn)
+{
+ gfc_expr *fcn;
+ gfc_isym_id id;
+
+ if (e->rank == 0 || e->expr_type == EXPR_FUNCTION)
+ fcn = gfc_copy_expr (e);
+ else
+ {
+ id = fn->value.function.isym->id;
+
+ if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT)
+ fcn = gfc_build_intrinsic_call (current_ns,
+ fn->value.function.isym->id,
+ fn->value.function.isym->name,
+ fn->where, 3, gfc_copy_expr (e),
+ NULL, NULL);
+ else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL)
+ fcn = gfc_build_intrinsic_call (current_ns,
+ fn->value.function.isym->id,
+ fn->value.function.isym->name,
+ fn->where, 2, gfc_copy_expr (e),
+ NULL);
+ else
+ gfc_error ("Illegal id in copy_walk_reduction_arg");
+
+ fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE;
+ }
+
+ (void) gfc_expr_walker (&fcn, callback_reduction, NULL);
+
+ return fcn;
+}
+
+/* Callback function for optimzation of reductions to scalars. Transform ANY
+ ([f1,f2,f3, ...]) to f1 .or. f2 .or. f3 .or. ..., with ANY, SUM and PRODUCT
+ correspondingly. Handly only the simple cases without MASK and DIM. */
+
+static int
+callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_expr *fn, *arg;
+ gfc_intrinsic_op op;
+ gfc_isym_id id;
+ gfc_actual_arglist *a;
+ gfc_actual_arglist *dim;
+ gfc_constructor *c;
+ gfc_expr *res, *new_expr;
+ gfc_actual_arglist *mask;
+
+ fn = *e;
+
+ if (fn->rank != 0 || fn->expr_type != EXPR_FUNCTION
+ || fn->value.function.isym == NULL)
+ return 0;
+
+ id = fn->value.function.isym->id;
+
+ if (id != GFC_ISYM_SUM && id != GFC_ISYM_PRODUCT
+ && id != GFC_ISYM_ANY && id != GFC_ISYM_ALL)
+ return 0;
+
+ a = fn->value.function.actual;
+
+ /* Don't handle MASK or DIM. */
+
+ dim = a->next;
+
+ if (dim->expr != NULL)
+ return 0;
+
+ mask = dim->next;
+ if (mask != NULL)
+ if ( mask->expr != NULL)
+ return 0;
+
+ arg = a->expr;
+
+ if (arg->expr_type != EXPR_ARRAY)
+ return 0;
+
+ switch (id)
+ {
+ case GFC_ISYM_SUM:
+ op = INTRINSIC_PLUS;
+ break;
+
+ case GFC_ISYM_PRODUCT:
+ op = INTRINSIC_TIMES;
+ break;
+
+ case GFC_ISYM_ANY:
+ op = INTRINSIC_OR;
+ break;
+
+ case GFC_ISYM_ALL:
+ op = INTRINSIC_AND;
+ break;
+
+ default:
+ return 0;
+ }
+
+ c = gfc_constructor_first (arg->value.constructor);
+
+ if (c == NULL)
+ return 0;
+
+ res = copy_walk_reduction_arg (c->expr, fn);
+
+ c = gfc_constructor_next (c);
+ while (c)
+ {
+ new_expr = gfc_get_expr ();
+ new_expr->ts = fn->ts;
+ new_expr->expr_type = EXPR_OP;
+ new_expr->rank = fn->rank;
+ new_expr->where = fn->where;
+ new_expr->value.op.op = op;
+ new_expr->value.op.op1 = res;
+ new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn);
+ res = new_expr;
+ c = gfc_constructor_next (c);
+ }
+
+ gfc_simplify_expr (res, 0);
+ *e = res;
+ gfc_free_expr (fn);
+
+ return 0;
+}
+
/* Callback function for common function elimination, called from cfe_expr_0.
Put all eligible function expressions into expr_array. */
@@ -484,6 +624,16 @@ dummy_expr_callback (gfc_expr **e ATTRIBUTE_UNUSED
return 0;
}
+/* Dummy function for code callback, for use when we really
+ don't want to do anything. */
+static int
+dummy_code_callback (gfc_code **e ATTRIBUTE_UNUSED,
+ int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ return 0;
+}
+
/* Code callback function for converting
do while(a)
end do
@@ -639,6 +789,20 @@ optimize_namespace (gfc_namespace *ns)
}
}
+static void
+optimize_reduction (gfc_namespace *ns)
+{
+ current_ns = ns;
+ gfc_code_walker (&ns->code, dummy_code_callback, callback_reduction, NULL);
+
+/* BLOCKs are handled in the expression walker below. */
+ for (ns = ns->contained; ns; ns = ns->sibling)
+ {
+ if (ns->code == NULL || ns->code->op != EXEC_BLOCK)
+ optimize_reduction (ns);
+ }
+}
+
/* Replace code like
a = matmul(b,c) + d
with
[-- Attachment #3: array_constructor_40.f90 --]
[-- Type: text/x-fortran, Size: 1300 bytes --]
! { dg-do run }
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
! PR 55806 - replace ANY intrinsic for array
! constructor with .or.
module mymod
implicit none
contains
subroutine bar(a,b,c, lo)
real, dimension(3,3), intent(in) :: a,b
logical, dimension(3,3), intent(in) :: lo
integer, intent(out) :: c
real, parameter :: acc = 1e-4
integer :: i,j
c = 0
do i=1,3
if (any([abs(a(i,1) - b(i,1)) > acc, &
(j==i+1,j=3,8)])) cycle
if (any([abs(a(i,2) - b(i,2)) > acc, &
abs(a(i,3) - b(i,3)) > acc, lo(i,:)])) cycle
c = c + i
end do
end subroutine bar
subroutine baz(a, b, c)
real, dimension(3,3), intent(in) :: a,b
real, intent(out) :: c
c = sum([a(1,1),a(2,2),a(3,3),b(:,1)])
end subroutine baz
end module mymod
program main
use mymod
implicit none
real, dimension(3,3) :: a,b
real :: res
integer :: c
logical lo(3,3)
data a/1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9/
b = a
b(2,2) = a(2,2) + 0.2
lo = .false.
lo(3,3) = .true.
call bar(a,b,c,lo)
if (c /= 1) call abort
call baz(a,b,res);
if (abs(res - 8.1) > 1e-5) call abort
end program main
! { dg-final { scan-tree-dump-times "while" 3 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, Fortran] PR 55806 - Inefficient ANY with array constructors
2013-01-13 22:14 ` Thomas Koenig
@ 2013-01-14 13:29 ` Mikael Morin
2013-01-14 21:51 ` Thomas Koenig
0 siblings, 1 reply; 8+ messages in thread
From: Mikael Morin @ 2013-01-14 13:29 UTC (permalink / raw)
To: Thomas Koenig; +Cc: fortran, gcc-patches
Le 13/01/2013 23:14, Thomas Koenig a écrit :
> Hi Mikael,
>
> thanks a lot for your comments!
>
>>> + actual_arglist->expr = gfc_copy_expr (e); +
>>> actual_arglist->next = gfc_get_actual_arglist ();
>> Another one is needed. I get a segmentation fault with SUM.
>
> Fixed by using gfc_build_intrisic_call.
Nice.
>
> Updated test case and patch attached.
> Index: frontend-passes.c
> ===================================================================
> --- frontend-passes.c (Revision 195136)
> +++ frontend-passes.c (Arbeitskopie)
[...]
> + else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL)
> + fcn = gfc_build_intrinsic_call (current_ns,
> + fn->value.function.isym->id,
> + fn->value.function.isym->name,
> + fn->where, 2, gfc_copy_expr (e),
> + NULL);
> + else
> + gfc_error ("Illegal id in copy_walk_reduction_arg");
This is not very useful for a user. It should be an internal error (or
gcc_unreachable would do as well).
> +
> +/* Callback function for optimzation of reductions to scalars. Transform ANY
> + ([f1,f2,f3, ...]) to f1 .or. f2 .or. f3 .or. ..., with ANY, SUM and PRODUCT
> + correspondingly. Handly only the simple cases without MASK and DIM. */
> +
> +static int
> +callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
> + void *data ATTRIBUTE_UNUSED)
> +{
> + gfc_expr *fn, *arg;
> + gfc_intrinsic_op op;
> + gfc_isym_id id;
> + gfc_actual_arglist *a;
> + gfc_actual_arglist *dim;
> + gfc_constructor *c;
> + gfc_expr *res, *new_expr;
> + gfc_actual_arglist *mask;
> +
> + fn = *e;
> +
> + if (fn->rank != 0 || fn->expr_type != EXPR_FUNCTION
> + || fn->value.function.isym == NULL)
> + return 0;
> +
> + id = fn->value.function.isym->id;
> +
> + if (id != GFC_ISYM_SUM && id != GFC_ISYM_PRODUCT
> + && id != GFC_ISYM_ANY && id != GFC_ISYM_ALL)
> + return 0;
> +
> + a = fn->value.function.actual;
> +
> + /* Don't handle MASK or DIM. */
> +
> + dim = a->next;
> +
> + if (dim->expr != NULL)
> + return 0;
> +
Trailing whitespace.
> + mask = dim->next;
> + if (mask != NULL)
> + if ( mask->expr != NULL)
> + return 0;
This is a bit confusing as mask is the first argument in the ANY/ALL
case. You can use something like this instead:
if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT)
{
mask = dim->next;
if (mask->expr != NULL)
return 0;
}
>
> OK for trunk?
>
OK with the changes suggested above. Thanks.
Mikael
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, Fortran] PR 55806 - Inefficient ANY with array constructors
2013-01-14 13:29 ` Mikael Morin
@ 2013-01-14 21:51 ` Thomas Koenig
2017-11-02 10:27 ` Bernhard Reutner-Fischer
0 siblings, 1 reply; 8+ messages in thread
From: Thomas Koenig @ 2013-01-14 21:51 UTC (permalink / raw)
To: Mikael Morin; +Cc: fortran, gcc-patches
Am 14.01.2013 14:29, schrieb Mikael Morin:
> Le 13/01/2013 23:14, Thomas Koenig a écrit :
>> OK for trunk?
>>
> OK with the changes suggested above. Thanks.
Committed as rev. 195179 with your changes.
Thanks a lot for the thorough review!
Thomas
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [patch, Fortran] PR 55806 - Inefficient ANY with array constructors
2013-01-14 21:51 ` Thomas Koenig
@ 2017-11-02 10:27 ` Bernhard Reutner-Fischer
0 siblings, 0 replies; 8+ messages in thread
From: Bernhard Reutner-Fischer @ 2017-11-02 10:27 UTC (permalink / raw)
To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches
On Mon, Jan 14, 2013 at 10:51:25PM +0100, Thomas Koenig wrote:
> Am 14.01.2013 14:29, schrieb Mikael Morin:
> > Le 13/01/2013 23:14, Thomas Koenig a écrit :
>
> > > OK for trunk?
> > >
> > OK with the changes suggested above. Thanks.
>
> Committed as rev. 195179 with your changes.
s/intrnisics/intrinsics/; # in a comment
And in r232774 this found it's way into a runtime error:
s/intrnisic/intrinsic/g
( gfortran.dg/matmul_bounds_9.f90 needs adjustment)
TIA,
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2017-11-02 10:27 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-01-01 20:18 [patch, Fortran] PR 55806 - Inefficient ANY with array constructors Thomas Koenig
2013-01-06 16:33 ` Thomas Koenig
2013-01-08 23:16 ` *ping* " Thomas Koenig
2013-01-11 19:53 ` Mikael Morin
2013-01-13 22:14 ` Thomas Koenig
2013-01-14 13:29 ` Mikael Morin
2013-01-14 21:51 ` Thomas Koenig
2017-11-02 10:27 ` Bernhard Reutner-Fischer
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).