[patch, fortran] PR fortran/52537 Optimize string comparisons against empty strings

[patch, fortran] PR fortran/52537 Optimize string comparisons against empty strings

[Thomas Koenig]

[-- Attachment #1: Type: text/plain, Size: 846 bytes --]

Hello world,

this patch replaces  a != '' with len_trim(a) != 0, to
speed up the comparison.  It also introduces a bit of cleanup
in frontend-passes.c.

Regression-tested. OK for trunk?

	Thomas

2012-04-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/52537
         * frontend-passes.c (optimize_op):  Change
         old-style comparison operators to new-style, simplify
         switch as a result.
         (empty_string):  New function.
         (get_len_trim_call):  New function.
         (optimize_comparison):  If comparing to an empty string,
         use comparison of len_trim to zero.
         Use new-style comparison operators only.
         (optimize_trim):  Use get_len_trim_call.

2012-04-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/52537
         * gfortran.dg/string_compare_4.f90:  New test.

[-- Attachment #2: empty-string-1.diff --]
[-- Type: text/x-patch, Size: 5714 bytes --]

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 186213)
+++ frontend-passes.c	(Arbeitskopie)
@@ -796,20 +796,45 @@ optimize_op (gfc_expr *e)
 {
   gfc_intrinsic_op op = e->value.op.op;
 
+  /* Only use new-style comparisions.  */
+  switch(op)
+    {
+    case INTRINSIC_EQ_OS:
+      op = INTRINSIC_EQ;
+      break;
+
+    case INTRINSIC_GE_OS:
+      op = INTRINSIC_GE;
+      break;
+
+    case INTRINSIC_LE_OS:
+      op = INTRINSIC_LE;
+      break;
+
+    case INTRINSIC_NE_OS:
+      op = INTRINSIC_NE;
+      break;
+
+    case INTRINSIC_GT_OS:
+      op = INTRINSIC_GT;
+      break;
+
+    case INTRINSIC_LT_OS:
+      op = INTRINSIC_LT;
+      break;
+
+    default:
+      break;
+    }
+
   switch (op)
     {
     case INTRINSIC_EQ:
-    case INTRINSIC_EQ_OS:
     case INTRINSIC_GE:
-    case INTRINSIC_GE_OS:
     case INTRINSIC_LE:
-    case INTRINSIC_LE_OS:
     case INTRINSIC_NE:
-    case INTRINSIC_NE_OS:
     case INTRINSIC_GT:
-    case INTRINSIC_GT_OS:
     case INTRINSIC_LT:
-    case INTRINSIC_LT_OS:
       return optimize_comparison (e, op);
 
     default:
@@ -819,6 +844,61 @@ optimize_op (gfc_expr *e)
   return false;
 }
 
+/* Return true if a constant string contains spaces only.  */
+
+static bool
+empty_string (gfc_expr *e)
+{
+  int i;
+
+  if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT)
+    return false;
+
+  for (i=0; i<e->value.character.length; i++)
+    {
+      if (e->value.character.string[i] != ' ')
+	return false;
+    }
+
+  return true;
+}
+
+/* Insert a call to the intrinsic len_trim. Use a different name for
+   the symbol tree so we don't run into trouble when the user has
+   renamed len_trim for some reason.  */
+
+static gfc_expr*
+get_len_trim_call (gfc_expr *str, int kind)
+{
+  gfc_expr *fcn;
+  gfc_actual_arglist *actual_arglist, *next;
+
+  fcn = gfc_get_expr ();
+  fcn->expr_type = EXPR_FUNCTION;
+  fcn->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
+  actual_arglist = gfc_get_actual_arglist ();
+  actual_arglist->expr = str;
+  next = gfc_get_actual_arglist ();
+  next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, kind);
+  actual_arglist->next = next;
+
+  fcn->value.function.actual = actual_arglist;
+  fcn->where = str->where;
+  fcn->ts.type = BT_INTEGER;
+  fcn->ts.kind = gfc_charlen_int_kind;
+
+  gfc_get_sym_tree("__internal_len_trim", current_ns, &fcn->symtree, false);
+  fcn->symtree->n.sym->ts = fcn->ts;
+  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);
+
+  return fcn;
+}
+
 /* Optimize expressions for equality.  */
 
 static bool
@@ -862,6 +942,46 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
   if (e->rank > 0)
     return change;
 
