Skip to content
Newer
Older
100644 698 lines (493 sloc) 16 KB
cf201ea Initial revision
andyv authored Sep 24, 2000
1 /* Expression matcher
5dafbb7 Update copyright date (Steven)
andyv authored Apr 25, 2002
2 Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
cf201ea Initial revision
andyv authored Sep 24, 2000
3 Contributed by Andy Vaught
4
a21461f 7/28
andyv authored Jul 28, 2003
5 This file is part of G95.
cf201ea Initial revision
andyv authored Sep 24, 2000
6
a21461f 7/28
andyv authored Jul 28, 2003
7 G95 is free software; you can redistribute it and/or modify
cf201ea Initial revision
andyv authored Sep 24, 2000
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
a21461f 7/28
andyv authored Jul 28, 2003
12 G95 is distributed in the hope that it will be useful,
cf201ea Initial revision
andyv authored Sep 24, 2000
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
a21461f 7/28
andyv authored Jul 28, 2003
18 along with G95; see the file COPYING. If not, write to
cf201ea Initial revision
andyv authored Sep 24, 2000
19 the Free Software Foundation, 59 Temple Place - Suite 330,
a81ffe8 3/17
andyv authored Mar 17, 2004
20 Boston, MA 02111-1307, USA. */
21
22 /* matchexp.c-- Expression parser */
23
24
4b0c574 Pawel Sawek's patch to add sometimes-needed includes. Also fixes illegal
andyv authored Apr 5, 2001
25 #include <string.h>
cf201ea Initial revision
andyv authored Sep 24, 2000
26 #include <ctype.h>
27 #include "g95.h"
a81ffe8 3/17
andyv authored Mar 17, 2004
28
29 static char expression_syntax[] = "Syntax error in expression at %C";
30
4145993 12/17/03
andyv authored Dec 18, 2003
31
32
dbcdce1 `8/9
andyv authored Aug 11, 2003
33
a81ffe8 3/17
andyv authored Mar 17, 2004
34 /* match_primary()-- Match a primary expression */
4145993 12/17/03
andyv authored Dec 18, 2003
35
a81ffe8 3/17
andyv authored Mar 17, 2004
36 static match match_primary(g95_expr **result) {
37 match y;
4145993 12/17/03
andyv authored Dec 18, 2003
38
a81ffe8 3/17
andyv authored Mar 17, 2004
39 y = g95_match_literal_constant(result, 0);
40 if (y != MATCH_NO) return y;
4145993 12/17/03
andyv authored Dec 18, 2003
41
a81ffe8 3/17
andyv authored Mar 17, 2004
42 y = g95_match_array_constructor(result);
43 if (y != MATCH_NO) return y;
44
45 y = g95_match_rvalue(result);
46 if (y != MATCH_NO) return y;
47
48 /* Match an expression in parenthesis */
49
50 if (g95_match_char('(') != MATCH_YES) return MATCH_NO;
51
52 y = g95_match_expr(result);
53 if (y == MATCH_NO) goto syntax;
54 if (y == MATCH_ERROR) return y;
55
56 y = g95_match_char(')');
57 if (y == MATCH_NO)
58 g95_error("Expected a right parenthesis in expression at %C");
dbcdce1 `8/9
andyv authored Aug 11, 2003
59
a81ffe8 3/17
andyv authored Mar 17, 2004
60 if (y != MATCH_YES) {
61 g95_free_expr(*result);
62 return MATCH_ERROR;
63 }
64
65 return MATCH_YES;
66
67 syntax:
68 g95_error(expression_syntax);
69 return MATCH_ERROR;
70 }
71
72
4145993 12/17/03
andyv authored Dec 18, 2003
73
a81ffe8 3/17
andyv authored Mar 17, 2004
74
75 /* g95_match_defined_op_name()-- Match a user-defined operator name.
76 * This is a normal name with a few restrictions. The error_flag
77 * controls whether an error is raised if 'true' or 'false' are used
78 * or not. */
79
80 match g95_match_defined_op_name(char *result, int error_flag) {
81 static char *badops[] = {
82 "and", "or", "not", "eqv", "neqv", "eq", "ne", "ge", "le", "lt", "gt", NULL };
dbcdce1 `8/9
andyv authored Aug 11, 2003
83
a81ffe8 3/17
andyv authored Mar 17, 2004
84 char nm[G95_MAX_SYMBOL_LEN+1];
85 g95_locus oldl;
86 match s;
87 int y;
4145993 12/17/03
andyv authored Dec 18, 2003
88
a81ffe8 3/17
andyv authored Mar 17, 2004
89 oldl = g95_current_locus;
90
91 s = g95_match(" . %n .", nm);
92 if (s != MATCH_YES) return s;
93
94 /* .true. and .false. have interpretations as constants. Trying to
95 * use these as operators will fail at a later time */
96
97 if (strcmp(nm, "true") == 0 || strcmp(nm, "false") == 0) {
98 if (error_flag) goto error;
99 g95_current_locus = oldl;
100 return MATCH_NO;
101 }
a21461f 7/28
andyv authored Jul 28, 2003
102
a81ffe8 3/17
andyv authored Mar 17, 2004
103 for(y=0; badops[y]; y++)
104 if (strcmp(badops[y], nm) == 0) goto error;
105
106 for(y=0; nm[y]; y++)
107 if (!isalpha(nm[y])) {
108 g95_error("Bad character '%c' in OPERATOR name at %C", nm[y]);
109 return MATCH_ERROR;
110 }
111
112 strcpy(result, nm);
113 return MATCH_YES;
114
115 error:
116 g95_error("The name '%s' cannot be used as a defined operator at %C",
117 nm);
dbcdce1 `8/9
andyv authored Aug 11, 2003
118
a81ffe8 3/17
andyv authored Mar 17, 2004
119 g95_current_locus = oldl;
120 return MATCH_ERROR;
121 }
122
123
124
125
126 /* next_operator()-- Checks to see if the given operator is next on
127 * the input. If this is not the case, the parse pointer remains
128 * where it was. */
4145993 12/17/03
andyv authored Dec 18, 2003
129
a81ffe8 3/17
andyv authored Mar 17, 2004
130 static int next_operator(g95_intrinsic_op v) {
131 g95_intrinsic_op n;
132 g95_locus old_loc;
133
134 old_loc = g95_current_locus;
135 if (g95_match_intrinsic_op(&n) == MATCH_YES && v == n) return 1;
136
137 g95_current_locus = old_loc;
138 return 0;
139 }
dbcdce1 `8/9
andyv authored Aug 11, 2003
140
4145993 12/17/03
andyv authored Dec 18, 2003
141
142
143
a81ffe8 3/17
andyv authored Mar 17, 2004
144 static int match_add_op(void) {
145
146 if (next_operator(INTRINSIC_MINUS)) return -1;
147 if (next_operator(INTRINSIC_PLUS)) return 1;
148 return 0;
149 }
a21461f 7/28
andyv authored Jul 28, 2003
150
151
4145993 12/17/03
andyv authored Dec 18, 2003
152
153
a81ffe8 3/17
andyv authored Mar 17, 2004
154 /* build_node()-- Build an operator expression node. */
155
156 static g95_expr *build_node(g95_intrinsic_op oper, g95_locus *where,
157 g95_expr *op, g95_expr *op2) {
158 g95_expr *n1;
159
160 n1 = g95_get_expr();
161 n1->type = EXPR_OP;
162 n1->operator = oper;
163 n1->where = *where;
164
165 n1->op1 = op;
166 n1->op2 = op2;
167
168 return n1;
4145993 12/17/03
andyv authored Dec 18, 2003
169 }
dbcdce1 `8/9
andyv authored Aug 11, 2003
170
171
172
a21461f 7/28
andyv authored Jul 28, 2003
173
4145993 12/17/03
andyv authored Dec 18, 2003
174 /* match_defined_operator()-- Match a user defined operator. The
a81ffe8 3/17
andyv authored Mar 17, 2004
175 * symbol found must be an operator already. */
dbcdce1 `8/9
andyv authored Aug 11, 2003
176
a81ffe8 3/17
andyv authored Mar 17, 2004
177 static match match_defined_operator(g95_user_op **rslt) {
178 char name[G95_MAX_SYMBOL_LEN+1];
179 match m;
4145993 12/17/03
andyv authored Dec 18, 2003
180
a81ffe8 3/17
andyv authored Mar 17, 2004
181 m = g95_match_defined_op_name(name, 0);
182 if (m != MATCH_YES) return m;
183
184 *rslt = g95_get_uop(name);
185 return MATCH_YES;
186 }
4145993 12/17/03
andyv authored Dec 18, 2003
187
188
a81ffe8 3/17
andyv authored Mar 17, 2004
189
190
191 /* match_level_1()-- Match a level 1 expression */
192
193 static match match_level_1(g95_expr **result) {
194 g95_user_op *op;
195 g95_expr *z, *o;
196 g95_locus where;
197 match x;
a21461f 7/28
andyv authored Jul 28, 2003
198
a81ffe8 3/17
andyv authored Mar 17, 2004
199 where = g95_current_locus;
200 op = NULL;
201 x = match_defined_operator(&op);
202 if (x == MATCH_ERROR) return x;
203
204 x = match_primary(&z);
205 if (x != MATCH_YES) return x;
4145993 12/17/03
andyv authored Dec 18, 2003
206
a81ffe8 3/17
andyv authored Mar 17, 2004
207 if (op == NULL)
208 *result = z;
209 else {
210 o = build_node(INTRINSIC_USER, &where, z, NULL);
211 o->uop = op;
212 *result = o;
213 }
214
215 return MATCH_YES;
4145993 12/17/03
andyv authored Dec 18, 2003
216 }
217
dbcdce1 `8/9
andyv authored Aug 11, 2003
218
4145993 12/17/03
andyv authored Dec 18, 2003
219
220
a81ffe8 3/17
andyv authored Mar 17, 2004
221 static match match_mult_operand(g95_expr **res) {
222 g95_expr *o, *exp, *u;
223 g95_locus where;
224 match p;
225
226 p = match_level_1(&o);
227 if (p != MATCH_YES) return p;
228
229 if (!next_operator(INTRINSIC_POWER)) {
230 *res = o;
231 return MATCH_YES;
232 }
233
234 where = g95_current_locus;
4145993 12/17/03
andyv authored Dec 18, 2003
235
a81ffe8 3/17
andyv authored Mar 17, 2004
236 p = match_mult_operand(&exp);
237 if (p == MATCH_NO) g95_error("Expected exponent in expression at %C");
238 if (p != MATCH_YES) {
239 g95_free_expr(o);
240 return MATCH_ERROR;
241 }
a21461f 7/28
andyv authored Jul 28, 2003
242
a81ffe8 3/17
andyv authored Mar 17, 2004
243 u = g95_power(o, exp);
244 if (u == NULL) {
245 g95_free_expr(o);
246 g95_free_expr(exp);
247 return MATCH_ERROR;
248 }
a21461f 7/28
andyv authored Jul 28, 2003
249
a81ffe8 3/17
andyv authored Mar 17, 2004
250 u->where = where;
251 *res = u;
4145993 12/17/03
andyv authored Dec 18, 2003
252
a81ffe8 3/17
andyv authored Mar 17, 2004
253 return MATCH_YES;
4145993 12/17/03
andyv authored Dec 18, 2003
254 }
255
256
a81ffe8 3/17
andyv authored Mar 17, 2004
257
258
259 static match match_add_operand(g95_expr **res) {
260 g95_expr *all, *f, *total;
261 g95_locus where, oldl;
262 match u;
263 int g;
264
265 u = match_mult_operand(&all);
266 if (u != MATCH_YES) return u;
267
268 for(;;) { /* Build up a string of products or quotients */
269 g = 0;
270
271 oldl = g95_current_locus;
4145993 12/17/03
andyv authored Dec 18, 2003
272
a81ffe8 3/17
andyv authored Mar 17, 2004
273 if (next_operator(INTRINSIC_TIMES))
274 g = INTRINSIC_TIMES;
275 else {
276 if (next_operator(INTRINSIC_DIVIDE))
277 g = INTRINSIC_DIVIDE;
278 else
279 break;
280 }
281
282 where = g95_current_locus;
283
284 u = match_mult_operand(&f);
285 if (u == MATCH_NO) {
286 g95_current_locus = oldl;
287 break;
288 }
4145993 12/17/03
andyv authored Dec 18, 2003
289
a81ffe8 3/17
andyv authored Mar 17, 2004
290 if (u == MATCH_ERROR) {
291 g95_free_expr(all);
292 return MATCH_ERROR;
293 }
294
295 if (g == INTRINSIC_TIMES)
296 total = g95_multiply(all, f);
297 else
298 total = g95_divide(all, f);
299
300 if (total == NULL) {
301 g95_free_expr(all);
302 g95_free_expr(f);
303 return MATCH_ERROR;
304 }
4145993 12/17/03
andyv authored Dec 18, 2003
305
a81ffe8 3/17
andyv authored Mar 17, 2004
306 all = total;
307 all->where = where;
dbcdce1 `8/9
andyv authored Aug 11, 2003
308 }
309
a81ffe8 3/17
andyv authored Mar 17, 2004
310 *res = all;
311 return MATCH_YES;
312 }
313
314
315
316
317 /* match_level_2()-- Match a level 2 expression. */
318
319 static match match_level_2(g95_expr **rslt) {
320 g95_expr *all, *b, *total;
321 g95_locus where;
322 match v;
323 int j;
324
325 where = g95_current_locus;
326 j = match_add_op();
4145993 12/17/03
andyv authored Dec 18, 2003
327
a81ffe8 3/17
andyv authored Mar 17, 2004
328 v = match_add_operand(&b);
329 if (j != 0 && v == MATCH_NO) {
330 g95_error(expression_syntax);
331 v = MATCH_ERROR;
332 }
333
334 if (v != MATCH_YES) return v;
335
336 if (j == 0)
337 all = b;
338 else {
339 if (j == -1)
340 all = g95_uminus(b);
341 else
342 all = g95_uplus(b);
4145993 12/17/03
andyv authored Dec 18, 2003
343
a81ffe8 3/17
andyv authored Mar 17, 2004
344 if (all == NULL) {
345 g95_free_expr(b);
346 return MATCH_ERROR;
347 }
348 }
4145993 12/17/03
andyv authored Dec 18, 2003
349
a81ffe8 3/17
andyv authored Mar 17, 2004
350 all->where = where;
351
352 /* Append add-operands to the sum */
353
354 for(;;) {
355 where = g95_current_locus;
356 j = match_add_op();
357 if (j == 0) break;
358
359 v = match_add_operand(&b);
360 if (v == MATCH_NO) g95_error(expression_syntax);
361 if (v != MATCH_YES) {
362 g95_free_expr(all);
4145993 12/17/03
andyv authored Dec 18, 2003
363 return MATCH_ERROR;
a81ffe8 3/17
andyv authored Mar 17, 2004
364 }
365
366 if (j == -1)
367 total = g95_subtract(all, b);
368 else
369 total = g95_add(all, b);
370
371 if (total == NULL) {
372 g95_free_expr(all);
373 g95_free_expr(b);
374 return MATCH_ERROR;
375 }
376
377 all = total;
378 all->where = where;
379 }
380
381 *rslt = all;
382 return MATCH_YES;
383 }
384
4145993 12/17/03
andyv authored Dec 18, 2003
385
a21461f 7/28
andyv authored Jul 28, 2003
386
dbcdce1 `8/9
andyv authored Aug 11, 2003
387
a81ffe8 3/17
andyv authored Mar 17, 2004
388 /* match_level_3()-- Match a level three expression */
4145993 12/17/03
andyv authored Dec 18, 2003
389
a81ffe8 3/17
andyv authored Mar 17, 2004
390 static match match_level_3(g95_expr **result) {
391 g95_expr *all, *p, *total;
392 g95_locus where;
393 match y;
a21461f 7/28
andyv authored Jul 28, 2003
394
a81ffe8 3/17
andyv authored Mar 17, 2004
395 y = match_level_2(&all);
396 if (y != MATCH_YES) return y;
397
398 for(;;) {
399 if (!next_operator(INTRINSIC_CONCAT)) break;
400
401 where = g95_current_locus;
402
403 y = match_level_2(&p);
404 if (y == MATCH_NO) {
405 g95_error(expression_syntax);
4145993 12/17/03
andyv authored Dec 18, 2003
406 g95_free_expr(all);
a81ffe8 3/17
andyv authored Mar 17, 2004
407 }
408 if (y != MATCH_YES) return MATCH_ERROR;
409
410 total = g95_concat(all, p);
411 if (total == NULL) {
412 g95_free_expr(all);
413 g95_free_expr(p);
414 return MATCH_ERROR;
415 }
416
4145993 12/17/03
andyv authored Dec 18, 2003
417 all = total;
a81ffe8 3/17
andyv authored Mar 17, 2004
418 all->where = where;
419 }
420
421 *result = all;
4145993 12/17/03
andyv authored Dec 18, 2003
422 return MATCH_YES;
a81ffe8 3/17
andyv authored Mar 17, 2004
423 }
4145993 12/17/03
andyv authored Dec 18, 2003
424
a81ffe8 3/17
andyv authored Mar 17, 2004
425
426
4145993 12/17/03
andyv authored Dec 18, 2003
427
a81ffe8 3/17
andyv authored Mar 17, 2004
428 /* match_level_4()-- Match a level 4 expression */
a21461f 7/28
andyv authored Jul 28, 2003
429
a81ffe8 3/17
andyv authored Mar 17, 2004
430 static match match_level_4(g95_expr **result) {
431 g95_expr *left, *right, *t;
432 g95_locus old, where;
433 g95_intrinsic_op l;
434 match n;
435
436 n = match_level_3(&left);
437 if (n != MATCH_YES) return n;
4145993 12/17/03
andyv authored Dec 18, 2003
438
a81ffe8 3/17
andyv authored Mar 17, 2004
439 old = g95_current_locus;
440
441 if (g95_match_intrinsic_op(&l) != MATCH_YES) {
442 *result = left;
443 return MATCH_YES;
444 }
445
446 if (l != INTRINSIC_EQ && l != INTRINSIC_NE && l != INTRINSIC_GE &&
447 l != INTRINSIC_LE && l != INTRINSIC_LT && l != INTRINSIC_GT) {
448 g95_current_locus = old;
449 *result = left;
450 return MATCH_YES;
451 }
452
453 where = g95_current_locus;
454
455 n = match_level_3(&right);
456 if (n == MATCH_NO) g95_error(expression_syntax);
457 if (n != MATCH_YES) {
458 g95_free_expr(left);
459 return MATCH_ERROR;
460 }
461
462 switch(l) {
4145993 12/17/03
andyv authored Dec 18, 2003
463 case INTRINSIC_EQ:
a81ffe8 3/17
andyv authored Mar 17, 2004
464 t = g95_eq(left, right);
465 break;
466
467 case INTRINSIC_NE:
468 t = g95_ne(left, right);
469 break;
470
471 case INTRINSIC_LT:
472 t = g95_lt(left, right);
4145993 12/17/03
andyv authored Dec 18, 2003
473 break;
474
a81ffe8 3/17
andyv authored Mar 17, 2004
475 case INTRINSIC_LE:
476 t = g95_le(left, right);
4145993 12/17/03
andyv authored Dec 18, 2003
477 break;
478
a81ffe8 3/17
andyv authored Mar 17, 2004
479 case INTRINSIC_GT:
480 t = g95_gt(left, right);
481 break;
482
483 case INTRINSIC_GE:
484 t = g95_ge(left, right);
4145993 12/17/03
andyv authored Dec 18, 2003
485 break;
486
487 default:
dbcdce1 `8/9
andyv authored Aug 11, 2003
488 g95_internal_error("match_level_4(): Bad operator");
a81ffe8 3/17
andyv authored Mar 17, 2004
489 }
490
491 if (t == NULL) {
492 g95_free_expr(left);
493 g95_free_expr(right);
494 return MATCH_ERROR;
495 }
dbcdce1 `8/9
andyv authored Aug 11, 2003
496
a81ffe8 3/17
andyv authored Mar 17, 2004
497 t->where = where;
498 *result = t;
499
500 return MATCH_YES;
501 }
dbcdce1 `8/9
andyv authored Aug 11, 2003
502
a81ffe8 3/17
andyv authored Mar 17, 2004
503
504
a21461f 7/28
andyv authored Jul 28, 2003
505
a81ffe8 3/17
andyv authored Mar 17, 2004
506 static match match_and_operand(g95_expr **result) {
507 g95_expr *u, *l;
508 g95_locus where;
509 match o;
510 int d;
4145993 12/17/03
andyv authored Dec 18, 2003
511
a81ffe8 3/17
andyv authored Mar 17, 2004
512 d = next_operator(INTRINSIC_NOT);
513 where = g95_current_locus;
514
515 o = match_level_4(&u);
516 if (o != MATCH_YES) return o;
517
518 l = u;
519 if (d) {
520 l = g95_not(u);
521 if (l == NULL) {
522 g95_free_expr(u);
523 return MATCH_ERROR;
524 }
4145993 12/17/03
andyv authored Dec 18, 2003
525 }
526
a81ffe8 3/17
andyv authored Mar 17, 2004
527 l->where = where;
528 *result = l;
529
530 return MATCH_YES;
531 }
532
533
a21461f 7/28
andyv authored Jul 28, 2003
534
a81ffe8 3/17
andyv authored Mar 17, 2004
535
536 static match match_or_operand(g95_expr **res) {
537 g95_expr *all, *e, *total;
538 g95_locus where;
539 match k;
540
4145993 12/17/03
andyv authored Dec 18, 2003
541 k = match_and_operand(&all);
a81ffe8 3/17
andyv authored Mar 17, 2004
542 if (k != MATCH_YES) return k;
543
544 for(;;) {
4145993 12/17/03
andyv authored Dec 18, 2003
545 if (!next_operator(INTRINSIC_AND)) break;
a81ffe8 3/17
andyv authored Mar 17, 2004
546 where = g95_current_locus;
547
548 k = match_and_operand(&e);
549 if (k == MATCH_NO) g95_error(expression_syntax);
550 if (k != MATCH_YES) {
551 g95_free_expr(all);
552 return MATCH_ERROR;
553 }
554
555 total = g95_and(all, e);
556 if (total == NULL) {
557 g95_free_expr(all);
558 g95_free_expr(e);
559 return MATCH_ERROR;
dbcdce1 `8/9
andyv authored Aug 11, 2003
560 }
561
a81ffe8 3/17
andyv authored Mar 17, 2004
562 all = total;
563 all->where = where;
564 }
565
566 *res = all;
567 return MATCH_YES;
568 }
a21461f 7/28
andyv authored Jul 28, 2003
569
a81ffe8 3/17
andyv authored Mar 17, 2004
570
571
572
573 static match match_equiv_operand(g95_expr **res) {
574 g95_expr *all, *q, *total;
575 g95_locus where;
576 match l;
577
578 l = match_or_operand(&all);
579 if (l != MATCH_YES) return l;
4145993 12/17/03
andyv authored Dec 18, 2003
580
a81ffe8 3/17
andyv authored Mar 17, 2004
581 for(;;) {
582 if (!next_operator(INTRINSIC_OR)) break;
583 where = g95_current_locus;
4145993 12/17/03
andyv authored Dec 18, 2003
584
a81ffe8 3/17
andyv authored Mar 17, 2004
585 l = match_or_operand(&q);
586 if (l == MATCH_NO) g95_error(expression_syntax);
587 if (l != MATCH_YES) {
588 g95_free_expr(all);
589 return MATCH_ERROR;
590 }
4145993 12/17/03
andyv authored Dec 18, 2003
591
a81ffe8 3/17
andyv authored Mar 17, 2004
592 total = g95_or(all, q);
593 if (total == NULL) {
dbcdce1 `8/9
andyv authored Aug 11, 2003
594 g95_free_expr(all);
a81ffe8 3/17
andyv authored Mar 17, 2004
595 g95_free_expr(q);
a21461f 7/28
andyv authored Jul 28, 2003
596 return MATCH_ERROR;
a81ffe8 3/17
andyv authored Mar 17, 2004
597 }
598
599 all = total;
600 all->where = where;
601 }
602
603 *res = all;
604 return MATCH_YES;
605 }
606
607
608
609
610 /* match_level_5()-- Match a level 5 expression */
4145993 12/17/03
andyv authored Dec 18, 2003
611
a81ffe8 3/17
andyv authored Mar 17, 2004
612 static match match_level_5(g95_expr **r) {
613 g95_expr *all, *n, *total;
614 g95_locus where;
615 match k;
616 int p;
617
618 k = match_equiv_operand(&all);
619 if (k != MATCH_YES) return k;
620
621 for(;;) {
4145993 12/17/03
andyv authored Dec 18, 2003
622 if (next_operator(INTRINSIC_EQV))
a81ffe8 3/17
andyv authored Mar 17, 2004
623 p = INTRINSIC_EQV;
624 else {
625 if (next_operator(INTRINSIC_NEQV))
626 p = INTRINSIC_NEQV;
627 else
628 break;
dbcdce1 `8/9
andyv authored Aug 11, 2003
629 }
630
a81ffe8 3/17
andyv authored Mar 17, 2004
631 where = g95_current_locus;
632
633 k = match_equiv_operand(&n);
634 if (k == MATCH_NO) g95_error(expression_syntax);
635 if (k != MATCH_YES) {
636 g95_free_expr(all);
637 return MATCH_ERROR;
638 }
639
640 if (p == INTRINSIC_EQV)
641 total = g95_eqv(all, n);
642 else
643 total = g95_neqv(all, n);
644
4145993 12/17/03
andyv authored Dec 18, 2003
645 if (total == NULL) {
a81ffe8 3/17
andyv authored Mar 17, 2004
646 g95_free_expr(all);
647 g95_free_expr(n);
648 return MATCH_ERROR;
649 }
650
651 all = total;
652 all->where = where;
653 }
4145993 12/17/03
andyv authored Dec 18, 2003
654
a81ffe8 3/17
andyv authored Mar 17, 2004
655 *r = all;
656 return MATCH_YES;
657 }
658
659
660
661
662 /* g95_match_expr()-- Match an expression. At this level, we are
663 * stringing together level 5 expressions separated by binary operators. */
664
665 match g95_match_expr(g95_expr **rslt) {
666 g95_expr *all, *f;
667 g95_user_op *op;
668 g95_locus where;
669 match s;
4145993 12/17/03
andyv authored Dec 18, 2003
670
a81ffe8 3/17
andyv authored Mar 17, 2004
671 s = match_level_5(&all);
672 if (s != MATCH_YES) return s;
673
674 for(;;) {
675 s = match_defined_operator(&op);
676 if (s == MATCH_NO) break;
677 if (s == MATCH_ERROR) {
678 g95_free_expr(all);
679 return MATCH_ERROR;
680 }
681
682 where = g95_current_locus;
683
684 s = match_level_5(&f);
685 if (s == MATCH_NO) g95_error(expression_syntax);
686 if (s != MATCH_YES) {
687 g95_free_expr(all);
688 return MATCH_ERROR;
689 }
690
691 all = build_node(INTRINSIC_USER, &where, all, f);
692 all->uop = op;
693 }
4145993 12/17/03
andyv authored Dec 18, 2003
694
a81ffe8 3/17
andyv authored Mar 17, 2004
695 *rslt = all;
4145993 12/17/03
andyv authored Dec 18, 2003
696 return MATCH_YES;
a81ffe8 3/17
andyv authored Mar 17, 2004
697 }
Something went wrong with that request. Please try again.