[patch, fortran] PR20923 gfortran slow for large array constructors

[Jerry DeLisle <jvdelisle at verizon dot net>]

Hi folks,

This patch cuts the compilation time for some programs with large array 
constructors in half.  It does this by traversing the constructor and only 
calling the more complicated expand_constructor for expression types that are 
EXPR_ARRAY.

Since gfc_constant_ac can be called recursively, this simplification indeed has 
significant benefit.

I do not see a real need for another test case since all it would accomplish is 
lengthen the time it takes to run the test suite.  One interesting side effect 
of this was an ICE in gfc_conv_array_constructor_expr, at 
fortran/trans-expr.c:3832.  This occurs with the following test case where the 
limit of 65535 is exceeded.

integer, parameter :: n=65536
integer, parameter :: i(n)=(/(mod(k,2),k=1,n)/)
integer, parameter :: m(n)=i(n:1:-1)
print *, i(1), m(1), i(n), m(n)
end

This takes several minutes before hitting the error:

integer, parameter :: i(n)=(/(mod(k,2),k=1,n)/)
                           1
Error: The number of elements in the array constructor at (1) requires an 
increase of the allowed 65535 upper limit.   See -fmax-array-constructor option

The ICE occurs after the error message.

I tried several ways to avoid the ICE with no avail.  I opted to change the 
error to a gfc_fatal_error.  If one thinks about it, this really is a fatal error.

The test case which shows the improvement is:

program sel
    implicit none
    integer,parameter              :: n=1000
    integer                        :: i,j
    real,dimension(n*n) :: vect
    vect(:) = (/ ((( (i+j+3)),i=1,n),j=1,n) /)
end

$ time gfc44 pr20923.f90

real	0m18.616s
user	0m17.173s
sys	0m0.063s

$ time gfc pr20923.f90

real	0m9.467s
user	0m8.764s
sys	0m0.044s

Regression tested on x86-64=linux-gnu.  OK for trunk?  Is this sufficient to 
close the PR or shall I leave it open?

Regards,

Jerry

2009-12-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/20923
	* trans-array.c (gfc_conv_array_initializer): Change gfc_error_now to
	gfc_fatal_error.
	* array.c (count_elements): Whitespace. (extract_element): Whitespace.
	(is_constant_element): Changed name from constant_element.
	(gfc_constant_element): Only use expand_construuctor for expression
	types of EXPR_ARRAY.  If expression type is EXPR_CONSTANT, no need to
	call gfc_is_constant_expr.

Index: trans-array.c
===================================================================
--- trans-array.c	(revision 155006)
+++ trans-array.c	(working copy)
@@ -4109,11 +4109,11 @@ gfc_conv_array_initializer (tree type, gfc_expr *
             {
               /* Problems occur when we get something like
                  integer :: a(lots) = (/(i, i=1, lots)/)  */
-              gfc_error_now ("The number of elements in the array constructor "
-			     "at %L requires an increase of the allowed %d "
-			     "upper limit.   See -fmax-array-constructor "
-			     "option", &expr->where,
-			     gfc_option.flag_max_array_constructor);
+              gfc_fatal_error ("The number of elements in the array constructor "
+			       "at %L requires an increase of the allowed %d "
+			       "upper limit.   See -fmax-array-constructor "
+			       "option", &expr->where,
+			       gfc_option.flag_max_array_constructor);
 	      return NULL_TREE;
 	    }
           if (mpz_cmp_si (c->n.offset, 0) != 0)
Index: array.c
===================================================================
--- array.c	(revision 155006)
+++ array.c	(working copy)
@@ -1237,7 +1237,6 @@ count_elements (gfc_expr *e)
 static gfc_try
 extract_element (gfc_expr *e)
 {
-
   if (e->rank != 0)
     {				/* Something unextractable */
       gfc_free_expr (e);
@@ -1250,6 +1249,7 @@ extract_element (gfc_expr *e)
     gfc_free_expr (e);
 
   current_expand.extract_count++;
+  
   return SUCCESS;
 }
 
@@ -1495,7 +1495,7 @@ done:
    FAILURE if not so.  */
 
 static gfc_try
-constant_element (gfc_expr *e)
+is_constant_element (gfc_expr *e)
 {
   int rv;
 
@@ -1517,14 +1517,38 @@ gfc_constant_ac (gfc_expr *e)
 {
   expand_info expand_save;
   gfc_try rc;
+  gfc_constructor * con;
+  
+  rc = SUCCESS;
 
-  iter_stack = NULL;
-  expand_save = current_expand;
-  current_expand.expand_work_function = constant_element;
+  if (e->value.constructor
+      && e->value.constructor->expr->expr_type == EXPR_ARRAY 
+      && !e->value.constructor->iterator)
+    {
+      /* Expand the constructor.  */
+      iter_stack = NULL;
+      expand_save = current_expand;
+      current_expand.expand_work_function = is_constant_element;
 
-  rc = expand_constructor (e->value.constructor);
+      rc = expand_constructor (e->value.constructor);
 
-  current_expand = expand_save;
+      current_expand = expand_save;
+    }
+  else
+    {
+      /* No need to expand this further.  */
+      for (con = e->value.constructor; con; con = con->next)
+	{
+	  if (con->expr->expr_type == EXPR_CONSTANT)
+	    continue;
+	  else
+	    {
+	      if (!gfc_is_constant_expr (con->expr))
+		rc = FAILURE;
+	    }
+	}
+    }
+
   if (rc == FAILURE)
     return 0;
 
Index: expr.c
===================================================================
--- expr.c	(revision 155006)
+++ expr.c	(working copy)
@@ -2438,15 +2438,18 @@ gfc_reduce_init_expr (gfc_expr *expr)
   if (t == FAILURE)
     return FAILURE;
 
-  if (expr->expr_type == EXPR_ARRAY
-      && (gfc_check_constructor_type (expr) == FAILURE
-      || gfc_expand_constructor (expr) == FAILURE))
-    return FAILURE;
+  if (expr->expr_type == EXPR_ARRAY)
+    {
+      if (gfc_check_constructor_type (expr) == FAILURE)
+	return FAILURE;
+      if (gfc_expand_constructor (expr) == FAILURE)
+	return FAILURE;
+    }
 
   /* Not all inquiry functions are simplified to constant expressions
      so it is necessary to call check_inquiry again.  */ 
-  if (!gfc_is_constant_expr (expr) && check_inquiry (expr, 1) != MATCH_YES
-      && !gfc_in_match_data ())
+  if (expr->ts.type == BT_UNKNOWN && !gfc_is_constant_expr (expr)
+      && check_inquiry (expr, 1) != MATCH_YES && !gfc_in_match_data ())
     {
       gfc_error ("Initialization expression didn't reduce %C");
       return FAILURE;