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