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-2001 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 : 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          --  Assume positional case if comma, right paren, or literal or
1275          --  identifier or OTHERS follows (the latter cases are missing
1276          --  comma cases). Also assume positional if a semicolon follows,
1277          --  which can happen if there are missing parens
1278
1279          elsif Token = Tok_Comma
1280            or else Token = Tok_Right_Paren
1281            or else Token = Tok_Others
1282            or else Token in Token_Class_Lit_Or_Name
1283            or else Token = Tok_Semicolon
1284          then
1285             if Present (Assoc_List) then
1286                Error_Msg_BC
1287                   ("""=>"" expected (positional association cannot follow " &
1288                    "named association)");
1289             end if;
1290
1291             if No (Expr_List) then
1292                Expr_List := New_List;
1293             end if;
1294
1295             Append (Expr_Node, Expr_List);
1296
1297          --  Anything else is assumed to be a named association
1298
1299          else
1300             Restore_Scan_State (Scan_State); -- to start of expression
1301
1302             if No (Assoc_List) then
1303                Assoc_List := New_List;
1304             end if;
1305
1306             Append (P_Record_Or_Array_Component_Association, Assoc_List);
1307          end if;
1308
1309          exit when not Comma_Present;
1310
1311          --  If we are at an expression terminator, something is seriously
1312          --  wrong, so let's get out now, before we start eating up stuff
1313          --  that doesn't belong to us!
1314
1315          if Token in Token_Class_Eterm then
1316             Error_Msg_AP ("expecting expression or component association");
1317             exit;
1318          end if;
1319
1320          --  Otherwise initiate for reentry to top of loop by scanning an
1321          --  initial expression, unless the first token is OTHERS.
1322
1323          if Token = Tok_Others then
1324             Expr_Node := Empty;
1325          else
1326             Save_Scan_State (Scan_State); -- at start of expression
1327             Expr_Node := P_Expression;
1328          end if;
1329       end loop;
1330
1331       --  All component associations (positional and named) have been scanned
1332
1333       T_Right_Paren;
1334       Set_Expressions (Aggregate_Node, Expr_List);
1335       Set_Component_Associations (Aggregate_Node, Assoc_List);
1336       return Aggregate_Node;
1337    end P_Aggregate_Or_Paren_Expr;
1338
1339    ------------------------------------------------
1340    -- 4.3  Record or Array Component Association --
1341    ------------------------------------------------
1342
1343    --  RECORD_COMPONENT_ASSOCIATION ::=
1344    --    [COMPONENT_CHOICE_LIST =>] EXPRESSION
1345
1346    --  COMPONENT_CHOICE_LIST =>
1347    --    component_SELECTOR_NAME {| component_SELECTOR_NAME}
1348    --  | others
1349
1350    --  ARRAY_COMPONENT_ASSOCIATION ::=
1351    --    DISCRETE_CHOICE_LIST => EXPRESSION
1352
1353    --  Note: this routine only handles the named cases, including others.
1354    --  Cases where the component choice list is not present have already
1355    --  been handled directly.
1356
1357    --  Error recovery: can raise Error_Resync
1358
1359    function P_Record_Or_Array_Component_Association return Node_Id is
1360       Assoc_Node : Node_Id;
1361
1362    begin
1363       Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1364       Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1365       Set_Sloc (Assoc_Node, Token_Ptr);
1366       TF_Arrow;
1367       Set_Expression (Assoc_Node, P_Expression);
1368       return Assoc_Node;
1369    end P_Record_Or_Array_Component_Association;
1370
1371    -----------------------------
1372    -- 4.3.1  Record Aggregate --
1373    -----------------------------
1374
1375    --  Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1376    --  All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1377
1378    ----------------------------------------------
1379    -- 4.3.1  Record Component Association List --
1380    ----------------------------------------------
1381
1382    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1383
1384    ----------------------------------
1385    -- 4.3.1  Component Choice List --
1386    ----------------------------------
1387
1388    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1389
1390    --------------------------------
1391    -- 4.3.1  Extension Aggregate --
1392    --------------------------------
1393
1394    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1395
1396    --------------------------
1397    -- 4.3.1  Ancestor Part --
1398    --------------------------
1399
1400    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1401
1402    ----------------------------
1403    -- 4.3.1  Array Aggregate --
1404    ----------------------------
1405
1406    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1407
1408    ---------------------------------------
1409    -- 4.3.1  Positional Array Aggregate --
1410    ---------------------------------------
1411
1412    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1413
1414    ----------------------------------
1415    -- 4.3.1  Named Array Aggregate --
1416    ----------------------------------
1417
1418    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1419
1420    ----------------------------------------
1421    -- 4.3.1  Array Component Association --
1422    ----------------------------------------
1423
1424    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1425
1426    ---------------------
1427    -- 4.4  Expression --
1428    ---------------------
1429
1430    --  EXPRESSION ::=
1431    --    RELATION {and RELATION} | RELATION {and then RELATION}
1432    --  | RELATION {or RELATION}  | RELATION {or else RELATION}
1433    --  | RELATION {xor RELATION}
1434
1435    --  On return, Expr_Form indicates the categorization of the expression
1436    --  EF_Range_Attr is not a possible value (if a range attribute is found,
1437    --  an error message is given, and Error is returned).
1438
1439    --  Error recovery: cannot raise Error_Resync
1440
1441    function P_Expression return Node_Id is
1442       Logical_Op      : Node_Kind;
1443       Prev_Logical_Op : Node_Kind;
1444       Op_Location     : Source_Ptr;
1445       Node1           : Node_Id;
1446       Node2           : Node_Id;
1447
1448    begin
1449       Node1 := P_Relation;
1450
1451       if Token in Token_Class_Logop then
1452          Prev_Logical_Op := N_Empty;
1453
1454          loop
1455             Op_Location := Token_Ptr;
1456             Logical_Op := P_Logical_Operator;
1457
1458             if Prev_Logical_Op /= N_Empty and then
1459                Logical_Op /= Prev_Logical_Op
1460             then
1461                Error_Msg
1462                  ("mixed logical operators in expression", Op_Location);
1463                Prev_Logical_Op := N_Empty;
1464             else
1465                Prev_Logical_Op := Logical_Op;
1466             end if;
1467
1468             Node2 := Node1;
1469             Node1 := New_Node (Logical_Op, Op_Location);
1470             Set_Left_Opnd (Node1, Node2);
1471             Set_Right_Opnd (Node1, P_Relation);
1472             Set_Op_Name (Node1);
1473             exit when Token not in Token_Class_Logop;
1474          end loop;
1475
1476          Expr_Form := EF_Non_Simple;
1477       end if;
1478
1479       if Token = Tok_Apostrophe then
1480          Bad_Range_Attribute (Token_Ptr);
1481          return Error;
1482       else
1483          return Node1;
1484       end if;
1485
1486    end P_Expression;
1487
1488    --  This function is identical to the normal P_Expression, except that it
1489    --  checks that the expression scan did not stop on a right paren. It is
1490    --  called in all contexts where a right parenthesis cannot legitimately
1491    --  follow an expression.
1492
1493    function P_Expression_No_Right_Paren return Node_Id is
1494    begin
1495       return No_Right_Paren (P_Expression);
1496    end P_Expression_No_Right_Paren;
1497
1498    ----------------------------------------
1499    -- 4.4  Expression_Or_Range_Attribute --
1500    ----------------------------------------
1501
1502    --  EXPRESSION ::=
1503    --    RELATION {and RELATION} | RELATION {and then RELATION}
1504    --  | RELATION {or RELATION}  | RELATION {or else RELATION}
1505    --  | RELATION {xor RELATION}
1506
1507    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1508
1509    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1510
1511    --  On return, Expr_Form indicates the categorization of the expression
1512    --  and EF_Range_Attr is one of the possibilities.
1513
1514    --  Error recovery: cannot raise Error_Resync
1515
1516    --  In the grammar, a RANGE attribute is simply a name, but its use is
1517    --  highly restricted, so in the parser, we do not regard it as a name.
1518    --  Instead, P_Name returns without scanning the 'RANGE part of the
1519    --  attribute, and P_Expression_Or_Range_Attribute handles the range
1520    --  attribute reference. In the normal case where a range attribute is
1521    --  not allowed, an error message is issued by P_Expression.
1522
1523    function P_Expression_Or_Range_Attribute return Node_Id is
1524       Logical_Op      : Node_Kind;
1525       Prev_Logical_Op : Node_Kind;
1526       Op_Location     : Source_Ptr;
1527       Node1           : Node_Id;
1528       Node2           : Node_Id;
1529       Attr_Node       : Node_Id;
1530
1531    begin
1532       Node1 := P_Relation;
1533
1534       if Token = Tok_Apostrophe then
1535          Attr_Node := P_Range_Attribute_Reference (Node1);
1536          Expr_Form := EF_Range_Attr;
1537          return Attr_Node;
1538
1539       elsif Token in Token_Class_Logop then
1540          Prev_Logical_Op := N_Empty;
1541
1542          loop
1543             Op_Location := Token_Ptr;
1544             Logical_Op := P_Logical_Operator;
1545
1546             if Prev_Logical_Op /= N_Empty and then
1547                Logical_Op /= Prev_Logical_Op
1548             then
1549                Error_Msg
1550                  ("mixed logical operators in expression", Op_Location);
1551                Prev_Logical_Op := N_Empty;
1552             else
1553                Prev_Logical_Op := Logical_Op;
1554             end if;
1555
1556             Node2 := Node1;
1557             Node1 := New_Node (Logical_Op, Op_Location);
1558             Set_Left_Opnd (Node1, Node2);
1559             Set_Right_Opnd (Node1, P_Relation);
1560             Set_Op_Name (Node1);
1561             exit when Token not in Token_Class_Logop;
1562          end loop;
1563
1564          Expr_Form := EF_Non_Simple;
1565       end if;
1566
1567       if Token = Tok_Apostrophe then
1568          Bad_Range_Attribute (Token_Ptr);
1569          return Error;
1570       else
1571          return Node1;
1572       end if;
1573    end P_Expression_Or_Range_Attribute;
1574
1575    -------------------
1576    -- 4.4  Relation --
1577    -------------------
1578
1579    --  RELATION ::=
1580    --    SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1581    --  | SIMPLE_EXPRESSION [not] in RANGE
1582    --  | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1583
1584    --  On return, Expr_Form indicates the categorization of the expression
1585
1586    --  Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1587    --  EF_Simple_Name and the following token is RANGE (range attribute case).
1588
1589    --  Error recovery: cannot raise Error_Resync. If an error occurs within an
1590    --  expression, then tokens are scanned until either a non-expression token,
1591    --  a right paren (not matched by a left paren) or a comma, is encountered.
1592
1593    function P_Relation return Node_Id is
1594       Node1, Node2 : Node_Id;
1595       Optok        : Source_Ptr;
1596
1597    begin
1598       Node1 := P_Simple_Expression;
1599
1600       if Token not in Token_Class_Relop then
1601          return Node1;
1602
1603       else
1604          --  Here we have a relational operator following. If so then scan it
1605          --  out. Note that the assignment symbol := is treated as a relational
1606          --  operator to improve the error recovery when it is misused for =.
1607          --  P_Relational_Operator also parses the IN and NOT IN operations.
1608
1609          Optok := Token_Ptr;
1610          Node2 := New_Node (P_Relational_Operator, Optok);
1611          Set_Left_Opnd (Node2, Node1);
1612          Set_Op_Name (Node2);
1613
1614          --  Case of IN or NOT IN
1615
1616          if Prev_Token = Tok_In then
1617             Set_Right_Opnd (Node2, P_Range_Or_Subtype_Mark);
1618
1619          --  Case of relational operator (= /= < <= > >=)
1620
1621          else
1622             Set_Right_Opnd (Node2, P_Simple_Expression);
1623          end if;
1624
1625          Expr_Form := EF_Non_Simple;
1626
1627          if Token in Token_Class_Relop then
1628             Error_Msg_SC ("unexpected relational operator");
1629             raise Error_Resync;
1630          end if;
1631
1632          return Node2;
1633       end if;
1634
1635    --  If any error occurs, then scan to the next expression terminator symbol
1636    --  or comma or right paren at the outer (i.e. current) parentheses level.
1637    --  The flags are set to indicate a normal simple expression.
1638
1639    exception
1640       when Error_Resync =>
1641          Resync_Expression;
1642          Expr_Form := EF_Simple;
1643          return Error;
1644    end P_Relation;
1645
1646    ----------------------------
1647    -- 4.4  Simple Expression --
1648    ----------------------------
1649
1650    --  SIMPLE_EXPRESSION ::=
1651    --    [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1652
1653    --  On return, Expr_Form indicates the categorization of the expression
1654
1655    --  Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1656    --  EF_Simple_Name and the following token is RANGE (range attribute case).
1657
1658    --  Error recovery: cannot raise Error_Resync. If an error occurs within an
1659    --  expression, then tokens are scanned until either a non-expression token,
1660    --  a right paren (not matched by a left paren) or a comma, is encountered.
1661
1662    --  Note: P_Simple_Expression is called only internally by higher level
1663    --  expression routines. In cases in the grammar where a simple expression
1664    --  is required, the approach is to scan an expression, and then post an
1665    --  appropriate error message if the expression obtained is not simple. This
1666    --  gives better error recovery and treatment.
1667
1668    function P_Simple_Expression return Node_Id is
1669       Scan_State : Saved_Scan_State;
1670       Node1      : Node_Id;
1671       Node2      : Node_Id;
1672       Tokptr     : Source_Ptr;
1673
1674    begin
1675       --  Check for cases starting with a name. There are two reasons for
1676       --  special casing. First speed things up by catching a common case
1677       --  without going through several routine layers. Second the caller must
1678       --  be informed via Expr_Form when the simple expression is a name.
1679
1680       if Token in Token_Class_Name then
1681          Node1 := P_Name;
1682
1683          --  Deal with apostrophe cases
1684
1685          if Token = Tok_Apostrophe then
1686             Save_Scan_State (Scan_State); -- at apostrophe
1687             Scan; -- past apostrophe
1688
1689             --  If qualified expression, scan it out and fall through
1690
1691             if Token = Tok_Left_Paren then
1692                Node1 := P_Qualified_Expression (Node1);
1693                Expr_Form := EF_Simple;
1694
1695             --  If range attribute, then we return with Token pointing to the
1696             --  apostrophe. Note: avoid the normal error check on exit. We
1697             --  know that the expression really is complete in this case!
1698
1699             else -- Token = Tok_Range then
1700                Restore_Scan_State (Scan_State); -- to apostrophe
1701                Expr_Form := EF_Simple_Name;
1702                return Node1;
1703             end if;
1704          end if;
1705
1706          --  If an expression terminator follows, the previous processing
1707          --  completely scanned out the expression (a common case), and
1708          --  left Expr_Form set appropriately for returning to our caller.
1709
1710          if Token in Token_Class_Sterm then
1711             null;
1712
1713          --  If we do not have an expression terminator, then complete the
1714          --  scan of a simple expression. This code duplicates the code
1715          --  found in P_Term and P_Factor.
1716
1717          else
1718             if Token = Tok_Double_Asterisk then
1719                if Style_Check then Style.Check_Exponentiation_Operator; end if;
1720                Node2 := New_Node (N_Op_Expon, Token_Ptr);
1721                Scan; -- past **
1722                Set_Left_Opnd (Node2, Node1);
1723                Set_Right_Opnd (Node2, P_Primary);
1724                Set_Op_Name (Node2);
1725                Node1 := Node2;
1726             end if;
1727
1728             loop
1729                exit when Token not in Token_Class_Mulop;
1730                Tokptr := Token_Ptr;
1731                Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1732                if Style_Check then Style.Check_Binary_Operator; end if;
1733                Scan; -- past operator
1734                Set_Left_Opnd (Node2, Node1);
1735                Set_Right_Opnd (Node2, P_Factor);
1736                Set_Op_Name (Node2);
1737                Node1 := Node2;
1738             end loop;
1739
1740             loop
1741                exit when Token not in Token_Class_Binary_Addop;
1742                Tokptr := Token_Ptr;
1743                Node2 := New_Node (P_Binary_Adding_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_Term);
1748                Set_Op_Name (Node2);
1749                Node1 := Node2;
1750             end loop;
1751
1752             Expr_Form := EF_Simple;
1753          end if;
1754
1755       --  Cases where simple expression does not start with a name
1756
1757       else
1758          --  Scan initial sign and initial Term
1759
1760          if Token in Token_Class_Unary_Addop then
1761             Tokptr := Token_Ptr;
1762             Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
1763             if Style_Check then Style.Check_Unary_Plus_Or_Minus; end if;
1764             Scan; -- past operator
1765             Set_Right_Opnd (Node1, P_Term);
1766             Set_Op_Name (Node1);
1767          else
1768             Node1 := P_Term;
1769          end if;
1770
1771          --  Scan out sequence of terms separated by binary adding operators
1772
1773          loop
1774             exit when Token not in Token_Class_Binary_Addop;
1775             Tokptr := Token_Ptr;
1776             Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1777             Scan; -- past operator
1778             Set_Left_Opnd (Node2, Node1);
1779             Set_Right_Opnd (Node2, P_Term);
1780             Set_Op_Name (Node2);
1781             Node1 := Node2;
1782          end loop;
1783
1784          --  All done, we clearly do not have name or numeric literal so this
1785          --  is a case of a simple expression which is some other possibility.
1786
1787          Expr_Form := EF_Simple;
1788       end if;
1789
1790       --  Come here at end of simple expression, where we do a couple of
1791       --  special checks to improve error recovery.
1792
1793       --  Special test to improve error recovery. If the current token
1794       --  is a period, then someone is trying to do selection on something
1795       --  that is not a name, e.g. a qualified expression.
1796
1797       if Token = Tok_Dot then
1798          Error_Msg_SC ("prefix for selection is not a name");
1799          raise Error_Resync;
1800       end if;
1801
1802       --  Special test to improve error recovery: If the current token is
1803       --  not the first token on a line (as determined by checking the
1804       --  previous token position with the start of the current line),
1805       --  then we insist that we have an appropriate terminating token.
1806       --  Consider the following two examples:
1807
1808       --   1)  if A nad B then ...
1809
1810       --   2)  A := B
1811       --       C := D
1812
1813       --  In the first example, we would like to issue a binary operator
1814       --  expected message and resynchronize to the then. In the second
1815       --  example, we do not want to issue a binary operator message, so
1816       --  that instead we will get the missing semicolon message. This
1817       --  distinction is of course a heuristic which does not always work,
1818       --  but in practice it is quite effective.
1819
1820       --  Note: the one case in which we do not go through this circuit is
1821       --  when we have scanned a range attribute and want to return with
1822       --  Token pointing to the apostrophe. The apostrophe is not normally
1823       --  an expression terminator, and is not in Token_Class_Sterm, but
1824       --  in this special case we know that the expression is complete.
1825
1826       if not Token_Is_At_Start_Of_Line
1827          and then Token not in Token_Class_Sterm
1828       then
1829          Error_Msg_AP ("binary operator expected");
1830          raise Error_Resync;
1831       else
1832          return Node1;
1833       end if;
1834
1835    --  If any error occurs, then scan to next expression terminator symbol
1836    --  or comma, right paren or vertical bar at the outer (i.e. current) paren
1837    --  level. Expr_Form is set to indicate a normal simple expression.
1838
1839    exception
1840       when Error_Resync =>
1841          Resync_Expression;
1842          Expr_Form := EF_Simple;
1843          return Error;
1844
1845    end P_Simple_Expression;
1846
1847    -----------------------------------------------
1848    -- 4.4  Simple Expression or Range Attribute --
1849    -----------------------------------------------
1850
1851    --  SIMPLE_EXPRESSION ::=
1852    --    [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1853
1854    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1855
1856    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1857
1858    --  Error recovery: cannot raise Error_Resync
1859
1860    function P_Simple_Expression_Or_Range_Attribute return Node_Id is
1861       Sexpr     : Node_Id;
1862       Attr_Node : Node_Id;
1863
1864    begin
1865       Sexpr := P_Simple_Expression;
1866
1867       if Token = Tok_Apostrophe then
1868          Attr_Node := P_Range_Attribute_Reference (Sexpr);
1869          Expr_Form := EF_Range_Attr;
1870          return Attr_Node;
1871
1872       else
1873          return Sexpr;
1874       end if;
1875    end P_Simple_Expression_Or_Range_Attribute;
1876
1877    ---------------
1878    -- 4.4  Term --
1879    ---------------
1880
1881    --  TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
1882
1883    --  Error recovery: can raise Error_Resync
1884
1885    function P_Term return Node_Id is
1886       Node1, Node2 : Node_Id;
1887       Tokptr       : Source_Ptr;
1888
1889    begin
1890       Node1 := P_Factor;
1891
1892       loop
1893          exit when Token not in Token_Class_Mulop;
1894          Tokptr := Token_Ptr;
1895          Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1896          Scan; -- past operator
1897          Set_Left_Opnd (Node2, Node1);
1898          Set_Right_Opnd (Node2, P_Factor);
1899          Set_Op_Name (Node2);
1900          Node1 := Node2;
1901       end loop;
1902
1903       return Node1;
1904    end P_Term;
1905
1906    -----------------
1907    -- 4.4  Factor --
1908    -----------------
1909
1910    --  FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
1911
1912    --  Error recovery: can raise Error_Resync
1913
1914    function P_Factor return Node_Id is
1915       Node1 : Node_Id;
1916       Node2 : Node_Id;
1917
1918    begin
1919       if Token = Tok_Abs then
1920          Node1 := New_Node (N_Op_Abs, Token_Ptr);
1921          if Style_Check then Style.Check_Abs_Not; end if;
1922          Scan; -- past ABS
1923          Set_Right_Opnd (Node1, P_Primary);
1924          Set_Op_Name (Node1);
1925          return Node1;
1926
1927       elsif Token = Tok_Not then
1928          Node1 := New_Node (N_Op_Not, Token_Ptr);
1929          if Style_Check then Style.Check_Abs_Not; end if;
1930          Scan; -- past NOT
1931          Set_Right_Opnd (Node1, P_Primary);
1932          Set_Op_Name (Node1);
1933          return Node1;
1934
1935       else
1936          Node1 := P_Primary;
1937
1938          if Token = Tok_Double_Asterisk then
1939             Node2 := New_Node (N_Op_Expon, Token_Ptr);
1940             Scan; -- past **
1941             Set_Left_Opnd (Node2, Node1);
1942             Set_Right_Opnd (Node2, P_Primary);
1943             Set_Op_Name (Node2);
1944             return Node2;
1945          else
1946             return Node1;
1947          end if;
1948       end if;
1949    end P_Factor;
1950
1951    ------------------
1952    -- 4.4  Primary --
1953    ------------------
1954
1955    --  PRIMARY ::=
1956    --    NUMERIC_LITERAL  | null
1957    --  | STRING_LITERAL   | AGGREGATE
1958    --  | NAME             | QUALIFIED_EXPRESSION
1959    --  | ALLOCATOR        | (EXPRESSION)
1960
1961    --  Error recovery: can raise Error_Resync
1962
1963    function P_Primary return Node_Id is
1964       Scan_State : Saved_Scan_State;
1965       Node1      : Node_Id;
1966
1967    begin
1968       --  The loop runs more than once only if misplaced pragmas are found
1969
1970       loop
1971          case Token is
1972
1973             --  Name token can start a name, call or qualified expression, all
1974             --  of which are acceptable possibilities for primary. Note also
1975             --  that string literal is included in name (as operator symbol)
1976             --  and type conversion is included in name (as indexed component).
1977
1978             when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
1979                Node1 := P_Name;
1980
1981                --  All done unless apostrophe follows
1982
1983                if Token /= Tok_Apostrophe then
1984                   return Node1;
1985
1986                --  Apostrophe following means that we have either just parsed
1987                --  the subtype mark of a qualified expression, or the prefix
1988                --  or a range attribute.
1989
1990                else -- Token = Tok_Apostrophe
1991                   Save_Scan_State (Scan_State); -- at apostrophe
1992                   Scan; -- past apostrophe
1993
1994                   --  If range attribute, then this is always an error, since
1995                   --  the only legitimate case (where the scanned expression is
1996                   --  a qualified simple name) is handled at the level of the
1997                   --  Simple_Expression processing. This case corresponds to a
1998                   --  usage such as 3 + A'Range, which is always illegal.
1999
2000                   if Token = Tok_Range then
2001                      Restore_Scan_State (Scan_State); -- to apostrophe
2002                      Bad_Range_Attribute (Token_Ptr);
2003                      return Error;
2004
2005                   --  If left paren, then we have a qualified expression.
2006                   --  Note that P_Name guarantees that in this case, where
2007                   --  Token = Tok_Apostrophe on return, the only two possible
2008                   --  tokens following the apostrophe are left paren and
2009                   --  RANGE, so we know we have a left paren here.
2010
2011                   else -- Token = Tok_Left_Paren
2012                      return P_Qualified_Expression (Node1);
2013
2014                   end if;
2015                end if;
2016
2017             --  Numeric or string literal
2018
2019             when Tok_Integer_Literal |
2020                  Tok_Real_Literal    |
2021                  Tok_String_Literal  =>
2022
2023                Node1 := Token_Node;
2024                Scan; -- past number
2025                return Node1;
2026
2027             --  Left paren, starts aggregate or parenthesized expression
2028
2029             when Tok_Left_Paren =>
2030                return P_Aggregate_Or_Paren_Expr;
2031
2032             --  Allocator
2033
2034             when Tok_New =>
2035                return P_Allocator;
2036
2037             --  Null
2038
2039             when Tok_Null =>
2040                Scan; -- past NULL
2041                return New_Node (N_Null, Prev_Token_Ptr);
2042
2043             --  Pragma, not allowed here, so just skip past it
2044
2045             when Tok_Pragma =>
2046                P_Pragmas_Misplaced;
2047
2048             --  Anything else is illegal as the first token of a primary, but
2049             --  we test for a reserved identifier so that it is treated nicely
2050
2051             when others =>
2052                if Is_Reserved_Identifier then
2053                   return P_Identifier;
2054
2055                elsif Prev_Token = Tok_Comma then
2056                   Error_Msg_SP ("extra "","" ignored");
2057                   raise Error_Resync;
2058
2059                else
2060                   Error_Msg_AP ("missing operand");
2061                   raise Error_Resync;
2062                end if;
2063
2064          end case;
2065       end loop;
2066    end P_Primary;
2067
2068    ---------------------------
2069    -- 4.5  Logical Operator --
2070    ---------------------------
2071
2072    --  LOGICAL_OPERATOR  ::=  and | or | xor
2073
2074    --  Note: AND THEN and OR ELSE are also treated as logical operators
2075    --  by the parser (even though they are not operators semantically)
2076
2077    --  The value returned is the appropriate Node_Kind code for the operator
2078    --  On return, Token points to the token following the scanned operator.
2079
2080    --  The caller has checked that the first token is a legitimate logical
2081    --  operator token (i.e. is either XOR, AND, OR).
2082
2083    --  Error recovery: cannot raise Error_Resync
2084
2085    function P_Logical_Operator return Node_Kind is
2086    begin
2087       if Token = Tok_And then
2088          if Style_Check then Style.Check_Binary_Operator; end if;
2089          Scan; -- past AND
2090
2091          if Token = Tok_Then then
2092             Scan; -- past THEN
2093             return N_And_Then;
2094          else
2095             return N_Op_And;
2096          end if;
2097
2098       elsif Token = Tok_Or then
2099          if Style_Check then Style.Check_Binary_Operator; end if;
2100          Scan; -- past OR
2101
2102          if Token = Tok_Else then
2103             Scan; -- past ELSE
2104             return N_Or_Else;
2105          else
2106             return N_Op_Or;
2107          end if;
2108
2109       else -- Token = Tok_Xor
2110          if Style_Check then Style.Check_Binary_Operator; end if;
2111          Scan; -- past XOR
2112          return N_Op_Xor;
2113       end if;
2114    end P_Logical_Operator;
2115
2116    ------------------------------
2117    -- 4.5  Relational Operator --
2118    ------------------------------
2119
2120    --  RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2121
2122    --  The value returned is the appropriate Node_Kind code for the operator.
2123    --  On return, Token points to the operator token, NOT past it.
2124
2125    --  The caller has checked that the first token is a legitimate relational
2126    --  operator token (i.e. is one of the operator tokens listed above).
2127
2128    --  Error recovery: cannot raise Error_Resync
2129
2130    function P_Relational_Operator return Node_Kind is
2131       Op_Kind : Node_Kind;
2132       Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2133         (Tok_Less           => N_Op_Lt,
2134          Tok_Equal          => N_Op_Eq,
2135          Tok_Greater        => N_Op_Gt,
2136          Tok_Not_Equal      => N_Op_Ne,
2137          Tok_Greater_Equal  => N_Op_Ge,
2138          Tok_Less_Equal     => N_Op_Le,
2139          Tok_In             => N_In,
2140          Tok_Not            => N_Not_In,
2141          Tok_Box            => N_Op_Ne);
2142
2143    begin
2144       if Token = Tok_Box then
2145          Error_Msg_SC ("""<>"" should be ""/=""");
2146       end if;
2147
2148       Op_Kind := Relop_Node (Token);
2149       if Style_Check then Style.Check_Binary_Operator; end if;
2150       Scan; -- past operator token
2151
2152       if Prev_Token = Tok_Not then
2153          T_In;
2154       end if;
2155
2156       return Op_Kind;
2157    end P_Relational_Operator;
2158
2159    ---------------------------------
2160    -- 4.5  Binary Adding Operator --
2161    ---------------------------------
2162
2163    --  BINARY_ADDING_OPERATOR ::= + | - | &
2164
2165    --  The value returned is the appropriate Node_Kind code for the operator.
2166    --  On return, Token points to the operator token (NOT past it).
2167
2168    --  The caller has checked that the first token is a legitimate adding
2169    --  operator token (i.e. is one of the operator tokens listed above).
2170
2171    --  Error recovery: cannot raise Error_Resync
2172
2173    function P_Binary_Adding_Operator return Node_Kind is
2174       Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2175         (Tok_Ampersand      => N_Op_Concat,
2176          Tok_Minus          => N_Op_Subtract,
2177          Tok_Plus           => N_Op_Add);
2178    begin
2179       return Addop_Node (Token);
2180    end P_Binary_Adding_Operator;
2181
2182    --------------------------------
2183    -- 4.5  Unary Adding Operator --
2184    --------------------------------
2185
2186    --  UNARY_ADDING_OPERATOR ::= + | -
2187
2188    --  The value returned is the appropriate Node_Kind code for the operator.
2189    --  On return, Token points to the operator token (NOT past it).
2190
2191    --  The caller has checked that the first token is a legitimate adding
2192    --  operator token (i.e. is one of the operator tokens listed above).
2193
2194    --  Error recovery: cannot raise Error_Resync
2195
2196    function P_Unary_Adding_Operator return Node_Kind is
2197       Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2198         (Tok_Minus          => N_Op_Minus,
2199          Tok_Plus           => N_Op_Plus);
2200    begin
2201       return Addop_Node (Token);
2202    end P_Unary_Adding_Operator;
2203
2204    -------------------------------
2205    -- 4.5  Multiplying Operator --
2206    -------------------------------
2207
2208    --  MULTIPLYING_OPERATOR ::= * | / | mod | rem
2209
2210    --  The value returned is the appropriate Node_Kind code for the operator.
2211    --  On return, Token points to the operator token (NOT past it).
2212
2213    --  The caller has checked that the first token is a legitimate multiplying
2214    --  operator token (i.e. is one of the operator tokens listed above).
2215
2216    --  Error recovery: cannot raise Error_Resync
2217
2218    function P_Multiplying_Operator return Node_Kind is
2219       Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2220         (Tok_Asterisk       => N_Op_Multiply,
2221          Tok_Mod            => N_Op_Mod,
2222          Tok_Rem            => N_Op_Rem,
2223          Tok_Slash          => N_Op_Divide);
2224    begin
2225       return Mulop_Node (Token);
2226    end P_Multiplying_Operator;
2227
2228    --------------------------------------
2229    -- 4.5  Highest Precedence Operator --
2230    --------------------------------------
2231
2232    --  Parsed by P_Factor (4.4)
2233
2234    --  Note: this rule is not in fact used by the grammar at any point!
2235
2236    --------------------------
2237    -- 4.6  Type Conversion --
2238    --------------------------
2239
2240    --  Parsed by P_Primary as a Name (4.1)
2241
2242    -------------------------------
2243    -- 4.7  Qualified Expression --
2244    -------------------------------
2245
2246    --  QUALIFIED_EXPRESSION ::=
2247    --    SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2248
2249    --  The caller has scanned the name which is the Subtype_Mark parameter
2250    --  and scanned past the single quote following the subtype mark. The
2251    --  caller has not checked that this name is in fact appropriate for
2252    --  a subtype mark name (i.e. it is a selected component or identifier).
2253
2254    --  Error_Recovery: cannot raise Error_Resync
2255
2256    function  P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2257       Qual_Node : Node_Id;
2258
2259    begin
2260       Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2261       Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2262       Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2263       return Qual_Node;
2264    end P_Qualified_Expression;
2265
2266    --------------------
2267    -- 4.8  Allocator --
2268    --------------------
2269
2270    --  ALLOCATOR ::=
2271    --   new SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2272
2273    --  The caller has checked that the initial token is NEW
2274
2275    --  Error recovery: can raise Error_Resync
2276
2277    function P_Allocator return Node_Id is
2278       Alloc_Node  : Node_Id;
2279       Type_Node   : Node_Id;
2280
2281    begin
2282       Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2283       T_New;
2284       Type_Node := P_Subtype_Mark_Resync;
2285
2286       if Token = Tok_Apostrophe then
2287          Scan; -- past apostrophe
2288          Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2289       else
2290          Set_Expression (Alloc_Node, P_Subtype_Indication (Type_Node));
2291       end if;
2292
2293       return Alloc_Node;
2294    end P_Allocator;
2295
2296 end Ch4;