gcc/ada/par-ch4.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P A R . C H 4                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 pragma Style_Checks (All_Checks);
  28 --  Turn off subprogram body ordering check. Subprograms are in order
  29 --  by RM section rather than alphabetical
  30
  31 with Hostparm; use Hostparm;
  32
  33 separate (Par)
  34 package body Ch4 is
  35
  36    -----------------------
  37    -- Local Subprograms --
  38    -----------------------
  39
  40    function P_Aggregate_Or_Paren_Expr                 return Node_Id;
  41    function P_Allocator                               return Node_Id;
  42    function P_Record_Or_Array_Component_Association   return Node_Id;
  43    function P_Factor                                  return Node_Id;
  44    function P_Primary                                 return Node_Id;
  45    function P_Relation                                return Node_Id;
  46    function P_Term                                    return Node_Id;
  47
  48    function P_Binary_Adding_Operator                  return Node_Kind;
  49    function P_Logical_Operator                        return Node_Kind;
  50    function P_Multiplying_Operator                    return Node_Kind;
  51    function P_Relational_Operator                     return Node_Kind;
  52    function P_Unary_Adding_Operator                   return Node_Kind;
  53
  54    procedure Bad_Range_Attribute (Loc : Source_Ptr);
  55    --  Called to place complaint about bad range attribute at the given
  56    --  source location. Terminates by raising Error_Resync.
  57
  58    function P_Range_Attribute_Reference
  59      (Prefix_Node : Node_Id)
  60       return        Node_Id;
  61    --  Scan a range attribute reference. The caller has scanned out the
  62    --  prefix. The current token is known to be an apostrophe and the
  63    --  following token is known to be RANGE.
  64
  65    procedure Set_Op_Name (Node : Node_Id);
  66    --  Procedure to set name field (Chars) in operator node
  67
  68    -------------------------
  69    -- Bad_Range_Attribute --
  70    -------------------------
  71
  72    procedure Bad_Range_Attribute (Loc : Source_Ptr) is
  73    begin
  74       Error_Msg ("range attribute cannot be used in expression", Loc);
  75       Resync_Expression;
  76    end Bad_Range_Attribute;
  77
  78    ------------------
  79    -- Set_Op_Name --
  80    ------------------
  81
  82    procedure Set_Op_Name (Node : Node_Id) is
  83       type Name_Of_Type is array (N_Op) of Name_Id;
  84       Name_Of : constant Name_Of_Type := Name_Of_Type'(
  85          N_Op_And                    => Name_Op_And,
  86          N_Op_Or                     => Name_Op_Or,
  87          N_Op_Xor                    => Name_Op_Xor,
  88          N_Op_Eq                     => Name_Op_Eq,
  89          N_Op_Ne                     => Name_Op_Ne,
  90          N_Op_Lt                     => Name_Op_Lt,
  91          N_Op_Le                     => Name_Op_Le,
  92          N_Op_Gt                     => Name_Op_Gt,
  93          N_Op_Ge                     => Name_Op_Ge,
  94          N_Op_Add                    => Name_Op_Add,
  95          N_Op_Subtract               => Name_Op_Subtract,
  96          N_Op_Concat                 => Name_Op_Concat,
  97          N_Op_Multiply               => Name_Op_Multiply,
  98          N_Op_Divide                 => Name_Op_Divide,
  99          N_Op_Mod                    => Name_Op_Mod,
 100          N_Op_Rem                    => Name_Op_Rem,
 101          N_Op_Expon                  => Name_Op_Expon,
 102          N_Op_Plus                   => Name_Op_Add,
 103          N_Op_Minus                  => Name_Op_Subtract,
 104          N_Op_Abs                    => Name_Op_Abs,
 105          N_Op_Not                    => Name_Op_Not,
 106
 107          --  We don't really need these shift operators, since they never
 108          --  appear as operators in the source, but the path of least
 109          --  resistance is to put them in (the aggregate must be complete)
 110
 111          N_Op_Rotate_Left            => Name_Rotate_Left,
 112          N_Op_Rotate_Right           => Name_Rotate_Right,
 113          N_Op_Shift_Left             => Name_Shift_Left,
 114          N_Op_Shift_Right            => Name_Shift_Right,
 115          N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
 116
 117    begin
 118       if Nkind (Node) in N_Op then
 119          Set_Chars (Node, Name_Of (Nkind (Node)));
 120       end if;
 121    end Set_Op_Name;
 122
 123    --------------------------
 124    -- 4.1  Name (also 6.4) --
 125    --------------------------
 126
 127    --  NAME ::=
 128    --    DIRECT_NAME        | EXPLICIT_DEREFERENCE
 129    --  | INDEXED_COMPONENT  | SLICE
 130    --  | SELECTED_COMPONENT | ATTRIBUTE
 131    --  | TYPE_CONVERSION    | FUNCTION_CALL
 132    --  | CHARACTER_LITERAL
 133
 134    --  DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
 135
 136    --  PREFIX ::= NAME | IMPLICIT_DEREFERENCE
 137
 138    --  EXPLICIT_DEREFERENCE ::= NAME . all
 139
 140    --  IMPLICIT_DEREFERENCE ::= NAME
 141
 142    --  INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
 143
 144    --  SLICE ::= PREFIX (DISCRETE_RANGE)
 145
 146    --  SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
 147
 148    --  SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
 149
 150    --  ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
 151
 152    --  ATTRIBUTE_DESIGNATOR ::=
 153    --    IDENTIFIER [(static_EXPRESSION)]
 154    --  | access | delta | digits
 155
 156    --  FUNCTION_CALL ::=
 157    --    function_NAME
 158    --  | function_PREFIX ACTUAL_PARAMETER_PART
 159
 160    --  ACTUAL_PARAMETER_PART ::=
 161    --    (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
 162
 163    --  PARAMETER_ASSOCIATION ::=
 164    --    [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
 165
 166    --  EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
 167
 168    --  Note: syntactically a procedure call looks just like a function call,
 169    --  so this routine is in practice used to scan out procedure calls as well.
 170
 171    --  On return, Expr_Form is set to either EF_Name or EF_Simple_Name
 172
 173    --  Error recovery: can raise Error_Resync
 174
 175    --  Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
 176    --  followed by either a left paren (qualified expression case), or by
 177    --  range (range attribute case). All other uses of apostrophe (i.e. all
 178    --  other attributes) are handled in this routine.
 179
 180    --  Error recovery: can raise Error_Resync
 181
 182    function P_Name return Node_Id is
 183       Scan_State  : Saved_Scan_State;
 184       Name_Node   : Node_Id;
 185       Prefix_Node : Node_Id;
 186       Ident_Node  : Node_Id;
 187       Expr_Node   : Node_Id;
 188       Range_Node  : Node_Id;
 189       Arg_Node    : Node_Id;
 190
 191       Arg_List  : List_Id := No_List; -- kill junk warning
 192       Attr_Name : Name_Id := No_Name; -- kill junk warning
 193
 194    begin
 195       if Token not in Token_Class_Name then
 196          Error_Msg_AP ("name expected");
 197          raise Error_Resync;
 198       end if;
 199
 200       --  Loop through designators in qualified name
 201
 202       Name_Node := Token_Node;
 203
 204       loop
 205          Scan; -- past designator
 206          exit when Token /= Tok_Dot;
 207          Save_Scan_State (Scan_State); -- at dot
 208          Scan; -- past dot
 209
 210          --  If we do not have another designator after the dot, then join
 211          --  the normal circuit to handle a dot extension (may be .all or
 212          --  character literal case). Otherwise loop back to scan the next
 213          --  designator.
 214
 215          if Token not in Token_Class_Desig then
 216             goto Scan_Name_Extension_Dot;
 217          else
 218             Prefix_Node := Name_Node;
 219             Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
 220             Set_Prefix (Name_Node, Prefix_Node);
 221             Set_Selector_Name (Name_Node, Token_Node);
 222          end if;
 223       end loop;
 224
 225       --  We have now scanned out a qualified designator. If the last token is
 226       --  an operator symbol, then we certainly do not have the Snam case, so
 227       --  we can just use the normal name extension check circuit
 228
 229       if Prev_Token = Tok_Operator_Symbol then
 230          goto Scan_Name_Extension;
 231       end if;
 232
 233       --  We have scanned out a qualified simple name, check for name extension
 234       --  Note that we know there is no dot here at this stage, so the only
 235       --  possible cases of name extension are apostrophe and left paren.
 236
 237       if Token = Tok_Apostrophe then
 238          Save_Scan_State (Scan_State); -- at apostrophe
 239          Scan; -- past apostrophe
 240
 241          --  If left paren, then this might be a qualified expression, but we
 242          --  are only in the business of scanning out names, so return with
 243          --  Token backed up to point to the apostrophe. The treatment for
 244          --  the range attribute is similar (we do not consider x'range to
 245          --  be a name in this grammar).
 246
 247          if Token = Tok_Left_Paren or else Token = Tok_Range then
 248             Restore_Scan_State (Scan_State); -- to apostrophe
 249             Expr_Form := EF_Simple_Name;
 250             return Name_Node;
 251
 252          --  Otherwise we have the case of a name extended by an attribute
 253
 254          else
 255             goto Scan_Name_Extension_Apostrophe;
 256          end if;
 257
 258       --  Check case of qualified simple name extended by a left parenthesis
 259
 260       elsif Token = Tok_Left_Paren then
 261          Scan; -- past left paren
 262          goto Scan_Name_Extension_Left_Paren;
 263
 264       --  Otherwise the qualified simple name is not extended, so return
 265
 266       else
 267          Expr_Form := EF_Simple_Name;
 268          return Name_Node;
 269       end if;
 270
 271       --  Loop scanning past name extensions. A label is used for control
 272       --  transfer for this loop for ease of interfacing with the finite state
 273       --  machine in the parenthesis scanning circuit, and also to allow for
 274       --  passing in control to the appropriate point from the above code.
 275
 276       <<Scan_Name_Extension>>
 277
 278          --  Character literal used as name cannot be extended. Also this
 279          --  cannot be a call, since the name for a call must be a designator.
 280          --  Return in these cases, or if there is no name extension
 281
 282          if Token not in Token_Class_Namext
 283            or else Prev_Token = Tok_Char_Literal
 284          then
 285             Expr_Form := EF_Name;
 286             return Name_Node;
 287          end if;
 288
 289       --  Merge here when we know there is a name extension
 290
 291       <<Scan_Name_Extension_OK>>
 292
 293          if Token = Tok_Left_Paren then
 294             Scan; -- past left paren
 295             goto Scan_Name_Extension_Left_Paren;
 296
 297          elsif Token = Tok_Apostrophe then
 298             Save_Scan_State (Scan_State); -- at apostrophe
 299             Scan; -- past apostrophe
 300             goto Scan_Name_Extension_Apostrophe;
 301
 302          else -- Token = Tok_Dot
 303             Save_Scan_State (Scan_State); -- at dot
 304             Scan; -- past dot
 305             goto Scan_Name_Extension_Dot;
 306          end if;
 307
 308       --  Case of name extended by dot (selection), dot is already skipped
 309       --  and the scan state at the point of the dot is saved in Scan_State.
 310
 311       <<Scan_Name_Extension_Dot>>
 312
 313          --  Explicit dereference case
 314
 315          if Token = Tok_All then
 316             Prefix_Node := Name_Node;
 317             Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
 318             Set_Prefix (Name_Node, Prefix_Node);
 319             Scan; -- past ALL
 320             goto Scan_Name_Extension;
 321
 322          --  Selected component case
 323
 324          elsif Token in Token_Class_Name then
 325             Prefix_Node := Name_Node;
 326             Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
 327             Set_Prefix (Name_Node, Prefix_Node);
 328             Set_Selector_Name (Name_Node, Token_Node);
 329             Scan; -- past selector
 330             goto Scan_Name_Extension;
 331
 332          --  Reserved identifier as selector
 333
 334          elsif Is_Reserved_Identifier then
 335             Scan_Reserved_Identifier (Force_Msg => False);
 336             Prefix_Node := Name_Node;
 337             Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
 338             Set_Prefix (Name_Node, Prefix_Node);
 339             Set_Selector_Name (Name_Node, Token_Node);
 340             Scan; -- past identifier used as selector
 341             goto Scan_Name_Extension;
 342
 343          --  If dot is at end of line and followed by nothing legal,
 344          --  then assume end of name and quit (dot will be taken as
 345          --  an erroneous form of some other punctuation by our caller).
 346
 347          elsif Token_Is_At_Start_Of_Line then
 348             Restore_Scan_State (Scan_State);
 349             return Name_Node;
 350
 351          --  Here if nothing legal after the dot
 352
 353          else
 354             Error_Msg_AP ("selector expected");
 355             raise Error_Resync;
 356          end if;
 357
 358       --  Here for an apostrophe as name extension. The scan position at the
 359       --  apostrophe has already been saved, and the apostrophe scanned out.
 360
 361       <<Scan_Name_Extension_Apostrophe>>
 362
 363          Scan_Apostrophe : declare
 364             function Apostrophe_Should_Be_Semicolon return Boolean;
 365             --  Checks for case where apostrophe should probably be
 366             --  a semicolon, and if so, gives appropriate message,
 367             --  resets the scan pointer to the apostrophe, changes
 368             --  the current token to Tok_Semicolon, and returns True.
 369             --  Otherwise returns False.
 370
 371             function Apostrophe_Should_Be_Semicolon return Boolean is
 372             begin
 373                if Token_Is_At_Start_Of_Line then
 374                   Restore_Scan_State (Scan_State); -- to apostrophe
 375                   Error_Msg_SC ("""''"" should be "";""");
 376                   Token := Tok_Semicolon;
 377                   return True;
 378                else
 379                   return False;
 380                end if;
 381             end Apostrophe_Should_Be_Semicolon;
 382
 383          --  Start of processing for Scan_Apostrophe
 384
 385          begin
 386             --  If range attribute after apostrophe, then return with Token
 387             --  pointing to the apostrophe. Note that in this case the prefix
 388             --  need not be a simple name (cases like A.all'range). Similarly
 389             --  if there is a left paren after the apostrophe, then we also
 390             --  return with Token pointing to the apostrophe (this is the
 391             --  qualified expression case).
 392
 393             if Token = Tok_Range or else Token = Tok_Left_Paren then
 394                Restore_Scan_State (Scan_State); -- to apostrophe
 395                Expr_Form := EF_Name;
 396                return Name_Node;
 397
 398             --  Here for cases where attribute designator is an identifier
 399
 400             elsif Token = Tok_Identifier then
 401                Attr_Name := Token_Name;
 402
 403                if not Is_Attribute_Name (Attr_Name) then
 404                   if Apostrophe_Should_Be_Semicolon then
 405                      Expr_Form := EF_Name;
 406                      return Name_Node;
 407                   else
 408                      Signal_Bad_Attribute;
 409                   end if;
 410                end if;
 411
 412                if Style_Check then
 413                   Style.Check_Attribute_Name (False);
 414                end if;
 415
 416                Delete_Node (Token_Node);
 417
 418             --  Here for case of attribute designator is not an identifier
 419
 420             else
 421                if Token = Tok_Delta then
 422                   Attr_Name := Name_Delta;
 423
 424                elsif Token = Tok_Digits then
 425                   Attr_Name := Name_Digits;
 426
 427                elsif Token = Tok_Access then
 428                   Attr_Name := Name_Access;
 429
 430                elsif Apostrophe_Should_Be_Semicolon then
 431                   Expr_Form := EF_Name;
 432                   return Name_Node;
 433
 434                else
 435                   Error_Msg_AP ("attribute designator expected");
 436                   raise Error_Resync;
 437                end if;
 438
 439                if Style_Check then
 440                   Style.Check_Attribute_Name (True);
 441                end if;
 442             end if;
 443
 444             --  We come here with an OK attribute scanned, and the
 445             --  corresponding Attribute identifier node stored in Ident_Node.
 446
 447             Prefix_Node := Name_Node;
 448             Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
 449             Scan; -- past attribute designator
 450             Set_Prefix (Name_Node, Prefix_Node);
 451             Set_Attribute_Name (Name_Node, Attr_Name);
 452
 453             --  Scan attribute arguments/designator
 454
 455             if Token = Tok_Left_Paren then
 456                Set_Expressions (Name_Node, New_List);
 457                Scan; -- past left paren
 458
 459                loop
 460                   declare
 461                      Expr : constant Node_Id := P_Expression;
 462
 463                   begin
 464                      if Token = Tok_Arrow then
 465                         Error_Msg_SC
 466                           ("named parameters not permitted for attributes");
 467                         Scan; -- past junk arrow
 468
 469                      else
 470                         Append (Expr, Expressions (Name_Node));
 471                         exit when not Comma_Present;
 472                      end if;
 473                   end;
 474                end loop;
 475
 476                T_Right_Paren;
 477             end if;
 478
 479             goto Scan_Name_Extension;
 480          end Scan_Apostrophe;
 481
 482       --  Here for left parenthesis extending name (left paren skipped)
 483
 484       <<Scan_Name_Extension_Left_Paren>>
 485
 486          --  We now have to scan through a list of items, terminated by a
 487          --  right parenthesis. The scan is handled by a finite state
 488          --  machine. The possibilities are:
 489
 490          --   (discrete_range)
 491
 492          --      This is a slice. This case is handled in LP_State_Init.
 493
 494          --   (expression, expression, ..)
 495
 496          --      This is interpreted as an indexed component, i.e. as a
 497          --      case of a name which can be extended in the normal manner.
 498          --      This case is handled by LP_State_Name or LP_State_Expr.
 499
 500          --   (..., identifier => expression , ...)
 501
 502          --      If there is at least one occurrence of identifier => (but
 503          --      none of the other cases apply), then we have a call.
 504
 505          --  Test for Id => case
 506
 507          if Token = Tok_Identifier then
 508             Save_Scan_State (Scan_State); -- at Id
 509             Scan; -- past Id
 510
 511             --  Test for => (allow := as an error substitute)
 512
 513             if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
 514                Restore_Scan_State (Scan_State); -- to Id
 515                Arg_List := New_List;
 516                goto LP_State_Call;
 517
 518             else
 519                Restore_Scan_State (Scan_State); -- to Id
 520             end if;
 521          end if;
 522
 523          --  Here we have an expression after all
 524
 525          Expr_Node := P_Expression_Or_Range_Attribute;
 526
 527          --  Check cases of discrete range for a slice
 528
 529          --  First possibility: Range_Attribute_Reference
 530
 531          if Expr_Form = EF_Range_Attr then
 532             Range_Node := Expr_Node;
 533
 534          --  Second possibility: Simple_expression .. Simple_expression
 535
 536          elsif Token = Tok_Dot_Dot then
 537             Check_Simple_Expression (Expr_Node);
 538             Range_Node := New_Node (N_Range, Token_Ptr);
 539             Set_Low_Bound (Range_Node, Expr_Node);
 540             Scan; -- past ..
 541             Expr_Node := P_Expression;
 542             Check_Simple_Expression (Expr_Node);
 543             Set_High_Bound (Range_Node, Expr_Node);
 544
 545          --  Third possibility: Type_name range Range
 546
 547          elsif Token = Tok_Range then
 548             if Expr_Form /= EF_Simple_Name then
 549                Error_Msg_SC ("subtype mark must precede RANGE");
 550                raise Error_Resync;
 551             end if;
 552
 553             Range_Node := P_Subtype_Indication (Expr_Node);
 554
 555          --  Otherwise we just have an expression. It is true that we might
 556          --  have a subtype mark without a range constraint but this case
 557          --  is syntactically indistinguishable from the expression case.
 558
 559          else
 560             Arg_List := New_List;
 561             goto LP_State_Expr;
 562          end if;
 563
 564          --  Fall through here with unmistakable Discrete range scanned,
 565          --  which means that we definitely have the case of a slice. The
 566          --  Discrete range is in Range_Node.
 567
 568          if Token = Tok_Comma then
 569             Error_Msg_SC ("slice cannot have more than one dimension");
 570             raise Error_Resync;
 571
 572          elsif Token /= Tok_Right_Paren then
 573             T_Right_Paren;
 574             raise Error_Resync;
 575
 576          else
 577             Scan; -- past right paren
 578             Prefix_Node := Name_Node;
 579             Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
 580             Set_Prefix (Name_Node, Prefix_Node);
 581             Set_Discrete_Range (Name_Node, Range_Node);
 582
 583             --  An operator node is legal as a prefix to other names,
 584             --  but not for a slice.
 585
 586             if Nkind (Prefix_Node) = N_Operator_Symbol then
 587                Error_Msg_N ("illegal prefix for slice", Prefix_Node);
 588             end if;
 589
 590             --  If we have a name extension, go scan it
 591
 592             if Token in Token_Class_Namext then
 593                goto Scan_Name_Extension_OK;
 594
 595             --  Otherwise return (a slice is a name, but is not a call)
 596
 597             else
 598                Expr_Form := EF_Name;
 599                return Name_Node;
 600             end if;
 601          end if;
 602
 603       --  In LP_State_Expr, we have scanned one or more expressions, and
 604       --  so we have a call or an indexed component which is a name. On
 605       --  entry we have the expression just scanned in Expr_Node and
 606       --  Arg_List contains the list of expressions encountered so far
 607
 608       <<LP_State_Expr>>
 609          Append (Expr_Node, Arg_List);
 610
 611          if Token = Tok_Arrow then
 612             Error_Msg
 613               ("expect identifier in parameter association",
 614                 Sloc (Expr_Node));
 615             Scan;  --   past arrow.
 616
 617          elsif not Comma_Present then
 618             T_Right_Paren;
 619             Prefix_Node := Name_Node;
 620             Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
 621             Set_Prefix (Name_Node, Prefix_Node);
 622             Set_Expressions (Name_Node, Arg_List);
 623             goto Scan_Name_Extension;
 624          end if;
 625
 626          --  Comma present (and scanned out), test for identifier => case
 627          --  Test for identifier => case
 628
 629          if Token = Tok_Identifier then
 630             Save_Scan_State (Scan_State); -- at Id
 631             Scan; -- past Id
 632
 633             --  Test for => (allow := as error substitute)
 634
 635             if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
 636                Restore_Scan_State (Scan_State); -- to Id
 637                goto LP_State_Call;
 638
 639             --  Otherwise it's just an expression after all, so backup
 640
 641             else
 642                Restore_Scan_State (Scan_State); -- to Id
 643             end if;
 644          end if;
 645
 646          --  Here we have an expression after all, so stay in this state
 647
 648          Expr_Node := P_Expression;
 649          goto LP_State_Expr;
 650
 651       --  LP_State_Call corresponds to the situation in which at least
 652       --  one instance of Id => Expression has been encountered, so we
 653       --  know that we do not have a name, but rather a call. We enter
 654       --  it with the scan pointer pointing to the next argument to scan,
 655       --  and Arg_List containing the list of arguments scanned so far.
 656
 657       <<LP_State_Call>>
 658
 659          --  Test for case of Id => Expression (named parameter)
 660
 661          if Token = Tok_Identifier then
 662             Save_Scan_State (Scan_State); -- at Id
 663             Ident_Node := Token_Node;
 664             Scan; -- past Id
 665
 666             --  Deal with => (allow := as erroneous substitute)
 667
 668             if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
 669                Arg_Node :=
 670                  New_Node (N_Parameter_Association, Prev_Token_Ptr);
 671                Set_Selector_Name (Arg_Node, Ident_Node);
 672                T_Arrow;
 673                Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
 674                Append (Arg_Node, Arg_List);
 675
 676                --  If a comma follows, go back and scan next entry
 677
 678                if Comma_Present then
 679                   goto LP_State_Call;
 680
 681                --  Otherwise we have the end of a call
 682
 683                else
 684                   Prefix_Node := Name_Node;
 685                   Name_Node :=
 686                     New_Node (N_Function_Call, Sloc (Prefix_Node));
 687                   Set_Name (Name_Node, Prefix_Node);
 688                   Set_Parameter_Associations (Name_Node, Arg_List);
 689                   T_Right_Paren;
 690
 691                   if Token in Token_Class_Namext then
 692                      goto Scan_Name_Extension_OK;
 693
 694                   --  This is a case of a call which cannot be a name
 695
 696                   else
 697                      Expr_Form := EF_Name;
 698                      return Name_Node;
 699                   end if;
 700                end if;
 701
 702             --  Not named parameter: Id started an expression after all
 703
 704             else
 705                Restore_Scan_State (Scan_State); -- to Id
 706             end if;
 707          end if;
 708
 709          --  Here if entry did not start with Id => which means that it
 710          --  is a positional parameter, which is not allowed, since we
 711          --  have seen at least one named parameter already.
 712
 713          Error_Msg_SC
 714             ("positional parameter association " &
 715               "not allowed after named one");
 716
 717          Expr_Node := P_Expression;
 718
 719          --  Leaving the '>' in an association is not unusual, so suggest
 720          --  a possible fix.
 721
 722          if Nkind (Expr_Node) = N_Op_Eq then
 723             Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
 724          end if;
 725
 726          --  We go back to scanning out expressions, so that we do not get
 727          --  multiple error messages when several positional parameters
 728          --  follow a named parameter.
 729
 730          goto LP_State_Expr;
 731
 732          --  End of treatment for name extensions starting with left paren
 733
 734       --  End of loop through name extensions
 735
 736    end P_Name;
 737
 738    --  This function parses a restricted form of Names which are either
 739    --  designators, or designators preceded by a sequence of prefixes
 740    --  that are direct names.
 741
 742    --  Error recovery: cannot raise Error_Resync
 743
 744    function P_Function_Name return Node_Id is
 745       Designator_Node : Node_Id;
 746       Prefix_Node     : Node_Id;
 747       Selector_Node   : Node_Id;
 748       Dot_Sloc        : Source_Ptr := No_Location;
 749
 750    begin
 751       --  Prefix_Node is set to the gathered prefix so far, Empty means that
 752       --  no prefix has been scanned. This allows us to build up the result
 753       --  in the required right recursive manner.
 754
 755       Prefix_Node := Empty;
 756
 757       --  Loop through prefixes
 758
 759       loop
 760          Designator_Node := Token_Node;
 761
 762          if Token not in Token_Class_Desig then
 763             return P_Identifier; -- let P_Identifier issue the error message
 764
 765          else -- Token in Token_Class_Desig
 766             Scan; -- past designator
 767             exit when Token /= Tok_Dot;
 768          end if;
 769
 770          --  Here at a dot, with token just before it in Designator_Node
 771
 772          if No (Prefix_Node) then
 773             Prefix_Node := Designator_Node;
 774          else
 775             Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 776             Set_Prefix (Selector_Node, Prefix_Node);
 777             Set_Selector_Name (Selector_Node, Designator_Node);
 778             Prefix_Node := Selector_Node;
 779          end if;
 780
 781          Dot_Sloc := Token_Ptr;
 782          Scan; -- past dot
 783       end loop;
 784
 785       --  Fall out of the loop having just scanned a designator
 786
 787       if No (Prefix_Node) then
 788          return Designator_Node;
 789       else
 790          Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 791          Set_Prefix (Selector_Node, Prefix_Node);
 792          Set_Selector_Name (Selector_Node, Designator_Node);
 793          return Selector_Node;
 794       end if;
 795
 796    exception
 797       when Error_Resync =>
 798          return Error;
 799
 800    end P_Function_Name;
 801
 802    --  This function parses a restricted form of Names which are either
 803    --  identifiers, or identifiers preceded by a sequence of prefixes
 804    --  that are direct names.
 805
 806    --  Error recovery: cannot raise Error_Resync
 807
 808    function P_Qualified_Simple_Name return Node_Id is
 809       Designator_Node : Node_Id;
 810       Prefix_Node     : Node_Id;
 811       Selector_Node   : Node_Id;
 812       Dot_Sloc        : Source_Ptr := No_Location;
 813
 814    begin
 815       --  Prefix node is set to the gathered prefix so far, Empty means that
 816       --  no prefix has been scanned. This allows us to build up the result
 817       --  in the required right recursive manner.
 818
 819       Prefix_Node := Empty;
 820
 821       --  Loop through prefixes
 822
 823       loop
 824          Designator_Node := Token_Node;
 825
 826          if Token = Tok_Identifier then
 827             Scan; -- past identifier
 828             exit when Token /= Tok_Dot;
 829
 830          elsif Token not in Token_Class_Desig then
 831             return P_Identifier; -- let P_Identifier issue the error message
 832
 833          else
 834             Scan; -- past designator
 835
 836             if Token /= Tok_Dot then
 837                Error_Msg_SP ("identifier expected");
 838                return Error;
 839             end if;
 840          end if;
 841
 842          --  Here at a dot, with token just before it in Designator_Node
 843
 844          if No (Prefix_Node) then
 845             Prefix_Node := Designator_Node;
 846          else
 847             Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 848             Set_Prefix (Selector_Node, Prefix_Node);
 849             Set_Selector_Name (Selector_Node, Designator_Node);
 850             Prefix_Node := Selector_Node;
 851          end if;
 852
 853          Dot_Sloc := Token_Ptr;
 854          Scan; -- past dot
 855       end loop;
 856
 857       --  Fall out of the loop having just scanned an identifier
 858
 859       if No (Prefix_Node) then
 860          return Designator_Node;
 861       else
 862          Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 863          Set_Prefix (Selector_Node, Prefix_Node);
 864          Set_Selector_Name (Selector_Node, Designator_Node);
 865          return Selector_Node;
 866       end if;
 867
 868    exception
 869       when Error_Resync =>
 870          return Error;
 871
 872    end P_Qualified_Simple_Name;
 873
 874    --  This procedure differs from P_Qualified_Simple_Name only in that it
 875    --  raises Error_Resync if any error is encountered. It only returns after
 876    --  scanning a valid qualified simple name.
 877
 878    --  Error recovery: can raise Error_Resync
 879
 880    function P_Qualified_Simple_Name_Resync return Node_Id is
 881       Designator_Node : Node_Id;
 882       Prefix_Node     : Node_Id;
 883       Selector_Node   : Node_Id;
 884       Dot_Sloc        : Source_Ptr := No_Location;
 885
 886    begin
 887       Prefix_Node := Empty;
 888
 889       --  Loop through prefixes
 890
 891       loop
 892          Designator_Node := Token_Node;
 893
 894          if Token = Tok_Identifier then
 895             Scan; -- past identifier
 896             exit when Token /= Tok_Dot;
 897
 898          elsif Token not in Token_Class_Desig then
 899             Discard_Junk_Node (P_Identifier); -- to issue the error message
 900             raise Error_Resync;
 901
 902          else
 903             Scan; -- past designator
 904
 905             if Token /= Tok_Dot then
 906                Error_Msg_SP ("identifier expected");
 907                raise Error_Resync;
 908             end if;
 909          end if;
 910
 911          --  Here at a dot, with token just before it in Designator_Node
 912
 913          if No (Prefix_Node) then
 914             Prefix_Node := Designator_Node;
 915          else
 916             Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 917             Set_Prefix (Selector_Node, Prefix_Node);
 918             Set_Selector_Name (Selector_Node, Designator_Node);
 919             Prefix_Node := Selector_Node;
 920          end if;
 921
 922          Dot_Sloc := Token_Ptr;
 923          Scan; -- past period
 924       end loop;
 925
 926       --  Fall out of the loop having just scanned an identifier
 927
 928       if No (Prefix_Node) then
 929          return Designator_Node;
 930       else
 931          Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
 932          Set_Prefix (Selector_Node, Prefix_Node);
 933          Set_Selector_Name (Selector_Node, Designator_Node);
 934          return Selector_Node;
 935       end if;
 936
 937    end P_Qualified_Simple_Name_Resync;
 938
 939    ----------------------
 940    -- 4.1  Direct_Name --
 941    ----------------------
 942
 943    --  Parsed by P_Name and other functions in section 4.1
 944
 945    -----------------
 946    -- 4.1  Prefix --
 947    -----------------
 948
 949    --  Parsed by P_Name (4.1)
 950
 951    -------------------------------
 952    -- 4.1  Explicit Dereference --
 953    -------------------------------
 954
 955    --  Parsed by P_Name (4.1)
 956
 957    -------------------------------
 958    -- 4.1  Implicit_Dereference --
 959    -------------------------------
 960
 961    --  Parsed by P_Name (4.1)
 962
 963    ----------------------------
 964    -- 4.1  Indexed Component --
 965    ----------------------------
 966
 967    --  Parsed by P_Name (4.1)
 968
 969    ----------------
 970    -- 4.1  Slice --
 971    ----------------
 972
 973    --  Parsed by P_Name (4.1)
 974
 975    -----------------------------
 976    -- 4.1  Selected_Component --
 977    -----------------------------
 978
 979    --  Parsed by P_Name (4.1)
 980
 981    ------------------------
 982    -- 4.1  Selector Name --
 983    ------------------------
 984
 985    --  Parsed by P_Name (4.1)
 986
 987    ------------------------------
 988    -- 4.1  Attribute Reference --
 989    ------------------------------
 990
 991    --  Parsed by P_Name (4.1)
 992
 993    -------------------------------
 994    -- 4.1  Attribute Designator --
 995    -------------------------------
 996
 997    --  Parsed by P_Name (4.1)
 998
 999    --------------------------------------
1000    -- 4.1.4  Range Attribute Reference --
1001    --------------------------------------
1002
1003    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1004
1005    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1006
1007    --  In the grammar, a RANGE attribute is simply a name, but its use is
1008    --  highly restricted, so in the parser, we do not regard it as a name.
1009    --  Instead, P_Name returns without scanning the 'RANGE part of the
1010    --  attribute, and the caller uses the following function to construct
1011    --  a range attribute in places where it is appropriate.
1012
1013    --  Note that RANGE here is treated essentially as an identifier,
1014    --  rather than a reserved word.
1015
1016    --  The caller has parsed the prefix, i.e. a name, and Token points to
1017    --  the apostrophe. The token after the apostrophe is known to be RANGE
1018    --  at this point. The prefix node becomes the prefix of the attribute.
1019
1020    --  Error_Recovery: Cannot raise Error_Resync
1021
1022    function P_Range_Attribute_Reference
1023      (Prefix_Node : Node_Id)
1024       return        Node_Id
1025    is
1026       Attr_Node  : Node_Id;
1027
1028    begin
1029       Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1030       Set_Prefix (Attr_Node, Prefix_Node);
1031       Scan; -- past apostrophe
1032
1033       if Style_Check then
1034          Style.Check_Attribute_Name (True);
1035       end if;
1036
1037       Set_Attribute_Name (Attr_Node, Name_Range);
1038       Scan; -- past RANGE
1039
1040       if Token = Tok_Left_Paren then
1041          Scan; -- past left paren
1042          Set_Expressions (Attr_Node, New_List (P_Expression));
1043          T_Right_Paren;
1044       end if;
1045
1046       return Attr_Node;
1047    end P_Range_Attribute_Reference;
1048
1049    ---------------------------------------
1050    -- 4.1.4  Range Attribute Designator --
1051    ---------------------------------------
1052
1053    --  Parsed by P_Range_Attribute_Reference (4.4)
1054
1055    --------------------
1056    -- 4.3  Aggregate --
1057    --------------------
1058
1059    --  AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1060
1061    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1062    --  an aggregate is known to be required (code statement, extension
1063    --  aggregate), in which cases this routine performs the necessary check
1064    --  that we have an aggregate rather than a parenthesized expression
1065
1066    --  Error recovery: can raise Error_Resync
1067
1068    function P_Aggregate return Node_Id is
1069       Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1070       Aggr_Node : constant Node_Id    := P_Aggregate_Or_Paren_Expr;
1071
1072    begin
1073       if Nkind (Aggr_Node) /= N_Aggregate
1074            and then
1075          Nkind (Aggr_Node) /= N_Extension_Aggregate
1076       then
1077          Error_Msg
1078            ("aggregate may not have single positional component", Aggr_Sloc);
1079          return Error;
1080       else
1081          return Aggr_Node;
1082       end if;
1083    end P_Aggregate;
1084
1085    -------------------------------------------------
1086    -- 4.3  Aggregate or Parenthesized Expresssion --
1087    -------------------------------------------------
1088
1089    --  This procedure parses out either an aggregate or a parenthesized
1090    --  expression (these two constructs are closely related, since a
1091    --  parenthesized expression looks like an aggregate with a single
1092    --  positional component).
1093
1094    --  AGGREGATE ::=
1095    --    RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1096
1097    --  RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1098
1099    --  RECORD_COMPONENT_ASSOCIATION_LIST ::=
1100    --     RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1101    --   | null record
1102
1103    --  RECORD_COMPONENT_ASSOCIATION ::=
1104    --    [COMPONENT_CHOICE_LIST =>] EXPRESSION
1105
1106    --  COMPONENT_CHOICE_LIST ::=
1107    --    component_SELECTOR_NAME {| component_SELECTOR_NAME}
1108    --  | others
1109
1110    --  EXTENSION_AGGREGATE ::=
1111    --    (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1112
1113    --  ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1114
1115    --  ARRAY_AGGREGATE ::=
1116    --    POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1117
1118    --  POSITIONAL_ARRAY_AGGREGATE ::=
1119    --    (EXPRESSION, EXPRESSION {, EXPRESSION})
1120    --  | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1121    --  | (EXPRESSION {, EXPRESSION}, others => <>)
1122
1123    --  NAMED_ARRAY_AGGREGATE ::=
1124    --    (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1125
1126    --  PRIMARY ::= (EXPRESSION);
1127
1128    --  Error recovery: can raise Error_Resync
1129
1130    --  Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1131    --        to Ada0Y limited aggregates (AI-287)
1132
1133    function P_Aggregate_Or_Paren_Expr return Node_Id is
1134       Aggregate_Node : Node_Id;
1135       Expr_List      : List_Id;
1136       Assoc_List     : List_Id;
1137       Expr_Node      : Node_Id;
1138       Lparen_Sloc    : Source_Ptr;
1139       Scan_State     : Saved_Scan_State;
1140
1141    begin
1142       Lparen_Sloc := Token_Ptr;
1143       T_Left_Paren;
1144
1145       --  Note: the mechanism used here of rescanning the initial expression
1146       --  is distinctly unpleasant, but it saves a lot of fiddling in scanning
1147       --  out the discrete choice list.
1148
1149       --  Deal with expression and extension aggregate cases first
1150
1151       if Token /= Tok_Others then
1152          Save_Scan_State (Scan_State); -- at start of expression
1153
1154          --  Deal with (NULL RECORD) case
1155
1156          if Token = Tok_Null then
1157             Scan; -- past NULL
1158
1159             if Token = Tok_Record then
1160                Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1161                Set_Null_Record_Present (Aggregate_Node, True);
1162                Scan; -- past RECORD
1163                T_Right_Paren;
1164                return Aggregate_Node;
1165             else
1166                Restore_Scan_State (Scan_State); -- to NULL that must be expr
1167             end if;
1168          end if;
1169
1170          --  Ada0Y (AI-287): The box notation is allowed only with named
1171          --  notation because positional notation might be error prone. For
1172          --  example, in "(X, <>, Y, <>)", there is no type associated with
1173          --  the boxes, so you might not be leaving out the components you
1174          --  thought you were leaving out.
1175
1176          if Extensions_Allowed and then Token = Tok_Box then
1177             Error_Msg_SC ("(Ada 0Y) box notation only allowed with "
1178                           & "named notation");
1179             Scan; --  past BOX
1180             Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1181             return Aggregate_Node;
1182          end if;
1183
1184          Expr_Node := P_Expression_Or_Range_Attribute;
1185
1186          --  Extension aggregate case
1187
1188          if Token = Tok_With then
1189
1190             if Nkind (Expr_Node) = N_Attribute_Reference
1191               and then Attribute_Name (Expr_Node) = Name_Range
1192             then
1193                Bad_Range_Attribute (Sloc (Expr_Node));
1194                return Error;
1195             end if;
1196
1197             if Ada_83 then
1198                Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1199             end if;
1200
1201             Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1202             Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1203             Scan; -- past WITH
1204
1205             --  Deal with WITH NULL RECORD case
1206
1207             if Token = Tok_Null then
1208                Save_Scan_State (Scan_State); -- at NULL
1209                Scan; -- past NULL
1210
1211                if Token = Tok_Record then
1212                   Scan; -- past RECORD
1213                   Set_Null_Record_Present (Aggregate_Node, True);
1214                   T_Right_Paren;
1215                   return Aggregate_Node;
1216
1217                else
1218                   Restore_Scan_State (Scan_State); -- to NULL that must be expr
1219                end if;
1220             end if;
1221
1222             if Token /= Tok_Others then
1223                Save_Scan_State (Scan_State);
1224                Expr_Node := P_Expression;
1225             else
1226                Expr_Node := Empty;
1227             end if;
1228
1229          --  Expression case
1230
1231          elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1232
1233             if Nkind (Expr_Node) = N_Attribute_Reference
1234               and then Attribute_Name (Expr_Node) = Name_Range
1235             then
1236                Bad_Range_Attribute (Sloc (Expr_Node));
1237                return Error;
1238             end if;
1239
1240             --  Bump paren count of expression, note that if the paren count
1241             --  is already at the maximum, then we leave it alone. This will
1242             --  cause some failures in pathalogical conformance tests, which
1243             --  we do not shed a tear over!
1244
1245             if Expr_Node /= Error then
1246                if Paren_Count (Expr_Node) /= Paren_Count_Type'Last then
1247                   Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1248                end if;
1249             end if;
1250
1251             T_Right_Paren; -- past right paren (error message if none)
1252             return Expr_Node;
1253
1254          --  Normal aggregate case
1255
1256          else
1257             Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1258          end if;
1259
1260       --  Others case
1261
1262       else
1263          Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1264          Expr_Node := Empty;
1265       end if;
1266
1267       --  Prepare to scan list of component associations
1268
1269       Expr_List  := No_List; -- don't set yet, maybe all named entries
1270       Assoc_List := No_List; -- don't set yet, maybe all positional entries
1271
1272       --  This loop scans through component associations. On entry to the
1273       --  loop, an expression has been scanned at the start of the current
1274       --  association unless initial token was OTHERS, in which case
1275       --  Expr_Node is set to Empty.
1276
1277       loop
1278          --  Deal with others association first. This is a named association
1279
1280          if No (Expr_Node) then
1281             if No (Assoc_List) then
1282                Assoc_List := New_List;
1283             end if;
1284
1285             Append (P_Record_Or_Array_Component_Association, Assoc_List);
1286
1287          --  Improper use of WITH
1288
1289          elsif Token = Tok_With then
1290             Error_Msg_SC ("WITH must be preceded by single expression in " &
1291                              "extension aggregate");
1292             raise Error_Resync;
1293
1294          --  A range attribute can only appear as part of a discrete choice
1295          --  list.
1296
1297          elsif Nkind (Expr_Node) = N_Attribute_Reference
1298            and then Attribute_Name (Expr_Node) = Name_Range
1299            and then Token /= Tok_Arrow
1300            and then Token /= Tok_Vertical_Bar
1301          then
1302             Bad_Range_Attribute (Sloc (Expr_Node));
1303             return Error;
1304
1305          --  Assume positional case if comma, right paren, or literal or
1306          --  identifier or OTHERS follows (the latter cases are missing
1307          --  comma cases). Also assume positional if a semicolon follows,
1308          --  which can happen if there are missing parens
1309
1310          elsif Token = Tok_Comma
1311            or else Token = Tok_Right_Paren
1312            or else Token = Tok_Others
1313            or else Token in Token_Class_Lit_Or_Name
1314            or else Token = Tok_Semicolon
1315          then
1316             if Present (Assoc_List) then
1317                Error_Msg_BC
1318                   ("""='>"" expected (positional association cannot follow " &
1319                    "named association)");
1320             end if;
1321
1322             if No (Expr_List) then
1323                Expr_List := New_List;
1324             end if;
1325
1326             Append (Expr_Node, Expr_List);
1327
1328          --  Anything else is assumed to be a named association
1329
1330          else
1331             Restore_Scan_State (Scan_State); -- to start of expression
1332
1333             if No (Assoc_List) then
1334                Assoc_List := New_List;
1335             end if;
1336
1337             Append (P_Record_Or_Array_Component_Association, Assoc_List);
1338          end if;
1339
1340          exit when not Comma_Present;
1341
1342          --  If we are at an expression terminator, something is seriously
1343          --  wrong, so let's get out now, before we start eating up stuff
1344          --  that doesn't belong to us!
1345
1346          if Token in Token_Class_Eterm then
1347             Error_Msg_AP ("expecting expression or component association");
1348             exit;
1349          end if;
1350
1351          --  Otherwise initiate for reentry to top of loop by scanning an
1352          --  initial expression, unless the first token is OTHERS.
1353
1354          if Token = Tok_Others then
1355             Expr_Node := Empty;
1356          else
1357             Save_Scan_State (Scan_State); -- at start of expression
1358             Expr_Node := P_Expression_Or_Range_Attribute;
1359
1360          end if;
1361       end loop;
1362
1363       --  All component associations (positional and named) have been scanned
1364
1365       T_Right_Paren;
1366       Set_Expressions (Aggregate_Node, Expr_List);
1367       Set_Component_Associations (Aggregate_Node, Assoc_List);
1368       return Aggregate_Node;
1369    end P_Aggregate_Or_Paren_Expr;
1370
1371    ------------------------------------------------
1372    -- 4.3  Record or Array Component Association --
1373    ------------------------------------------------
1374
1375    --  RECORD_COMPONENT_ASSOCIATION ::=
1376    --    [COMPONENT_CHOICE_LIST =>] EXPRESSION
1377    --  | COMPONENT_CHOICE_LIST => <>
1378
1379    --  COMPONENT_CHOICE_LIST =>
1380    --    component_SELECTOR_NAME {| component_SELECTOR_NAME}
1381    --  | others
1382
1383    --  ARRAY_COMPONENT_ASSOCIATION ::=
1384    --    DISCRETE_CHOICE_LIST => EXPRESSION
1385    --  | DISCRETE_CHOICE_LIST => <>
1386
1387    --  Note: this routine only handles the named cases, including others.
1388    --  Cases where the component choice list is not present have already
1389    --  been handled directly.
1390
1391    --  Error recovery: can raise Error_Resync
1392
1393    --  Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1394    --        rules have been extended to give support to Ada0Y limited
1395    --        aggregates (AI-287)
1396
1397    function P_Record_Or_Array_Component_Association return Node_Id is
1398       Assoc_Node : Node_Id;
1399
1400    begin
1401       Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1402       Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1403       Set_Sloc (Assoc_Node, Token_Ptr);
1404       TF_Arrow;
1405
1406       if Token = Tok_Box then
1407
1408          --  Ada0Y (AI-287): The box notation is used to indicate the default
1409          --  initialization of limited aggregate components
1410
1411          if not Extensions_Allowed then
1412             Error_Msg_SP
1413               ("(Ada 0Y) limited aggregates are an Ada0X extension");
1414
1415             if OpenVMS then
1416                Error_Msg_SP
1417                  ("\unit must be compiled with " &
1418                   "'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier");
1419             else
1420                Error_Msg_SP
1421                  ("\unit must be compiled with -gnatX switch");
1422             end if;
1423          end if;
1424
1425          Set_Box_Present (Assoc_Node);
1426          Scan; -- Past box
1427       else
1428          Set_Expression (Assoc_Node, P_Expression);
1429       end if;
1430
1431       return Assoc_Node;
1432    end P_Record_Or_Array_Component_Association;
1433
1434    -----------------------------
1435    -- 4.3.1  Record Aggregate --
1436    -----------------------------
1437
1438    --  Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1439    --  All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1440
1441    ----------------------------------------------
1442    -- 4.3.1  Record Component Association List --
1443    ----------------------------------------------
1444
1445    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1446
1447    ----------------------------------
1448    -- 4.3.1  Component Choice List --
1449    ----------------------------------
1450
1451    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1452
1453    --------------------------------
1454    -- 4.3.1  Extension Aggregate --
1455    --------------------------------
1456
1457    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1458
1459    --------------------------
1460    -- 4.3.1  Ancestor Part --
1461    --------------------------
1462
1463    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1464
1465    ----------------------------
1466    -- 4.3.1  Array Aggregate --
1467    ----------------------------
1468
1469    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1470
1471    ---------------------------------------
1472    -- 4.3.1  Positional Array Aggregate --
1473    ---------------------------------------
1474
1475    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1476
1477    ----------------------------------
1478    -- 4.3.1  Named Array Aggregate --
1479    ----------------------------------
1480
1481    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1482
1483    ----------------------------------------
1484    -- 4.3.1  Array Component Association --
1485    ----------------------------------------
1486
1487    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1488
1489    ---------------------
1490    -- 4.4  Expression --
1491    ---------------------
1492
1493    --  EXPRESSION ::=
1494    --    RELATION {and RELATION} | RELATION {and then RELATION}
1495    --  | RELATION {or RELATION}  | RELATION {or else RELATION}
1496    --  | RELATION {xor RELATION}
1497
1498    --  On return, Expr_Form indicates the categorization of the expression
1499    --  EF_Range_Attr is not a possible value (if a range attribute is found,
1500    --  an error message is given, and Error is returned).
1501
1502    --  Error recovery: cannot raise Error_Resync
1503
1504    function P_Expression return Node_Id is
1505       Logical_Op      : Node_Kind;
1506       Prev_Logical_Op : Node_Kind;
1507       Op_Location     : Source_Ptr;
1508       Node1           : Node_Id;
1509       Node2           : Node_Id;
1510
1511    begin
1512       Node1 := P_Relation;
1513
1514       if Token in Token_Class_Logop then
1515          Prev_Logical_Op := N_Empty;
1516
1517          loop
1518             Op_Location := Token_Ptr;
1519             Logical_Op := P_Logical_Operator;
1520
1521             if Prev_Logical_Op /= N_Empty and then
1522                Logical_Op /= Prev_Logical_Op
1523             then
1524                Error_Msg
1525                  ("mixed logical operators in expression", Op_Location);
1526                Prev_Logical_Op := N_Empty;
1527             else
1528                Prev_Logical_Op := Logical_Op;
1529             end if;
1530
1531             Node2 := Node1;
1532             Node1 := New_Node (Logical_Op, Op_Location);
1533             Set_Left_Opnd (Node1, Node2);
1534             Set_Right_Opnd (Node1, P_Relation);
1535             Set_Op_Name (Node1);
1536             exit when Token not in Token_Class_Logop;
1537          end loop;
1538
1539          Expr_Form := EF_Non_Simple;
1540       end if;
1541
1542       if Token = Tok_Apostrophe then
1543          Bad_Range_Attribute (Token_Ptr);
1544          return Error;
1545       else
1546          return Node1;
1547       end if;
1548
1549    end P_Expression;
1550
1551    --  This function is identical to the normal P_Expression, except that it
1552    --  checks that the expression scan did not stop on a right paren. It is
1553    --  called in all contexts where a right parenthesis cannot legitimately
1554    --  follow an expression.
1555
1556    function P_Expression_No_Right_Paren return Node_Id is
1557    begin
1558       return No_Right_Paren (P_Expression);
1559    end P_Expression_No_Right_Paren;
1560
1561    ----------------------------------------
1562    -- 4.4  Expression_Or_Range_Attribute --
1563    ----------------------------------------
1564
1565    --  EXPRESSION ::=
1566    --    RELATION {and RELATION} | RELATION {and then RELATION}
1567    --  | RELATION {or RELATION}  | RELATION {or else RELATION}
1568    --  | RELATION {xor RELATION}
1569
1570    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1571
1572    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1573
1574    --  On return, Expr_Form indicates the categorization of the expression
1575    --  and EF_Range_Attr is one of the possibilities.
1576
1577    --  Error recovery: cannot raise Error_Resync
1578
1579    --  In the grammar, a RANGE attribute is simply a name, but its use is
1580    --  highly restricted, so in the parser, we do not regard it as a name.
1581    --  Instead, P_Name returns without scanning the 'RANGE part of the
1582    --  attribute, and P_Expression_Or_Range_Attribute handles the range
1583    --  attribute reference. In the normal case where a range attribute is
1584    --  not allowed, an error message is issued by P_Expression.
1585
1586    function P_Expression_Or_Range_Attribute return Node_Id is
1587       Logical_Op      : Node_Kind;
1588       Prev_Logical_Op : Node_Kind;
1589       Op_Location     : Source_Ptr;
1590       Node1           : Node_Id;
1591       Node2           : Node_Id;
1592       Attr_Node       : Node_Id;
1593
1594    begin
1595       Node1 := P_Relation;
1596
1597       if Token = Tok_Apostrophe then
1598          Attr_Node := P_Range_Attribute_Reference (Node1);
1599          Expr_Form := EF_Range_Attr;
1600          return Attr_Node;
1601
1602       elsif Token in Token_Class_Logop then
1603          Prev_Logical_Op := N_Empty;
1604
1605          loop
1606             Op_Location := Token_Ptr;
1607             Logical_Op := P_Logical_Operator;
1608
1609             if Prev_Logical_Op /= N_Empty and then
1610                Logical_Op /= Prev_Logical_Op
1611             then
1612                Error_Msg
1613                  ("mixed logical operators in expression", Op_Location);
1614                Prev_Logical_Op := N_Empty;
1615             else
1616                Prev_Logical_Op := Logical_Op;
1617             end if;
1618
1619             Node2 := Node1;
1620             Node1 := New_Node (Logical_Op, Op_Location);
1621             Set_Left_Opnd (Node1, Node2);
1622             Set_Right_Opnd (Node1, P_Relation);
1623             Set_Op_Name (Node1);
1624             exit when Token not in Token_Class_Logop;
1625          end loop;
1626
1627          Expr_Form := EF_Non_Simple;
1628       end if;
1629
1630       if Token = Tok_Apostrophe then
1631          Bad_Range_Attribute (Token_Ptr);
1632          return Error;
1633       else
1634          return Node1;
1635       end if;
1636    end P_Expression_Or_Range_Attribute;
1637
1638    -------------------
1639    -- 4.4  Relation --
1640    -------------------
1641
1642    --  RELATION ::=
1643    --    SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1644    --  | SIMPLE_EXPRESSION [not] in RANGE
1645    --  | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1646
1647    --  On return, Expr_Form indicates the categorization of the expression
1648
1649    --  Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1650    --  EF_Simple_Name and the following token is RANGE (range attribute case).
1651
1652    --  Error recovery: cannot raise Error_Resync. If an error occurs within an
1653    --  expression, then tokens are scanned until either a non-expression token,
1654    --  a right paren (not matched by a left paren) or a comma, is encountered.
1655
1656    function P_Relation return Node_Id is
1657       Node1, Node2 : Node_Id;
1658       Optok        : Source_Ptr;
1659
1660    begin
1661       Node1 := P_Simple_Expression;
1662
1663       if Token not in Token_Class_Relop then
1664          return Node1;
1665
1666       else
1667          --  Here we have a relational operator following. If so then scan it
1668          --  out. Note that the assignment symbol := is treated as a relational
1669          --  operator to improve the error recovery when it is misused for =.
1670          --  P_Relational_Operator also parses the IN and NOT IN operations.
1671
1672          Optok := Token_Ptr;
1673          Node2 := New_Node (P_Relational_Operator, Optok);
1674          Set_Left_Opnd (Node2, Node1);
1675          Set_Op_Name (Node2);
1676
1677          --  Case of IN or NOT IN
1678
1679          if Prev_Token = Tok_In then
1680             Set_Right_Opnd (Node2, P_Range_Or_Subtype_Mark);
1681
1682          --  Case of relational operator (= /= < <= > >=)
1683
1684          else
1685             Set_Right_Opnd (Node2, P_Simple_Expression);
1686          end if;
1687
1688          Expr_Form := EF_Non_Simple;
1689
1690          if Token in Token_Class_Relop then
1691             Error_Msg_SC ("unexpected relational operator");
1692             raise Error_Resync;
1693          end if;
1694
1695          return Node2;
1696       end if;
1697
1698    --  If any error occurs, then scan to the next expression terminator symbol
1699    --  or comma or right paren at the outer (i.e. current) parentheses level.
1700    --  The flags are set to indicate a normal simple expression.
1701
1702    exception
1703       when Error_Resync =>
1704          Resync_Expression;
1705          Expr_Form := EF_Simple;
1706          return Error;
1707    end P_Relation;
1708
1709    ----------------------------
1710    -- 4.4  Simple Expression --
1711    ----------------------------
1712
1713    --  SIMPLE_EXPRESSION ::=
1714    --    [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1715
1716    --  On return, Expr_Form indicates the categorization of the expression
1717
1718    --  Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1719    --  EF_Simple_Name and the following token is RANGE (range attribute case).
1720
1721    --  Error recovery: cannot raise Error_Resync. If an error occurs within an
1722    --  expression, then tokens are scanned until either a non-expression token,
1723    --  a right paren (not matched by a left paren) or a comma, is encountered.
1724
1725    --  Note: P_Simple_Expression is called only internally by higher level
1726    --  expression routines. In cases in the grammar where a simple expression
1727    --  is required, the approach is to scan an expression, and then post an
1728    --  appropriate error message if the expression obtained is not simple. This
1729    --  gives better error recovery and treatment.
1730
1731    function P_Simple_Expression return Node_Id is
1732       Scan_State : Saved_Scan_State;
1733       Node1      : Node_Id;
1734       Node2      : Node_Id;
1735       Tokptr     : Source_Ptr;
1736
1737    begin
1738       --  Check for cases starting with a name. There are two reasons for
1739       --  special casing. First speed things up by catching a common case
1740       --  without going through several routine layers. Second the caller must
1741       --  be informed via Expr_Form when the simple expression is a name.
1742
1743       if Token in Token_Class_Name then
1744          Node1 := P_Name;
1745
1746          --  Deal with apostrophe cases
1747
1748          if Token = Tok_Apostrophe then
1749             Save_Scan_State (Scan_State); -- at apostrophe
1750             Scan; -- past apostrophe
1751
1752             --  If qualified expression, scan it out and fall through
1753
1754             if Token = Tok_Left_Paren then
1755                Node1 := P_Qualified_Expression (Node1);
1756                Expr_Form := EF_Simple;
1757
1758             --  If range attribute, then we return with Token pointing to the
1759             --  apostrophe. Note: avoid the normal error check on exit. We
1760             --  know that the expression really is complete in this case!
1761
1762             else -- Token = Tok_Range then
1763                Restore_Scan_State (Scan_State); -- to apostrophe
1764                Expr_Form := EF_Simple_Name;
1765                return Node1;
1766             end if;
1767          end if;
1768
1769          --  If an expression terminator follows, the previous processing
1770          --  completely scanned out the expression (a common case), and
1771          --  left Expr_Form set appropriately for returning to our caller.
1772
1773          if Token in Token_Class_Sterm then
1774             null;
1775
1776          --  If we do not have an expression terminator, then complete the
1777          --  scan of a simple expression. This code duplicates the code
1778          --  found in P_Term and P_Factor.
1779
1780          else
1781             if Token = Tok_Double_Asterisk then
1782                if Style_Check then Style.Check_Exponentiation_Operator; end if;
1783                Node2 := New_Node (N_Op_Expon, Token_Ptr);
1784                Scan; -- past **
1785                Set_Left_Opnd (Node2, Node1);
1786                Set_Right_Opnd (Node2, P_Primary);
1787                Set_Op_Name (Node2);
1788                Node1 := Node2;
1789             end if;
1790
1791             loop
1792                exit when Token not in Token_Class_Mulop;
1793                Tokptr := Token_Ptr;
1794                Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1795                if Style_Check then Style.Check_Binary_Operator; end if;
1796                Scan; -- past operator
1797                Set_Left_Opnd (Node2, Node1);
1798                Set_Right_Opnd (Node2, P_Factor);
1799                Set_Op_Name (Node2);
1800                Node1 := Node2;
1801             end loop;
1802
1803             loop
1804                exit when Token not in Token_Class_Binary_Addop;
1805                Tokptr := Token_Ptr;
1806                Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1807                if Style_Check then Style.Check_Binary_Operator; end if;
1808                Scan; -- past operator
1809                Set_Left_Opnd (Node2, Node1);
1810                Set_Right_Opnd (Node2, P_Term);
1811                Set_Op_Name (Node2);
1812                Node1 := Node2;
1813             end loop;
1814
1815             Expr_Form := EF_Simple;
1816          end if;
1817
1818       --  Cases where simple expression does not start with a name
1819
1820       else
1821          --  Scan initial sign and initial Term
1822
1823          if Token in Token_Class_Unary_Addop then
1824             Tokptr := Token_Ptr;
1825             Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
1826             if Style_Check then Style.Check_Unary_Plus_Or_Minus; end if;
1827             Scan; -- past operator
1828             Set_Right_Opnd (Node1, P_Term);
1829             Set_Op_Name (Node1);
1830          else
1831             Node1 := P_Term;
1832          end if;
1833
1834          --  Scan out sequence of terms separated by binary adding operators
1835
1836          loop
1837             exit when Token not in Token_Class_Binary_Addop;
1838             Tokptr := Token_Ptr;
1839             Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1840             Scan; -- past operator
1841             Set_Left_Opnd (Node2, Node1);
1842             Set_Right_Opnd (Node2, P_Term);
1843             Set_Op_Name (Node2);
1844             Node1 := Node2;
1845          end loop;
1846
1847          --  All done, we clearly do not have name or numeric literal so this
1848          --  is a case of a simple expression which is some other possibility.
1849
1850          Expr_Form := EF_Simple;
1851       end if;
1852
1853       --  Come here at end of simple expression, where we do a couple of
1854       --  special checks to improve error recovery.
1855
1856       --  Special test to improve error recovery. If the current token
1857       --  is a period, then someone is trying to do selection on something
1858       --  that is not a name, e.g. a qualified expression.
1859
1860       if Token = Tok_Dot then
1861          Error_Msg_SC ("prefix for selection is not a name");
1862          raise Error_Resync;
1863       end if;
1864
1865       --  Special test to improve error recovery: If the current token is
1866       --  not the first token on a line (as determined by checking the
1867       --  previous token position with the start of the current line),
1868       --  then we insist that we have an appropriate terminating token.
1869       --  Consider the following two examples:
1870
1871       --   1)  if A nad B then ...
1872
1873       --   2)  A := B
1874       --       C := D
1875
1876       --  In the first example, we would like to issue a binary operator
1877       --  expected message and resynchronize to the then. In the second
1878       --  example, we do not want to issue a binary operator message, so
1879       --  that instead we will get the missing semicolon message. This
1880       --  distinction is of course a heuristic which does not always work,
1881       --  but in practice it is quite effective.
1882
1883       --  Note: the one case in which we do not go through this circuit is
1884       --  when we have scanned a range attribute and want to return with
1885       --  Token pointing to the apostrophe. The apostrophe is not normally
1886       --  an expression terminator, and is not in Token_Class_Sterm, but
1887       --  in this special case we know that the expression is complete.
1888
1889       if not Token_Is_At_Start_Of_Line
1890          and then Token not in Token_Class_Sterm
1891       then
1892          Error_Msg_AP ("binary operator expected");
1893          raise Error_Resync;
1894       else
1895          return Node1;
1896       end if;
1897
1898    --  If any error occurs, then scan to next expression terminator symbol
1899    --  or comma, right paren or vertical bar at the outer (i.e. current) paren
1900    --  level. Expr_Form is set to indicate a normal simple expression.
1901
1902    exception
1903       when Error_Resync =>
1904          Resync_Expression;
1905          Expr_Form := EF_Simple;
1906          return Error;
1907
1908    end P_Simple_Expression;
1909
1910    -----------------------------------------------
1911    -- 4.4  Simple Expression or Range Attribute --
1912    -----------------------------------------------
1913
1914    --  SIMPLE_EXPRESSION ::=
1915    --    [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1916
1917    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1918
1919    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1920
1921    --  Error recovery: cannot raise Error_Resync
1922
1923    function P_Simple_Expression_Or_Range_Attribute return Node_Id is
1924       Sexpr     : Node_Id;
1925       Attr_Node : Node_Id;
1926
1927    begin
1928       Sexpr := P_Simple_Expression;
1929
1930       if Token = Tok_Apostrophe then
1931          Attr_Node := P_Range_Attribute_Reference (Sexpr);
1932          Expr_Form := EF_Range_Attr;
1933          return Attr_Node;
1934
1935       else
1936          return Sexpr;
1937       end if;
1938    end P_Simple_Expression_Or_Range_Attribute;
1939
1940    ---------------
1941    -- 4.4  Term --
1942    ---------------
1943
1944    --  TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
1945
1946    --  Error recovery: can raise Error_Resync
1947
1948    function P_Term return Node_Id is
1949       Node1, Node2 : Node_Id;
1950       Tokptr       : Source_Ptr;
1951
1952    begin
1953       Node1 := P_Factor;
1954
1955       loop
1956          exit when Token not in Token_Class_Mulop;
1957          Tokptr := Token_Ptr;
1958          Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1959          Scan; -- past operator
1960          Set_Left_Opnd (Node2, Node1);
1961          Set_Right_Opnd (Node2, P_Factor);
1962          Set_Op_Name (Node2);
1963          Node1 := Node2;
1964       end loop;
1965
1966       return Node1;
1967    end P_Term;
1968
1969    -----------------
1970    -- 4.4  Factor --
1971    -----------------
1972
1973    --  FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
1974
1975    --  Error recovery: can raise Error_Resync
1976
1977    function P_Factor return Node_Id is
1978       Node1 : Node_Id;
1979       Node2 : Node_Id;
1980
1981    begin
1982       if Token = Tok_Abs then
1983          Node1 := New_Node (N_Op_Abs, Token_Ptr);
1984          if Style_Check then Style.Check_Abs_Not; end if;
1985          Scan; -- past ABS
1986          Set_Right_Opnd (Node1, P_Primary);
1987          Set_Op_Name (Node1);
1988          return Node1;
1989
1990       elsif Token = Tok_Not then
1991          Node1 := New_Node (N_Op_Not, Token_Ptr);
1992          if Style_Check then Style.Check_Abs_Not; end if;
1993          Scan; -- past NOT
1994          Set_Right_Opnd (Node1, P_Primary);
1995          Set_Op_Name (Node1);
1996          return Node1;
1997
1998       else
1999          Node1 := P_Primary;
2000
2001          if Token = Tok_Double_Asterisk then
2002             Node2 := New_Node (N_Op_Expon, Token_Ptr);
2003             Scan; -- past **
2004             Set_Left_Opnd (Node2, Node1);
2005             Set_Right_Opnd (Node2, P_Primary);
2006             Set_Op_Name (Node2);
2007             return Node2;
2008          else
2009             return Node1;
2010          end if;
2011       end if;
2012    end P_Factor;
2013
2014    ------------------
2015    -- 4.4  Primary --
2016    ------------------
2017
2018    --  PRIMARY ::=
2019    --    NUMERIC_LITERAL  | null
2020    --  | STRING_LITERAL   | AGGREGATE
2021    --  | NAME             | QUALIFIED_EXPRESSION
2022    --  | ALLOCATOR        | (EXPRESSION)
2023
2024    --  Error recovery: can raise Error_Resync
2025
2026    function P_Primary return Node_Id is
2027       Scan_State : Saved_Scan_State;
2028       Node1      : Node_Id;
2029
2030    begin
2031       --  The loop runs more than once only if misplaced pragmas are found
2032
2033       loop
2034          case Token is
2035
2036             --  Name token can start a name, call or qualified expression, all
2037             --  of which are acceptable possibilities for primary. Note also
2038             --  that string literal is included in name (as operator symbol)
2039             --  and type conversion is included in name (as indexed component).
2040
2041             when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2042                Node1 := P_Name;
2043
2044                --  All done unless apostrophe follows
2045
2046                if Token /= Tok_Apostrophe then
2047                   return Node1;
2048
2049                --  Apostrophe following means that we have either just parsed
2050                --  the subtype mark of a qualified expression, or the prefix
2051                --  or a range attribute.
2052
2053                else -- Token = Tok_Apostrophe
2054                   Save_Scan_State (Scan_State); -- at apostrophe
2055                   Scan; -- past apostrophe
2056
2057                   --  If range attribute, then this is always an error, since
2058                   --  the only legitimate case (where the scanned expression is
2059                   --  a qualified simple name) is handled at the level of the
2060                   --  Simple_Expression processing. This case corresponds to a
2061                   --  usage such as 3 + A'Range, which is always illegal.
2062
2063                   if Token = Tok_Range then
2064                      Restore_Scan_State (Scan_State); -- to apostrophe
2065                      Bad_Range_Attribute (Token_Ptr);
2066                      return Error;
2067
2068                   --  If left paren, then we have a qualified expression.
2069                   --  Note that P_Name guarantees that in this case, where
2070                   --  Token = Tok_Apostrophe on return, the only two possible
2071                   --  tokens following the apostrophe are left paren and
2072                   --  RANGE, so we know we have a left paren here.
2073
2074                   else -- Token = Tok_Left_Paren
2075                      return P_Qualified_Expression (Node1);
2076
2077                   end if;
2078                end if;
2079
2080             --  Numeric or string literal
2081
2082             when Tok_Integer_Literal |
2083                  Tok_Real_Literal    |
2084                  Tok_String_Literal  =>
2085
2086                Node1 := Token_Node;
2087                Scan; -- past number
2088                return Node1;
2089
2090             --  Left paren, starts aggregate or parenthesized expression
2091
2092             when Tok_Left_Paren =>
2093                return P_Aggregate_Or_Paren_Expr;
2094
2095             --  Allocator
2096
2097             when Tok_New =>
2098                return P_Allocator;
2099
2100             --  Null
2101
2102             when Tok_Null =>
2103                Scan; -- past NULL
2104                return New_Node (N_Null, Prev_Token_Ptr);
2105
2106             --  Pragma, not allowed here, so just skip past it
2107
2108             when Tok_Pragma =>
2109                P_Pragmas_Misplaced;
2110
2111             --  Anything else is illegal as the first token of a primary, but
2112             --  we test for a reserved identifier so that it is treated nicely
2113
2114             when others =>
2115                if Is_Reserved_Identifier then
2116                   return P_Identifier;
2117
2118                elsif Prev_Token = Tok_Comma then
2119                   Error_Msg_SP ("extra "","" ignored");
2120                   raise Error_Resync;
2121
2122                else
2123                   Error_Msg_AP ("missing operand");
2124                   raise Error_Resync;
2125                end if;
2126
2127          end case;
2128       end loop;
2129    end P_Primary;
2130
2131    ---------------------------
2132    -- 4.5  Logical Operator --
2133    ---------------------------
2134
2135    --  LOGICAL_OPERATOR  ::=  and | or | xor
2136
2137    --  Note: AND THEN and OR ELSE are also treated as logical operators
2138    --  by the parser (even though they are not operators semantically)
2139
2140    --  The value returned is the appropriate Node_Kind code for the operator
2141    --  On return, Token points to the token following the scanned operator.
2142
2143    --  The caller has checked that the first token is a legitimate logical
2144    --  operator token (i.e. is either XOR, AND, OR).
2145
2146    --  Error recovery: cannot raise Error_Resync
2147
2148    function P_Logical_Operator return Node_Kind is
2149    begin
2150       if Token = Tok_And then
2151          if Style_Check then Style.Check_Binary_Operator; end if;
2152          Scan; -- past AND
2153
2154          if Token = Tok_Then then
2155             Scan; -- past THEN
2156             return N_And_Then;
2157          else
2158             return N_Op_And;
2159          end if;
2160
2161       elsif Token = Tok_Or then
2162          if Style_Check then Style.Check_Binary_Operator; end if;
2163          Scan; -- past OR
2164
2165          if Token = Tok_Else then
2166             Scan; -- past ELSE
2167             return N_Or_Else;
2168          else
2169             return N_Op_Or;
2170          end if;
2171
2172       else -- Token = Tok_Xor
2173          if Style_Check then Style.Check_Binary_Operator; end if;
2174          Scan; -- past XOR
2175          return N_Op_Xor;
2176       end if;
2177    end P_Logical_Operator;
2178
2179    ------------------------------
2180    -- 4.5  Relational Operator --
2181    ------------------------------
2182
2183    --  RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2184
2185    --  The value returned is the appropriate Node_Kind code for the operator.
2186    --  On return, Token points to the operator token, NOT past it.
2187
2188    --  The caller has checked that the first token is a legitimate relational
2189    --  operator token (i.e. is one of the operator tokens listed above).
2190
2191    --  Error recovery: cannot raise Error_Resync
2192
2193    function P_Relational_Operator return Node_Kind is
2194       Op_Kind : Node_Kind;
2195       Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2196         (Tok_Less           => N_Op_Lt,
2197          Tok_Equal          => N_Op_Eq,
2198          Tok_Greater        => N_Op_Gt,
2199          Tok_Not_Equal      => N_Op_Ne,
2200          Tok_Greater_Equal  => N_Op_Ge,
2201          Tok_Less_Equal     => N_Op_Le,
2202          Tok_In             => N_In,
2203          Tok_Not            => N_Not_In,
2204          Tok_Box            => N_Op_Ne);
2205
2206    begin
2207       if Token = Tok_Box then
2208          Error_Msg_SC ("""'<'>"" should be ""/=""");
2209       end if;
2210
2211       Op_Kind := Relop_Node (Token);
2212       if Style_Check then Style.Check_Binary_Operator; end if;
2213       Scan; -- past operator token
2214
2215       if Prev_Token = Tok_Not then
2216          T_In;
2217       end if;
2218
2219       return Op_Kind;
2220    end P_Relational_Operator;
2221
2222    ---------------------------------
2223    -- 4.5  Binary Adding Operator --
2224    ---------------------------------
2225
2226    --  BINARY_ADDING_OPERATOR ::= + | - | &
2227
2228    --  The value returned is the appropriate Node_Kind code for the operator.
2229    --  On return, Token points to the operator token (NOT past it).
2230
2231    --  The caller has checked that the first token is a legitimate adding
2232    --  operator token (i.e. is one of the operator tokens listed above).
2233
2234    --  Error recovery: cannot raise Error_Resync
2235
2236    function P_Binary_Adding_Operator return Node_Kind is
2237       Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2238         (Tok_Ampersand      => N_Op_Concat,
2239          Tok_Minus          => N_Op_Subtract,
2240          Tok_Plus           => N_Op_Add);
2241    begin
2242       return Addop_Node (Token);
2243    end P_Binary_Adding_Operator;
2244
2245    --------------------------------
2246    -- 4.5  Unary Adding Operator --
2247    --------------------------------
2248
2249    --  UNARY_ADDING_OPERATOR ::= + | -
2250
2251    --  The value returned is the appropriate Node_Kind code for the operator.
2252    --  On return, Token points to the operator token (NOT past it).
2253
2254    --  The caller has checked that the first token is a legitimate adding
2255    --  operator token (i.e. is one of the operator tokens listed above).
2256
2257    --  Error recovery: cannot raise Error_Resync
2258
2259    function P_Unary_Adding_Operator return Node_Kind is
2260       Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2261         (Tok_Minus          => N_Op_Minus,
2262          Tok_Plus           => N_Op_Plus);
2263    begin
2264       return Addop_Node (Token);
2265    end P_Unary_Adding_Operator;
2266
2267    -------------------------------
2268    -- 4.5  Multiplying Operator --
2269    -------------------------------
2270
2271    --  MULTIPLYING_OPERATOR ::= * | / | mod | rem
2272
2273    --  The value returned is the appropriate Node_Kind code for the operator.
2274    --  On return, Token points to the operator token (NOT past it).
2275
2276    --  The caller has checked that the first token is a legitimate multiplying
2277    --  operator token (i.e. is one of the operator tokens listed above).
2278
2279    --  Error recovery: cannot raise Error_Resync
2280
2281    function P_Multiplying_Operator return Node_Kind is
2282       Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2283         (Tok_Asterisk       => N_Op_Multiply,
2284          Tok_Mod            => N_Op_Mod,
2285          Tok_Rem            => N_Op_Rem,
2286          Tok_Slash          => N_Op_Divide);
2287    begin
2288       return Mulop_Node (Token);
2289    end P_Multiplying_Operator;
2290
2291    --------------------------------------
2292    -- 4.5  Highest Precedence Operator --
2293    --------------------------------------
2294
2295    --  Parsed by P_Factor (4.4)
2296
2297    --  Note: this rule is not in fact used by the grammar at any point!
2298
2299    --------------------------
2300    -- 4.6  Type Conversion --
2301    --------------------------
2302
2303    --  Parsed by P_Primary as a Name (4.1)
2304
2305    -------------------------------
2306    -- 4.7  Qualified Expression --
2307    -------------------------------
2308
2309    --  QUALIFIED_EXPRESSION ::=
2310    --    SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2311
2312    --  The caller has scanned the name which is the Subtype_Mark parameter
2313    --  and scanned past the single quote following the subtype mark. The
2314    --  caller has not checked that this name is in fact appropriate for
2315    --  a subtype mark name (i.e. it is a selected component or identifier).
2316
2317    --  Error_Recovery: cannot raise Error_Resync
2318
2319    function  P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2320       Qual_Node : Node_Id;
2321
2322    begin
2323       Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2324       Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2325       Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2326       return Qual_Node;
2327    end P_Qualified_Expression;
2328
2329    --------------------
2330    -- 4.8  Allocator --
2331    --------------------
2332
2333    --  ALLOCATOR ::=
2334    --   new SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2335
2336    --  The caller has checked that the initial token is NEW
2337
2338    --  Error recovery: can raise Error_Resync
2339
2340    function P_Allocator return Node_Id is
2341       Alloc_Node  : Node_Id;
2342       Type_Node   : Node_Id;
2343
2344    begin
2345       Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2346       T_New;
2347       Type_Node := P_Subtype_Mark_Resync;
2348
2349       if Token = Tok_Apostrophe then
2350          Scan; -- past apostrophe
2351          Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2352       else
2353          Set_Expression (Alloc_Node, P_Subtype_Indication (Type_Node));
2354       end if;
2355
2356       return Alloc_Node;
2357    end P_Allocator;
2358
2359 end Ch4;