[patch, fortran] Extend character optimization to LLE and friends

[Thomas Koenig <tkoenig at netcologne dot de>]

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.

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;
 		}

Attachment: character_comparison_8.f90
Description: Text document