* [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).