1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 pragma Style_Checks (All_Checks);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
30 with Stringt; use Stringt;
39 Is_Parameterless_Attribute : constant Attribute_Class_Array :=
40 (Attribute_Body_Version => True,
41 Attribute_External_Tag => True,
42 Attribute_Img => True,
43 Attribute_Version => True,
44 Attribute_Base => True,
45 Attribute_Class => True,
46 Attribute_Stub_Type => True,
48 -- This map contains True for parameterless attributes that return a
49 -- string or a type. For those attributes, a left parenthesis after
50 -- the attribute should not be analyzed as the beginning of a parameters
51 -- list because it may denote a slice operation (X'Img (1 .. 2)) or
52 -- a type conversion (X'Class (Y)).
54 -----------------------
55 -- Local Subprograms --
56 -----------------------
58 function P_Aggregate_Or_Paren_Expr return Node_Id;
59 function P_Allocator return Node_Id;
60 function P_Record_Or_Array_Component_Association return Node_Id;
61 function P_Factor return Node_Id;
62 function P_Primary return Node_Id;
63 function P_Relation return Node_Id;
64 function P_Term return Node_Id;
66 function P_Binary_Adding_Operator return Node_Kind;
67 function P_Logical_Operator return Node_Kind;
68 function P_Multiplying_Operator return Node_Kind;
69 function P_Relational_Operator return Node_Kind;
70 function P_Unary_Adding_Operator return Node_Kind;
72 procedure Bad_Range_Attribute (Loc : Source_Ptr);
73 -- Called to place complaint about bad range attribute at the given
74 -- source location. Terminates by raising Error_Resync.
76 function P_Range_Attribute_Reference
77 (Prefix_Node : Node_Id)
79 -- Scan a range attribute reference. The caller has scanned out the
80 -- prefix. The current token is known to be an apostrophe and the
81 -- following token is known to be RANGE.
83 procedure Set_Op_Name (Node : Node_Id);
84 -- Procedure to set name field (Chars) in operator node
86 -------------------------
87 -- Bad_Range_Attribute --
88 -------------------------
90 procedure Bad_Range_Attribute (Loc : Source_Ptr) is
92 Error_Msg ("range attribute cannot be used in expression!", Loc);
94 end Bad_Range_Attribute;
100 procedure Set_Op_Name (Node : Node_Id) is
101 type Name_Of_Type is array (N_Op) of Name_Id;
102 Name_Of : constant Name_Of_Type := Name_Of_Type'(
103 N_Op_And => Name_Op_And,
104 N_Op_Or => Name_Op_Or,
105 N_Op_Xor => Name_Op_Xor,
106 N_Op_Eq => Name_Op_Eq,
107 N_Op_Ne => Name_Op_Ne,
108 N_Op_Lt => Name_Op_Lt,
109 N_Op_Le => Name_Op_Le,
110 N_Op_Gt => Name_Op_Gt,
111 N_Op_Ge => Name_Op_Ge,
112 N_Op_Add => Name_Op_Add,
113 N_Op_Subtract => Name_Op_Subtract,
114 N_Op_Concat => Name_Op_Concat,
115 N_Op_Multiply => Name_Op_Multiply,
116 N_Op_Divide => Name_Op_Divide,
117 N_Op_Mod => Name_Op_Mod,
118 N_Op_Rem => Name_Op_Rem,
119 N_Op_Expon => Name_Op_Expon,
120 N_Op_Plus => Name_Op_Add,
121 N_Op_Minus => Name_Op_Subtract,
122 N_Op_Abs => Name_Op_Abs,
123 N_Op_Not => Name_Op_Not,
125 -- We don't really need these shift operators, since they never
126 -- appear as operators in the source, but the path of least
127 -- resistance is to put them in (the aggregate must be complete)
129 N_Op_Rotate_Left => Name_Rotate_Left,
130 N_Op_Rotate_Right => Name_Rotate_Right,
131 N_Op_Shift_Left => Name_Shift_Left,
132 N_Op_Shift_Right => Name_Shift_Right,
133 N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
136 if Nkind (Node) in N_Op then
137 Set_Chars (Node, Name_Of (Nkind (Node)));
141 --------------------------
142 -- 4.1 Name (also 6.4) --
143 --------------------------
146 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
147 -- | INDEXED_COMPONENT | SLICE
148 -- | SELECTED_COMPONENT | ATTRIBUTE
149 -- | TYPE_CONVERSION | FUNCTION_CALL
150 -- | CHARACTER_LITERAL
152 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
154 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
156 -- EXPLICIT_DEREFERENCE ::= NAME . all
158 -- IMPLICIT_DEREFERENCE ::= NAME
160 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
162 -- SLICE ::= PREFIX (DISCRETE_RANGE)
164 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
166 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
168 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
170 -- ATTRIBUTE_DESIGNATOR ::=
171 -- IDENTIFIER [(static_EXPRESSION)]
172 -- | access | delta | digits
176 -- | function_PREFIX ACTUAL_PARAMETER_PART
178 -- ACTUAL_PARAMETER_PART ::=
179 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
181 -- PARAMETER_ASSOCIATION ::=
182 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
184 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
186 -- Note: syntactically a procedure call looks just like a function call,
187 -- so this routine is in practice used to scan out procedure calls as well.
189 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
191 -- Error recovery: can raise Error_Resync
193 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
194 -- followed by either a left paren (qualified expression case), or by
195 -- range (range attribute case). All other uses of apostrophe (i.e. all
196 -- other attributes) are handled in this routine.
198 -- Error recovery: can raise Error_Resync
200 function P_Name return Node_Id is
201 Scan_State : Saved_Scan_State;
203 Prefix_Node : Node_Id;
204 Ident_Node : Node_Id;
206 Range_Node : Node_Id;
209 Arg_List : List_Id := No_List; -- kill junk warning
210 Attr_Name : Name_Id := No_Name; -- kill junk warning
213 -- Case of not a name
215 if Token not in Token_Class_Name then
217 -- If it looks like start of expression, complain and scan expression
219 if Token in Token_Class_Literal
220 or else Token = Tok_Left_Paren
222 Error_Msg_SC ("name expected");
225 -- Otherwise some other junk, not much we can do
228 Error_Msg_AP ("name expected");
233 -- Loop through designators in qualified name
235 Name_Node := Token_Node;
238 Scan; -- past designator
239 exit when Token /= Tok_Dot;
240 Save_Scan_State (Scan_State); -- at dot
243 -- If we do not have another designator after the dot, then join
244 -- the normal circuit to handle a dot extension (may be .all or
245 -- character literal case). Otherwise loop back to scan the next
248 if Token not in Token_Class_Desig then
249 goto Scan_Name_Extension_Dot;
251 Prefix_Node := Name_Node;
252 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
253 Set_Prefix (Name_Node, Prefix_Node);
254 Set_Selector_Name (Name_Node, Token_Node);
258 -- We have now scanned out a qualified designator. If the last token is
259 -- an operator symbol, then we certainly do not have the Snam case, so
260 -- we can just use the normal name extension check circuit
262 if Prev_Token = Tok_Operator_Symbol then
263 goto Scan_Name_Extension;
266 -- We have scanned out a qualified simple name, check for name extension
267 -- Note that we know there is no dot here at this stage, so the only
268 -- possible cases of name extension are apostrophe and left paren.
270 if Token = Tok_Apostrophe then
271 Save_Scan_State (Scan_State); -- at apostrophe
272 Scan; -- past apostrophe
274 -- If left paren, then this might be a qualified expression, but we
275 -- are only in the business of scanning out names, so return with
276 -- Token backed up to point to the apostrophe. The treatment for
277 -- the range attribute is similar (we do not consider x'range to
278 -- be a name in this grammar).
280 if Token = Tok_Left_Paren or else Token = Tok_Range then
281 Restore_Scan_State (Scan_State); -- to apostrophe
282 Expr_Form := EF_Simple_Name;
285 -- Otherwise we have the case of a name extended by an attribute
288 goto Scan_Name_Extension_Apostrophe;
291 -- Check case of qualified simple name extended by a left parenthesis
293 elsif Token = Tok_Left_Paren then
294 Scan; -- past left paren
295 goto Scan_Name_Extension_Left_Paren;
297 -- Otherwise the qualified simple name is not extended, so return
300 Expr_Form := EF_Simple_Name;
304 -- Loop scanning past name extensions. A label is used for control
305 -- transfer for this loop for ease of interfacing with the finite state
306 -- machine in the parenthesis scanning circuit, and also to allow for
307 -- passing in control to the appropriate point from the above code.
309 <<Scan_Name_Extension>>
311 -- Character literal used as name cannot be extended. Also this
312 -- cannot be a call, since the name for a call must be a designator.
313 -- Return in these cases, or if there is no name extension
315 if Token not in Token_Class_Namext
316 or else Prev_Token = Tok_Char_Literal
318 Expr_Form := EF_Name;
322 -- Merge here when we know there is a name extension
324 <<Scan_Name_Extension_OK>>
326 if Token = Tok_Left_Paren then
327 Scan; -- past left paren
328 goto Scan_Name_Extension_Left_Paren;
330 elsif Token = Tok_Apostrophe then
331 Save_Scan_State (Scan_State); -- at apostrophe
332 Scan; -- past apostrophe
333 goto Scan_Name_Extension_Apostrophe;
335 else -- Token = Tok_Dot
336 Save_Scan_State (Scan_State); -- at dot
338 goto Scan_Name_Extension_Dot;
341 -- Case of name extended by dot (selection), dot is already skipped
342 -- and the scan state at the point of the dot is saved in Scan_State.
344 <<Scan_Name_Extension_Dot>>
346 -- Explicit dereference case
348 if Token = Tok_All then
349 Prefix_Node := Name_Node;
350 Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
351 Set_Prefix (Name_Node, Prefix_Node);
353 goto Scan_Name_Extension;
355 -- Selected component case
357 elsif Token in Token_Class_Name then
358 Prefix_Node := Name_Node;
359 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
360 Set_Prefix (Name_Node, Prefix_Node);
361 Set_Selector_Name (Name_Node, Token_Node);
362 Scan; -- past selector
363 goto Scan_Name_Extension;
365 -- Reserved identifier as selector
367 elsif Is_Reserved_Identifier then
368 Scan_Reserved_Identifier (Force_Msg => False);
369 Prefix_Node := Name_Node;
370 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
371 Set_Prefix (Name_Node, Prefix_Node);
372 Set_Selector_Name (Name_Node, Token_Node);
373 Scan; -- past identifier used as selector
374 goto Scan_Name_Extension;
376 -- If dot is at end of line and followed by nothing legal,
377 -- then assume end of name and quit (dot will be taken as
378 -- an erroneous form of some other punctuation by our caller).
380 elsif Token_Is_At_Start_Of_Line then
381 Restore_Scan_State (Scan_State);
384 -- Here if nothing legal after the dot
387 Error_Msg_AP ("selector expected");
391 -- Here for an apostrophe as name extension. The scan position at the
392 -- apostrophe has already been saved, and the apostrophe scanned out.
394 <<Scan_Name_Extension_Apostrophe>>
396 Scan_Apostrophe : declare
397 function Apostrophe_Should_Be_Semicolon return Boolean;
398 -- Checks for case where apostrophe should probably be
399 -- a semicolon, and if so, gives appropriate message,
400 -- resets the scan pointer to the apostrophe, changes
401 -- the current token to Tok_Semicolon, and returns True.
402 -- Otherwise returns False.
404 function Apostrophe_Should_Be_Semicolon return Boolean is
406 if Token_Is_At_Start_Of_Line then
407 Restore_Scan_State (Scan_State); -- to apostrophe
408 Error_Msg_SC ("""''"" should be "";""");
409 Token := Tok_Semicolon;
414 end Apostrophe_Should_Be_Semicolon;
416 -- Start of processing for Scan_Apostrophe
419 -- If range attribute after apostrophe, then return with Token
420 -- pointing to the apostrophe. Note that in this case the prefix
421 -- need not be a simple name (cases like A.all'range). Similarly
422 -- if there is a left paren after the apostrophe, then we also
423 -- return with Token pointing to the apostrophe (this is the
424 -- qualified expression case).
426 if Token = Tok_Range or else Token = Tok_Left_Paren then
427 Restore_Scan_State (Scan_State); -- to apostrophe
428 Expr_Form := EF_Name;
431 -- Here for cases where attribute designator is an identifier
433 elsif Token = Tok_Identifier then
434 Attr_Name := Token_Name;
436 if not Is_Attribute_Name (Attr_Name) then
437 if Apostrophe_Should_Be_Semicolon then
438 Expr_Form := EF_Name;
441 -- Here for a bad attribute name
444 Signal_Bad_Attribute;
445 Scan; -- past bad identifier
447 if Token = Tok_Left_Paren then
448 Scan; -- past left paren
451 Discard_Junk_Node (P_Expression);
452 exit when not Comma_Present;
463 Style.Check_Attribute_Name (False);
466 Delete_Node (Token_Node);
468 -- Here for case of attribute designator is not an identifier
471 if Token = Tok_Delta then
472 Attr_Name := Name_Delta;
474 elsif Token = Tok_Digits then
475 Attr_Name := Name_Digits;
477 elsif Token = Tok_Access then
478 Attr_Name := Name_Access;
480 elsif Token = Tok_Mod and then Ada_Version = Ada_05 then
481 Attr_Name := Name_Mod;
483 elsif Apostrophe_Should_Be_Semicolon then
484 Expr_Form := EF_Name;
488 Error_Msg_AP ("attribute designator expected");
493 Style.Check_Attribute_Name (True);
497 -- We come here with an OK attribute scanned, and the
498 -- corresponding Attribute identifier node stored in Ident_Node.
500 Prefix_Node := Name_Node;
501 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
502 Scan; -- past attribute designator
503 Set_Prefix (Name_Node, Prefix_Node);
504 Set_Attribute_Name (Name_Node, Attr_Name);
506 -- Scan attribute arguments/designator
508 if Token = Tok_Left_Paren
510 not Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
512 Set_Expressions (Name_Node, New_List);
513 Scan; -- past left paren
517 Expr : constant Node_Id := P_Expression;
520 if Token = Tok_Arrow then
522 ("named parameters not permitted for attributes");
523 Scan; -- past junk arrow
526 Append (Expr, Expressions (Name_Node));
527 exit when not Comma_Present;
535 goto Scan_Name_Extension;
538 -- Here for left parenthesis extending name (left paren skipped)
540 <<Scan_Name_Extension_Left_Paren>>
542 -- We now have to scan through a list of items, terminated by a
543 -- right parenthesis. The scan is handled by a finite state
544 -- machine. The possibilities are:
548 -- This is a slice. This case is handled in LP_State_Init
550 -- (expression, expression, ..)
552 -- This is interpreted as an indexed component, i.e. as a
553 -- case of a name which can be extended in the normal manner.
554 -- This case is handled by LP_State_Name or LP_State_Expr.
556 -- (..., identifier => expression , ...)
558 -- If there is at least one occurrence of identifier => (but
559 -- none of the other cases apply), then we have a call.
561 -- Test for Id => case
563 if Token = Tok_Identifier then
564 Save_Scan_State (Scan_State); -- at Id
567 -- Test for => (allow := as an error substitute)
569 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
570 Restore_Scan_State (Scan_State); -- to Id
571 Arg_List := New_List;
575 Restore_Scan_State (Scan_State); -- to Id
579 -- Here we have an expression after all
581 Expr_Node := P_Expression_Or_Range_Attribute;
583 -- Check cases of discrete range for a slice
585 -- First possibility: Range_Attribute_Reference
587 if Expr_Form = EF_Range_Attr then
588 Range_Node := Expr_Node;
590 -- Second possibility: Simple_expression .. Simple_expression
592 elsif Token = Tok_Dot_Dot then
593 Check_Simple_Expression (Expr_Node);
594 Range_Node := New_Node (N_Range, Token_Ptr);
595 Set_Low_Bound (Range_Node, Expr_Node);
597 Expr_Node := P_Expression;
598 Check_Simple_Expression (Expr_Node);
599 Set_High_Bound (Range_Node, Expr_Node);
601 -- Third possibility: Type_name range Range
603 elsif Token = Tok_Range then
604 if Expr_Form /= EF_Simple_Name then
605 Error_Msg_SC ("subtype mark must precede RANGE");
609 Range_Node := P_Subtype_Indication (Expr_Node);
611 -- Otherwise we just have an expression. It is true that we might
612 -- have a subtype mark without a range constraint but this case
613 -- is syntactically indistinguishable from the expression case.
616 Arg_List := New_List;
620 -- Fall through here with unmistakable Discrete range scanned,
621 -- which means that we definitely have the case of a slice. The
622 -- Discrete range is in Range_Node.
624 if Token = Tok_Comma then
625 Error_Msg_SC ("slice cannot have more than one dimension");
628 elsif Token /= Tok_Right_Paren then
633 Scan; -- past right paren
634 Prefix_Node := Name_Node;
635 Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
636 Set_Prefix (Name_Node, Prefix_Node);
637 Set_Discrete_Range (Name_Node, Range_Node);
639 -- An operator node is legal as a prefix to other names,
640 -- but not for a slice.
642 if Nkind (Prefix_Node) = N_Operator_Symbol then
643 Error_Msg_N ("illegal prefix for slice", Prefix_Node);
646 -- If we have a name extension, go scan it
648 if Token in Token_Class_Namext then
649 goto Scan_Name_Extension_OK;
651 -- Otherwise return (a slice is a name, but is not a call)
654 Expr_Form := EF_Name;
659 -- In LP_State_Expr, we have scanned one or more expressions, and
660 -- so we have a call or an indexed component which is a name. On
661 -- entry we have the expression just scanned in Expr_Node and
662 -- Arg_List contains the list of expressions encountered so far
665 Append (Expr_Node, Arg_List);
667 if Token = Tok_Arrow then
669 ("expect identifier in parameter association",
673 elsif not Comma_Present then
675 Prefix_Node := Name_Node;
676 Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
677 Set_Prefix (Name_Node, Prefix_Node);
678 Set_Expressions (Name_Node, Arg_List);
679 goto Scan_Name_Extension;
682 -- Comma present (and scanned out), test for identifier => case
683 -- Test for identifier => case
685 if Token = Tok_Identifier then
686 Save_Scan_State (Scan_State); -- at Id
689 -- Test for => (allow := as error substitute)
691 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
692 Restore_Scan_State (Scan_State); -- to Id
695 -- Otherwise it's just an expression after all, so backup
698 Restore_Scan_State (Scan_State); -- to Id
702 -- Here we have an expression after all, so stay in this state
704 Expr_Node := P_Expression;
707 -- LP_State_Call corresponds to the situation in which at least
708 -- one instance of Id => Expression has been encountered, so we
709 -- know that we do not have a name, but rather a call. We enter
710 -- it with the scan pointer pointing to the next argument to scan,
711 -- and Arg_List containing the list of arguments scanned so far.
715 -- Test for case of Id => Expression (named parameter)
717 if Token = Tok_Identifier then
718 Save_Scan_State (Scan_State); -- at Id
719 Ident_Node := Token_Node;
722 -- Deal with => (allow := as erroneous substitute)
724 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
726 New_Node (N_Parameter_Association, Prev_Token_Ptr);
727 Set_Selector_Name (Arg_Node, Ident_Node);
729 Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
730 Append (Arg_Node, Arg_List);
732 -- If a comma follows, go back and scan next entry
734 if Comma_Present then
737 -- Otherwise we have the end of a call
740 Prefix_Node := Name_Node;
742 New_Node (N_Function_Call, Sloc (Prefix_Node));
743 Set_Name (Name_Node, Prefix_Node);
744 Set_Parameter_Associations (Name_Node, Arg_List);
747 if Token in Token_Class_Namext then
748 goto Scan_Name_Extension_OK;
750 -- This is a case of a call which cannot be a name
753 Expr_Form := EF_Name;
758 -- Not named parameter: Id started an expression after all
761 Restore_Scan_State (Scan_State); -- to Id
765 -- Here if entry did not start with Id => which means that it
766 -- is a positional parameter, which is not allowed, since we
767 -- have seen at least one named parameter already.
770 ("positional parameter association " &
771 "not allowed after named one");
773 Expr_Node := P_Expression;
775 -- Leaving the '>' in an association is not unusual, so suggest
778 if Nkind (Expr_Node) = N_Op_Eq then
779 Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
782 -- We go back to scanning out expressions, so that we do not get
783 -- multiple error messages when several positional parameters
784 -- follow a named parameter.
788 -- End of treatment for name extensions starting with left paren
790 -- End of loop through name extensions
794 -- This function parses a restricted form of Names which are either
795 -- designators, or designators preceded by a sequence of prefixes
796 -- that are direct names.
798 -- Error recovery: cannot raise Error_Resync
800 function P_Function_Name return Node_Id is
801 Designator_Node : Node_Id;
802 Prefix_Node : Node_Id;
803 Selector_Node : Node_Id;
804 Dot_Sloc : Source_Ptr := No_Location;
807 -- Prefix_Node is set to the gathered prefix so far, Empty means that
808 -- no prefix has been scanned. This allows us to build up the result
809 -- in the required right recursive manner.
811 Prefix_Node := Empty;
813 -- Loop through prefixes
816 Designator_Node := Token_Node;
818 if Token not in Token_Class_Desig then
819 return P_Identifier; -- let P_Identifier issue the error message
821 else -- Token in Token_Class_Desig
822 Scan; -- past designator
823 exit when Token /= Tok_Dot;
826 -- Here at a dot, with token just before it in Designator_Node
828 if No (Prefix_Node) then
829 Prefix_Node := Designator_Node;
831 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
832 Set_Prefix (Selector_Node, Prefix_Node);
833 Set_Selector_Name (Selector_Node, Designator_Node);
834 Prefix_Node := Selector_Node;
837 Dot_Sloc := Token_Ptr;
841 -- Fall out of the loop having just scanned a designator
843 if No (Prefix_Node) then
844 return Designator_Node;
846 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
847 Set_Prefix (Selector_Node, Prefix_Node);
848 Set_Selector_Name (Selector_Node, Designator_Node);
849 return Selector_Node;
858 -- This function parses a restricted form of Names which are either
859 -- identifiers, or identifiers preceded by a sequence of prefixes
860 -- that are direct names.
862 -- Error recovery: cannot raise Error_Resync
864 function P_Qualified_Simple_Name return Node_Id is
865 Designator_Node : Node_Id;
866 Prefix_Node : Node_Id;
867 Selector_Node : Node_Id;
868 Dot_Sloc : Source_Ptr := No_Location;
871 -- Prefix node is set to the gathered prefix so far, Empty means that
872 -- no prefix has been scanned. This allows us to build up the result
873 -- in the required right recursive manner.
875 Prefix_Node := Empty;
877 -- Loop through prefixes
880 Designator_Node := Token_Node;
882 if Token = Tok_Identifier then
883 Scan; -- past identifier
884 exit when Token /= Tok_Dot;
886 elsif Token not in Token_Class_Desig then
887 return P_Identifier; -- let P_Identifier issue the error message
890 Scan; -- past designator
892 if Token /= Tok_Dot then
893 Error_Msg_SP ("identifier expected");
898 -- Here at a dot, with token just before it in Designator_Node
900 if No (Prefix_Node) then
901 Prefix_Node := Designator_Node;
903 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
904 Set_Prefix (Selector_Node, Prefix_Node);
905 Set_Selector_Name (Selector_Node, Designator_Node);
906 Prefix_Node := Selector_Node;
909 Dot_Sloc := Token_Ptr;
913 -- Fall out of the loop having just scanned an identifier
915 if No (Prefix_Node) then
916 return Designator_Node;
918 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
919 Set_Prefix (Selector_Node, Prefix_Node);
920 Set_Selector_Name (Selector_Node, Designator_Node);
921 return Selector_Node;
928 end P_Qualified_Simple_Name;
930 -- This procedure differs from P_Qualified_Simple_Name only in that it
931 -- raises Error_Resync if any error is encountered. It only returns after
932 -- scanning a valid qualified simple name.
934 -- Error recovery: can raise Error_Resync
936 function P_Qualified_Simple_Name_Resync return Node_Id is
937 Designator_Node : Node_Id;
938 Prefix_Node : Node_Id;
939 Selector_Node : Node_Id;
940 Dot_Sloc : Source_Ptr := No_Location;
943 Prefix_Node := Empty;
945 -- Loop through prefixes
948 Designator_Node := Token_Node;
950 if Token = Tok_Identifier then
951 Scan; -- past identifier
952 exit when Token /= Tok_Dot;
954 elsif Token not in Token_Class_Desig then
955 Discard_Junk_Node (P_Identifier); -- to issue the error message
959 Scan; -- past designator
961 if Token /= Tok_Dot then
962 Error_Msg_SP ("identifier expected");
967 -- Here at a dot, with token just before it in Designator_Node
969 if No (Prefix_Node) then
970 Prefix_Node := Designator_Node;
972 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
973 Set_Prefix (Selector_Node, Prefix_Node);
974 Set_Selector_Name (Selector_Node, Designator_Node);
975 Prefix_Node := Selector_Node;
978 Dot_Sloc := Token_Ptr;
982 -- Fall out of the loop having just scanned an identifier
984 if No (Prefix_Node) then
985 return Designator_Node;
987 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
988 Set_Prefix (Selector_Node, Prefix_Node);
989 Set_Selector_Name (Selector_Node, Designator_Node);
990 return Selector_Node;
993 end P_Qualified_Simple_Name_Resync;
995 ----------------------
996 -- 4.1 Direct_Name --
997 ----------------------
999 -- Parsed by P_Name and other functions in section 4.1
1005 -- Parsed by P_Name (4.1)
1007 -------------------------------
1008 -- 4.1 Explicit Dereference --
1009 -------------------------------
1011 -- Parsed by P_Name (4.1)
1013 -------------------------------
1014 -- 4.1 Implicit_Dereference --
1015 -------------------------------
1017 -- Parsed by P_Name (4.1)
1019 ----------------------------
1020 -- 4.1 Indexed Component --
1021 ----------------------------
1023 -- Parsed by P_Name (4.1)
1029 -- Parsed by P_Name (4.1)
1031 -----------------------------
1032 -- 4.1 Selected_Component --
1033 -----------------------------
1035 -- Parsed by P_Name (4.1)
1037 ------------------------
1038 -- 4.1 Selector Name --
1039 ------------------------
1041 -- Parsed by P_Name (4.1)
1043 ------------------------------
1044 -- 4.1 Attribute Reference --
1045 ------------------------------
1047 -- Parsed by P_Name (4.1)
1049 -------------------------------
1050 -- 4.1 Attribute Designator --
1051 -------------------------------
1053 -- Parsed by P_Name (4.1)
1055 --------------------------------------
1056 -- 4.1.4 Range Attribute Reference --
1057 --------------------------------------
1059 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1061 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1063 -- In the grammar, a RANGE attribute is simply a name, but its use is
1064 -- highly restricted, so in the parser, we do not regard it as a name.
1065 -- Instead, P_Name returns without scanning the 'RANGE part of the
1066 -- attribute, and the caller uses the following function to construct
1067 -- a range attribute in places where it is appropriate.
1069 -- Note that RANGE here is treated essentially as an identifier,
1070 -- rather than a reserved word.
1072 -- The caller has parsed the prefix, i.e. a name, and Token points to
1073 -- the apostrophe. The token after the apostrophe is known to be RANGE
1074 -- at this point. The prefix node becomes the prefix of the attribute.
1076 -- Error_Recovery: Cannot raise Error_Resync
1078 function P_Range_Attribute_Reference
1079 (Prefix_Node : Node_Id)
1082 Attr_Node : Node_Id;
1085 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1086 Set_Prefix (Attr_Node, Prefix_Node);
1087 Scan; -- past apostrophe
1090 Style.Check_Attribute_Name (True);
1093 Set_Attribute_Name (Attr_Node, Name_Range);
1096 if Token = Tok_Left_Paren then
1097 Scan; -- past left paren
1098 Set_Expressions (Attr_Node, New_List (P_Expression));
1103 end P_Range_Attribute_Reference;
1105 ---------------------------------------
1106 -- 4.1.4 Range Attribute Designator --
1107 ---------------------------------------
1109 -- Parsed by P_Range_Attribute_Reference (4.4)
1111 --------------------
1113 --------------------
1115 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1117 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1118 -- an aggregate is known to be required (code statement, extension
1119 -- aggregate), in which cases this routine performs the necessary check
1120 -- that we have an aggregate rather than a parenthesized expression
1122 -- Error recovery: can raise Error_Resync
1124 function P_Aggregate return Node_Id is
1125 Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1126 Aggr_Node : constant Node_Id := P_Aggregate_Or_Paren_Expr;
1129 if Nkind (Aggr_Node) /= N_Aggregate
1131 Nkind (Aggr_Node) /= N_Extension_Aggregate
1134 ("aggregate may not have single positional component", Aggr_Sloc);
1141 -------------------------------------------------
1142 -- 4.3 Aggregate or Parenthesized Expresssion --
1143 -------------------------------------------------
1145 -- This procedure parses out either an aggregate or a parenthesized
1146 -- expression (these two constructs are closely related, since a
1147 -- parenthesized expression looks like an aggregate with a single
1148 -- positional component).
1151 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1153 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1155 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1156 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1159 -- RECORD_COMPONENT_ASSOCIATION ::=
1160 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1162 -- COMPONENT_CHOICE_LIST ::=
1163 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1166 -- EXTENSION_AGGREGATE ::=
1167 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1169 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1171 -- ARRAY_AGGREGATE ::=
1172 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1174 -- POSITIONAL_ARRAY_AGGREGATE ::=
1175 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1176 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1177 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1179 -- NAMED_ARRAY_AGGREGATE ::=
1180 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1182 -- PRIMARY ::= (EXPRESSION);
1184 -- Error recovery: can raise Error_Resync
1186 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1187 -- to Ada 2005 limited aggregates (AI-287)
1189 function P_Aggregate_Or_Paren_Expr return Node_Id is
1190 Aggregate_Node : Node_Id;
1191 Expr_List : List_Id;
1192 Assoc_List : List_Id;
1193 Expr_Node : Node_Id;
1194 Lparen_Sloc : Source_Ptr;
1195 Scan_State : Saved_Scan_State;
1198 Lparen_Sloc := Token_Ptr;
1201 -- Note: the mechanism used here of rescanning the initial expression
1202 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1203 -- out the discrete choice list.
1205 -- Deal with expression and extension aggregate cases first
1207 if Token /= Tok_Others then
1208 Save_Scan_State (Scan_State); -- at start of expression
1210 -- Deal with (NULL RECORD) case
1212 if Token = Tok_Null then
1215 if Token = Tok_Record then
1216 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1217 Set_Null_Record_Present (Aggregate_Node, True);
1218 Scan; -- past RECORD
1220 return Aggregate_Node;
1222 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1226 -- Ada 2005 (AI-287): The box notation is allowed only with named
1227 -- notation because positional notation might be error prone. For
1228 -- example, in "(X, <>, Y, <>)", there is no type associated with
1229 -- the boxes, so you might not be leaving out the components you
1230 -- thought you were leaving out.
1232 if Ada_Version >= Ada_05 and then Token = Tok_Box then
1233 Error_Msg_SC ("(Ada 2005) box notation only allowed with "
1234 & "named notation");
1236 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1237 return Aggregate_Node;
1240 Expr_Node := P_Expression_Or_Range_Attribute;
1242 -- Extension aggregate case
1244 if Token = Tok_With then
1246 if Nkind (Expr_Node) = N_Attribute_Reference
1247 and then Attribute_Name (Expr_Node) = Name_Range
1249 Bad_Range_Attribute (Sloc (Expr_Node));
1253 if Ada_Version = Ada_83 then
1254 Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1257 Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1258 Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1261 -- Deal with WITH NULL RECORD case
1263 if Token = Tok_Null then
1264 Save_Scan_State (Scan_State); -- at NULL
1267 if Token = Tok_Record then
1268 Scan; -- past RECORD
1269 Set_Null_Record_Present (Aggregate_Node, True);
1271 return Aggregate_Node;
1274 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1278 if Token /= Tok_Others then
1279 Save_Scan_State (Scan_State);
1280 Expr_Node := P_Expression;
1287 elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1288 if Nkind (Expr_Node) = N_Attribute_Reference
1289 and then Attribute_Name (Expr_Node) = Name_Range
1292 ("|parentheses not allowed for range attribute", Lparen_Sloc);
1293 Scan; -- past right paren
1297 -- Bump paren count of expression
1299 if Expr_Node /= Error then
1300 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1303 T_Right_Paren; -- past right paren (error message if none)
1306 -- Normal aggregate case
1309 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1315 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1319 -- Prepare to scan list of component associations
1321 Expr_List := No_List; -- don't set yet, maybe all named entries
1322 Assoc_List := No_List; -- don't set yet, maybe all positional entries
1324 -- This loop scans through component associations. On entry to the
1325 -- loop, an expression has been scanned at the start of the current
1326 -- association unless initial token was OTHERS, in which case
1327 -- Expr_Node is set to Empty.
1330 -- Deal with others association first. This is a named association
1332 if No (Expr_Node) then
1333 if No (Assoc_List) then
1334 Assoc_List := New_List;
1337 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1339 -- Improper use of WITH
1341 elsif Token = Tok_With then
1342 Error_Msg_SC ("WITH must be preceded by single expression in " &
1343 "extension aggregate");
1346 -- A range attribute can only appear as part of a discrete choice
1349 elsif Nkind (Expr_Node) = N_Attribute_Reference
1350 and then Attribute_Name (Expr_Node) = Name_Range
1351 and then Token /= Tok_Arrow
1352 and then Token /= Tok_Vertical_Bar
1354 Bad_Range_Attribute (Sloc (Expr_Node));
1357 -- Assume positional case if comma, right paren, or literal or
1358 -- identifier or OTHERS follows (the latter cases are missing
1359 -- comma cases). Also assume positional if a semicolon follows,
1360 -- which can happen if there are missing parens
1362 elsif Token = Tok_Comma
1363 or else Token = Tok_Right_Paren
1364 or else Token = Tok_Others
1365 or else Token in Token_Class_Lit_Or_Name
1366 or else Token = Tok_Semicolon
1368 if Present (Assoc_List) then
1370 ("""='>"" expected (positional association cannot follow " &
1371 "named association)");
1374 if No (Expr_List) then
1375 Expr_List := New_List;
1378 Append (Expr_Node, Expr_List);
1380 -- Anything else is assumed to be a named association
1383 Restore_Scan_State (Scan_State); -- to start of expression
1385 if No (Assoc_List) then
1386 Assoc_List := New_List;
1389 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1392 exit when not Comma_Present;
1394 -- If we are at an expression terminator, something is seriously
1395 -- wrong, so let's get out now, before we start eating up stuff
1396 -- that doesn't belong to us!
1398 if Token in Token_Class_Eterm then
1399 Error_Msg_AP ("expecting expression or component association");
1403 -- Otherwise initiate for reentry to top of loop by scanning an
1404 -- initial expression, unless the first token is OTHERS.
1406 if Token = Tok_Others then
1409 Save_Scan_State (Scan_State); -- at start of expression
1410 Expr_Node := P_Expression_Or_Range_Attribute;
1415 -- All component associations (positional and named) have been scanned
1418 Set_Expressions (Aggregate_Node, Expr_List);
1419 Set_Component_Associations (Aggregate_Node, Assoc_List);
1420 return Aggregate_Node;
1421 end P_Aggregate_Or_Paren_Expr;
1423 ------------------------------------------------
1424 -- 4.3 Record or Array Component Association --
1425 ------------------------------------------------
1427 -- RECORD_COMPONENT_ASSOCIATION ::=
1428 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1429 -- | COMPONENT_CHOICE_LIST => <>
1431 -- COMPONENT_CHOICE_LIST =>
1432 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1435 -- ARRAY_COMPONENT_ASSOCIATION ::=
1436 -- DISCRETE_CHOICE_LIST => EXPRESSION
1437 -- | DISCRETE_CHOICE_LIST => <>
1439 -- Note: this routine only handles the named cases, including others.
1440 -- Cases where the component choice list is not present have already
1441 -- been handled directly.
1443 -- Error recovery: can raise Error_Resync
1445 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1446 -- rules have been extended to give support to Ada 2005 limited
1447 -- aggregates (AI-287)
1449 function P_Record_Or_Array_Component_Association return Node_Id is
1450 Assoc_Node : Node_Id;
1453 Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1454 Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1455 Set_Sloc (Assoc_Node, Token_Ptr);
1458 if Token = Tok_Box then
1460 -- Ada 2005(AI-287): The box notation is used to indicate the
1461 -- default initialization of aggregate components
1463 if Ada_Version < Ada_05 then
1465 ("component association with '<'> is an Ada 2005 extension");
1466 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1469 Set_Box_Present (Assoc_Node);
1472 Set_Expression (Assoc_Node, P_Expression);
1476 end P_Record_Or_Array_Component_Association;
1478 -----------------------------
1479 -- 4.3.1 Record Aggregate --
1480 -----------------------------
1482 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1483 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1485 ----------------------------------------------
1486 -- 4.3.1 Record Component Association List --
1487 ----------------------------------------------
1489 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1491 ----------------------------------
1492 -- 4.3.1 Component Choice List --
1493 ----------------------------------
1495 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1497 --------------------------------
1498 -- 4.3.1 Extension Aggregate --
1499 --------------------------------
1501 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1503 --------------------------
1504 -- 4.3.1 Ancestor Part --
1505 --------------------------
1507 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1509 ----------------------------
1510 -- 4.3.1 Array Aggregate --
1511 ----------------------------
1513 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1515 ---------------------------------------
1516 -- 4.3.1 Positional Array Aggregate --
1517 ---------------------------------------
1519 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1521 ----------------------------------
1522 -- 4.3.1 Named Array Aggregate --
1523 ----------------------------------
1525 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1527 ----------------------------------------
1528 -- 4.3.1 Array Component Association --
1529 ----------------------------------------
1531 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1533 ---------------------
1534 -- 4.4 Expression --
1535 ---------------------
1538 -- RELATION {and RELATION} | RELATION {and then RELATION}
1539 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1540 -- | RELATION {xor RELATION}
1542 -- On return, Expr_Form indicates the categorization of the expression
1543 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1544 -- an error message is given, and Error is returned).
1546 -- Error recovery: cannot raise Error_Resync
1548 function P_Expression return Node_Id is
1549 Logical_Op : Node_Kind;
1550 Prev_Logical_Op : Node_Kind;
1551 Op_Location : Source_Ptr;
1556 Node1 := P_Relation;
1558 if Token in Token_Class_Logop then
1559 Prev_Logical_Op := N_Empty;
1562 Op_Location := Token_Ptr;
1563 Logical_Op := P_Logical_Operator;
1565 if Prev_Logical_Op /= N_Empty and then
1566 Logical_Op /= Prev_Logical_Op
1569 ("mixed logical operators in expression", Op_Location);
1570 Prev_Logical_Op := N_Empty;
1572 Prev_Logical_Op := Logical_Op;
1576 Node1 := New_Node (Logical_Op, Op_Location);
1577 Set_Left_Opnd (Node1, Node2);
1578 Set_Right_Opnd (Node1, P_Relation);
1579 Set_Op_Name (Node1);
1580 exit when Token not in Token_Class_Logop;
1583 Expr_Form := EF_Non_Simple;
1586 if Token = Tok_Apostrophe then
1587 Bad_Range_Attribute (Token_Ptr);
1594 -- This function is identical to the normal P_Expression, except that it
1595 -- checks that the expression scan did not stop on a right paren. It is
1596 -- called in all contexts where a right parenthesis cannot legitimately
1597 -- follow an expression.
1599 -- Error recovery: can not raise Error_Resync
1601 function P_Expression_No_Right_Paren return Node_Id is
1602 Expr : constant Node_Id := P_Expression;
1604 Check_No_Right_Paren;
1606 end P_Expression_No_Right_Paren;
1608 ----------------------------------------
1609 -- 4.4 Expression_Or_Range_Attribute --
1610 ----------------------------------------
1613 -- RELATION {and RELATION} | RELATION {and then RELATION}
1614 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1615 -- | RELATION {xor RELATION}
1617 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1619 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1621 -- On return, Expr_Form indicates the categorization of the expression
1622 -- and EF_Range_Attr is one of the possibilities.
1624 -- Error recovery: cannot raise Error_Resync
1626 -- In the grammar, a RANGE attribute is simply a name, but its use is
1627 -- highly restricted, so in the parser, we do not regard it as a name.
1628 -- Instead, P_Name returns without scanning the 'RANGE part of the
1629 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1630 -- attribute reference. In the normal case where a range attribute is
1631 -- not allowed, an error message is issued by P_Expression.
1633 function P_Expression_Or_Range_Attribute return Node_Id is
1634 Logical_Op : Node_Kind;
1635 Prev_Logical_Op : Node_Kind;
1636 Op_Location : Source_Ptr;
1639 Attr_Node : Node_Id;
1642 Node1 := P_Relation;
1644 if Token = Tok_Apostrophe then
1645 Attr_Node := P_Range_Attribute_Reference (Node1);
1646 Expr_Form := EF_Range_Attr;
1649 elsif Token in Token_Class_Logop then
1650 Prev_Logical_Op := N_Empty;
1653 Op_Location := Token_Ptr;
1654 Logical_Op := P_Logical_Operator;
1656 if Prev_Logical_Op /= N_Empty and then
1657 Logical_Op /= Prev_Logical_Op
1660 ("mixed logical operators in expression", Op_Location);
1661 Prev_Logical_Op := N_Empty;
1663 Prev_Logical_Op := Logical_Op;
1667 Node1 := New_Node (Logical_Op, Op_Location);
1668 Set_Left_Opnd (Node1, Node2);
1669 Set_Right_Opnd (Node1, P_Relation);
1670 Set_Op_Name (Node1);
1671 exit when Token not in Token_Class_Logop;
1674 Expr_Form := EF_Non_Simple;
1677 if Token = Tok_Apostrophe then
1678 Bad_Range_Attribute (Token_Ptr);
1683 end P_Expression_Or_Range_Attribute;
1690 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1691 -- | SIMPLE_EXPRESSION [not] in RANGE
1692 -- | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1694 -- On return, Expr_Form indicates the categorization of the expression
1696 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1697 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1699 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1700 -- expression, then tokens are scanned until either a non-expression token,
1701 -- a right paren (not matched by a left paren) or a comma, is encountered.
1703 function P_Relation return Node_Id is
1704 Node1, Node2 : Node_Id;
1708 Node1 := P_Simple_Expression;
1710 if Token not in Token_Class_Relop then
1714 -- Here we have a relational operator following. If so then scan it
1715 -- out. Note that the assignment symbol := is treated as a relational
1716 -- operator to improve the error recovery when it is misused for =.
1717 -- P_Relational_Operator also parses the IN and NOT IN operations.
1720 Node2 := New_Node (P_Relational_Operator, Optok);
1721 Set_Left_Opnd (Node2, Node1);
1722 Set_Op_Name (Node2);
1724 -- Case of IN or NOT IN
1726 if Prev_Token = Tok_In then
1727 Set_Right_Opnd (Node2, P_Range_Or_Subtype_Mark);
1729 -- Case of relational operator (= /= < <= > >=)
1732 Set_Right_Opnd (Node2, P_Simple_Expression);
1735 Expr_Form := EF_Non_Simple;
1737 if Token in Token_Class_Relop then
1738 Error_Msg_SC ("unexpected relational operator");
1745 -- If any error occurs, then scan to the next expression terminator symbol
1746 -- or comma or right paren at the outer (i.e. current) parentheses level.
1747 -- The flags are set to indicate a normal simple expression.
1750 when Error_Resync =>
1752 Expr_Form := EF_Simple;
1756 ----------------------------
1757 -- 4.4 Simple Expression --
1758 ----------------------------
1760 -- SIMPLE_EXPRESSION ::=
1761 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1763 -- On return, Expr_Form indicates the categorization of the expression
1765 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1766 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1768 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1769 -- expression, then tokens are scanned until either a non-expression token,
1770 -- a right paren (not matched by a left paren) or a comma, is encountered.
1772 -- Note: P_Simple_Expression is called only internally by higher level
1773 -- expression routines. In cases in the grammar where a simple expression
1774 -- is required, the approach is to scan an expression, and then post an
1775 -- appropriate error message if the expression obtained is not simple. This
1776 -- gives better error recovery and treatment.
1778 function P_Simple_Expression return Node_Id is
1779 Scan_State : Saved_Scan_State;
1782 Tokptr : Source_Ptr;
1785 -- Check for cases starting with a name. There are two reasons for
1786 -- special casing. First speed things up by catching a common case
1787 -- without going through several routine layers. Second the caller must
1788 -- be informed via Expr_Form when the simple expression is a name.
1790 if Token in Token_Class_Name then
1793 -- Deal with apostrophe cases
1795 if Token = Tok_Apostrophe then
1796 Save_Scan_State (Scan_State); -- at apostrophe
1797 Scan; -- past apostrophe
1799 -- If qualified expression, scan it out and fall through
1801 if Token = Tok_Left_Paren then
1802 Node1 := P_Qualified_Expression (Node1);
1803 Expr_Form := EF_Simple;
1805 -- If range attribute, then we return with Token pointing to the
1806 -- apostrophe. Note: avoid the normal error check on exit. We
1807 -- know that the expression really is complete in this case!
1809 else -- Token = Tok_Range then
1810 Restore_Scan_State (Scan_State); -- to apostrophe
1811 Expr_Form := EF_Simple_Name;
1816 -- If an expression terminator follows, the previous processing
1817 -- completely scanned out the expression (a common case), and
1818 -- left Expr_Form set appropriately for returning to our caller.
1820 if Token in Token_Class_Sterm then
1823 -- If we do not have an expression terminator, then complete the
1824 -- scan of a simple expression. This code duplicates the code
1825 -- found in P_Term and P_Factor.
1828 if Token = Tok_Double_Asterisk then
1830 Style.Check_Exponentiation_Operator;
1833 Node2 := New_Node (N_Op_Expon, Token_Ptr);
1835 Set_Left_Opnd (Node2, Node1);
1836 Set_Right_Opnd (Node2, P_Primary);
1837 Set_Op_Name (Node2);
1842 exit when Token not in Token_Class_Mulop;
1843 Tokptr := Token_Ptr;
1844 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1847 Style.Check_Binary_Operator;
1850 Scan; -- past operator
1851 Set_Left_Opnd (Node2, Node1);
1852 Set_Right_Opnd (Node2, P_Factor);
1853 Set_Op_Name (Node2);
1858 exit when Token not in Token_Class_Binary_Addop;
1859 Tokptr := Token_Ptr;
1860 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1863 Style.Check_Binary_Operator;
1866 Scan; -- past operator
1867 Set_Left_Opnd (Node2, Node1);
1868 Set_Right_Opnd (Node2, P_Term);
1869 Set_Op_Name (Node2);
1873 Expr_Form := EF_Simple;
1876 -- Cases where simple expression does not start with a name
1879 -- Scan initial sign and initial Term
1881 if Token in Token_Class_Unary_Addop then
1882 Tokptr := Token_Ptr;
1883 Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
1886 Style.Check_Unary_Plus_Or_Minus;
1889 Scan; -- past operator
1890 Set_Right_Opnd (Node1, P_Term);
1891 Set_Op_Name (Node1);
1896 -- In the following, we special-case a sequence of concatentations of
1897 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
1898 -- else mixed in. For such a sequence, we return a tree representing
1899 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
1900 -- the number of concatenations is large. If semantic analysis
1901 -- resolves the "&" to a predefined one, then this folding gives the
1902 -- right answer. Otherwise, semantic analysis will complain about a
1903 -- capacity-exceeded error. The purpose of this trick is to avoid
1904 -- creating a deeply nested tree, which would cause deep recursion
1905 -- during semantics, causing stack overflow. This way, we can handle
1906 -- enormous concatenations in the normal case of predefined "&". We
1907 -- first build up the normal tree, and then rewrite it if
1911 Num_Concats_Threshold : constant Positive := 1000;
1912 -- Arbitrary threshold value to enable optimization
1914 First_Node : constant Node_Id := Node1;
1915 Is_Strlit_Concat : Boolean;
1916 -- True iff we've parsed a sequence of concatenations of string
1917 -- literals, with nothing else mixed in.
1919 Num_Concats : Natural;
1920 -- Number of "&" operators if Is_Strlit_Concat is True
1924 Nkind (Node1) = N_String_Literal
1925 and then Token = Tok_Ampersand;
1928 -- Scan out sequence of terms separated by binary adding operators
1931 exit when Token not in Token_Class_Binary_Addop;
1932 Tokptr := Token_Ptr;
1933 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1934 Scan; -- past operator
1935 Set_Left_Opnd (Node2, Node1);
1937 Set_Right_Opnd (Node2, Node1);
1938 Set_Op_Name (Node2);
1940 -- Check if we're still concatenating string literals
1944 and then Nkind (Node2) = N_Op_Concat
1945 and then Nkind (Node1) = N_String_Literal;
1947 if Is_Strlit_Concat then
1948 Num_Concats := Num_Concats + 1;
1954 -- If we have an enormous series of concatenations of string
1955 -- literals, rewrite as explained above. The Is_Folded_In_Parser
1956 -- flag tells semantic analysis that if the "&" is not predefined,
1957 -- the folded value is wrong.
1960 and then Num_Concats >= Num_Concats_Threshold
1963 Empty_String_Val : String_Id;
1966 Strlit_Concat_Val : String_Id;
1967 -- Contains the folded value (which will be correct if the
1968 -- "&" operators are the predefined ones).
1971 -- For walking up the tree
1974 -- Folded node to replace Node1
1976 Loc : constant Source_Ptr := Sloc (First_Node);
1979 -- Walk up the tree starting at the leftmost string literal
1980 -- (First_Node), building up the Strlit_Concat_Val as we
1981 -- go. Note that we do not use recursion here -- the whole
1982 -- point is to avoid recursively walking that enormous tree.
1985 Store_String_Chars (Strval (First_Node));
1987 Cur_Node := Parent (First_Node);
1988 while Present (Cur_Node) loop
1989 pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
1990 Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
1992 Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
1993 Cur_Node := Parent (Cur_Node);
1996 Strlit_Concat_Val := End_String;
1998 -- Create new folded node, and rewrite result with a concat-
1999 -- enation of an empty string literal and the folded node.
2002 Empty_String_Val := End_String;
2004 Make_Op_Concat (Loc,
2005 Make_String_Literal (Loc, Empty_String_Val),
2006 Make_String_Literal (Loc, Strlit_Concat_Val,
2007 Is_Folded_In_Parser => True));
2008 Rewrite (Node1, New_Node);
2013 -- All done, we clearly do not have name or numeric literal so this
2014 -- is a case of a simple expression which is some other possibility.
2016 Expr_Form := EF_Simple;
2019 -- Come here at end of simple expression, where we do a couple of
2020 -- special checks to improve error recovery.
2022 -- Special test to improve error recovery. If the current token
2023 -- is a period, then someone is trying to do selection on something
2024 -- that is not a name, e.g. a qualified expression.
2026 if Token = Tok_Dot then
2027 Error_Msg_SC ("prefix for selection is not a name");
2031 -- Special test to improve error recovery: If the current token is
2032 -- not the first token on a line (as determined by checking the
2033 -- previous token position with the start of the current line),
2034 -- then we insist that we have an appropriate terminating token.
2035 -- Consider the following two examples:
2037 -- 1) if A nad B then ...
2042 -- In the first example, we would like to issue a binary operator
2043 -- expected message and resynchronize to the then. In the second
2044 -- example, we do not want to issue a binary operator message, so
2045 -- that instead we will get the missing semicolon message. This
2046 -- distinction is of course a heuristic which does not always work,
2047 -- but in practice it is quite effective.
2049 -- Note: the one case in which we do not go through this circuit is
2050 -- when we have scanned a range attribute and want to return with
2051 -- Token pointing to the apostrophe. The apostrophe is not normally
2052 -- an expression terminator, and is not in Token_Class_Sterm, but
2053 -- in this special case we know that the expression is complete.
2055 if not Token_Is_At_Start_Of_Line
2056 and then Token not in Token_Class_Sterm
2058 Error_Msg_AP ("binary operator expected");
2064 -- If any error occurs, then scan to next expression terminator symbol
2065 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2066 -- level. Expr_Form is set to indicate a normal simple expression.
2069 when Error_Resync =>
2071 Expr_Form := EF_Simple;
2074 end P_Simple_Expression;
2076 -----------------------------------------------
2077 -- 4.4 Simple Expression or Range Attribute --
2078 -----------------------------------------------
2080 -- SIMPLE_EXPRESSION ::=
2081 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2083 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2085 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2087 -- Error recovery: cannot raise Error_Resync
2089 function P_Simple_Expression_Or_Range_Attribute return Node_Id is
2091 Attr_Node : Node_Id;
2094 -- We don't just want to roar ahead and call P_Simple_Expression
2095 -- here, since we want to handle the case of a parenthesized range
2096 -- attribute cleanly.
2098 if Token = Tok_Left_Paren then
2100 Lptr : constant Source_Ptr := Token_Ptr;
2101 Scan_State : Saved_Scan_State;
2104 Save_Scan_State (Scan_State);
2105 Scan; -- past left paren
2106 Sexpr := P_Simple_Expression;
2108 if Token = Tok_Apostrophe then
2109 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2110 Expr_Form := EF_Range_Attr;
2112 if Token = Tok_Right_Paren then
2113 Scan; -- scan past right paren if present
2116 Error_Msg ("parentheses not allowed for range attribute", Lptr);
2121 Restore_Scan_State (Scan_State);
2125 -- Here after dealing with parenthesized range attribute
2127 Sexpr := P_Simple_Expression;
2129 if Token = Tok_Apostrophe then
2130 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2131 Expr_Form := EF_Range_Attr;
2137 end P_Simple_Expression_Or_Range_Attribute;
2143 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2145 -- Error recovery: can raise Error_Resync
2147 function P_Term return Node_Id is
2148 Node1, Node2 : Node_Id;
2149 Tokptr : Source_Ptr;
2155 exit when Token not in Token_Class_Mulop;
2156 Tokptr := Token_Ptr;
2157 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
2158 Scan; -- past operator
2159 Set_Left_Opnd (Node2, Node1);
2160 Set_Right_Opnd (Node2, P_Factor);
2161 Set_Op_Name (Node2);
2172 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2174 -- Error recovery: can raise Error_Resync
2176 function P_Factor return Node_Id is
2181 if Token = Tok_Abs then
2182 Node1 := New_Node (N_Op_Abs, Token_Ptr);
2185 Style.Check_Abs_Not;
2189 Set_Right_Opnd (Node1, P_Primary);
2190 Set_Op_Name (Node1);
2193 elsif Token = Tok_Not then
2194 Node1 := New_Node (N_Op_Not, Token_Ptr);
2197 Style.Check_Abs_Not;
2201 Set_Right_Opnd (Node1, P_Primary);
2202 Set_Op_Name (Node1);
2208 if Token = Tok_Double_Asterisk then
2209 Node2 := New_Node (N_Op_Expon, Token_Ptr);
2211 Set_Left_Opnd (Node2, Node1);
2212 Set_Right_Opnd (Node2, P_Primary);
2213 Set_Op_Name (Node2);
2226 -- NUMERIC_LITERAL | null
2227 -- | STRING_LITERAL | AGGREGATE
2228 -- | NAME | QUALIFIED_EXPRESSION
2229 -- | ALLOCATOR | (EXPRESSION)
2231 -- Error recovery: can raise Error_Resync
2233 function P_Primary return Node_Id is
2234 Scan_State : Saved_Scan_State;
2238 -- The loop runs more than once only if misplaced pragmas are found
2243 -- Name token can start a name, call or qualified expression, all
2244 -- of which are acceptable possibilities for primary. Note also
2245 -- that string literal is included in name (as operator symbol)
2246 -- and type conversion is included in name (as indexed component).
2248 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2251 -- All done unless apostrophe follows
2253 if Token /= Tok_Apostrophe then
2256 -- Apostrophe following means that we have either just parsed
2257 -- the subtype mark of a qualified expression, or the prefix
2258 -- or a range attribute.
2260 else -- Token = Tok_Apostrophe
2261 Save_Scan_State (Scan_State); -- at apostrophe
2262 Scan; -- past apostrophe
2264 -- If range attribute, then this is always an error, since
2265 -- the only legitimate case (where the scanned expression is
2266 -- a qualified simple name) is handled at the level of the
2267 -- Simple_Expression processing. This case corresponds to a
2268 -- usage such as 3 + A'Range, which is always illegal.
2270 if Token = Tok_Range then
2271 Restore_Scan_State (Scan_State); -- to apostrophe
2272 Bad_Range_Attribute (Token_Ptr);
2275 -- If left paren, then we have a qualified expression.
2276 -- Note that P_Name guarantees that in this case, where
2277 -- Token = Tok_Apostrophe on return, the only two possible
2278 -- tokens following the apostrophe are left paren and
2279 -- RANGE, so we know we have a left paren here.
2281 else -- Token = Tok_Left_Paren
2282 return P_Qualified_Expression (Node1);
2287 -- Numeric or string literal
2289 when Tok_Integer_Literal |
2291 Tok_String_Literal =>
2293 Node1 := Token_Node;
2294 Scan; -- past number
2297 -- Left paren, starts aggregate or parenthesized expression
2299 when Tok_Left_Paren =>
2301 Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2304 if Nkind (Expr) = N_Attribute_Reference
2305 and then Attribute_Name (Expr) = Name_Range
2307 Bad_Range_Attribute (Sloc (Expr));
2322 return New_Node (N_Null, Prev_Token_Ptr);
2324 -- Pragma, not allowed here, so just skip past it
2327 P_Pragmas_Misplaced;
2329 -- Anything else is illegal as the first token of a primary, but
2330 -- we test for a reserved identifier so that it is treated nicely
2333 if Is_Reserved_Identifier then
2334 return P_Identifier;
2336 elsif Prev_Token = Tok_Comma then
2337 Error_Msg_SP ("extra "","" ignored");
2341 Error_Msg_AP ("missing operand");
2349 ---------------------------
2350 -- 4.5 Logical Operator --
2351 ---------------------------
2353 -- LOGICAL_OPERATOR ::= and | or | xor
2355 -- Note: AND THEN and OR ELSE are also treated as logical operators
2356 -- by the parser (even though they are not operators semantically)
2358 -- The value returned is the appropriate Node_Kind code for the operator
2359 -- On return, Token points to the token following the scanned operator.
2361 -- The caller has checked that the first token is a legitimate logical
2362 -- operator token (i.e. is either XOR, AND, OR).
2364 -- Error recovery: cannot raise Error_Resync
2366 function P_Logical_Operator return Node_Kind is
2368 if Token = Tok_And then
2370 Style.Check_Binary_Operator;
2375 if Token = Tok_Then then
2382 elsif Token = Tok_Or then
2384 Style.Check_Binary_Operator;
2389 if Token = Tok_Else then
2396 else -- Token = Tok_Xor
2398 Style.Check_Binary_Operator;
2404 end P_Logical_Operator;
2406 ------------------------------
2407 -- 4.5 Relational Operator --
2408 ------------------------------
2410 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2412 -- The value returned is the appropriate Node_Kind code for the operator.
2413 -- On return, Token points to the operator token, NOT past it.
2415 -- The caller has checked that the first token is a legitimate relational
2416 -- operator token (i.e. is one of the operator tokens listed above).
2418 -- Error recovery: cannot raise Error_Resync
2420 function P_Relational_Operator return Node_Kind is
2421 Op_Kind : Node_Kind;
2422 Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2423 (Tok_Less => N_Op_Lt,
2424 Tok_Equal => N_Op_Eq,
2425 Tok_Greater => N_Op_Gt,
2426 Tok_Not_Equal => N_Op_Ne,
2427 Tok_Greater_Equal => N_Op_Ge,
2428 Tok_Less_Equal => N_Op_Le,
2430 Tok_Not => N_Not_In,
2431 Tok_Box => N_Op_Ne);
2434 if Token = Tok_Box then
2435 Error_Msg_SC ("""'<'>"" should be ""/=""");
2438 Op_Kind := Relop_Node (Token);
2441 Style.Check_Binary_Operator;
2444 Scan; -- past operator token
2446 if Prev_Token = Tok_Not then
2451 end P_Relational_Operator;
2453 ---------------------------------
2454 -- 4.5 Binary Adding Operator --
2455 ---------------------------------
2457 -- BINARY_ADDING_OPERATOR ::= + | - | &
2459 -- The value returned is the appropriate Node_Kind code for the operator.
2460 -- On return, Token points to the operator token (NOT past it).
2462 -- The caller has checked that the first token is a legitimate adding
2463 -- operator token (i.e. is one of the operator tokens listed above).
2465 -- Error recovery: cannot raise Error_Resync
2467 function P_Binary_Adding_Operator return Node_Kind is
2468 Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2469 (Tok_Ampersand => N_Op_Concat,
2470 Tok_Minus => N_Op_Subtract,
2471 Tok_Plus => N_Op_Add);
2473 return Addop_Node (Token);
2474 end P_Binary_Adding_Operator;
2476 --------------------------------
2477 -- 4.5 Unary Adding Operator --
2478 --------------------------------
2480 -- UNARY_ADDING_OPERATOR ::= + | -
2482 -- The value returned is the appropriate Node_Kind code for the operator.
2483 -- On return, Token points to the operator token (NOT past it).
2485 -- The caller has checked that the first token is a legitimate adding
2486 -- operator token (i.e. is one of the operator tokens listed above).
2488 -- Error recovery: cannot raise Error_Resync
2490 function P_Unary_Adding_Operator return Node_Kind is
2491 Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2492 (Tok_Minus => N_Op_Minus,
2493 Tok_Plus => N_Op_Plus);
2495 return Addop_Node (Token);
2496 end P_Unary_Adding_Operator;
2498 -------------------------------
2499 -- 4.5 Multiplying Operator --
2500 -------------------------------
2502 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2504 -- The value returned is the appropriate Node_Kind code for the operator.
2505 -- On return, Token points to the operator token (NOT past it).
2507 -- The caller has checked that the first token is a legitimate multiplying
2508 -- operator token (i.e. is one of the operator tokens listed above).
2510 -- Error recovery: cannot raise Error_Resync
2512 function P_Multiplying_Operator return Node_Kind is
2513 Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2514 (Tok_Asterisk => N_Op_Multiply,
2515 Tok_Mod => N_Op_Mod,
2516 Tok_Rem => N_Op_Rem,
2517 Tok_Slash => N_Op_Divide);
2519 return Mulop_Node (Token);
2520 end P_Multiplying_Operator;
2522 --------------------------------------
2523 -- 4.5 Highest Precedence Operator --
2524 --------------------------------------
2526 -- Parsed by P_Factor (4.4)
2528 -- Note: this rule is not in fact used by the grammar at any point!
2530 --------------------------
2531 -- 4.6 Type Conversion --
2532 --------------------------
2534 -- Parsed by P_Primary as a Name (4.1)
2536 -------------------------------
2537 -- 4.7 Qualified Expression --
2538 -------------------------------
2540 -- QUALIFIED_EXPRESSION ::=
2541 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2543 -- The caller has scanned the name which is the Subtype_Mark parameter
2544 -- and scanned past the single quote following the subtype mark. The
2545 -- caller has not checked that this name is in fact appropriate for
2546 -- a subtype mark name (i.e. it is a selected component or identifier).
2548 -- Error_Recovery: cannot raise Error_Resync
2550 function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2551 Qual_Node : Node_Id;
2553 Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2554 Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2555 Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2557 end P_Qualified_Expression;
2559 --------------------
2561 --------------------
2564 -- new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2566 -- The caller has checked that the initial token is NEW
2568 -- Error recovery: can raise Error_Resync
2570 function P_Allocator return Node_Id is
2571 Alloc_Node : Node_Id;
2572 Type_Node : Node_Id;
2573 Null_Exclusion_Present : Boolean;
2576 Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2579 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2581 Null_Exclusion_Present := P_Null_Exclusion;
2582 Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
2583 Type_Node := P_Subtype_Mark_Resync;
2585 if Token = Tok_Apostrophe then
2586 Scan; -- past apostrophe
2587 Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2591 P_Subtype_Indication (Type_Node, Null_Exclusion_Present));