diff mbox

[fortran] Extend character optimization to LLE and friends

Message ID 4D90D869.40503@netcologne.de
State New
Headers show

Commit Message

Thomas Koenig March 28, 2011, 6:50 p.m. UTC 
Hello world,

the attached patch extends the character optimizations to the lexical 
comparison functions (LLE and friends).

Regression-tested.  OK for trunk?

	Thomas


2010-03-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

         * frontend-passes (optimize_lexical_comparison): New function.
         (optimize_expr): Call it.
         (optimize_comparison): Also handle lexical comparison functions.
         Return false instad of -2 for unequal comparison.

2010-03-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

         * gfortran.dg/character_comparison_8.f90:  New test.
! { dg-do run }
! { dg-options "-O -fdump-tree-original" }
! Check for compile-time optimization of LLE and friends.
program main
  character(3) :: a
  a = 'ab'
  if (.not. LLE(a,a)) call abort
  if (LLT(a,a)) call abort
  if (.not. LGE(a,a)) call abort
  if (LGT(a,a)) call abort
end program main
! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

Comments

Richard Henderson March 28, 2011, 8:07 p.m. UTC | #1 
On 03/28/2011 11:50 AM, Thomas Koenig wrote:
> +    case GFC_ISYM_LLE:
> +      return optimize_comparison (e, INTRINSIC_LE);
> +      break;

Style nit: remove the unreachable break statements.


r~
Thomas Koenig March 28, 2011, 9:02 p.m. UTC | #2 
Am 28.03.2011 22:07, schrieb Richard Henderson:
> Style nit: remove the unreachable break statements.

Fixed, thanks.

Any further comments?

	Thomas
Jerry DeLisle April 1, 2011, 1:29 p.m. UTC | #3 
On 03/28/2011 11:50 AM, Thomas Koenig wrote:
> Hello world,
>
> the attached patch extends the character optimizations to the lexical comparison
> functions (LLE and friends).
>
> Regression-tested. OK for trunk?
>

Yes, this patch is OK?

Thanks,

Jerry
Jerry DeLisle April 1, 2011, 2:14 p.m. UTC | #4 
On 04/01/2011 06:29 AM, Jerry DeLisle wrote:
> On 03/28/2011 11:50 AM, Thomas Koenig wrote:
>> Hello world,
>>
>> the attached patch extends the character optimizations to the lexical comparison
>> functions (LLE and friends).
>>
>> Regression-tested. OK for trunk?
>>
>
> Yes, this patch is OK?

Fat fingers, s/?/./

No question.

Jerry
diff mbox

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 171618)
+++ frontend-passes.c	(Arbeitskopie)
@@ -35,6 +35,7 @@  static void optimize_assignment (gfc_code *);
 static bool optimize_op (gfc_expr *);
 static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op);
 static bool optimize_trim (gfc_expr *);
+static bool optimize_lexical_comparison (gfc_expr *);
 
 /* How deep we are inside an argument list.  */
 
@@ -119,6 +120,9 @@  optimize_expr (gfc_expr **e, int *walk_subtrees AT
   if (optimize_trim (*e))
     gfc_simplify_expr (*e, 0);
 
+  if (optimize_lexical_comparison (*e))
+    gfc_simplify_expr (*e, 0);
+
   if ((*e)->expr_type == EXPR_OP && optimize_op (*e))
     gfc_simplify_expr (*e, 0);
 
@@ -474,6 +478,38 @@  strip_function_call (gfc_expr *e)
 
 }
 
+/* Optimization of lexical comparison functions.  */
+
+static bool
+optimize_lexical_comparison (gfc_expr *e)
+{
+  if (e->expr_type != EXPR_FUNCTION || e->value.function.isym == NULL)
+    return false;
+
+  switch (e->value.function.isym->id)
+    {
+    case GFC_ISYM_LLE:
+      return optimize_comparison (e, INTRINSIC_LE);
+      break;
+
+    case GFC_ISYM_LGE:
+      return optimize_comparison (e, INTRINSIC_GE);
+      break;
+
+    case GFC_ISYM_LGT:
+      return optimize_comparison (e, INTRINSIC_GT);
+      break;
+
+    case GFC_ISYM_LLT:
+      return optimize_comparison (e, INTRINSIC_LT);
+      break;
+
+    default:
+      break;
+    }
+  return false;
+}
+
 /* Recursive optimization of operators.  */
 
 static bool
@@ -513,9 +549,25 @@  optimize_comparison (gfc_expr *e, gfc_intrinsic_op
   bool change;
   int eq;
   bool result;
+  gfc_actual_arglist *firstarg, *secondarg;
 
-  op1 = e->value.op.op1;
-  op2 = e->value.op.op2;
+  if (e->expr_type == EXPR_OP)
+    {
+      firstarg = NULL;
+      secondarg = NULL;
+      op1 = e->value.op.op1;
+      op2 = e->value.op.op2;
+    }
+  else if (e->expr_type == EXPR_FUNCTION)
+    {
+      /* One of the lexical comparision functions.  */
+      firstarg = e->value.function.actual;
+      secondarg = firstarg->next;
+      op1 = firstarg->expr;
+      op2 = secondarg->expr;
+    }
+  else
+    gcc_unreachable ();
 
   /* Strip off unneeded TRIM calls from string comparisons.  */
 
@@ -578,13 +630,21 @@  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 -2;
+		    return false;
 		  else
 		    {
 		      gfc_free (op1_left);
 		      gfc_free (op2_left);
-		      e->value.op.op1 = op1_right;
-		      e->value.op.op2 = op2_right;
+		      if (firstarg)
+			{
+			  firstarg->expr = op1_right;
+			  secondarg->expr = op2_right;
+			}
+		      else
+			{
+			  e->value.op.op1 = op1_right;
+			  e->value.op.op2 = op2_right;
+			}
 		      optimize_comparison (e, op);
 		      return true;
 		    }
@@ -593,8 +653,17 @@  optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 		{
 		  gfc_free (op1_right);
 		  gfc_free (op2_right);
-		  e->value.op.op1 = op1_left;
-		  e->value.op.op2 = op2_left;
+		  if (firstarg)
+		    {
+		      firstarg->expr = op1_left;
+		      secondarg->expr = op2_left;
+		    }
+		  else
+		    {
+		      e->value.op.op1 = op1_left;
+		      e->value.op.op2 = op2_left;
+		    }
+
 		  optimize_comparison (e, op);
 		  return true;
 		}