2 Copyright (C) 2000, 2001, 2002, 2004, 2005 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
5 This file is part of GCC.
7 GCC is free software; you can redistribute it and/or modify it under
8 the terms of the GNU General Public License as published by the Free
9 Software Foundation; either version 2, or (at your option) any later
12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with GCC; see the file COPYING. If not, write to the Free
19 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
29 static char expression_syntax[] = "Syntax error in expression at %C";
32 /* Match a user-defined operator name. This is a normal name with a
33 few restrictions. The error_flag controls whether an error is
34 raised if 'true' or 'false' are used or not. */
37 gfc_match_defined_op_name (char *result, int error_flag)
39 static const char * const badops[] = {
40 "and", "or", "not", "eqv", "neqv", "eq", "ne", "ge", "le", "lt", "gt",
44 char name[GFC_MAX_SYMBOL_LEN + 1];
49 old_loc = gfc_current_locus;
51 m = gfc_match (" . %n .", name);
55 /* .true. and .false. have interpretations as constants. Trying to
56 use these as operators will fail at a later time. */
58 if (strcmp (name, "true") == 0 || strcmp (name, "false") == 0)
62 gfc_current_locus = old_loc;
66 for (i = 0; badops[i]; i++)
67 if (strcmp (badops[i], name) == 0)
70 for (i = 0; name[i]; i++)
71 if (!ISALPHA (name[i]))
73 gfc_error ("Bad character '%c' in OPERATOR name at %C", name[i]);
77 strcpy (result, name);
81 gfc_error ("The name '%s' cannot be used as a defined operator at %C",
84 gfc_current_locus = old_loc;
89 /* Match a user defined operator. The symbol found must be an
93 match_defined_operator (gfc_user_op ** result)
95 char name[GFC_MAX_SYMBOL_LEN + 1];
98 m = gfc_match_defined_op_name (name, 0);
102 *result = gfc_get_uop (name);
107 /* Check to see if the given operator is next on the input. If this
108 is not the case, the parse pointer remains where it was. */
111 next_operator (gfc_intrinsic_op t)
116 old_loc = gfc_current_locus;
117 if (gfc_match_intrinsic_op (&u) == MATCH_YES && t == u)
120 gfc_current_locus = old_loc;
125 /* Match a primary expression. */
128 match_primary (gfc_expr ** result)
132 m = gfc_match_literal_constant (result, 0);
136 m = gfc_match_array_constructor (result);
140 m = gfc_match_rvalue (result);
144 /* Match an expression in parenthesis. */
145 if (gfc_match_char ('(') != MATCH_YES)
148 m = gfc_match_expr (result);
151 if (m == MATCH_ERROR)
154 m = gfc_match_char (')');
156 gfc_error ("Expected a right parenthesis in expression at %C");
160 gfc_free_expr (*result);
167 gfc_error (expression_syntax);
172 /* Build an operator expression node. */
175 build_node (gfc_intrinsic_op operator, locus * where,
176 gfc_expr * op1, gfc_expr * op2)
180 new = gfc_get_expr ();
181 new->expr_type = EXPR_OP;
182 new->value.op.operator = operator;
185 new->value.op.op1 = op1;
186 new->value.op.op2 = op2;
192 /* Match a level 1 expression. */
195 match_level_1 (gfc_expr ** result)
202 where = gfc_current_locus;
204 m = match_defined_operator (&uop);
205 if (m == MATCH_ERROR)
208 m = match_primary (&e);
216 f = build_node (INTRINSIC_USER, &where, e, NULL);
217 f->value.op.uop = uop;
225 /* As a GNU extension we support an expanded level-2 expression syntax.
226 Via this extension we support (arbitrary) nesting of unary plus and
227 minus operations following unary and binary operators, such as **.
228 The grammar of section 7.1.1.3 is effectively rewitten as:
230 R704 mult-operand is level-1-expr [ power-op ext-mult-operand ]
231 R704' ext-mult-operand is add-op ext-mult-operand
233 R705 add-operand is add-operand mult-op ext-mult-operand
235 R705' ext-add-operand is add-op ext-add-operand
237 R706 level-2-expr is [ level-2-expr ] add-op ext-add-operand
241 static match match_ext_mult_operand (gfc_expr ** result);
242 static match match_ext_add_operand (gfc_expr ** result);
249 if (next_operator (INTRINSIC_MINUS))
251 if (next_operator (INTRINSIC_PLUS))
258 match_mult_operand (gfc_expr ** result)
260 gfc_expr *e, *exp, *r;
264 m = match_level_1 (&e);
268 if (!next_operator (INTRINSIC_POWER))
274 where = gfc_current_locus;
276 m = match_ext_mult_operand (&exp);
278 gfc_error ("Expected exponent in expression at %C");
285 r = gfc_power (e, exp);
301 match_ext_mult_operand (gfc_expr ** result)
308 where = gfc_current_locus;
312 return match_mult_operand (result);
314 if (gfc_notify_std (GFC_STD_GNU, "Extension: Unary operator following"
315 " arithmetic operator (use parentheses) at %C")
319 m = match_ext_mult_operand (&e);
324 all = gfc_uminus (e);
341 match_add_operand (gfc_expr ** result)
343 gfc_expr *all, *e, *total;
344 locus where, old_loc;
348 m = match_mult_operand (&all);
354 /* Build up a string of products or quotients. */
356 old_loc = gfc_current_locus;
358 if (next_operator (INTRINSIC_TIMES))
362 if (next_operator (INTRINSIC_DIVIDE))
363 i = INTRINSIC_DIVIDE;
368 where = gfc_current_locus;
370 m = match_ext_mult_operand (&e);
373 gfc_current_locus = old_loc;
377 if (m == MATCH_ERROR)
383 if (i == INTRINSIC_TIMES)
384 total = gfc_multiply (all, e);
386 total = gfc_divide (all, e);
405 match_ext_add_operand (gfc_expr ** result)
412 where = gfc_current_locus;
416 return match_add_operand (result);
418 if (gfc_notify_std (GFC_STD_GNU, "Extension: Unary operator following"
419 " arithmetic operator (use parentheses) at %C")
423 m = match_ext_add_operand (&e);
428 all = gfc_uminus (e);
444 /* Match a level 2 expression. */
447 match_level_2 (gfc_expr ** result)
449 gfc_expr *all, *e, *total;
454 where = gfc_current_locus;
459 m = match_ext_add_operand (&e);
462 gfc_error (expression_syntax);
467 m = match_add_operand (&e);
477 all = gfc_uminus (e);
490 /* Append add-operands to the sum */
494 where = gfc_current_locus;
499 m = match_ext_add_operand (&e);
501 gfc_error (expression_syntax);
509 total = gfc_subtract (all, e);
511 total = gfc_add (all, e);
529 /* Match a level three expression. */
532 match_level_3 (gfc_expr ** result)
534 gfc_expr *all, *e, *total;
538 m = match_level_2 (&all);
544 if (!next_operator (INTRINSIC_CONCAT))
547 where = gfc_current_locus;
549 m = match_level_2 (&e);
552 gfc_error (expression_syntax);
558 total = gfc_concat (all, e);
575 /* Match a level 4 expression. */
578 match_level_4 (gfc_expr ** result)
580 gfc_expr *left, *right, *r;
586 m = match_level_3 (&left);
590 old_loc = gfc_current_locus;
592 if (gfc_match_intrinsic_op (&i) != MATCH_YES)
598 if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
599 && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT)
601 gfc_current_locus = old_loc;
606 where = gfc_current_locus;
608 m = match_level_3 (&right);
610 gfc_error (expression_syntax);
613 gfc_free_expr (left);
620 r = gfc_eq (left, right);
624 r = gfc_ne (left, right);
628 r = gfc_lt (left, right);
632 r = gfc_le (left, right);
636 r = gfc_gt (left, right);
640 r = gfc_ge (left, right);
644 gfc_internal_error ("match_level_4(): Bad operator");
649 gfc_free_expr (left);
650 gfc_free_expr (right);
662 match_and_operand (gfc_expr ** result)
669 i = next_operator (INTRINSIC_NOT);
670 where = gfc_current_locus;
672 m = match_level_4 (&e);
695 match_or_operand (gfc_expr ** result)
697 gfc_expr *all, *e, *total;
701 m = match_and_operand (&all);
707 if (!next_operator (INTRINSIC_AND))
709 where = gfc_current_locus;
711 m = match_and_operand (&e);
713 gfc_error (expression_syntax);
720 total = gfc_and (all, e);
738 match_equiv_operand (gfc_expr ** result)
740 gfc_expr *all, *e, *total;
744 m = match_or_operand (&all);
750 if (!next_operator (INTRINSIC_OR))
752 where = gfc_current_locus;
754 m = match_or_operand (&e);
756 gfc_error (expression_syntax);
763 total = gfc_or (all, e);
780 /* Match a level 5 expression. */
783 match_level_5 (gfc_expr ** result)
785 gfc_expr *all, *e, *total;
790 m = match_equiv_operand (&all);
796 if (next_operator (INTRINSIC_EQV))
800 if (next_operator (INTRINSIC_NEQV))
806 where = gfc_current_locus;
808 m = match_equiv_operand (&e);
810 gfc_error (expression_syntax);
817 if (i == INTRINSIC_EQV)
818 total = gfc_eqv (all, e);
820 total = gfc_neqv (all, e);
838 /* Match an expression. At this level, we are stringing together
839 level 5 expressions separated by binary operators. */
842 gfc_match_expr (gfc_expr ** result)
849 m = match_level_5 (&all);
855 m = match_defined_operator (&uop);
858 if (m == MATCH_ERROR)
864 where = gfc_current_locus;
866 m = match_level_5 (&e);
868 gfc_error (expression_syntax);
875 all = build_node (INTRINSIC_USER, &where, all, e);
876 all->value.op.uop = uop;