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