/* Expression parser.
- Copyright (C) 2000, 2001, 2002, 2004 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 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 2, or (at your option) any later
+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
for more details.
You should have received a copy of the GNU General Public License
-along with GCC; 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 rewitten 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 add-operand
*/
-static match match_ext_mult_operand (gfc_expr ** result);
-static match match_ext_add_operand (gfc_expr ** result);
-
+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))
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_ext_mult_operand (&exp);
if (m == MATCH_NO)
static match
-match_ext_mult_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 ();
+ where = gfc_current_locus;
i = match_add_op ();
if (i == 0)
return match_mult_operand (result);
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Unary operator following"
- " arithmetic operator (use parentheses) at %C")
- == FAILURE)
- return MATCH_ERROR;
+ 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)
static match
-match_add_operand (gfc_expr ** result)
+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_ext_mult_operand (&e);
if (m == MATCH_NO)
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
break;
}
static match
-match_ext_add_operand (gfc_expr ** result)
+match_ext_add_operand (gfc_expr **result)
{
gfc_expr *all, *e;
locus where;
match m;
int i;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
i = match_add_op ();
if (i == 0)
return match_add_operand (result);
- if (gfc_notify_std (GFC_STD_GNU, "Extension: Unary operator following"
- " arithmetic operator (use parentheses) at %C")
- == FAILURE)
- return MATCH_ERROR;
+ 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)
/* 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 ();
if (i != 0)
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;
/* 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
