[patch, fortran] Final TRIM optimizations

[patch, fortran] Final TRIM optimizations

[Thomas Koenig]

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

Hello world,

this is the last round of TRIM optimizations.  This patch extends the
treatment of trailing TRIMs in concatenations to comparisions.  It also
does a bit of code cleanup by removing some duplication, and by not
changing the rhs in optimize_assignment.

OK for trunk?

	Thomas

2011-06-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

         * frontend-passes.c (remove_trim):  New function.
         (optimize_assignment):  Use it.
         (optimize_comparison):  Likewise.  Return correct status
         for previous change.

2011-06-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

         * gfortran.dg/trim_optimize_8.f90:  New test case.

[-- Attachment #2: trim-final.diff --]
[-- Type: text/x-patch, Size: 3547 bytes --]

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 174958)
+++ frontend-passes.c	(Arbeitskopie)
@@ -486,6 +486,35 @@ optimize_binop_array_assignment (gfc_code *c, gfc_
   return false;
 }
 
+/* Remove unneeded TRIMs at the end of expressions.  */
+
+static bool
+remove_trim (gfc_expr *rhs)
+{
+  bool ret;
+
+  ret = false;
+
+  /* Check for a // b // trim(c).  Looping is probably not
+     necessary because the parser usually generates
+     (// (// a b ) trim(c) ) , but better safe than sorry.  */
+
+  while (rhs->expr_type == EXPR_OP
+	 && rhs->value.op.op == INTRINSIC_CONCAT)
+    rhs = rhs->value.op.op2;
+
+  while (rhs->expr_type == EXPR_FUNCTION && rhs->value.function.isym
+	 && rhs->value.function.isym->id == GFC_ISYM_TRIM)
+    {
+      strip_function_call (rhs);
+      /* Recursive call to catch silly stuff like trim ( a // trim(b)).  */
+      remove_trim (rhs);
+      ret = true;
+    }
+
+  return ret;
+}
+
 /* Optimizations for an assignment.  */
 
 static void
@@ -499,25 +528,8 @@ optimize_assignment (gfc_code * c)
   /* Optimize away a = trim(b), where a is a character variable.  */
 
   if (lhs->ts.type == BT_CHARACTER)
-    {
-      /* Check for a // b // trim(c).  Looping is probably not
-	 necessary because the parser usually generates
-	 (// (// a b ) trim(c) ) , but better safe than sorry.  */
+    remove_trim (rhs);
 
-      while (rhs->expr_type == EXPR_OP
-	     && rhs->value.op.op == INTRINSIC_CONCAT)
-	rhs = rhs->value.op.op2;
-
-      if (rhs->expr_type == EXPR_FUNCTION &&
-	  rhs->value.function.isym &&
-	  rhs->value.function.isym->id == GFC_ISYM_TRIM)
-	{
-	  strip_function_call (rhs);
-	  optimize_assignment (c);
-	  return;
-	}
-    }
-
   if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0)
     optimize_binop_array_assignment (c, &rhs, false);
 }
@@ -639,36 +651,17 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 
   /* Strip off unneeded TRIM calls from string comparisons.  */
 
-  change = false;
+  change = remove_trim (op1);
 
-  if (op1->expr_type == EXPR_FUNCTION 
-      && op1->value.function.isym
-      && op1->value.function.isym->id == GFC_ISYM_TRIM)
-    {
-      strip_function_call (op1);
-      change = true;
-    }
+  if (remove_trim (op2))
+    change = true;
 
-  if (op2->expr_type == EXPR_FUNCTION 
-      && op2->value.function.isym
-      && op2->value.function.isym->id == GFC_ISYM_TRIM)
-    {
-      strip_function_call (op2);
-      change = true;
-    }
-
-  if (change)
-    {
-      optimize_comparison (e, op);
-      return true;
-    }
-
   /* An expression of type EXPR_CONSTANT is only valid for scalars.  */
   /* TODO: A scalar constant may be acceptable in some cases (the scalarizer
      handles them well). However, there are also cases that need a non-scalar
      argument. For example the any intrinsic. See PR 45380.  */
   if (e->rank > 0)
-    return false;
+    return change;
 
   /* Don't compare REAL or COMPLEX expressions when honoring NaNs.  */
 
@@ -698,7 +691,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 			&& op2_left->expr_type == EXPR_CONSTANT
 			&& op1_left->value.character.length
 			   != op2_left->value.character.length)
-		    return false;
+		    return change;
 		  else
 		    {
 		      free (op1_left);
@@ -787,7 +780,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 	}
     }
 
-  return false;
+  return change;
 }
 
 /* Optimize a trim function by replacing it with an equivalent substring

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

! { dg-do compile }
! { dg-options "-O -fdump-tree-original" }
! Check that trailing trims are also removed from assignment of
! expressions involving concatenations of strings .
program main
  character(2) :: a,b
  character(8) :: d
  a = 'a '
  b = 'b '
  if (trim(a // trim(b)) /= 'a b ') call abort
  if (trim (trim(a) // trim(b)) /= 'ab ') call abort
end
! { dg-final { scan-tree-dump-times "string_len_trim" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

Re: [patch, fortran] Final TRIM optimizations

[Steve Kargl]

On Mon, Jun 13, 2011 at 12:24:02AM +0200, Thomas Koenig wrote:
> Hello world,
> 
> this is the last round of TRIM optimizations.  This patch extends the
> treatment of trailing TRIMs in concatenations to comparisions.  It also
> does a bit of code cleanup by removing some duplication, and by not
> changing the rhs in optimize_assignment.
> 
> OK for trunk?
> 
> 	Thomas
> 
> 2011-06-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
>         * frontend-passes.c (remove_trim):  New function.
>         (optimize_assignment):  Use it.
>         (optimize_comparison):  Likewise.  Return correct status
>         for previous change.
> 
> 2011-06-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
>         * gfortran.dg/trim_optimize_8.f90:  New test case.

OK.

-- 
Steve