/* Expression parser.
- Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
-This file is part of GNU G95.
+This file is part of GCC.
-GNU G95 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 2, or (at your option)
-any later version.
+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.
-GNU G95 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.
+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 GNU G95; see the file COPYING. If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
#include "config.h"
-#include <string.h>
+#include "system.h"
#include "gfortran.h"
#include "arith.h"
#include "match.h"
-static char expression_syntax[] = "Syntax error in expression at %C";
+static char expression_syntax[] = N_("Syntax error in expression at %C");
/* Match a user-defined operator name. This is a normal name with a
match m;
int i;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
m = gfc_match (" . %n .", name);
if (m != MATCH_YES)
{
if (error_flag)
goto error;
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO;
}
gfc_error ("The name '%s' cannot be used as a defined operator at %C",
name);
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_ERROR;
}
operator already. */
static match
-match_defined_operator (gfc_user_op ** result)
+match_defined_operator (gfc_user_op **result)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
match m;
gfc_intrinsic_op u;
locus old_loc;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
if (gfc_match_intrinsic_op (&u) == MATCH_YES && t == u)
return 1;
- gfc_set_locus (&old_loc);
+ 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_operator_expr (&e->where, INTRINSIC_PARENTHESES, e, NULL);
+ e2->ts = e->ts;
+ e2->rank = e->rank;
+
+ return e2;
+}
+
+
/* Match a primary expression. */
static match
-match_primary (gfc_expr ** result)
+match_primary (gfc_expr **result)
{
match m;
+ gfc_expr *e;
m = gfc_match_literal_constant (result, 0);
if (m != MATCH_NO)
if (m != MATCH_NO)
return m;
- /* Match an expression in parenthesis. */
+ /* Match an expression in parentheses. */
if (gfc_match_char ('(') != MATCH_YES)
return MATCH_NO;
- m = gfc_match_expr (result);
+ m = gfc_match_expr (&e);
if (m == MATCH_NO)
goto syntax;
if (m == MATCH_ERROR)
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);
}
-/* Build an operator expression node. */
-
-static gfc_expr *
-build_node (gfc_intrinsic_op operator, locus * where,
- gfc_expr * op1, gfc_expr * op2)
-{
- gfc_expr *new;
-
- new = gfc_get_expr ();
- new->expr_type = EXPR_OP;
- new->operator = operator;
- new->where = *where;
-
- new->op1 = op1;
- new->op2 = op2;
-
- return new;
-}
-
-
/* Match a level 1 expression. */
static match
-match_level_1 (gfc_expr ** result)
+match_level_1 (gfc_expr **result)
{
gfc_user_op *uop;
gfc_expr *e, *f;
locus where;
match m;
- where = *gfc_current_locus ();
+ gfc_gobble_whitespace ();
+ where = gfc_current_locus;
uop = NULL;
m = match_defined_operator (&uop);
if (m == MATCH_ERROR)
*result = e;
else
{
- f = build_node (INTRINSIC_USER, &where, e, NULL);
- f->uop = uop;
+ f = gfc_get_operator_expr (&where, INTRINSIC_USER, e, NULL);
+ f->value.op.uop = uop;
*result = f;
}
}
+/* 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)
+match_mult_operand (gfc_expr **result)
{
gfc_expr *e, *exp, *r;
locus where;
return MATCH_YES;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
- m = match_mult_operand (&exp);
+ m = match_ext_mult_operand (&exp);
if (m == MATCH_NO)
gfc_error ("Expected exponent in expression at %C");
if (m != MATCH_YES)
static match
-match_add_operand (gfc_expr ** result)
+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;
{
/* Build up a string of products or quotients. */
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
if (next_operator (INTRINSIC_TIMES))
i = INTRINSIC_TIMES;
break;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
- m = match_mult_operand (&e);
+ m = match_ext_mult_operand (&e);
if (m == MATCH_NO)
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
break;
}
}
-static int
-match_add_op (void)
+static match
+match_ext_add_operand (gfc_expr **result)
{
+ gfc_expr *all, *e;
+ locus where;
+ match m;
+ int i;
- if (next_operator (INTRINSIC_MINUS))
- return -1;
- if (next_operator (INTRINSIC_PLUS))
- return 1;
- return 0;
+ 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)
+match_level_2 (gfc_expr **result)
{
gfc_expr *all, *e, *total;
locus where;
match m;
int i;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
i = match_add_op ();
- m = match_add_operand (&e);
- if (i != 0 && m == MATCH_NO)
+ if (i != 0)
{
- gfc_error (expression_syntax);
- m = MATCH_ERROR;
+ 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;
all->where = where;
-/* Append add-operands to the sum */
+ /* Append add-operands to the sum. */
for (;;)
{
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
i = match_add_op ();
if (i == 0)
break;
- m = match_add_operand (&e);
+ m = match_ext_add_operand (&e);
if (m == MATCH_NO)
gfc_error (expression_syntax);
if (m != MATCH_YES)
/* Match a level three expression. */
static match
-match_level_3 (gfc_expr ** result)
+match_level_3 (gfc_expr **result)
{
gfc_expr *all, *e, *total;
locus where;
if (!next_operator (INTRINSIC_CONCAT))
break;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_level_2 (&e);
if (m == MATCH_NO)
/* Match a level 4 expression. */
static match
-match_level_4 (gfc_expr ** result)
+match_level_4 (gfc_expr **result)
{
gfc_expr *left, *right, *r;
gfc_intrinsic_op i;
if (m != MATCH_YES)
return m;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
if (gfc_match_intrinsic_op (&i) != MATCH_YES)
{
}
if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
- && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT)
+ && 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_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
*result = left;
return MATCH_YES;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_level_3 (&right);
if (m == MATCH_NO)
switch (i)
{
case INTRINSIC_EQ:
- r = gfc_eq (left, right);
+ case INTRINSIC_EQ_OS:
+ r = gfc_eq (left, right, i);
break;
case INTRINSIC_NE:
- r = gfc_ne (left, right);
+ case INTRINSIC_NE_OS:
+ r = gfc_ne (left, right, i);
break;
case INTRINSIC_LT:
- r = gfc_lt (left, right);
+ case INTRINSIC_LT_OS:
+ r = gfc_lt (left, right, i);
break;
case INTRINSIC_LE:
- r = gfc_le (left, right);
+ case INTRINSIC_LE_OS:
+ r = gfc_le (left, right, i);
break;
case INTRINSIC_GT:
- r = gfc_gt (left, right);
+ case INTRINSIC_GT_OS:
+ r = gfc_gt (left, right, i);
break;
case INTRINSIC_GE:
- r = gfc_ge (left, right);
+ case INTRINSIC_GE_OS:
+ r = gfc_ge (left, right, i);
break;
default:
static match
-match_and_operand (gfc_expr ** result)
+match_and_operand (gfc_expr **result)
{
gfc_expr *e, *r;
locus where;
int i;
i = next_operator (INTRINSIC_NOT);
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_level_4 (&e);
if (m != MATCH_YES)
static match
-match_or_operand (gfc_expr ** result)
+match_or_operand (gfc_expr **result)
{
gfc_expr *all, *e, *total;
locus where;
{
if (!next_operator (INTRINSIC_AND))
break;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_and_operand (&e);
if (m == MATCH_NO)
static match
-match_equiv_operand (gfc_expr ** result)
+match_equiv_operand (gfc_expr **result)
{
gfc_expr *all, *e, *total;
locus where;
{
if (!next_operator (INTRINSIC_OR))
break;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_or_operand (&e);
if (m == MATCH_NO)
/* Match a level 5 expression. */
static match
-match_level_5 (gfc_expr ** result)
+match_level_5 (gfc_expr **result)
{
gfc_expr *all, *e, *total;
locus where;
break;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_equiv_operand (&e);
if (m == MATCH_NO)
level 5 expressions separated by binary operators. */
match
-gfc_match_expr (gfc_expr ** result)
+gfc_match_expr (gfc_expr **result)
{
gfc_expr *all, *e;
gfc_user_op *uop;
for (;;)
{
+ uop = NULL;
m = match_defined_operator (&uop);
if (m == MATCH_NO)
break;
return MATCH_ERROR;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_level_5 (&e);
if (m == MATCH_NO)
return MATCH_ERROR;
}
- all = build_node (INTRINSIC_USER, &where, all, e);
- all->uop = uop;
+ all = gfc_get_operator_expr (&where, INTRINSIC_USER, all, e);
+ all->value.op.uop = uop;
}
*result = all;
OSDN Git Service
