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