This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
* 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.
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
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |