Patchwork [fortran] Optimize some more string comparisons

login
register
mail settings
Submitter Thomas Koenig
Date Oct. 9, 2010, 8:21 a.m.
Message ID <1286612501.4999.3.camel@linux-fd1f.site>
Download mbox | patch
Permalink /patch/67315/
State New
Headers show

Comments

Thomas Koenig - Oct. 9, 2010, 8:21 a.m.
Hello world,

the attached patch simplifies some more cases of string comparisons. For
example, when comparing 'a' // x vs. 'b' // y, the result can be
calculated directly.  Also, for 'a' // x vs. 'a' // y, it is sufficient
to compare x vs. y.

Regression-tested.  OK for trunk?

	Thomas

2010-10-09  Thomas Koenig  <tkoenig@gcc.gnu.org>

	* frontend-passes.c:  Include opts.h.
	(optimize_comparison):  Renamed from optimize_equality.
	Change second argument to operation to be compared.
	Use flag_finite_math_only to avoid comparing REAL and
	COMPLEX only when NANs are honored.  Simplify comparing
	of string concatenations where left or right operands are
	equal.  Simplify all comparison operations, based on the result
	of gfc_dep_compare_expr.
	* dependency.c:  Include arith.h.
	(gfc_are_identical_variables):  Volatile variables should not
	compare equal to themselves.
	(gfc_dep_compare_expr):  Handle string constants and string
	concatenations.

2010-10-09  Thomas Koenig  <tkoenig@gcc.gnu.org>

	* gfortran.dg/character_comparison_4.f90:  New test.
	* gfortran.dg/character_comparison_5.f90:  New test.
	* gfortran.dg/character_comparison_6.f90:  New test.
Steve Kargl - Oct. 9, 2010, 3:01 p.m.
On Sat, Oct 09, 2010 at 10:21:41AM +0200, Thomas Koenig wrote:
> 
> 2010-10-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
> 	* frontend-passes.c:  Include opts.h.
> 	(optimize_comparison):  Renamed from optimize_equality.
> 	Change second argument to operation to be compared.
> 	Use flag_finite_math_only to avoid comparing REAL and
> 	COMPLEX only when NANs are honored.  Simplify comparing
> 	of string concatenations where left or right operands are
> 	equal.  Simplify all comparison operations, based on the result
> 	of gfc_dep_compare_expr.
> 	* dependency.c:  Include arith.h.
> 	(gfc_are_identical_variables):  Volatile variables should not
> 	compare equal to themselves.
> 	(gfc_dep_compare_expr):  Handle string constants and string
> 	concatenations.
> 
> 2010-10-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
> 	* gfortran.dg/character_comparison_4.f90:  New test.
> 	* gfortran.dg/character_comparison_5.f90:  New test.
> 	* gfortran.dg/character_comparison_6.f90:  New test.

OK.
Thomas Koenig - Oct. 10, 2010, 9:53 a.m.
Hello Steve,

> On Sat, Oct 09, 2010 at 10:21:41AM +0200, Thomas Koenig wrote:
> > 
> > 2010-10-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
> > 
> > 	* frontend-passes.c:  Include opts.h.
> > 	(optimize_comparison):  Renamed from optimize_equality.
> > 	Change second argument to operation to be compared.
> > 	Use flag_finite_math_only to avoid comparing REAL and
> > 	COMPLEX only when NANs are honored.  Simplify comparing
> > 	of string concatenations where left or right operands are
> > 	equal.  Simplify all comparison operations, based on the result
> > 	of gfc_dep_compare_expr.
> > 	* dependency.c:  Include arith.h.
> > 	(gfc_are_identical_variables):  Volatile variables should not
> > 	compare equal to themselves.
> > 	(gfc_dep_compare_expr):  Handle string constants and string
> > 	concatenations.
> > 
> > 2010-10-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
> > 
> > 	* gfortran.dg/character_comparison_4.f90:  New test.
> > 	* gfortran.dg/character_comparison_5.f90:  New test.
> > 	* gfortran.dg/character_comparison_6.f90:  New test.
> 
> OK.

Waiting for Emacs...
Sending        fortran/ChangeLog
Sending        fortran/dependency.c
Sending        fortran/frontend-passes.c
Sending        testsuite/ChangeLog
Adding         testsuite/gfortran.dg/character_comparison_4.f90
Adding         testsuite/gfortran.dg/character_comparison_5.f90
Adding         testsuite/gfortran.dg/character_comparison_6.f90
Transmitting file data .......
Committed revision 165248.

Thanks a lot for the review!

	Thomas

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 165124)
+++ frontend-passes.c	(Arbeitskopie)
@@ -25,6 +25,7 @@  along with GCC; see the file COPYING3.  If not see
 #include "flags.h"
 #include "dependency.h"
 #include "constructor.h"
+#include "opts.h"
 
 /* Forward declarations.  */
 
@@ -32,7 +33,7 @@  static void strip_function_call (gfc_expr *);
 static void optimize_namespace (gfc_namespace *);
 static void optimize_assignment (gfc_code *);
 static bool optimize_op (gfc_expr *);
-static bool optimize_equality (gfc_expr *, bool);
+static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op);
 
 /* Entry point - run all passes for a namespace.  So far, only an
    optimization pass is run.  */
@@ -226,15 +227,13 @@  optimize_op (gfc_expr *e)
     case INTRINSIC_GE_OS:
     case INTRINSIC_LE:
     case INTRINSIC_LE_OS:
-      return optimize_equality (e, true);
-
     case INTRINSIC_NE:
     case INTRINSIC_NE_OS:
     case INTRINSIC_GT:
     case INTRINSIC_GT_OS:
     case INTRINSIC_LT:
     case INTRINSIC_LT_OS:
