[gcc r12-5316] fortran: simplify elemental arguments walking

[gcc r12-5316] fortran: simplify elemental arguments walking

[Mikael Morin]

https://gcc.gnu.org/g:5d9d16db96f2fcb47a00a7ce7e2d0e51400b47ab

commit r12-5316-g5d9d16db96f2fcb47a00a7ce7e2d0e51400b47ab
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Sun Nov 7 14:40:11 2021 +0100

    fortran: simplify elemental arguments walking
    
    This adds two functions working with the wrapper struct 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/ChangeLog:
            * interface.c (gfc_dummy_arg_get_typespec,
            gfc_dummy_arg_is_optional): New functions.
            * gfortran.h (gfc_dummy_arg_get_typespec,
            gfc_dummy_arg_is_optional): Declare them.
            * trans.h (gfc_ss_info::dummy_arg): Use the wrapper type
            as declaration type.
            * trans-array.c (gfc_scalar_elemental_arg_saved_as_reference):
            use gfc_dummy_arg_get_typespec function 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.

Diff:
---
 gcc/fortran/gfortran.h        |  4 ++++
 gcc/fortran/interface.c       | 34 ++++++++++++++++++++++++++++++++++
 gcc/fortran/trans-array.c     | 19 ++++++-------------
 gcc/fortran/trans-array.h     |  2 +-
 gcc/fortran/trans-intrinsic.c |  2 +-
 gcc/fortran/trans-stmt.c      | 22 ----------------------
 gcc/fortran/trans.h           |  4 ++--
 7 files changed, 48 insertions(+), 39 deletions(-)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 86c096a9da7..4230b5ae2dc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2334,6 +2334,10 @@ struct gfc_dummy_arg
 #define gfc_get_dummy_arg() XCNEW (gfc_dummy_arg)
 
 
+const gfc_typespec & gfc_dummy_arg_get_typespec (gfc_dummy_arg &);
+bool gfc_dummy_arg_is_optional (gfc_dummy_arg &);
+
+
 /* Specifies the various kinds of check functions used to verify the
    argument lists of intrinsic functions. fX with X an integer refer
    to check functions of intrinsics with X arguments. f1m is used for
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 2c9d371ba2d..9194fe745ed 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -5537,3 +5537,37 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sym,
       f = &((*f)->next);
     }
 }
+
+
+const gfc_typespec &
+gfc_dummy_arg_get_typespec (gfc_dummy_arg & dummy_arg)
+{
+  switch (dummy_arg.intrinsicness)
+    {
+    case GFC_INTRINSIC_DUMMY_ARG:
+      return dummy_arg.u.intrinsic->ts;
+
+    case GFC_NON_INTRINSIC_DUMMY_ARG:
+      return dummy_arg.u.non_intrinsic->sym->ts;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
+
+bool
+gfc_dummy_arg_is_optional (gfc_dummy_arg & dummy_arg)
+{
+  switch (dummy_arg.intrinsicness)
+    {
+    case GFC_INTRINSIC_DUMMY_ARG:
+      return dummy_arg.u.intrinsic->optional;
+
+    case GFC_NON_INTRINSIC_DUMMY_ARG:
+      return dummy_arg.u.non_intrinsic->sym->attr.optional;
+
+    default:
+      gcc_unreachable ();
+    }
+}
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 79321854498..d37c1e7ad7f 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3010,7 +3010,8 @@ 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
+      && gfc_dummy_arg_get_typespec (*ss_info->data.scalar.dummy_arg).type
+	 == BT_CLASS
       && ss_info->expr->ts.type == BT_CLASS)
     return true;
 
@@ -11521,9 +11522,8 @@ arg_evaluated_for_scalarization (gfc_intrinsic_sym *function,
 gfc_ss *
 gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
 				  gfc_intrinsic_sym *intrinsic_sym,
-				  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;
@@ -11532,15 +11532,11 @@ 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;
-
   int arg_num = 0;
   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
 	  || !arg_evaluated_for_scalarization (intrinsic_sym, *arg, arg_num))
@@ -11554,13 +11550,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
+	  && gfc_dummy_arg_is_optional (*dummy_arg)
 	  && arg->expr->expr_type == EXPR_VARIABLE
 	  && (gfc_expr_attr (arg->expr).optional
 	      || gfc_expr_attr (arg->expr).allocatable
@@ -11577,8 +11573,6 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
 
 loop_continue:
       arg_num++;
-      if (dummy_arg != NULL)
-	dummy_arg = dummy_arg->next;
     }
 
   if (scalar)
@@ -11638,7 +11632,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_intrinsic_for_expr (expr),
-					     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 8f806c32f80..9c4bd06d414 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -87,7 +87,7 @@ 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_intrinsic_sym *,
-					  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 3f867911af5..c1b51f4da26 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -11085,7 +11085,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,
 					     expr->value.function.isym,
-					     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 bdf7957c4a0..1fc6d3adda5 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -375,27 +375,6 @@ get_intrinsic_for_code (gfc_code *code)
 }
 
 
-/* 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
@@ -422,7 +401,6 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
   if (code->resolved_sym->attr.elemental)
     ss = gfc_walk_elemental_function_args (ss, code->ext.actual,
 					   get_intrinsic_for_code (code),
-					   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 0d4eed20d20..15012a336ff 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