gcc/ada/par-ch4.adb

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