URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [fortran/] [matchexp.c] - Rev 856
Go to most recent revision | Compare with Previous | Blame | View Log
/* Expression parser. Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. GCC is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3, or (at your option) any later version. GCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ #include "config.h" #include "system.h" #include "gfortran.h" #include "arith.h" #include "match.h" static char expression_syntax[] = N_("Syntax error in expression at %C"); /* Match a user-defined operator name. This is a normal name with a few restrictions. The error_flag controls whether an error is raised if 'true' or 'false' are used or not. */ match gfc_match_defined_op_name (char *result, int error_flag) { static const char * const badops[] = { "and", "or", "not", "eqv", "neqv", "eq", "ne", "ge", "le", "lt", "gt", NULL }; char name[GFC_MAX_SYMBOL_LEN + 1]; locus old_loc; match m; int i; old_loc = gfc_current_locus; m = gfc_match (" . %n .", name); if (m != MATCH_YES) return m; /* .true. and .false. have interpretations as constants. Trying to use these as operators will fail at a later time. */ if (strcmp (name, "true") == 0 || strcmp (name, "false") == 0) { if (error_flag) goto error; gfc_current_locus = old_loc; return MATCH_NO; } for (i = 0; badops[i]; i++) if (strcmp (badops[i], name) == 0) goto error; for (i = 0; name[i]; i++) if (!ISALPHA (name[i])) { gfc_error ("Bad character '%c' in OPERATOR name at %C", name[i]); return MATCH_ERROR; } strcpy (result, name); return MATCH_YES; error: gfc_error ("The name '%s' cannot be used as a defined operator at %C", name); gfc_current_locus = old_loc; return MATCH_ERROR; } /* Match a user defined operator. The symbol found must be an operator already. */ static match match_defined_operator (gfc_user_op **result) { char name[GFC_MAX_SYMBOL_LEN + 1]; match m; m = gfc_match_defined_op_name (name, 0); if (m != MATCH_YES) return m; *result = gfc_get_uop (name); return MATCH_YES; } /* Check to see if the given operator is next on the input. If this is not the case, the parse pointer remains where it was. */ static int next_operator (gfc_intrinsic_op t) { gfc_intrinsic_op u; locus old_loc; old_loc = gfc_current_locus; if (gfc_match_intrinsic_op (&u) == MATCH_YES && t == u) return 1; gfc_current_locus = old_loc; return 0; } /* Call the INTRINSIC_PARENTHESES function. This is both used explicitly, as below, or by resolve.c to generate temporaries. */ gfc_expr * gfc_get_parentheses (gfc_expr *e) { gfc_expr *e2; e2 = gfc_get_expr(); e2->expr_type = EXPR_OP; e2->ts = e->ts; e2->rank = e->rank; e2->where = e->where; e2->value.op.op = INTRINSIC_PARENTHESES; e2->value.op.op1 = e; e2->value.op.op2 = NULL; return e2; } /* Match a primary expression. */ static match match_primary (gfc_expr **result) { match m; gfc_expr *e; m = gfc_match_literal_constant (result, 0); if (m != MATCH_NO) return m; m = gfc_match_array_constructor (result); if (m != MATCH_NO) return m; m = gfc_match_rvalue (result); if (m != MATCH_NO) return m; /* Match an expression in parentheses. */ if (gfc_match_char ('(') != MATCH_YES) return MATCH_NO; m = gfc_match_expr (&e); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) return m; m = gfc_match_char (')'); if (m == MATCH_NO) gfc_error ("Expected a right parenthesis in expression at %C"); /* Now we have the expression inside the parentheses, build the expression pointing to it. By 7.1.7.2, any expression in parentheses shall be treated as a data entity. */ *result = gfc_get_parentheses (e); if (m != MATCH_YES) { gfc_free_expr (*result); return MATCH_ERROR; } return MATCH_YES; syntax: gfc_error (expression_syntax); return MATCH_ERROR; } /* Build an operator expression node. */ static gfc_expr * build_node (gfc_intrinsic_op op, locus *where, gfc_expr *op1, gfc_expr *op2) { gfc_expr *new_expr; new_expr = gfc_get_expr (); new_expr->expr_type = EXPR_OP; new_expr->value.op.op = op; new_expr->where = *where; new_expr->value.op.op1 = op1; new_expr->value.op.op2 = op2; return new_expr; } /* Match a level 1 expression. */ static match match_level_1 (gfc_expr **result) { gfc_user_op *uop; gfc_expr *e, *f; locus where; match m; where = gfc_current_locus; uop = NULL; m = match_defined_operator (&uop); if (m == MATCH_ERROR) return m; m = match_primary (&e); if (m != MATCH_YES) return m; if (uop == NULL) *result = e; else { f = build_node (INTRINSIC_USER, &where, e, NULL); f->value.op.uop = uop; *result = f; } return MATCH_YES; } /* As a GNU extension we support an expanded level-2 expression syntax. Via this extension we support (arbitrary) nesting of unary plus and minus operations following unary and binary operators, such as **. The grammar of section 7.1.1.3 is effectively rewritten as: R704 mult-operand is level-1-expr [ power-op ext-mult-operand ] R704' ext-mult-operand is add-op ext-mult-operand or mult-operand R705 add-operand is add-operand mult-op ext-mult-operand or mult-operand R705' ext-add-operand is add-op ext-add-operand or add-operand R706 level-2-expr is [ level-2-expr ] add-op ext-add-operand or add-operand */ static match match_ext_mult_operand (gfc_expr **result); static match match_ext_add_operand (gfc_expr **result); static int match_add_op (void) { if (next_operator (INTRINSIC_MINUS)) return -1; if (next_operator (INTRINSIC_PLUS)) return 1; return 0; } static match match_mult_operand (gfc_expr **result) { gfc_expr *e, *exp, *r; locus where; match m; m = match_level_1 (&e); if (m != MATCH_YES) return m; if (!next_operator (INTRINSIC_POWER)) { *result = e; return MATCH_YES; } where = gfc_current_locus; m = match_ext_mult_operand (&exp); if (m == MATCH_NO) gfc_error ("Expected exponent in expression at %C"); if (m != MATCH_YES) { gfc_free_expr (e); return MATCH_ERROR; } r = gfc_power (e, exp); if (r == NULL) { gfc_free_expr (e); gfc_free_expr (exp); return MATCH_ERROR; } r->where = where; *result = r; return MATCH_YES; } static match match_ext_mult_operand (gfc_expr **result) { gfc_expr *all, *e; locus where; match m; int i; where = gfc_current_locus; i = match_add_op (); if (i == 0) return match_mult_operand (result); if (gfc_notification_std (GFC_STD_GNU) == ERROR) { gfc_error ("Extension: Unary operator following " "arithmetic operator (use parentheses) at %C"); return MATCH_ERROR; } else gfc_warning ("Extension: Unary operator following " "arithmetic operator (use parentheses) at %C"); m = match_ext_mult_operand (&e); if (m != MATCH_YES) return m; if (i == -1) all = gfc_uminus (e); else all = gfc_uplus (e); if (all == NULL) { gfc_free_expr (e); return MATCH_ERROR; } all->where = where; *result = all; return MATCH_YES; } static match match_add_operand (gfc_expr **result) { gfc_expr *all, *e, *total; locus where, old_loc; match m; gfc_intrinsic_op i; m = match_mult_operand (&all); if (m != MATCH_YES) return m; for (;;) { /* Build up a string of products or quotients. */ old_loc = gfc_current_locus; if (next_operator (INTRINSIC_TIMES)) i = INTRINSIC_TIMES; else { if (next_operator (INTRINSIC_DIVIDE)) i = INTRINSIC_DIVIDE; else break; } where = gfc_current_locus; m = match_ext_mult_operand (&e); if (m == MATCH_NO) { gfc_current_locus = old_loc; break; } if (m == MATCH_ERROR) { gfc_free_expr (all); return MATCH_ERROR; } if (i == INTRINSIC_TIMES) total = gfc_multiply (all, e); else total = gfc_divide (all, e); if (total == NULL) { gfc_free_expr (all); gfc_free_expr (e); return MATCH_ERROR; } all = total; all->where = where; } *result = all; return MATCH_YES; } static match match_ext_add_operand (gfc_expr **result) { gfc_expr *all, *e; locus where; match m; int i; where = gfc_current_locus; i = match_add_op (); if (i == 0) return match_add_operand (result); if (gfc_notification_std (GFC_STD_GNU) == ERROR) { gfc_error ("Extension: Unary operator following " "arithmetic operator (use parentheses) at %C"); return MATCH_ERROR; } else gfc_warning ("Extension: Unary operator following " "arithmetic operator (use parentheses) at %C"); m = match_ext_add_operand (&e); if (m != MATCH_YES) return m; if (i == -1) all = gfc_uminus (e); else all = gfc_uplus (e); if (all == NULL) { gfc_free_expr (e); return MATCH_ERROR; } all->where = where; *result = all; return MATCH_YES; } /* Match a level 2 expression. */ static match match_level_2 (gfc_expr **result) { gfc_expr *all, *e, *total; locus where; match m; int i; where = gfc_current_locus; i = match_add_op (); if (i != 0) { m = match_ext_add_operand (&e); if (m == MATCH_NO) { gfc_error (expression_syntax); m = MATCH_ERROR; } } else m = match_add_operand (&e); if (m != MATCH_YES) return m; if (i == 0) all = e; else { if (i == -1) all = gfc_uminus (e); else all = gfc_uplus (e); if (all == NULL) { gfc_free_expr (e); return MATCH_ERROR; } } all->where = where; /* Append add-operands to the sum. */ for (;;) { where = gfc_current_locus; i = match_add_op (); if (i == 0) break; m = match_ext_add_operand (&e); if (m == MATCH_NO) gfc_error (expression_syntax); if (m != MATCH_YES) { gfc_free_expr (all); return MATCH_ERROR; } if (i == -1) total = gfc_subtract (all, e); else total = gfc_add (all, e); if (total == NULL) { gfc_free_expr (all); gfc_free_expr (e); return MATCH_ERROR; } all = total; all->where = where; } *result = all; return MATCH_YES; } /* Match a level three expression. */ static match match_level_3 (gfc_expr **result) { gfc_expr *all, *e, *total; locus where; match m; m = match_level_2 (&all); if (m != MATCH_YES) return m; for (;;) { if (!next_operator (INTRINSIC_CONCAT)) break; where = gfc_current_locus; m = match_level_2 (&e); if (m == MATCH_NO) { gfc_error (expression_syntax); gfc_free_expr (all); } if (m != MATCH_YES) return MATCH_ERROR; total = gfc_concat (all, e); if (total == NULL) { gfc_free_expr (all); gfc_free_expr (e); return MATCH_ERROR; } all = total; all->where = where; } *result = all; return MATCH_YES; } /* Match a level 4 expression. */ static match match_level_4 (gfc_expr **result) { gfc_expr *left, *right, *r; gfc_intrinsic_op i; locus old_loc; locus where; match m; m = match_level_3 (&left); if (m != MATCH_YES) return m; old_loc = gfc_current_locus; if (gfc_match_intrinsic_op (&i) != MATCH_YES) { *result = left; return MATCH_YES; } if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT && i != INTRINSIC_EQ_OS && i != INTRINSIC_NE_OS && i != INTRINSIC_GE_OS && i != INTRINSIC_LE_OS && i != INTRINSIC_LT_OS && i != INTRINSIC_GT_OS) { gfc_current_locus = old_loc; *result = left; return MATCH_YES; } where = gfc_current_locus; m = match_level_3 (&right); if (m == MATCH_NO) gfc_error (expression_syntax); if (m != MATCH_YES) { gfc_free_expr (left); return MATCH_ERROR; } switch (i) { case INTRINSIC_EQ: case INTRINSIC_EQ_OS: r = gfc_eq (left, right, i); break; case INTRINSIC_NE: case INTRINSIC_NE_OS: r = gfc_ne (left, right, i); break; case INTRINSIC_LT: case INTRINSIC_LT_OS: r = gfc_lt (left, right, i); break; case INTRINSIC_LE: case INTRINSIC_LE_OS: r = gfc_le (left, right, i); break; case INTRINSIC_GT: case INTRINSIC_GT_OS: r = gfc_gt (left, right, i); break; case INTRINSIC_GE: case INTRINSIC_GE_OS: r = gfc_ge (left, right, i); break; default: gfc_internal_error ("match_level_4(): Bad operator"); } if (r == NULL) { gfc_free_expr (left); gfc_free_expr (right); return MATCH_ERROR; } r->where = where; *result = r; return MATCH_YES; } static match match_and_operand (gfc_expr **result) { gfc_expr *e, *r; locus where; match m; int i; i = next_operator (INTRINSIC_NOT); where = gfc_current_locus; m = match_level_4 (&e); if (m != MATCH_YES) return m; r = e; if (i) { r = gfc_not (e); if (r == NULL) { gfc_free_expr (e); return MATCH_ERROR; } } r->where = where; *result = r; return MATCH_YES; } static match match_or_operand (gfc_expr **result) { gfc_expr *all, *e, *total; locus where; match m; m = match_and_operand (&all); if (m != MATCH_YES) return m; for (;;) { if (!next_operator (INTRINSIC_AND)) break; where = gfc_current_locus; m = match_and_operand (&e); if (m == MATCH_NO) gfc_error (expression_syntax); if (m != MATCH_YES) { gfc_free_expr (all); return MATCH_ERROR; } total = gfc_and (all, e); if (total == NULL) { gfc_free_expr (all); gfc_free_expr (e); return MATCH_ERROR; } all = total; all->where = where; } *result = all; return MATCH_YES; } static match match_equiv_operand (gfc_expr **result) { gfc_expr *all, *e, *total; locus where; match m; m = match_or_operand (&all); if (m != MATCH_YES) return m; for (;;) { if (!next_operator (INTRINSIC_OR)) break; where = gfc_current_locus; m = match_or_operand (&e); if (m == MATCH_NO) gfc_error (expression_syntax); if (m != MATCH_YES) { gfc_free_expr (all); return MATCH_ERROR; } total = gfc_or (all, e); if (total == NULL) { gfc_free_expr (all); gfc_free_expr (e); return MATCH_ERROR; } all = total; all->where = where; } *result = all; return MATCH_YES; } /* Match a level 5 expression. */ static match match_level_5 (gfc_expr **result) { gfc_expr *all, *e, *total; locus where; match m; gfc_intrinsic_op i; m = match_equiv_operand (&all); if (m != MATCH_YES) return m; for (;;) { if (next_operator (INTRINSIC_EQV)) i = INTRINSIC_EQV; else { if (next_operator (INTRINSIC_NEQV)) i = INTRINSIC_NEQV; else break; } where = gfc_current_locus; m = match_equiv_operand (&e); if (m == MATCH_NO) gfc_error (expression_syntax); if (m != MATCH_YES) { gfc_free_expr (all); return MATCH_ERROR; } if (i == INTRINSIC_EQV) total = gfc_eqv (all, e); else total = gfc_neqv (all, e); if (total == NULL) { gfc_free_expr (all); gfc_free_expr (e); return MATCH_ERROR; } all = total; all->where = where; } *result = all; return MATCH_YES; } /* Match an expression. At this level, we are stringing together level 5 expressions separated by binary operators. */ match gfc_match_expr (gfc_expr **result) { gfc_expr *all, *e; gfc_user_op *uop; locus where; match m; m = match_level_5 (&all); if (m != MATCH_YES) return m; for (;;) { uop = NULL; m = match_defined_operator (&uop); if (m == MATCH_NO) break; if (m == MATCH_ERROR) { gfc_free_expr (all); return MATCH_ERROR; } where = gfc_current_locus; m = match_level_5 (&e); if (m == MATCH_NO) gfc_error (expression_syntax); if (m != MATCH_YES) { gfc_free_expr (all); return MATCH_ERROR; } all = build_node (INTRINSIC_USER, &where, all, e); all->value.op.uop = uop; } *result = all; return MATCH_YES; }
Go to most recent revision | Compare with Previous | Blame | View Log