+  /* Replace a == '' with len_trim(a) == 0 and a /= '' with
+     len_trim(a) != 0 */
+  if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
+      && (op == INTRINSIC_EQ || op == INTRINSIC_NE))
+    {
+
+      bool empty_op1, empty_op2;
+      empty_op1 = empty_string(op1);
+      empty_op2 = empty_string(op2);
+
+      if (empty_op1 || empty_op2)
+	{
+	  gfc_expr *fcn;
+	  gfc_expr *zero;
+	  gfc_expr *str;
+
+	  /* This can only happen when an error for comparing
+	     characters of different kinds has already been issued.  */
+	  if (empty_op1 && empty_op2)
+	    return false;
+
+	  zero = gfc_get_int_expr (gfc_charlen_int_kind, &e->where, 0);
+	  str = empty_op1 ? op2 : op1;
+
+	  fcn = get_len_trim_call (str, gfc_charlen_int_kind);
+
+
+	  if (empty_op1)
+	    gfc_free_expr (op1);
+	  else
+	    gfc_free_expr (op2);
+
+	  op1 = fcn;
+	  op2 = zero;
+	  e->value.op.op1 = fcn;
+	  e->value.op.op2 = zero;
+	}
+    }
+
+
   /* Don't compare REAL or COMPLEX expressions when honoring NaNs.  */
 
   if (flag_finite_math_only
@@ -935,32 +1055,26 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 	  switch (op)
 	    {
 	    case INTRINSIC_EQ:
-	    case INTRINSIC_EQ_OS:
 	      result = eq == 0;
 	      break;
 	      
 	    case INTRINSIC_GE:
-	    case INTRINSIC_GE_OS:
 	      result = eq >= 0;
 	      break;
 
 	    case INTRINSIC_LE:
-	    case INTRINSIC_LE_OS:
 	      result = eq <= 0;
 	      break;
 
 	    case INTRINSIC_NE:
-	    case INTRINSIC_NE_OS:
 	      result = eq != 0;
 	      break;
 
 	    case INTRINSIC_GT:
-	    case INTRINSIC_GT_OS:
 	      result = eq > 0;
 	      break;
 
 	    case INTRINSIC_LT:
-	    case INTRINSIC_LT_OS:
 	      result = eq < 0;
 	      break;
 	      
@@ -992,7 +1106,6 @@ optimize_trim (gfc_expr *e)
   gfc_expr *a;
   gfc_ref *ref;
   gfc_expr *fcn;
-  gfc_actual_arglist *actual_arglist, *next;
   gfc_ref **rr = NULL;
 
   /* Don't do this optimization within an argument list, because
@@ -1041,17 +1154,7 @@ optimize_trim (gfc_expr *e)
 
   /* Build the function call to len_trim(x, gfc_defaul_integer_kind).  */
 
-  fcn = gfc_get_expr ();
-  fcn->expr_type = EXPR_FUNCTION;
-  fcn->value.function.isym =
-    gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
-  actual_arglist = gfc_get_actual_arglist ();
-  actual_arglist->expr = gfc_copy_expr (e);
-  next = gfc_get_actual_arglist ();
-  next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
-				 gfc_default_integer_kind);
-  actual_arglist->next = next;
-  fcn->value.function.actual = actual_arglist;
+  fcn = get_len_trim_call (gfc_copy_expr (e), gfc_default_integer_kind);
 
   /* Set the end of the reference to the call to len_trim.  */
 

[-- Attachment #3: string_compare_4.f90 --]
[-- Type: text/plain, Size: 615 bytes --]

! { dg-do compile }
! { dg-options "-ffrontend-optimize -fdump-fortran-original" }
! PR fortran/52537 - optimize comparisons with empty strings
program main
  implicit none
  character(len=10) :: a
  character(len=30) :: line
  line = 'x'
  read (unit=line,fmt='(A)') a
  if (trim(a) == '') print *,"empty"
  call foo(a)
  if (trim(a) == '    ') print *,"empty"
contains
  subroutine foo(b)
    character(*) :: b
    if (b /= '   ') print *,"full"
  end subroutine foo
end program main
! { dg-final { scan-tree-dump-times "_gfortran_string_len_trim" 3 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

Re: [patch, fortran] PR fortran/52537 Optimize string comparisons against empty strings

[Thomas Koenig]

Hi Tobias,

> Hello Thomas,
>
> below a very timely review - your patch is not even a month old
> and was never pinged, besides, you have chosen an unlucky day.
> (In other words: Sorry for the slow review.)

As a matter of fact, I had become 3/4 convinced that I had already
committed this patch, which is why I didn't ping it.  So, thanks
for remembering!

> Thomas Koenig wrote on Fri, 13 Apr 2012:
>> this patch replaces  a != '' with len_trim(a) != 0, to
>> speed up the comparison.
>
> I wonder how much it helps - especially for the real world
> code. Let's see whether the bug reporter will report back.

We'll see.

>
> Can you also check kind=4 string in the test case?

Added (in the second revision of the test case, I also had
a flag wrong).

> Otherwise, the patch is OK.

The whitespace fixes you suggested have been applied.

Thanks for the review!

	Thomas

Re: [patch, fortran] PR fortran/52537 Optimize string comparisons against empty strings

[Tobias Burnus]

Hello Thomas,

below a very timely review - your patch is not even a month old
and was never pinged, besides, you have chosen an unlucky day.
(In other words: Sorry for the slow review.)

Thomas Koenig wrote on Fri, 13 Apr 2012:
> this patch replaces  a != '' with len_trim(a) != 0, to
> speed up the comparison.

I wonder how much it helps - especially for the real world
code. Let's see whether the bug reporter will report back.


Can you also check kind=4 string in the test case?
I think your patch should simply work, but having a test
surely cannot harm.


> +  /* Only use new-style comparisions.  */
> +  switch(op)
> +    {
> +    case INTRINSIC_EQ_OS:
> +      op = INTRINSIC_EQ;
> +      break;

I have to admit that I do not like that part. At least for
this patch, I think it neither makes the code clearer nor
shorter. The only hypothetical advantage I see is that it
avoids some issues related to forgetting the _OS version in
the switch statements. Thus, my answer whether I like the
change is a (very weak) NO. But my answer to whether you
may do the change is YES.


>  }
>
> +/* Return true if a constant string contains spaces only.  */

Nit: Missing line break. (Two empty lines separate functions.)
I would use "only spaces" or even "only blanks" instead of
"spaces only".


> +  for (i=0; i<e->value.character.length; i++)

Missing space around the "<", i.e. "i < e->value".

> +}
> +
> +/* Insert a call to the intrinsic len_trim. Use a different name for

Empty line missing.

> +}
> +
>  /* Optimize expressions for equality.  */

Ditto.

> +  gfc_get_sym_tree("__internal_len_trim", current_ns, &fcn->symtree, false);

Blank missing before "(".


> +    {
> +
> +      bool empty_op1, empty_op2;

Spurious empty line.


> +      empty_op1 = empty_string(op1);
> +      empty_op2 = empty_string(op2);

Blank missing before "(".


Otherwise, the patch is OK.

Tobias