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