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