-      return optimize_equality (e, false);
+      return optimize_comparison (e, op);
 
     default:
       break;
@@ -246,10 +245,12 @@  optimize_op (gfc_expr *e)
 /* Optimize expressions for equality.  */
 
 static bool
-optimize_equality (gfc_expr *e, bool equal)
+optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
 {
   gfc_expr *op1, *op2;
   bool change;
+  int eq;
+  bool result;
 
   op1 = e->value.op.op1;
   op2 = e->value.op.op2;
@@ -276,7 +277,7 @@  static bool
 
   if (change)
     {
-      optimize_equality (e, equal);
+      optimize_comparison (e, op);
       return true;
     }
 
@@ -287,22 +288,106 @@  static bool
   if (e->rank > 0)
     return false;
 
-  /* Check for direct comparison between identical variables.  Don't compare
-     REAL or COMPLEX because of NaN checks.  */
-  if (op1->expr_type == EXPR_VARIABLE
-      && op2->expr_type == EXPR_VARIABLE
-      && op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
-      && op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX
-      && gfc_are_identical_variables (op1, op2))
+  /* Don't compare REAL or COMPLEX expressions when honoring NaNs.  */
+
+  if (flag_finite_math_only
+      || (op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
+	  && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX))
     {
-      /* Replace the expression by a constant expression.  The typespec
-	 and where remains the way it is.  */
-      gfc_free (op1);
-      gfc_free (op2);
-      e->expr_type = EXPR_CONSTANT;
-      e->value.logical = equal;
-      return true;
+      eq = gfc_dep_compare_expr (op1, op2);
+      if (eq == -2)
+	{
+	  /* Replace A // B < A // C with B < C, and A // B < C // B
+	     with A < C.  */
+	  if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
+	      && op1->value.op.op == INTRINSIC_CONCAT
+	      && op2->value.op.op == INTRINSIC_CONCAT)
+	    {
+	      gfc_expr *op1_left = op1->value.op.op1;
+	      gfc_expr *op2_left = op2->value.op.op1;
+	      gfc_expr *op1_right = op1->value.op.op2;
+	      gfc_expr *op2_right = op2->value.op.op2;
+
+	      if (gfc_dep_compare_expr (op1_left, op2_left) == 0)
+		{
+		  /* Watch out for 'A ' // x vs. 'A' // x.  */
+
+		  if (op1_left->expr_type == EXPR_CONSTANT
+			&& op2_left->expr_type == EXPR_CONSTANT
+			&& op1_left->value.character.length
+			   != op2_left->value.character.length)
+		    return -2;
+		  else
+		    {
+		      gfc_free (op1_left);
+		      gfc_free (op2_left);
+		      e->value.op.op1 = op1_right;
+		      e->value.op.op2 = op2_right;
+		      optimize_comparison (e, op);
+		      return true;
+		    }
+		}
+	      if (gfc_dep_compare_expr (op1_right, op2_right) == 0)
+		{
+		  gfc_free (op1_right);
+		  gfc_free (op2_right);
+		  e->value.op.op1 = op1_left;
+		  e->value.op.op2 = op2_left;
+		  optimize_comparison (e, op);
+		  return true;
+		}
+	    }
+	}
+      else
+	{
+	  /* eq can only be -1, 0 or 1 at this point.  */
+	  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;
+	      
+	    default:
+	      gfc_internal_error ("illegal OP in optimize_comparison");
+	      break;
+	    }
+
+	  /* Replace the expression by a constant expression.  The typespec
+	     and where remains the way it is.  */
+	  gfc_free (op1);
+	  gfc_free (op2);
+	  e->expr_type = EXPR_CONSTANT;
+	  e->value.logical = result;
+	  return true;
+	}
     }
+
   return false;
 }
 
Index: dependency.c
===================================================================
--- dependency.c	(Revision 165124)
+++ dependency.c	(Arbeitskopie)
@@ -29,6 +29,7 @@  along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "dependency.h"
 #include "constructor.h"
+#include "arith.h"
 
 /* static declarations */
 /* Enums  */
@@ -125,6 +126,11 @@  gfc_are_identical_variables (gfc_expr *e1, gfc_exp
   if (e1->symtree->n.sym != e2->symtree->n.sym)
     return false;
 
+  /* Volatile variables should never compare equal to themselves.  */
+
+  if (e1->symtree->n.sym->attr.volatile_)
+    return false;
+
   r1 = e1->ref;
   r2 = e2->ref;
 
@@ -306,6 +312,42 @@  gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 	}
     }
 
+  /* Compare A // B vs. C // D.  */
+
+  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_CONCAT
+      && e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_CONCAT)
+    {
+      int l, r;
+
+      l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+      r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+
+      if (l == -2)
+	return -2;
+
+      if (l == 0)
+	{
+	  /* Watch out for 'A ' // x vs. 'A' // x.  */
+	  gfc_expr *e1_left = e1->value.op.op1;
+	  gfc_expr *e2_left = e2->value.op.op1;
+
+	  if (e1_left->expr_type == EXPR_CONSTANT
+	      && e2_left->expr_type == EXPR_CONSTANT
+	      && e1_left->value.character.length
+	        != e2_left->value.character.length)
+	    return -2;
+	  else
+	    return r;
+	}
+      else
+	{
+	  if (l != 0)
+	    return l;
+	  else
+	    return r;
+	}
+    }
+
   /* Compare X vs. X-C.  */
   if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
     {
@@ -321,6 +363,10 @@  gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
   switch (e1->expr_type)
     {
     case EXPR_CONSTANT:
+      /* Compare strings for equality.  */
+      if (e1->ts.type == BT_CHARACTER && e2->ts.type == BT_CHARACTER)
+	return gfc_compare_string (e1, e2);
+
       if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
 	return -2;