gcc/fortran/matchexp.c

   1 /* Expression parser.
   2    Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007
   3    Free Software Foundation, Inc.
   4    Contributed by Andy Vaught
   5
   6 This file is part of GCC.
   7
   8 GCC is free software; you can redistribute it and/or modify it under
   9 the terms of the GNU General Public License as published by the Free
  10 Software Foundation; either version 2, or (at your option) any later
  11 version.
  12
  13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GCC; see the file COPYING.  If not, write to the Free
  20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
  21 02110-1301, USA.  */
  22
  23 #include "config.h"
  24 #include "system.h"
  25 #include "gfortran.h"
  26 #include "arith.h"
  27 #include "match.h"
  28
  29 static char expression_syntax[] = N_("Syntax error in expression at %C");
  30
  31
  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.  */
  35
  36 match
  37 gfc_match_defined_op_name (char *result, int error_flag)
  38 {
  39   static const char * const badops[] = {
  40     "and", "or", "not", "eqv", "neqv", "eq", "ne", "ge", "le", "lt", "gt",
  41       NULL
  42   };
  43
  44   char name[GFC_MAX_SYMBOL_LEN + 1];
  45   locus old_loc;
  46   match m;
  47   int i;
  48
  49   old_loc = gfc_current_locus;
  50
  51   m = gfc_match (" . %n .", name);
  52   if (m != MATCH_YES)
  53     return m;
  54
  55   /* .true. and .false. have interpretations as constants.  Trying to
  56      use these as operators will fail at a later time.  */
  57
  58   if (strcmp (name, "true") == 0 || strcmp (name, "false") == 0)
  59     {
  60       if (error_flag)
  61         goto error;
  62       gfc_current_locus = old_loc;
  63       return MATCH_NO;
  64     }
  65
  66   for (i = 0; badops[i]; i++)
  67     if (strcmp (badops[i], name) == 0)
  68       goto error;
  69
  70   for (i = 0; name[i]; i++)
  71     if (!ISALPHA (name[i]))
  72       {
  73         gfc_error ("Bad character '%c' in OPERATOR name at %C", name[i]);
  74         return MATCH_ERROR;
  75       }
  76
  77   strcpy (result, name);
  78   return MATCH_YES;
  79
  80 error:
  81   gfc_error ("The name '%s' cannot be used as a defined operator at %C",
  82              name);
  83
  84   gfc_current_locus = old_loc;
  85   return MATCH_ERROR;
  86 }
  87
  88
  89 /* Match a user defined operator.  The symbol found must be an
  90    operator already.  */
  91
  92 static match
  93 match_defined_operator (gfc_user_op **result)
  94 {
  95   char name[GFC_MAX_SYMBOL_LEN + 1];
  96   match m;
  97
  98   m = gfc_match_defined_op_name (name, 0);
  99   if (m != MATCH_YES)
 100     return m;
 101
 102   *result = gfc_get_uop (name);
 103   return MATCH_YES;
 104 }
 105
 106
 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.  */
 109
 110 static int
 111 next_operator (gfc_intrinsic_op t)
 112 {
 113   gfc_intrinsic_op u;
 114   locus old_loc;
 115
 116   old_loc = gfc_current_locus;
 117   if (gfc_match_intrinsic_op (&u) == MATCH_YES && t == u)
 118     return 1;
 119
 120   gfc_current_locus = old_loc;
 121   return 0;
 122 }
 123
 124
 125 /* Call the INTRINSIC_PARENTHESES function.  This is both
 126    used explicitly, as below, or by resolve.c to generate
 127    temporaries.  */
 128
 129 gfc_expr *
 130 gfc_get_parentheses (gfc_expr *e)
 131 {
 132   gfc_expr *e2;
 133
 134   /* This is a temporary fix, awaiting the patch for various
 135      other character problems.  The resolution and translation
 136      of substrings and concatenations are so kludged up that
 137      putting parentheses around them breaks everything.  */
 138   if (e->ts.type == BT_CHARACTER && e->ref)
 139     return e;
 140
 141   e2 = gfc_get_expr();
 142   e2->expr_type = EXPR_OP;
 143   e2->ts = e->ts;
 144   e2->rank = e->rank;
 145   e2->where = e->where;
 146   e2->value.op.operator = INTRINSIC_PARENTHESES;
 147   e2->value.op.op1 = e;
 148   e2->value.op.op2 = NULL;
 149   return e2;
 150 }
 151
 152
 153 /* Match a primary expression.  */
 154
 155 static match
 156 match_primary (gfc_expr **result)
 157 {
 158   match m;
 159   gfc_expr *e;
 160   locus where;
 161
 162   m = gfc_match_literal_constant (result, 0);
 163   if (m != MATCH_NO)
 164     return m;
 165
 166   m = gfc_match_array_constructor (result);
 167   if (m != MATCH_NO)
 168     return m;
 169
 170   m = gfc_match_rvalue (result);
 171   if (m != MATCH_NO)
 172     return m;
 173
 174   /* Match an expression in parentheses.  */
 175   where = gfc_current_locus;
 176
 177   if (gfc_match_char ('(') != MATCH_YES)
 178     return MATCH_NO;
 179
 180   m = gfc_match_expr (&e);
 181   if (m == MATCH_NO)
 182     goto syntax;
 183   if (m == MATCH_ERROR)
 184     return m;
 185
 186   m = gfc_match_char (')');
 187   if (m == MATCH_NO)
 188     gfc_error ("Expected a right parenthesis in expression at %C");
 189
 190   /* Now we have the expression inside the parentheses, build the
 191      expression pointing to it. By 7.1.7.2, any expression in
 192      parentheses shall be treated as a data entity.  */
 193   *result = gfc_get_parentheses (e);
 194
 195   if (m != MATCH_YES)
 196     {
 197       gfc_free_expr (*result);
 198       return MATCH_ERROR;
 199     }
 200
 201   return MATCH_YES;
 202
 203 syntax:
 204   gfc_error (expression_syntax);
 205   return MATCH_ERROR;
 206 }
 207
 208
 209 /* Build an operator expression node.  */
 210
 211 static gfc_expr *
 212 build_node (gfc_intrinsic_op operator, locus *where,
 213             gfc_expr *op1, gfc_expr *op2)
 214 {
 215   gfc_expr *new;
 216
 217   new = gfc_get_expr ();
 218   new->expr_type = EXPR_OP;
 219   new->value.op.operator = operator;
 220   new->where = *where;
 221
 222   new->value.op.op1 = op1;
 223   new->value.op.op2 = op2;
 224
 225   return new;
 226 }
 227
 228
 229 /* Match a level 1 expression.  */
 230
 231 static match
 232 match_level_1 (gfc_expr **result)
 233 {
 234   gfc_user_op *uop;
 235   gfc_expr *e, *f;
 236   locus where;
 237   match m;
 238
 239   where = gfc_current_locus;
 240   uop = NULL;
 241   m = match_defined_operator (&uop);
 242   if (m == MATCH_ERROR)
 243     return m;
 244
 245   m = match_primary (&e);
 246   if (m != MATCH_YES)
 247     return m;
 248
 249   if (uop == NULL)
 250     *result = e;
 251   else
 252     {
 253       f = build_node (INTRINSIC_USER, &where, e, NULL);
 254       f->value.op.uop = uop;
 255       *result = f;
 256     }
 257
 258   return MATCH_YES;
 259 }
 260
 261
 262 /* As a GNU extension we support an expanded level-2 expression syntax.
 263    Via this extension we support (arbitrary) nesting of unary plus and
 264    minus operations following unary and binary operators, such as **.
 265    The grammar of section 7.1.1.3 is effectively rewitten as:
 266
 267         R704  mult-operand     is level-1-expr [ power-op ext-mult-operand ]
 268         R704' ext-mult-operand is add-op ext-mult-operand
 269                                or mult-operand
 270         R705  add-operand      is add-operand mult-op ext-mult-operand
 271                                or mult-operand
 272         R705' ext-add-operand  is add-op ext-add-operand
 273                                or add-operand
 274         R706  level-2-expr     is [ level-2-expr ] add-op ext-add-operand
 275                                or add-operand
 276  */
 277
 278 static match match_ext_mult_operand (gfc_expr **result);
 279 static match match_ext_add_operand (gfc_expr **result);
 280
 281 static int
 282 match_add_op (void)
 283 {
 284   if (next_operator (INTRINSIC_MINUS))
 285     return -1;
 286   if (next_operator (INTRINSIC_PLUS))
 287     return 1;
 288   return 0;
 289 }
 290
 291
 292 static match
 293 match_mult_operand (gfc_expr **result)
 294 {
 295   gfc_expr *e, *exp, *r;
 296   locus where;
 297   match m;
 298
 299   m = match_level_1 (&e);
 300   if (m != MATCH_YES)
 301     return m;
 302
 303   if (!next_operator (INTRINSIC_POWER))
 304     {
 305       *result = e;
 306       return MATCH_YES;
 307     }
 308
 309   where = gfc_current_locus;
 310
 311   m = match_ext_mult_operand (&exp);
 312   if (m == MATCH_NO)
 313     gfc_error ("Expected exponent in expression at %C");
 314   if (m != MATCH_YES)
 315     {
 316       gfc_free_expr (e);
 317       return MATCH_ERROR;
 318     }
 319
 320   r = gfc_power (e, exp);
 321   if (r == NULL)
 322     {
 323       gfc_free_expr (e);
 324       gfc_free_expr (exp);
 325       return MATCH_ERROR;
 326     }
 327
 328   r->where = where;
 329   *result = r;
 330
 331   return MATCH_YES;
 332 }
 333
 334
 335 static match
 336 match_ext_mult_operand (gfc_expr **result)
 337 {
 338   gfc_expr *all, *e;
 339   locus where;
 340   match m;
 341   int i;
 342
 343   where = gfc_current_locus;
 344   i = match_add_op ();
 345
 346   if (i == 0)
 347     return match_mult_operand (result);
 348
 349   if (gfc_notify_std (GFC_STD_GNU, "Extension: Unary operator following "
 350                       "arithmetic operator (use parentheses) at %C")
 351       == FAILURE)
 352     return MATCH_ERROR;
 353
 354   m = match_ext_mult_operand (&e);
 355   if (m != MATCH_YES)
 356     return m;
 357
 358   if (i == -1)
 359     all = gfc_uminus (e);
 360   else
 361     all = gfc_uplus (e);
 362
 363   if (all == NULL)
 364     {
 365       gfc_free_expr (e);
 366       return MATCH_ERROR;
 367     }
 368
 369   all->where = where;
 370   *result = all;
 371   return MATCH_YES;
 372 }
 373
 374
 375 static match
 376 match_add_operand (gfc_expr **result)
 377 {
 378   gfc_expr *all, *e, *total;
 379   locus where, old_loc;
 380   match m;
 381   gfc_intrinsic_op i;
 382
 383   m = match_mult_operand (&all);
 384   if (m != MATCH_YES)
 385     return m;
 386
 387   for (;;)
 388     {
 389       /* Build up a string of products or quotients.  */
 390
 391       old_loc = gfc_current_locus;
 392
 393       if (next_operator (INTRINSIC_TIMES))
 394         i = INTRINSIC_TIMES;
 395       else
 396         {
 397           if (next_operator (INTRINSIC_DIVIDE))
 398             i = INTRINSIC_DIVIDE;
 399           else
 400             break;
 401         }
 402
 403       where = gfc_current_locus;
 404
 405       m = match_ext_mult_operand (&e);
 406       if (m == MATCH_NO)
 407         {
 408           gfc_current_locus = old_loc;
 409           break;
 410         }
 411
 412       if (m == MATCH_ERROR)
 413         {
 414           gfc_free_expr (all);
 415           return MATCH_ERROR;
 416         }
 417
 418       if (i == INTRINSIC_TIMES)
 419         total = gfc_multiply (all, e);
 420       else
 421         total = gfc_divide (all, e);
 422
 423       if (total == NULL)
 424         {
 425           gfc_free_expr (all);
 426           gfc_free_expr (e);
 427           return MATCH_ERROR;
 428         }
 429
 430       all = total;
 431       all->where = where;
 432     }
 433
 434   *result = all;
 435   return MATCH_YES;
 436 }
 437
 438
 439 static match
 440 match_ext_add_operand (gfc_expr **result)
 441 {
 442   gfc_expr *all, *e;
 443   locus where;
 444   match m;
 445   int i;
 446
 447   where = gfc_current_locus;
 448   i = match_add_op ();
 449
 450   if (i == 0)
 451     return match_add_operand (result);
 452
 453   if (gfc_notify_std (GFC_STD_GNU, "Extension: Unary operator following "
 454                       "arithmetic operator (use parentheses) at %C")
 455       == FAILURE)
 456     return MATCH_ERROR;
 457
 458   m = match_ext_add_operand (&e);
 459   if (m != MATCH_YES)
 460     return m;
 461
 462   if (i == -1)
 463     all = gfc_uminus (e);
 464   else
 465     all = gfc_uplus (e);
 466
 467   if (all == NULL)
 468     {
 469       gfc_free_expr (e);
 470       return MATCH_ERROR;
 471     }
 472
 473   all->where = where;
 474   *result = all;
 475   return MATCH_YES;
 476 }
 477
 478
 479 /* Match a level 2 expression.  */
 480
 481 static match
 482 match_level_2 (gfc_expr **result)
 483 {
 484   gfc_expr *all, *e, *total;
 485   locus where;
 486   match m;
 487   int i;
 488
 489   where = gfc_current_locus;
 490   i = match_add_op ();
 491
 492   if (i != 0)
 493     {
 494       m = match_ext_add_operand (&e);
 495       if (m == MATCH_NO)
 496         {
 497           gfc_error (expression_syntax);
 498           m = MATCH_ERROR;
 499         }
 500     }
 501   else
 502     m = match_add_operand (&e);
 503
 504   if (m != MATCH_YES)
 505     return m;
 506
 507   if (i == 0)
 508     all = e;
 509   else
 510     {
 511       if (i == -1)
 512         all = gfc_uminus (e);
 513       else
 514         all = gfc_uplus (e);
 515
 516       if (all == NULL)
 517         {
 518           gfc_free_expr (e);
 519           return MATCH_ERROR;
 520         }
 521     }
 522
 523   all->where = where;
 524
 525   /* Append add-operands to the sum.  */
 526
 527   for (;;)
 528     {
 529       where = gfc_current_locus;
 530       i = match_add_op ();
 531       if (i == 0)
 532         break;
 533
 534       m = match_ext_add_operand (&e);
 535       if (m == MATCH_NO)
 536         gfc_error (expression_syntax);
 537       if (m != MATCH_YES)
 538         {
 539           gfc_free_expr (all);
 540           return MATCH_ERROR;
 541         }
 542
 543       if (i == -1)
 544         total = gfc_subtract (all, e);
 545       else
 546         total = gfc_add (all, e);
 547
 548       if (total == NULL)
 549         {
 550           gfc_free_expr (all);
 551           gfc_free_expr (e);
 552           return MATCH_ERROR;
 553         }
 554
 555       all = total;
 556       all->where = where;
 557     }
 558
 559   *result = all;
 560   return MATCH_YES;
 561 }
 562
 563
 564 /* Match a level three expression.  */
 565
 566 static match
 567 match_level_3 (gfc_expr **result)
 568 {
 569   gfc_expr *all, *e, *total;
 570   locus where;
 571   match m;
 572
 573   m = match_level_2 (&all);
 574   if (m != MATCH_YES)
 575     return m;
 576
 577   for (;;)
 578     {
 579       if (!next_operator (INTRINSIC_CONCAT))
 580         break;
 581
 582       where = gfc_current_locus;
 583
 584       m = match_level_2 (&e);
 585       if (m == MATCH_NO)
 586         {
 587           gfc_error (expression_syntax);
 588           gfc_free_expr (all);
 589         }
 590       if (m != MATCH_YES)
 591         return MATCH_ERROR;
 592
 593       total = gfc_concat (all, e);
 594       if (total == NULL)
 595         {
 596           gfc_free_expr (all);
 597           gfc_free_expr (e);
 598           return MATCH_ERROR;
 599         }
 600
 601       all = total;
 602       all->where = where;
 603     }
 604
 605   *result = all;
 606   return MATCH_YES;
 607 }
 608
 609
 610 /* Match a level 4 expression.  */
 611
 612 static match
 613 match_level_4 (gfc_expr **result)
 614 {
 615   gfc_expr *left, *right, *r;
 616   gfc_intrinsic_op i;
 617   locus old_loc;
 618   locus where;
 619   match m;
 620
 621   m = match_level_3 (&left);
 622   if (m != MATCH_YES)
 623     return m;
 624
 625   old_loc = gfc_current_locus;
 626
 627   if (gfc_match_intrinsic_op (&i) != MATCH_YES)
 628     {
 629       *result = left;
 630       return MATCH_YES;
 631     }
 632
 633   if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
 634       && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT
 635       && i != INTRINSIC_EQ_OS && i != INTRINSIC_NE_OS && i != INTRINSIC_GE_OS
 636       && i != INTRINSIC_LE_OS && i != INTRINSIC_LT_OS && i != INTRINSIC_GT_OS)
 637     {
 638       gfc_current_locus = old_loc;
 639       *result = left;
 640       return MATCH_YES;
 641     }
 642
 643   where = gfc_current_locus;
 644
 645   m = match_level_3 (&right);
 646   if (m == MATCH_NO)
 647     gfc_error (expression_syntax);
 648   if (m != MATCH_YES)
 649     {
 650       gfc_free_expr (left);
 651       return MATCH_ERROR;
 652     }
 653
 654   switch (i)
 655     {
 656     case INTRINSIC_EQ:
 657     case INTRINSIC_EQ_OS:
 658       r = gfc_eq (left, right, i);
 659       break;
 660
 661     case INTRINSIC_NE:
 662     case INTRINSIC_NE_OS:
 663       r = gfc_ne (left, right, i);
 664       break;
 665
 666     case INTRINSIC_LT:
 667     case INTRINSIC_LT_OS:
 668       r = gfc_lt (left, right, i);
 669       break;
 670
 671     case INTRINSIC_LE:
 672     case INTRINSIC_LE_OS:
 673       r = gfc_le (left, right, i);
 674       break;
 675
 676     case INTRINSIC_GT:
 677     case INTRINSIC_GT_OS:
 678       r = gfc_gt (left, right, i);
 679       break;
 680
 681     case INTRINSIC_GE:
 682     case INTRINSIC_GE_OS:
 683       r = gfc_ge (left, right, i);
 684       break;
 685
 686     default:
 687       gfc_internal_error ("match_level_4(): Bad operator");
 688     }
 689
 690   if (r == NULL)
 691     {
 692       gfc_free_expr (left);
 693       gfc_free_expr (right);
 694       return MATCH_ERROR;
 695     }
 696
 697   r->where = where;
 698   *result = r;
 699
 700   return MATCH_YES;
 701 }
 702
 703
 704 static match
 705 match_and_operand (gfc_expr **result)
 706 {
 707   gfc_expr *e, *r;
 708   locus where;
 709   match m;
 710   int i;
 711
 712   i = next_operator (INTRINSIC_NOT);
 713   where = gfc_current_locus;
 714
 715   m = match_level_4 (&e);
 716   if (m != MATCH_YES)
 717     return m;
 718
 719   r = e;
 720   if (i)
 721     {
 722       r = gfc_not (e);
 723       if (r == NULL)
 724         {
 725           gfc_free_expr (e);
 726           return MATCH_ERROR;
 727         }
 728     }
 729
 730   r->where = where;
 731   *result = r;
 732
 733   return MATCH_YES;
 734 }
 735
 736
 737 static match
 738 match_or_operand (gfc_expr **result)
 739 {
 740   gfc_expr *all, *e, *total;
 741   locus where;
 742   match m;
 743
 744   m = match_and_operand (&all);
 745   if (m != MATCH_YES)
 746     return m;
 747
 748   for (;;)
 749     {
 750       if (!next_operator (INTRINSIC_AND))
 751         break;
 752       where = gfc_current_locus;
 753
 754       m = match_and_operand (&e);
 755       if (m == MATCH_NO)
 756         gfc_error (expression_syntax);
 757       if (m != MATCH_YES)
 758         {
 759           gfc_free_expr (all);
 760           return MATCH_ERROR;
 761         }
 762
 763       total = gfc_and (all, e);
 764       if (total == NULL)
 765         {
 766           gfc_free_expr (all);
 767           gfc_free_expr (e);
 768           return MATCH_ERROR;
 769         }
 770
 771       all = total;
 772       all->where = where;
 773     }
 774
 775   *result = all;
 776   return MATCH_YES;
 777 }
 778
 779
 780 static match
 781 match_equiv_operand (gfc_expr **result)
 782 {
 783   gfc_expr *all, *e, *total;
 784   locus where;
 785   match m;
 786
 787   m = match_or_operand (&all);
 788   if (m != MATCH_YES)
 789     return m;
 790
 791   for (;;)
 792     {
 793       if (!next_operator (INTRINSIC_OR))
 794         break;
 795       where = gfc_current_locus;
 796
 797       m = match_or_operand (&e);
 798       if (m == MATCH_NO)
 799         gfc_error (expression_syntax);
 800       if (m != MATCH_YES)
 801         {
 802           gfc_free_expr (all);
 803           return MATCH_ERROR;
 804         }
 805
 806       total = gfc_or (all, e);
 807       if (total == NULL)
 808         {
 809           gfc_free_expr (all);
 810           gfc_free_expr (e);
 811           return MATCH_ERROR;
 812         }
 813
 814       all = total;
 815       all->where = where;
 816     }
 817
 818   *result = all;
 819   return MATCH_YES;
 820 }
 821
 822
 823 /* Match a level 5 expression.  */
 824
 825 static match
 826 match_level_5 (gfc_expr **result)
 827 {
 828   gfc_expr *all, *e, *total;
 829   locus where;
 830   match m;
 831   gfc_intrinsic_op i;
 832
 833   m = match_equiv_operand (&all);
 834   if (m != MATCH_YES)
 835     return m;
 836
 837   for (;;)
 838     {
 839       if (next_operator (INTRINSIC_EQV))
 840         i = INTRINSIC_EQV;
 841       else
 842         {
 843           if (next_operator (INTRINSIC_NEQV))
 844             i = INTRINSIC_NEQV;
 845           else
 846             break;
 847         }
 848
 849       where = gfc_current_locus;
 850
 851       m = match_equiv_operand (&e);
 852       if (m == MATCH_NO)
 853         gfc_error (expression_syntax);
 854       if (m != MATCH_YES)
 855         {
 856           gfc_free_expr (all);
 857           return MATCH_ERROR;
 858         }
 859
 860       if (i == INTRINSIC_EQV)
 861         total = gfc_eqv (all, e);
 862       else
 863         total = gfc_neqv (all, e);
 864
 865       if (total == NULL)
 866         {
 867           gfc_free_expr (all);
 868           gfc_free_expr (e);
 869           return MATCH_ERROR;
 870         }
 871
 872       all = total;
 873       all->where = where;
 874     }
 875
 876   *result = all;
 877   return MATCH_YES;
 878 }
 879
 880
 881 /* Match an expression.  At this level, we are stringing together
 882    level 5 expressions separated by binary operators.  */
 883
 884 match
 885 gfc_match_expr (gfc_expr **result)
 886 {
 887   gfc_expr *all, *e;
 888   gfc_user_op *uop;
 889   locus where;
 890   match m;
 891
 892   m = match_level_5 (&all);
 893   if (m != MATCH_YES)
 894     return m;
 895
 896   for (;;)
 897     {
 898       uop = NULL;
 899       m = match_defined_operator (&uop);
 900       if (m == MATCH_NO)
 901         break;
 902       if (m == MATCH_ERROR)
 903         {
 904           gfc_free_expr (all);
 905           return MATCH_ERROR;
 906         }
 907
 908       where = gfc_current_locus;
 909
 910       m = match_level_5 (&e);
 911       if (m == MATCH_NO)
 912         gfc_error (expression_syntax);
 913       if (m != MATCH_YES)
 914         {
 915           gfc_free_expr (all);
 916           return MATCH_ERROR;
 917         }
 918
 919       all = build_node (INTRINSIC_USER, &where, all, e);
 920       all->value.op.uop = uop;
 921     }
 922
 923   *result = all;
 924   return MATCH_YES;
 925 }