This adds two methods to the abstract gfc_dummy_arg and makes usage of them to simplify a bit the walking of elemental procedure arguments for scalarization. As information about dummy arguments can be obtained from the actual argument through the just-introduced associated_dummy field, there is no need to carry around the procedure interface and walk dummy arguments manually together with actual arguments.
gcc/fortran/ * gfortran.h (gfc_dummy_arg::get_typespec, gfc_dummy_arg::is_optional): Declare new methods. (gfc_formal_arglist::get_typespec, gfc_formal_arglist::is_optional): Same. (gfc_intrinsic_arg::get_typespec, gfc_intrinsic_arg::is_optional): Same. * symbol.c (gfc_formal_arglist::get_typespec, gfc_formal_arglist::is_optional): Implement new methods. * intrinsic.c (gfc_intrinsic_arg::get_typespec, gfc_intrinsic_arg::is_optional): Same. * trans.h (gfc_ss_info::dummy_arg): Use the more general interface as declaration type. * trans-array.c (gfc_scalar_elemental_arg_saved_as_reference): use get_typespec_method to get the type. (gfc_walk_elemental_function_args): Remove proc_ifc argument. Get info about the dummy arg using the associated_dummy field. * trans-array.h (gfc_walk_elemental_function_args): Update declaration. * trans-intrinsic.c (gfc_walk_intrinsic_function): Update call to gfc_walk_elemental_function_args. * trans-stmt.c (gfc_trans_call): Ditto. (get_proc_ifc_for_call): Remove. --- gcc/fortran/gfortran.h | 9 +++++++++ gcc/fortran/intrinsic.c | 13 +++++++++++++ gcc/fortran/symbol.c | 13 +++++++++++++ gcc/fortran/trans-array.c | 22 ++++++---------------- gcc/fortran/trans-array.h | 2 +- gcc/fortran/trans-intrinsic.c | 2 +- gcc/fortran/trans-stmt.c | 22 ---------------------- gcc/fortran/trans.h | 4 ++-- 8 files changed, 45 insertions(+), 42 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 78b43a31a9a..edad3d9e98c 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1135,6 +1135,9 @@ gfc_component; /* dummy arg of either an intrinsic or a user-defined procedure. */ class gfc_dummy_arg { +public: + virtual const gfc_typespec & get_typespec () const = 0; + virtual bool is_optional () const = 0; }; @@ -1145,6 +1148,9 @@ struct gfc_formal_arglist : public gfc_dummy_arg struct gfc_symbol *sym; /* Points to the next formal argument. */ struct gfc_formal_arglist *next; + + virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE; + virtual bool is_optional () const FINAL OVERRIDE; }; #define GFC_NEW(T) new (XCNEW (T)) T @@ -2181,6 +2187,9 @@ struct gfc_intrinsic_arg : public gfc_dummy_arg ENUM_BITFIELD (sym_intent) intent:2; struct gfc_intrinsic_arg *next; + + virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE; + virtual bool is_optional () const FINAL OVERRIDE; }; #define gfc_get_intrinsic_arg() GFC_NEW (gfc_intrinsic_arg) diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index ef5da389434..007cac053cb 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -5507,3 +5507,16 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func) " only be called via an explicit interface or if declared" " EXTERNAL.", sym->name, &sym->declared_at); } + + +const gfc_typespec & +gfc_intrinsic_arg::get_typespec () const +{ + return ts; +} + +bool +gfc_intrinsic_arg::is_optional () const +{ + return optional; +} diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 6d61bf4982b..59f0d0385a0 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -5259,3 +5259,16 @@ gfc_sym_get_dummy_args (gfc_symbol *sym) return dummies; } + + +const gfc_typespec & +gfc_formal_arglist::get_typespec () const +{ + return sym->ts; +} + +bool +gfc_formal_arglist::is_optional () const +{ + return sym->attr.optional; +} diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0d013defdbb..7d85abb181f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2879,7 +2879,7 @@ gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info) /* If the expression is of polymorphic type, it's actual size is not known, so we avoid copying it anywhere. */ if (ss_info->data.scalar.dummy_arg - && ss_info->data.scalar.dummy_arg->ts.type == BT_CLASS + && ss_info->data.scalar.dummy_arg->get_typespec ().type == BT_CLASS && ss_info->expr->ts.type == BT_CLASS) return true; @@ -11207,9 +11207,8 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref) gfc_ss * gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, - gfc_symbol *proc_ifc, gfc_ss_type type) + gfc_ss_type type) { - gfc_formal_arglist *dummy_arg; int scalar; gfc_ss *head; gfc_ss *tail; @@ -11218,16 +11217,12 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, head = gfc_ss_terminator; tail = NULL; - if (proc_ifc) - dummy_arg = gfc_sym_get_dummy_args (proc_ifc); - else - dummy_arg = NULL; - scalar = 1; for (; arg; arg = arg->next) { + gfc_dummy_arg * const dummy_arg = arg->associated_dummy; if (!arg->expr || arg->expr->expr_type == EXPR_NULL) - goto loop_continue; + continue; newss = gfc_walk_subexpr (head, arg->expr); if (newss == head) @@ -11237,13 +11232,13 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, newss = gfc_get_scalar_ss (head, arg->expr); newss->info->type = type; if (dummy_arg) - newss->info->data.scalar.dummy_arg = dummy_arg->sym; + newss->info->data.scalar.dummy_arg = dummy_arg; } else scalar = 0; if (dummy_arg != NULL - && dummy_arg->sym->attr.optional + && dummy_arg->is_optional () && arg->expr->expr_type == EXPR_VARIABLE && (gfc_expr_attr (arg->expr).optional || gfc_expr_attr (arg->expr).allocatable @@ -11257,10 +11252,6 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, while (tail->next != gfc_ss_terminator) tail = tail->next; } - -loop_continue: - if (dummy_arg != NULL) - dummy_arg = dummy_arg->next; } if (scalar) @@ -11319,7 +11310,6 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) ss = gfc_walk_elemental_function_args (old_ss, expr->value.function.actual, - gfc_get_proc_ifc_for_expr (expr), GFC_SS_REFERENCE); if (ss != old_ss && (comp diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index e4d443d7118..998fd284dd6 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -82,7 +82,7 @@ gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *); gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref * ref); /* Walk the arguments of an elemental function. */ gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *, - gfc_symbol *, gfc_ss_type); + gfc_ss_type); /* Walk an intrinsic function. */ gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *, gfc_intrinsic_sym *); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 46670baae55..8a9283b358d 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -11163,7 +11163,7 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr, if (isym->elemental) return gfc_walk_elemental_function_args (ss, expr->value.function.actual, - NULL, GFC_SS_SCALAR); + GFC_SS_SCALAR); if (expr->rank == 0) return ss; diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 7cbdef7a304..3fd4475f411 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -356,27 +356,6 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, } -/* Get the interface symbol for the procedure corresponding to the given call. - We can't get the procedure symbol directly as we have to handle the case - of (deferred) type-bound procedures. */ - -static gfc_symbol * -get_proc_ifc_for_call (gfc_code *c) -{ - gfc_symbol *sym; - - gcc_assert (c->op == EXEC_ASSIGN_CALL || c->op == EXEC_CALL); - - sym = gfc_get_proc_ifc_for_expr (c->expr1); - - /* Fall back/last resort try. */ - if (sym == NULL) - sym = c->resolved_sym; - - return sym; -} - - /* Translate the CALL statement. Builds a call to an F95 subroutine. */ tree @@ -402,7 +381,6 @@ gfc_trans_call (gfc_code * code, bool dependency_check, ss = gfc_ss_terminator; if (code->resolved_sym->attr.elemental) ss = gfc_walk_elemental_function_args (ss, code->ext.actual, - get_proc_ifc_for_call (code), GFC_SS_REFERENCE); /* MVBITS is inlined but needs the dependency checking found here. */ diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 78578cfd732..a17a1ec2312 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -266,8 +266,8 @@ typedef struct gfc_ss_info struct { /* If the scalar is passed as actual argument to an (elemental) procedure, - this is the symbol of the corresponding dummy argument. */ - gfc_symbol *dummy_arg; + this is the corresponding dummy argument. */ + gfc_dummy_arg *dummy_arg; tree value; /* Tells that the scalar is a reference to a variable that might be present on the lhs, so that we should evaluate the value