Re: [patch, Fortran] PR 55806 - Inefficient ANY with array constructors

[Mikael Morin <mikael.morin@sfr.fr>]

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