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