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