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;
35 -----------------------
36 -- Local Subprograms --
37 -----------------------
39 function P_Aggregate_Or_Paren_Expr return Node_Id;
40 function P_Allocator return Node_Id;
41 function P_Record_Or_Array_Component_Association return Node_Id;
42 function P_Factor return Node_Id;
43 function P_Primary return Node_Id;
44 function P_Relation return Node_Id;
45 function P_Term return Node_Id;
47 function P_Binary_Adding_Operator return Node_Kind;
48 function P_Logical_Operator return Node_Kind;
49 function P_Multiplying_Operator return Node_Kind;
50 function P_Relational_Operator return Node_Kind;
51 function P_Unary_Adding_Operator return Node_Kind;
53 procedure Bad_Range_Attribute (Loc : Source_Ptr);
54 -- Called to place complaint about bad range attribute at the given
55 -- source location. Terminates by raising Error_Resync.
57 function P_Range_Attribute_Reference
58 (Prefix_Node : Node_Id)
60 -- Scan a range attribute reference. The caller has scanned out the
61 -- prefix. The current token is known to be an apostrophe and the
62 -- following token is known to be RANGE.
64 procedure Set_Op_Name (Node : Node_Id);
65 -- Procedure to set name field (Chars) in operator node
67 -------------------------
68 -- Bad_Range_Attribute --
69 -------------------------
71 procedure Bad_Range_Attribute (Loc : Source_Ptr) is
73 Error_Msg ("range attribute cannot be used in expression!", Loc);
75 end Bad_Range_Attribute;
81 procedure Set_Op_Name (Node : Node_Id) is
82 type Name_Of_Type is array (N_Op) of Name_Id;
83 Name_Of : constant Name_Of_Type := Name_Of_Type'(
84 N_Op_And => Name_Op_And,
85 N_Op_Or => Name_Op_Or,
86 N_Op_Xor => Name_Op_Xor,
87 N_Op_Eq => Name_Op_Eq,
88 N_Op_Ne => Name_Op_Ne,
89 N_Op_Lt => Name_Op_Lt,
90 N_Op_Le => Name_Op_Le,
91 N_Op_Gt => Name_Op_Gt,
92 N_Op_Ge => Name_Op_Ge,
93 N_Op_Add => Name_Op_Add,
94 N_Op_Subtract => Name_Op_Subtract,
95 N_Op_Concat => Name_Op_Concat,
96 N_Op_Multiply => Name_Op_Multiply,
97 N_Op_Divide => Name_Op_Divide,
98 N_Op_Mod => Name_Op_Mod,
99 N_Op_Rem => Name_Op_Rem,
100 N_Op_Expon => Name_Op_Expon,
101 N_Op_Plus => Name_Op_Add,
102 N_Op_Minus => Name_Op_Subtract,
103 N_Op_Abs => Name_Op_Abs,
104 N_Op_Not => Name_Op_Not,
106 -- We don't really need these shift operators, since they never
107 -- appear as operators in the source, but the path of least
108 -- resistance is to put them in (the aggregate must be complete)
110 N_Op_Rotate_Left => Name_Rotate_Left,
111 N_Op_Rotate_Right => Name_Rotate_Right,
112 N_Op_Shift_Left => Name_Shift_Left,
113 N_Op_Shift_Right => Name_Shift_Right,
114 N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
117 if Nkind (Node) in N_Op then
118 Set_Chars (Node, Name_Of (Nkind (Node)));
122 --------------------------
123 -- 4.1 Name (also 6.4) --
124 --------------------------
127 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
128 -- | INDEXED_COMPONENT | SLICE
129 -- | SELECTED_COMPONENT | ATTRIBUTE
130 -- | TYPE_CONVERSION | FUNCTION_CALL
131 -- | CHARACTER_LITERAL
133 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
135 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
137 -- EXPLICIT_DEREFERENCE ::= NAME . all
139 -- IMPLICIT_DEREFERENCE ::= NAME
141 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
143 -- SLICE ::= PREFIX (DISCRETE_RANGE)
145 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
147 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
149 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
151 -- ATTRIBUTE_DESIGNATOR ::=
152 -- IDENTIFIER [(static_EXPRESSION)]
153 -- | access | delta | digits
157 -- | function_PREFIX ACTUAL_PARAMETER_PART
159 -- ACTUAL_PARAMETER_PART ::=
160 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
162 -- PARAMETER_ASSOCIATION ::=
163 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
165 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
167 -- Note: syntactically a procedure call looks just like a function call,
168 -- so this routine is in practice used to scan out procedure calls as well.
170 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
172 -- Error recovery: can raise Error_Resync
174 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
175 -- followed by either a left paren (qualified expression case), or by
176 -- range (range attribute case). All other uses of apostrophe (i.e. all
177 -- other attributes) are handled in this routine.
179 -- Error recovery: can raise Error_Resync
181 function P_Name return Node_Id is
182 Scan_State : Saved_Scan_State;
184 Prefix_Node : Node_Id;
185 Ident_Node : Node_Id;
187 Range_Node : Node_Id;
190 Arg_List : List_Id := No_List; -- kill junk warning
191 Attr_Name : Name_Id := No_Name; -- kill junk warning
194 -- Case of not a name
196 if Token not in Token_Class_Name then
198 -- If it looks like start of expression, complain and scan expression
200 if Token in Token_Class_Literal
201 or else Token = Tok_Left_Paren
203 Error_Msg_SC ("name expected");
206 -- Otherwise some other junk, not much we can do
209 Error_Msg_AP ("name expected");
214 -- Loop through designators in qualified name
216 Name_Node := Token_Node;
219 Scan; -- past designator
220 exit when Token /= Tok_Dot;
221 Save_Scan_State (Scan_State); -- at dot
224 -- If we do not have another designator after the dot, then join
225 -- the normal circuit to handle a dot extension (may be .all or
226 -- character literal case). Otherwise loop back to scan the next
229 if Token not in Token_Class_Desig then
230 goto Scan_Name_Extension_Dot;
232 Prefix_Node := Name_Node;
233 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
234 Set_Prefix (Name_Node, Prefix_Node);
235 Set_Selector_Name (Name_Node, Token_Node);
239 -- We have now scanned out a qualified designator. If the last token is
240 -- an operator symbol, then we certainly do not have the Snam case, so
241 -- we can just use the normal name extension check circuit
243 if Prev_Token = Tok_Operator_Symbol then
244 goto Scan_Name_Extension;
247 -- We have scanned out a qualified simple name, check for name extension
248 -- Note that we know there is no dot here at this stage, so the only
249 -- possible cases of name extension are apostrophe and left paren.
251 if Token = Tok_Apostrophe then
252 Save_Scan_State (Scan_State); -- at apostrophe
253 Scan; -- past apostrophe
255 -- If left paren, then this might be a qualified expression, but we
256 -- are only in the business of scanning out names, so return with
257 -- Token backed up to point to the apostrophe. The treatment for
258 -- the range attribute is similar (we do not consider x'range to
259 -- be a name in this grammar).
261 if Token = Tok_Left_Paren or else Token = Tok_Range then
262 Restore_Scan_State (Scan_State); -- to apostrophe
263 Expr_Form := EF_Simple_Name;
266 -- Otherwise we have the case of a name extended by an attribute
269 goto Scan_Name_Extension_Apostrophe;
272 -- Check case of qualified simple name extended by a left parenthesis
274 elsif Token = Tok_Left_Paren then
275 Scan; -- past left paren
276 goto Scan_Name_Extension_Left_Paren;
278 -- Otherwise the qualified simple name is not extended, so return
281 Expr_Form := EF_Simple_Name;
285 -- Loop scanning past name extensions. A label is used for control
286 -- transfer for this loop for ease of interfacing with the finite state
287 -- machine in the parenthesis scanning circuit, and also to allow for
288 -- passing in control to the appropriate point from the above code.
290 <<Scan_Name_Extension>>
292 -- Character literal used as name cannot be extended. Also this
293 -- cannot be a call, since the name for a call must be a designator.
294 -- Return in these cases, or if there is no name extension
296 if Token not in Token_Class_Namext
297 or else Prev_Token = Tok_Char_Literal
299 Expr_Form := EF_Name;
303 -- Merge here when we know there is a name extension
305 <<Scan_Name_Extension_OK>>
307 if Token = Tok_Left_Paren then
308 Scan; -- past left paren
309 goto Scan_Name_Extension_Left_Paren;
311 elsif Token = Tok_Apostrophe then
312 Save_Scan_State (Scan_State); -- at apostrophe
313 Scan; -- past apostrophe
314 goto Scan_Name_Extension_Apostrophe;
316 else -- Token = Tok_Dot
317 Save_Scan_State (Scan_State); -- at dot
319 goto Scan_Name_Extension_Dot;
322 -- Case of name extended by dot (selection), dot is already skipped
323 -- and the scan state at the point of the dot is saved in Scan_State.
325 <<Scan_Name_Extension_Dot>>
327 -- Explicit dereference case
329 if Token = Tok_All then
330 Prefix_Node := Name_Node;
331 Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
332 Set_Prefix (Name_Node, Prefix_Node);
334 goto Scan_Name_Extension;
336 -- Selected component case
338 elsif Token in Token_Class_Name then
339 Prefix_Node := Name_Node;
340 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
341 Set_Prefix (Name_Node, Prefix_Node);
342 Set_Selector_Name (Name_Node, Token_Node);
343 Scan; -- past selector
344 goto Scan_Name_Extension;
346 -- Reserved identifier as selector
348 elsif Is_Reserved_Identifier then
349 Scan_Reserved_Identifier (Force_Msg => False);
350 Prefix_Node := Name_Node;
351 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
352 Set_Prefix (Name_Node, Prefix_Node);
353 Set_Selector_Name (Name_Node, Token_Node);
354 Scan; -- past identifier used as selector
355 goto Scan_Name_Extension;
357 -- If dot is at end of line and followed by nothing legal,
358 -- then assume end of name and quit (dot will be taken as
359 -- an erroneous form of some other punctuation by our caller).
361 elsif Token_Is_At_Start_Of_Line then
362 Restore_Scan_State (Scan_State);
365 -- Here if nothing legal after the dot
368 Error_Msg_AP ("selector expected");
372 -- Here for an apostrophe as name extension. The scan position at the
373 -- apostrophe has already been saved, and the apostrophe scanned out.
375 <<Scan_Name_Extension_Apostrophe>>
377 Scan_Apostrophe : declare
378 function Apostrophe_Should_Be_Semicolon return Boolean;
379 -- Checks for case where apostrophe should probably be
380 -- a semicolon, and if so, gives appropriate message,
381 -- resets the scan pointer to the apostrophe, changes
382 -- the current token to Tok_Semicolon, and returns True.
383 -- Otherwise returns False.
385 function Apostrophe_Should_Be_Semicolon return Boolean is
387 if Token_Is_At_Start_Of_Line then
388 Restore_Scan_State (Scan_State); -- to apostrophe
389 Error_Msg_SC ("""''"" should be "";""");
390 Token := Tok_Semicolon;
395 end Apostrophe_Should_Be_Semicolon;
397 -- Start of processing for Scan_Apostrophe
400 -- If range attribute after apostrophe, then return with Token
401 -- pointing to the apostrophe. Note that in this case the prefix
402 -- need not be a simple name (cases like A.all'range). Similarly
403 -- if there is a left paren after the apostrophe, then we also
404 -- return with Token pointing to the apostrophe (this is the
405 -- qualified expression case).
407 if Token = Tok_Range or else Token = Tok_Left_Paren then
408 Restore_Scan_State (Scan_State); -- to apostrophe
409 Expr_Form := EF_Name;
412 -- Here for cases where attribute designator is an identifier
414 elsif Token = Tok_Identifier then
415 Attr_Name := Token_Name;
417 if not Is_Attribute_Name (Attr_Name) then
418 if Apostrophe_Should_Be_Semicolon then
419 Expr_Form := EF_Name;
422 -- Here for a bad attribute name
425 Signal_Bad_Attribute;
426 Scan; -- past bad identifier
428 if Token = Tok_Left_Paren then
429 Scan; -- past left paren
432 Discard_Junk_Node (P_Expression);
433 exit when not Comma_Present;
444 Style.Check_Attribute_Name (False);
447 Delete_Node (Token_Node);
449 -- Here for case of attribute designator is not an identifier
452 if Token = Tok_Delta then
453 Attr_Name := Name_Delta;
455 elsif Token = Tok_Digits then
456 Attr_Name := Name_Digits;
458 elsif Token = Tok_Access then
459 Attr_Name := Name_Access;
461 elsif Token = Tok_Mod and then Ada_Version = Ada_05 then
462 Attr_Name := Name_Mod;
464 elsif Apostrophe_Should_Be_Semicolon then
465 Expr_Form := EF_Name;
469 Error_Msg_AP ("attribute designator expected");
474 Style.Check_Attribute_Name (True);
478 -- We come here with an OK attribute scanned, and the
479 -- corresponding Attribute identifier node stored in Ident_Node.
481 Prefix_Node := Name_Node;
482 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
483 Scan; -- past attribute designator
484 Set_Prefix (Name_Node, Prefix_Node);
485 Set_Attribute_Name (Name_Node, Attr_Name);
487 -- Scan attribute arguments/designator
489 if Token = Tok_Left_Paren then
490 Set_Expressions (Name_Node, New_List);
491 Scan; -- past left paren
495 Expr : constant Node_Id := P_Expression;
498 if Token = Tok_Arrow then
500 ("named parameters not permitted for attributes");
501 Scan; -- past junk arrow
504 Append (Expr, Expressions (Name_Node));
505 exit when not Comma_Present;
513 goto Scan_Name_Extension;
516 -- Here for left parenthesis extending name (left paren skipped)
518 <<Scan_Name_Extension_Left_Paren>>
520 -- We now have to scan through a list of items, terminated by a
521 -- right parenthesis. The scan is handled by a finite state
522 -- machine. The possibilities are:
526 -- This is a slice. This case is handled in LP_State_Init
528 -- (expression, expression, ..)
530 -- This is interpreted as an indexed component, i.e. as a
531 -- case of a name which can be extended in the normal manner.
532 -- This case is handled by LP_State_Name or LP_State_Expr.
534 -- (..., identifier => expression , ...)
536 -- If there is at least one occurrence of identifier => (but
537 -- none of the other cases apply), then we have a call.
539 -- Test for Id => case
541 if Token = Tok_Identifier then
542 Save_Scan_State (Scan_State); -- at Id
545 -- Test for => (allow := as an error substitute)
547 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
548 Restore_Scan_State (Scan_State); -- to Id
549 Arg_List := New_List;
553 Restore_Scan_State (Scan_State); -- to Id
557 -- Here we have an expression after all
559 Expr_Node := P_Expression_Or_Range_Attribute;
561 -- Check cases of discrete range for a slice
563 -- First possibility: Range_Attribute_Reference
565 if Expr_Form = EF_Range_Attr then
566 Range_Node := Expr_Node;
568 -- Second possibility: Simple_expression .. Simple_expression
570 elsif Token = Tok_Dot_Dot then
571 Check_Simple_Expression (Expr_Node);
572 Range_Node := New_Node (N_Range, Token_Ptr);
573 Set_Low_Bound (Range_Node, Expr_Node);
575 Expr_Node := P_Expression;
576 Check_Simple_Expression (Expr_Node);
577 Set_High_Bound (Range_Node, Expr_Node);
579 -- Third possibility: Type_name range Range
581 elsif Token = Tok_Range then
582 if Expr_Form /= EF_Simple_Name then
583 Error_Msg_SC ("subtype mark must precede RANGE");
587 Range_Node := P_Subtype_Indication (Expr_Node);
589 -- Otherwise we just have an expression. It is true that we might
590 -- have a subtype mark without a range constraint but this case
591 -- is syntactically indistinguishable from the expression case.
594 Arg_List := New_List;
598 -- Fall through here with unmistakable Discrete range scanned,
599 -- which means that we definitely have the case of a slice. The
600 -- Discrete range is in Range_Node.
602 if Token = Tok_Comma then
603 Error_Msg_SC ("slice cannot have more than one dimension");
606 elsif Token /= Tok_Right_Paren then
611 Scan; -- past right paren
612 Prefix_Node := Name_Node;
613 Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
614 Set_Prefix (Name_Node, Prefix_Node);
615 Set_Discrete_Range (Name_Node, Range_Node);
617 -- An operator node is legal as a prefix to other names,
618 -- but not for a slice.
620 if Nkind (Prefix_Node) = N_Operator_Symbol then
621 Error_Msg_N ("illegal prefix for slice", Prefix_Node);
624 -- If we have a name extension, go scan it
626 if Token in Token_Class_Namext then
627 goto Scan_Name_Extension_OK;
629 -- Otherwise return (a slice is a name, but is not a call)
632 Expr_Form := EF_Name;
637 -- In LP_State_Expr, we have scanned one or more expressions, and
638 -- so we have a call or an indexed component which is a name. On
639 -- entry we have the expression just scanned in Expr_Node and
640 -- Arg_List contains the list of expressions encountered so far
643 Append (Expr_Node, Arg_List);
645 if Token = Tok_Arrow then
647 ("expect identifier in parameter association",
651 elsif not Comma_Present then
653 Prefix_Node := Name_Node;
654 Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
655 Set_Prefix (Name_Node, Prefix_Node);
656 Set_Expressions (Name_Node, Arg_List);
657 goto Scan_Name_Extension;
660 -- Comma present (and scanned out), test for identifier => case
661 -- Test for identifier => case
663 if Token = Tok_Identifier then
664 Save_Scan_State (Scan_State); -- at Id
667 -- Test for => (allow := as error substitute)
669 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
670 Restore_Scan_State (Scan_State); -- to Id
673 -- Otherwise it's just an expression after all, so backup
676 Restore_Scan_State (Scan_State); -- to Id
680 -- Here we have an expression after all, so stay in this state
682 Expr_Node := P_Expression;
685 -- LP_State_Call corresponds to the situation in which at least
686 -- one instance of Id => Expression has been encountered, so we
687 -- know that we do not have a name, but rather a call. We enter
688 -- it with the scan pointer pointing to the next argument to scan,
689 -- and Arg_List containing the list of arguments scanned so far.
693 -- Test for case of Id => Expression (named parameter)
695 if Token = Tok_Identifier then
696 Save_Scan_State (Scan_State); -- at Id
697 Ident_Node := Token_Node;
700 -- Deal with => (allow := as erroneous substitute)
702 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
704 New_Node (N_Parameter_Association, Prev_Token_Ptr);
705 Set_Selector_Name (Arg_Node, Ident_Node);
707 Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
708 Append (Arg_Node, Arg_List);
710 -- If a comma follows, go back and scan next entry
712 if Comma_Present then
715 -- Otherwise we have the end of a call
718 Prefix_Node := Name_Node;
720 New_Node (N_Function_Call, Sloc (Prefix_Node));
721 Set_Name (Name_Node, Prefix_Node);
722 Set_Parameter_Associations (Name_Node, Arg_List);
725 if Token in Token_Class_Namext then
726 goto Scan_Name_Extension_OK;
728 -- This is a case of a call which cannot be a name
731 Expr_Form := EF_Name;
736 -- Not named parameter: Id started an expression after all
739 Restore_Scan_State (Scan_State); -- to Id
743 -- Here if entry did not start with Id => which means that it
744 -- is a positional parameter, which is not allowed, since we
745 -- have seen at least one named parameter already.
748 ("positional parameter association " &
749 "not allowed after named one");
751 Expr_Node := P_Expression;
753 -- Leaving the '>' in an association is not unusual, so suggest
756 if Nkind (Expr_Node) = N_Op_Eq then
757 Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
760 -- We go back to scanning out expressions, so that we do not get
761 -- multiple error messages when several positional parameters
762 -- follow a named parameter.
766 -- End of treatment for name extensions starting with left paren
768 -- End of loop through name extensions
772 -- This function parses a restricted form of Names which are either
773 -- designators, or designators preceded by a sequence of prefixes
774 -- that are direct names.
776 -- Error recovery: cannot raise Error_Resync
778 function P_Function_Name return Node_Id is
779 Designator_Node : Node_Id;
780 Prefix_Node : Node_Id;
781 Selector_Node : Node_Id;
782 Dot_Sloc : Source_Ptr := No_Location;
785 -- Prefix_Node is set to the gathered prefix so far, Empty means that
786 -- no prefix has been scanned. This allows us to build up the result
787 -- in the required right recursive manner.
789 Prefix_Node := Empty;
791 -- Loop through prefixes
794 Designator_Node := Token_Node;
796 if Token not in Token_Class_Desig then
797 return P_Identifier; -- let P_Identifier issue the error message
799 else -- Token in Token_Class_Desig
800 Scan; -- past designator
801 exit when Token /= Tok_Dot;
804 -- Here at a dot, with token just before it in Designator_Node
806 if No (Prefix_Node) then
807 Prefix_Node := Designator_Node;
809 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
810 Set_Prefix (Selector_Node, Prefix_Node);
811 Set_Selector_Name (Selector_Node, Designator_Node);
812 Prefix_Node := Selector_Node;
815 Dot_Sloc := Token_Ptr;
819 -- Fall out of the loop having just scanned a designator
821 if No (Prefix_Node) then
822 return Designator_Node;
824 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
825 Set_Prefix (Selector_Node, Prefix_Node);
826 Set_Selector_Name (Selector_Node, Designator_Node);
827 return Selector_Node;
836 -- This function parses a restricted form of Names which are either
837 -- identifiers, or identifiers preceded by a sequence of prefixes
838 -- that are direct names.
840 -- Error recovery: cannot raise Error_Resync
842 function P_Qualified_Simple_Name return Node_Id is
843 Designator_Node : Node_Id;
844 Prefix_Node : Node_Id;
845 Selector_Node : Node_Id;
846 Dot_Sloc : Source_Ptr := No_Location;
849 -- Prefix node is set to the gathered prefix so far, Empty means that
850 -- no prefix has been scanned. This allows us to build up the result
851 -- in the required right recursive manner.
853 Prefix_Node := Empty;
855 -- Loop through prefixes
858 Designator_Node := Token_Node;
860 if Token = Tok_Identifier then
861 Scan; -- past identifier
862 exit when Token /= Tok_Dot;
864 elsif Token not in Token_Class_Desig then
865 return P_Identifier; -- let P_Identifier issue the error message
868 Scan; -- past designator
870 if Token /= Tok_Dot then
871 Error_Msg_SP ("identifier expected");
876 -- Here at a dot, with token just before it in Designator_Node
878 if No (Prefix_Node) then
879 Prefix_Node := Designator_Node;
881 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
882 Set_Prefix (Selector_Node, Prefix_Node);
883 Set_Selector_Name (Selector_Node, Designator_Node);
884 Prefix_Node := Selector_Node;
887 Dot_Sloc := Token_Ptr;
891 -- Fall out of the loop having just scanned an identifier
893 if No (Prefix_Node) then
894 return Designator_Node;
896 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
897 Set_Prefix (Selector_Node, Prefix_Node);
898 Set_Selector_Name (Selector_Node, Designator_Node);
899 return Selector_Node;
906 end P_Qualified_Simple_Name;
908 -- This procedure differs from P_Qualified_Simple_Name only in that it
909 -- raises Error_Resync if any error is encountered. It only returns after
910 -- scanning a valid qualified simple name.
912 -- Error recovery: can raise Error_Resync
914 function P_Qualified_Simple_Name_Resync return Node_Id is
915 Designator_Node : Node_Id;
916 Prefix_Node : Node_Id;
917 Selector_Node : Node_Id;
918 Dot_Sloc : Source_Ptr := No_Location;
921 Prefix_Node := Empty;
923 -- Loop through prefixes
926 Designator_Node := Token_Node;
928 if Token = Tok_Identifier then
929 Scan; -- past identifier
930 exit when Token /= Tok_Dot;
932 elsif Token not in Token_Class_Desig then
933 Discard_Junk_Node (P_Identifier); -- to issue the error message
937 Scan; -- past designator
939 if Token /= Tok_Dot then
940 Error_Msg_SP ("identifier expected");
945 -- Here at a dot, with token just before it in Designator_Node
947 if No (Prefix_Node) then
948 Prefix_Node := Designator_Node;
950 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
951 Set_Prefix (Selector_Node, Prefix_Node);
952 Set_Selector_Name (Selector_Node, Designator_Node);
953 Prefix_Node := Selector_Node;
956 Dot_Sloc := Token_Ptr;
960 -- Fall out of the loop having just scanned an identifier
962 if No (Prefix_Node) then
963 return Designator_Node;
965 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
966 Set_Prefix (Selector_Node, Prefix_Node);
967 Set_Selector_Name (Selector_Node, Designator_Node);
968 return Selector_Node;
971 end P_Qualified_Simple_Name_Resync;
973 ----------------------
974 -- 4.1 Direct_Name --
975 ----------------------
977 -- Parsed by P_Name and other functions in section 4.1
983 -- Parsed by P_Name (4.1)
985 -------------------------------
986 -- 4.1 Explicit Dereference --
987 -------------------------------
989 -- Parsed by P_Name (4.1)
991 -------------------------------
992 -- 4.1 Implicit_Dereference --
993 -------------------------------
995 -- Parsed by P_Name (4.1)
997 ----------------------------
998 -- 4.1 Indexed Component --
999 ----------------------------
1001 -- Parsed by P_Name (4.1)
1007 -- Parsed by P_Name (4.1)
1009 -----------------------------
1010 -- 4.1 Selected_Component --
1011 -----------------------------
1013 -- Parsed by P_Name (4.1)
1015 ------------------------
1016 -- 4.1 Selector Name --
1017 ------------------------
1019 -- Parsed by P_Name (4.1)
1021 ------------------------------
1022 -- 4.1 Attribute Reference --
1023 ------------------------------
1025 -- Parsed by P_Name (4.1)
1027 -------------------------------
1028 -- 4.1 Attribute Designator --
1029 -------------------------------
1031 -- Parsed by P_Name (4.1)
1033 --------------------------------------
1034 -- 4.1.4 Range Attribute Reference --
1035 --------------------------------------
1037 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1039 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1041 -- In the grammar, a RANGE attribute is simply a name, but its use is
1042 -- highly restricted, so in the parser, we do not regard it as a name.
1043 -- Instead, P_Name returns without scanning the 'RANGE part of the
1044 -- attribute, and the caller uses the following function to construct
1045 -- a range attribute in places where it is appropriate.
1047 -- Note that RANGE here is treated essentially as an identifier,
1048 -- rather than a reserved word.
1050 -- The caller has parsed the prefix, i.e. a name, and Token points to
1051 -- the apostrophe. The token after the apostrophe is known to be RANGE
1052 -- at this point. The prefix node becomes the prefix of the attribute.
1054 -- Error_Recovery: Cannot raise Error_Resync
1056 function P_Range_Attribute_Reference
1057 (Prefix_Node : Node_Id)
1060 Attr_Node : Node_Id;
1063 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1064 Set_Prefix (Attr_Node, Prefix_Node);
1065 Scan; -- past apostrophe
1068 Style.Check_Attribute_Name (True);
1071 Set_Attribute_Name (Attr_Node, Name_Range);
1074 if Token = Tok_Left_Paren then
1075 Scan; -- past left paren
1076 Set_Expressions (Attr_Node, New_List (P_Expression));
1081 end P_Range_Attribute_Reference;
1083 ---------------------------------------
1084 -- 4.1.4 Range Attribute Designator --
1085 ---------------------------------------
1087 -- Parsed by P_Range_Attribute_Reference (4.4)
1089 --------------------
1091 --------------------
1093 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1095 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1096 -- an aggregate is known to be required (code statement, extension
1097 -- aggregate), in which cases this routine performs the necessary check
1098 -- that we have an aggregate rather than a parenthesized expression
1100 -- Error recovery: can raise Error_Resync
1102 function P_Aggregate return Node_Id is
1103 Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1104 Aggr_Node : constant Node_Id := P_Aggregate_Or_Paren_Expr;
1107 if Nkind (Aggr_Node) /= N_Aggregate
1109 Nkind (Aggr_Node) /= N_Extension_Aggregate
1112 ("aggregate may not have single positional component", Aggr_Sloc);
1119 -------------------------------------------------
1120 -- 4.3 Aggregate or Parenthesized Expresssion --
1121 -------------------------------------------------
1123 -- This procedure parses out either an aggregate or a parenthesized
1124 -- expression (these two constructs are closely related, since a
1125 -- parenthesized expression looks like an aggregate with a single
1126 -- positional component).
1129 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1131 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1133 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1134 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1137 -- RECORD_COMPONENT_ASSOCIATION ::=
1138 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1140 -- COMPONENT_CHOICE_LIST ::=
1141 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1144 -- EXTENSION_AGGREGATE ::=
1145 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1147 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1149 -- ARRAY_AGGREGATE ::=
1150 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1152 -- POSITIONAL_ARRAY_AGGREGATE ::=
1153 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1154 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1155 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1157 -- NAMED_ARRAY_AGGREGATE ::=
1158 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1160 -- PRIMARY ::= (EXPRESSION);
1162 -- Error recovery: can raise Error_Resync
1164 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1165 -- to Ada 2005 limited aggregates (AI-287)
1167 function P_Aggregate_Or_Paren_Expr return Node_Id is
1168 Aggregate_Node : Node_Id;
1169 Expr_List : List_Id;
1170 Assoc_List : List_Id;
1171 Expr_Node : Node_Id;
1172 Lparen_Sloc : Source_Ptr;
1173 Scan_State : Saved_Scan_State;
1176 Lparen_Sloc := Token_Ptr;
1179 -- Note: the mechanism used here of rescanning the initial expression
1180 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1181 -- out the discrete choice list.
1183 -- Deal with expression and extension aggregate cases first
1185 if Token /= Tok_Others then
1186 Save_Scan_State (Scan_State); -- at start of expression
1188 -- Deal with (NULL RECORD) case
1190 if Token = Tok_Null then
1193 if Token = Tok_Record then
1194 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1195 Set_Null_Record_Present (Aggregate_Node, True);
1196 Scan; -- past RECORD
1198 return Aggregate_Node;
1200 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1204 -- Ada 2005 (AI-287): The box notation is allowed only with named
1205 -- notation because positional notation might be error prone. For
1206 -- example, in "(X, <>, Y, <>)", there is no type associated with
1207 -- the boxes, so you might not be leaving out the components you
1208 -- thought you were leaving out.
1210 if Ada_Version >= Ada_05 and then Token = Tok_Box then
1211 Error_Msg_SC ("(Ada 2005) box notation only allowed with "
1212 & "named notation");
1214 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1215 return Aggregate_Node;
1218 Expr_Node := P_Expression_Or_Range_Attribute;
1220 -- Extension aggregate case
1222 if Token = Tok_With then
1224 if Nkind (Expr_Node) = N_Attribute_Reference
1225 and then Attribute_Name (Expr_Node) = Name_Range
1227 Bad_Range_Attribute (Sloc (Expr_Node));
1231 if Ada_Version = Ada_83 then
1232 Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1235 Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1236 Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1239 -- Deal with WITH NULL RECORD case
1241 if Token = Tok_Null then
1242 Save_Scan_State (Scan_State); -- at NULL
1245 if Token = Tok_Record then
1246 Scan; -- past RECORD
1247 Set_Null_Record_Present (Aggregate_Node, True);
1249 return Aggregate_Node;
1252 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1256 if Token /= Tok_Others then
1257 Save_Scan_State (Scan_State);
1258 Expr_Node := P_Expression;
1265 elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1266 if Nkind (Expr_Node) = N_Attribute_Reference
1267 and then Attribute_Name (Expr_Node) = Name_Range
1270 ("|parentheses not allowed for range attribute", Lparen_Sloc);
1271 Scan; -- past right paren
1275 -- Bump paren count of expression
1277 if Expr_Node /= Error then
1278 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1281 T_Right_Paren; -- past right paren (error message if none)
1284 -- Normal aggregate case
1287 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1293 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1297 -- Prepare to scan list of component associations
1299 Expr_List := No_List; -- don't set yet, maybe all named entries
1300 Assoc_List := No_List; -- don't set yet, maybe all positional entries
1302 -- This loop scans through component associations. On entry to the
1303 -- loop, an expression has been scanned at the start of the current
1304 -- association unless initial token was OTHERS, in which case
1305 -- Expr_Node is set to Empty.
1308 -- Deal with others association first. This is a named association
1310 if No (Expr_Node) then
1311 if No (Assoc_List) then
1312 Assoc_List := New_List;
1315 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1317 -- Improper use of WITH
1319 elsif Token = Tok_With then
1320 Error_Msg_SC ("WITH must be preceded by single expression in " &
1321 "extension aggregate");
1324 -- A range attribute can only appear as part of a discrete choice
1327 elsif Nkind (Expr_Node) = N_Attribute_Reference
1328 and then Attribute_Name (Expr_Node) = Name_Range
1329 and then Token /= Tok_Arrow
1330 and then Token /= Tok_Vertical_Bar
1332 Bad_Range_Attribute (Sloc (Expr_Node));
1335 -- Assume positional case if comma, right paren, or literal or
1336 -- identifier or OTHERS follows (the latter cases are missing
1337 -- comma cases). Also assume positional if a semicolon follows,
1338 -- which can happen if there are missing parens
1340 elsif Token = Tok_Comma
1341 or else Token = Tok_Right_Paren
1342 or else Token = Tok_Others
1343 or else Token in Token_Class_Lit_Or_Name
1344 or else Token = Tok_Semicolon
1346 if Present (Assoc_List) then
1348 ("""='>"" expected (positional association cannot follow " &
1349 "named association)");
1352 if No (Expr_List) then
1353 Expr_List := New_List;
1356 Append (Expr_Node, Expr_List);
1358 -- Anything else is assumed to be a named association
1361 Restore_Scan_State (Scan_State); -- to start of expression
1363 if No (Assoc_List) then
1364 Assoc_List := New_List;
1367 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1370 exit when not Comma_Present;
1372 -- If we are at an expression terminator, something is seriously
1373 -- wrong, so let's get out now, before we start eating up stuff
1374 -- that doesn't belong to us!
1376 if Token in Token_Class_Eterm then
1377 Error_Msg_AP ("expecting expression or component association");
1381 -- Otherwise initiate for reentry to top of loop by scanning an
1382 -- initial expression, unless the first token is OTHERS.
1384 if Token = Tok_Others then
1387 Save_Scan_State (Scan_State); -- at start of expression
1388 Expr_Node := P_Expression_Or_Range_Attribute;
1393 -- All component associations (positional and named) have been scanned
1396 Set_Expressions (Aggregate_Node, Expr_List);
1397 Set_Component_Associations (Aggregate_Node, Assoc_List);
1398 return Aggregate_Node;
1399 end P_Aggregate_Or_Paren_Expr;
1401 ------------------------------------------------
1402 -- 4.3 Record or Array Component Association --
1403 ------------------------------------------------
1405 -- RECORD_COMPONENT_ASSOCIATION ::=
1406 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1407 -- | COMPONENT_CHOICE_LIST => <>
1409 -- COMPONENT_CHOICE_LIST =>
1410 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1413 -- ARRAY_COMPONENT_ASSOCIATION ::=
1414 -- DISCRETE_CHOICE_LIST => EXPRESSION
1415 -- | DISCRETE_CHOICE_LIST => <>
1417 -- Note: this routine only handles the named cases, including others.
1418 -- Cases where the component choice list is not present have already
1419 -- been handled directly.
1421 -- Error recovery: can raise Error_Resync
1423 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1424 -- rules have been extended to give support to Ada 2005 limited
1425 -- aggregates (AI-287)
1427 function P_Record_Or_Array_Component_Association return Node_Id is
1428 Assoc_Node : Node_Id;
1431 Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1432 Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1433 Set_Sloc (Assoc_Node, Token_Ptr);
1436 if Token = Tok_Box then
1438 -- Ada 2005(AI-287): The box notation is used to indicate the
1439 -- default initialization of limited aggregate components
1441 if Ada_Version < Ada_05 then
1443 ("limited aggregate is an Ada 2005 extension");
1444 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1447 Set_Box_Present (Assoc_Node);
1450 Set_Expression (Assoc_Node, P_Expression);
1454 end P_Record_Or_Array_Component_Association;
1456 -----------------------------
1457 -- 4.3.1 Record Aggregate --
1458 -----------------------------
1460 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1461 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1463 ----------------------------------------------
1464 -- 4.3.1 Record Component Association List --
1465 ----------------------------------------------
1467 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1469 ----------------------------------
1470 -- 4.3.1 Component Choice List --
1471 ----------------------------------
1473 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1475 --------------------------------
1476 -- 4.3.1 Extension Aggregate --
1477 --------------------------------
1479 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1481 --------------------------
1482 -- 4.3.1 Ancestor Part --
1483 --------------------------
1485 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1487 ----------------------------
1488 -- 4.3.1 Array Aggregate --
1489 ----------------------------
1491 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1493 ---------------------------------------
1494 -- 4.3.1 Positional Array Aggregate --
1495 ---------------------------------------
1497 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1499 ----------------------------------
1500 -- 4.3.1 Named Array Aggregate --
1501 ----------------------------------
1503 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1505 ----------------------------------------
1506 -- 4.3.1 Array Component Association --
1507 ----------------------------------------
1509 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1511 ---------------------
1512 -- 4.4 Expression --
1513 ---------------------
1516 -- RELATION {and RELATION} | RELATION {and then RELATION}
1517 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1518 -- | RELATION {xor RELATION}
1520 -- On return, Expr_Form indicates the categorization of the expression
1521 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1522 -- an error message is given, and Error is returned).
1524 -- Error recovery: cannot raise Error_Resync
1526 function P_Expression return Node_Id is
1527 Logical_Op : Node_Kind;
1528 Prev_Logical_Op : Node_Kind;
1529 Op_Location : Source_Ptr;
1534 Node1 := P_Relation;
1536 if Token in Token_Class_Logop then
1537 Prev_Logical_Op := N_Empty;
1540 Op_Location := Token_Ptr;
1541 Logical_Op := P_Logical_Operator;
1543 if Prev_Logical_Op /= N_Empty and then
1544 Logical_Op /= Prev_Logical_Op
1547 ("mixed logical operators in expression", Op_Location);
1548 Prev_Logical_Op := N_Empty;
1550 Prev_Logical_Op := Logical_Op;
1554 Node1 := New_Node (Logical_Op, Op_Location);
1555 Set_Left_Opnd (Node1, Node2);
1556 Set_Right_Opnd (Node1, P_Relation);
1557 Set_Op_Name (Node1);
1558 exit when Token not in Token_Class_Logop;
1561 Expr_Form := EF_Non_Simple;
1564 if Token = Tok_Apostrophe then
1565 Bad_Range_Attribute (Token_Ptr);
1572 -- This function is identical to the normal P_Expression, except that it
1573 -- checks that the expression scan did not stop on a right paren. It is
1574 -- called in all contexts where a right parenthesis cannot legitimately
1575 -- follow an expression.
1577 -- Error recovery: can not raise Error_Resync
1579 function P_Expression_No_Right_Paren return Node_Id is
1580 Expr : constant Node_Id := P_Expression;
1582 Check_No_Right_Paren;
1584 end P_Expression_No_Right_Paren;
1586 ----------------------------------------
1587 -- 4.4 Expression_Or_Range_Attribute --
1588 ----------------------------------------
1591 -- RELATION {and RELATION} | RELATION {and then RELATION}
1592 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1593 -- | RELATION {xor RELATION}
1595 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1597 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1599 -- On return, Expr_Form indicates the categorization of the expression
1600 -- and EF_Range_Attr is one of the possibilities.
1602 -- Error recovery: cannot raise Error_Resync
1604 -- In the grammar, a RANGE attribute is simply a name, but its use is
1605 -- highly restricted, so in the parser, we do not regard it as a name.
1606 -- Instead, P_Name returns without scanning the 'RANGE part of the
1607 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1608 -- attribute reference. In the normal case where a range attribute is
1609 -- not allowed, an error message is issued by P_Expression.
1611 function P_Expression_Or_Range_Attribute return Node_Id is
1612 Logical_Op : Node_Kind;
1613 Prev_Logical_Op : Node_Kind;
1614 Op_Location : Source_Ptr;
1617 Attr_Node : Node_Id;
1620 Node1 := P_Relation;
1622 if Token = Tok_Apostrophe then
1623 Attr_Node := P_Range_Attribute_Reference (Node1);
1624 Expr_Form := EF_Range_Attr;
1627 elsif Token in Token_Class_Logop then
1628 Prev_Logical_Op := N_Empty;
1631 Op_Location := Token_Ptr;
1632 Logical_Op := P_Logical_Operator;
1634 if Prev_Logical_Op /= N_Empty and then
1635 Logical_Op /= Prev_Logical_Op
1638 ("mixed logical operators in expression", Op_Location);
1639 Prev_Logical_Op := N_Empty;
1641 Prev_Logical_Op := Logical_Op;
1645 Node1 := New_Node (Logical_Op, Op_Location);
1646 Set_Left_Opnd (Node1, Node2);
1647 Set_Right_Opnd (Node1, P_Relation);
1648 Set_Op_Name (Node1);
1649 exit when Token not in Token_Class_Logop;
1652 Expr_Form := EF_Non_Simple;
1655 if Token = Tok_Apostrophe then
1656 Bad_Range_Attribute (Token_Ptr);
1661 end P_Expression_Or_Range_Attribute;
1668 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1669 -- | SIMPLE_EXPRESSION [not] in RANGE
1670 -- | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1672 -- On return, Expr_Form indicates the categorization of the expression
1674 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1675 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1677 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1678 -- expression, then tokens are scanned until either a non-expression token,
1679 -- a right paren (not matched by a left paren) or a comma, is encountered.
1681 function P_Relation return Node_Id is
1682 Node1, Node2 : Node_Id;
1686 Node1 := P_Simple_Expression;
1688 if Token not in Token_Class_Relop then
1692 -- Here we have a relational operator following. If so then scan it
1693 -- out. Note that the assignment symbol := is treated as a relational
1694 -- operator to improve the error recovery when it is misused for =.
1695 -- P_Relational_Operator also parses the IN and NOT IN operations.
1698 Node2 := New_Node (P_Relational_Operator, Optok);
1699 Set_Left_Opnd (Node2, Node1);
1700 Set_Op_Name (Node2);
1702 -- Case of IN or NOT IN
1704 if Prev_Token = Tok_In then
1705 Set_Right_Opnd (Node2, P_Range_Or_Subtype_Mark);
1707 -- Case of relational operator (= /= < <= > >=)
1710 Set_Right_Opnd (Node2, P_Simple_Expression);
1713 Expr_Form := EF_Non_Simple;
1715 if Token in Token_Class_Relop then
1716 Error_Msg_SC ("unexpected relational operator");
1723 -- If any error occurs, then scan to the next expression terminator symbol
1724 -- or comma or right paren at the outer (i.e. current) parentheses level.
1725 -- The flags are set to indicate a normal simple expression.
1728 when Error_Resync =>
1730 Expr_Form := EF_Simple;
1734 ----------------------------
1735 -- 4.4 Simple Expression --
1736 ----------------------------
1738 -- SIMPLE_EXPRESSION ::=
1739 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1741 -- On return, Expr_Form indicates the categorization of the expression
1743 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1744 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1746 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1747 -- expression, then tokens are scanned until either a non-expression token,
1748 -- a right paren (not matched by a left paren) or a comma, is encountered.
1750 -- Note: P_Simple_Expression is called only internally by higher level
1751 -- expression routines. In cases in the grammar where a simple expression
1752 -- is required, the approach is to scan an expression, and then post an
1753 -- appropriate error message if the expression obtained is not simple. This
1754 -- gives better error recovery and treatment.
1756 function P_Simple_Expression return Node_Id is
1757 Scan_State : Saved_Scan_State;
1760 Tokptr : Source_Ptr;
1763 -- Check for cases starting with a name. There are two reasons for
1764 -- special casing. First speed things up by catching a common case
1765 -- without going through several routine layers. Second the caller must
1766 -- be informed via Expr_Form when the simple expression is a name.
1768 if Token in Token_Class_Name then
1771 -- Deal with apostrophe cases
1773 if Token = Tok_Apostrophe then
1774 Save_Scan_State (Scan_State); -- at apostrophe
1775 Scan; -- past apostrophe
1777 -- If qualified expression, scan it out and fall through
1779 if Token = Tok_Left_Paren then
1780 Node1 := P_Qualified_Expression (Node1);
1781 Expr_Form := EF_Simple;
1783 -- If range attribute, then we return with Token pointing to the
1784 -- apostrophe. Note: avoid the normal error check on exit. We
1785 -- know that the expression really is complete in this case!
1787 else -- Token = Tok_Range then
1788 Restore_Scan_State (Scan_State); -- to apostrophe
1789 Expr_Form := EF_Simple_Name;
1794 -- If an expression terminator follows, the previous processing
1795 -- completely scanned out the expression (a common case), and
1796 -- left Expr_Form set appropriately for returning to our caller.
1798 if Token in Token_Class_Sterm then
1801 -- If we do not have an expression terminator, then complete the
1802 -- scan of a simple expression. This code duplicates the code
1803 -- found in P_Term and P_Factor.
1806 if Token = Tok_Double_Asterisk then
1808 Style.Check_Exponentiation_Operator;
1811 Node2 := New_Node (N_Op_Expon, Token_Ptr);
1813 Set_Left_Opnd (Node2, Node1);
1814 Set_Right_Opnd (Node2, P_Primary);
1815 Set_Op_Name (Node2);
1820 exit when Token not in Token_Class_Mulop;
1821 Tokptr := Token_Ptr;
1822 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1825 Style.Check_Binary_Operator;
1828 Scan; -- past operator
1829 Set_Left_Opnd (Node2, Node1);
1830 Set_Right_Opnd (Node2, P_Factor);
1831 Set_Op_Name (Node2);
1836 exit when Token not in Token_Class_Binary_Addop;
1837 Tokptr := Token_Ptr;
1838 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1841 Style.Check_Binary_Operator;
1844 Scan; -- past operator
1845 Set_Left_Opnd (Node2, Node1);
1846 Set_Right_Opnd (Node2, P_Term);
1847 Set_Op_Name (Node2);
1851 Expr_Form := EF_Simple;
1854 -- Cases where simple expression does not start with a name
1857 -- Scan initial sign and initial Term
1859 if Token in Token_Class_Unary_Addop then
1860 Tokptr := Token_Ptr;
1861 Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
1864 Style.Check_Unary_Plus_Or_Minus;
1867 Scan; -- past operator
1868 Set_Right_Opnd (Node1, P_Term);
1869 Set_Op_Name (Node1);
1874 -- In the following, we special-case a sequence of concatentations of
1875 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
1876 -- else mixed in. For such a sequence, we return a tree representing
1877 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
1878 -- the number of concatenations is large. If semantic analysis
1879 -- resolves the "&" to a predefined one, then this folding gives the
1880 -- right answer. Otherwise, semantic analysis will complain about a
1881 -- capacity-exceeded error. The purpose of this trick is to avoid
1882 -- creating a deeply nested tree, which would cause deep recursion
1883 -- during semantics, causing stack overflow. This way, we can handle
1884 -- enormous concatenations in the normal case of predefined "&". We
1885 -- first build up the normal tree, and then rewrite it if
1889 Num_Concats_Threshold : constant Positive := 1000;
1890 -- Arbitrary threshold value to enable optimization
1892 First_Node : constant Node_Id := Node1;
1893 Is_Strlit_Concat : Boolean;
1894 -- True iff we've parsed a sequence of concatenations of string
1895 -- literals, with nothing else mixed in.
1897 Num_Concats : Natural;
1898 -- Number of "&" operators if Is_Strlit_Concat is True
1902 Nkind (Node1) = N_String_Literal
1903 and then Token = Tok_Ampersand;
1906 -- Scan out sequence of terms separated by binary adding operators
1909 exit when Token not in Token_Class_Binary_Addop;
1910 Tokptr := Token_Ptr;
1911 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1912 Scan; -- past operator
1913 Set_Left_Opnd (Node2, Node1);
1915 Set_Right_Opnd (Node2, Node1);
1916 Set_Op_Name (Node2);
1918 -- Check if we're still concatenating string literals
1922 and then Nkind (Node2) = N_Op_Concat
1923 and then Nkind (Node1) = N_String_Literal;
1925 if Is_Strlit_Concat then
1926 Num_Concats := Num_Concats + 1;
1932 -- If we have an enormous series of concatenations of string
1933 -- literals, rewrite as explained above. The Is_Folded_In_Parser
1934 -- flag tells semantic analysis that if the "&" is not predefined,
1935 -- the folded value is wrong.
1938 and then Num_Concats >= Num_Concats_Threshold
1941 Empty_String_Val : String_Id;
1944 Strlit_Concat_Val : String_Id;
1945 -- Contains the folded value (which will be correct if the
1946 -- "&" operators are the predefined ones).
1949 -- For walking up the tree
1952 -- Folded node to replace Node1
1954 Loc : constant Source_Ptr := Sloc (First_Node);
1957 -- Walk up the tree starting at the leftmost string literal
1958 -- (First_Node), building up the Strlit_Concat_Val as we
1959 -- go. Note that we do not use recursion here -- the whole
1960 -- point is to avoid recursively walking that enormous tree.
1963 Store_String_Chars (Strval (First_Node));
1965 Cur_Node := Parent (First_Node);
1966 while Present (Cur_Node) loop
1967 pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
1968 Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
1970 Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
1971 Cur_Node := Parent (Cur_Node);
1974 Strlit_Concat_Val := End_String;
1976 -- Create new folded node, and rewrite result with a concat-
1977 -- enation of an empty string literal and the folded node.
1980 Empty_String_Val := End_String;
1982 Make_Op_Concat (Loc,
1983 Make_String_Literal (Loc, Empty_String_Val),
1984 Make_String_Literal (Loc, Strlit_Concat_Val,
1985 Is_Folded_In_Parser => True));
1986 Rewrite (Node1, New_Node);
1991 -- All done, we clearly do not have name or numeric literal so this
1992 -- is a case of a simple expression which is some other possibility.
1994 Expr_Form := EF_Simple;
1997 -- Come here at end of simple expression, where we do a couple of
1998 -- special checks to improve error recovery.
2000 -- Special test to improve error recovery. If the current token
2001 -- is a period, then someone is trying to do selection on something
2002 -- that is not a name, e.g. a qualified expression.
2004 if Token = Tok_Dot then
2005 Error_Msg_SC ("prefix for selection is not a name");
2009 -- Special test to improve error recovery: If the current token is
2010 -- not the first token on a line (as determined by checking the
2011 -- previous token position with the start of the current line),
2012 -- then we insist that we have an appropriate terminating token.
2013 -- Consider the following two examples:
2015 -- 1) if A nad B then ...
2020 -- In the first example, we would like to issue a binary operator
2021 -- expected message and resynchronize to the then. In the second
2022 -- example, we do not want to issue a binary operator message, so
2023 -- that instead we will get the missing semicolon message. This
2024 -- distinction is of course a heuristic which does not always work,
2025 -- but in practice it is quite effective.
2027 -- Note: the one case in which we do not go through this circuit is
2028 -- when we have scanned a range attribute and want to return with
2029 -- Token pointing to the apostrophe. The apostrophe is not normally
2030 -- an expression terminator, and is not in Token_Class_Sterm, but
2031 -- in this special case we know that the expression is complete.
2033 if not Token_Is_At_Start_Of_Line
2034 and then Token not in Token_Class_Sterm
2036 Error_Msg_AP ("binary operator expected");
2042 -- If any error occurs, then scan to next expression terminator symbol
2043 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2044 -- level. Expr_Form is set to indicate a normal simple expression.
2047 when Error_Resync =>
2049 Expr_Form := EF_Simple;
2052 end P_Simple_Expression;
2054 -----------------------------------------------
2055 -- 4.4 Simple Expression or Range Attribute --
2056 -----------------------------------------------
2058 -- SIMPLE_EXPRESSION ::=
2059 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2061 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2063 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2065 -- Error recovery: cannot raise Error_Resync
2067 function P_Simple_Expression_Or_Range_Attribute return Node_Id is
2069 Attr_Node : Node_Id;
2072 -- We don't just want to roar ahead and call P_Simple_Expression
2073 -- here, since we want to handle the case of a parenthesized range
2074 -- attribute cleanly.
2076 if Token = Tok_Left_Paren then
2078 Lptr : constant Source_Ptr := Token_Ptr;
2079 Scan_State : Saved_Scan_State;
2082 Save_Scan_State (Scan_State);
2083 Scan; -- past left paren
2084 Sexpr := P_Simple_Expression;
2086 if Token = Tok_Apostrophe then
2087 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2088 Expr_Form := EF_Range_Attr;
2090 if Token = Tok_Right_Paren then
2091 Scan; -- scan past right paren if present
2094 Error_Msg ("parentheses not allowed for range attribute", Lptr);
2099 Restore_Scan_State (Scan_State);
2103 -- Here after dealing with parenthesized range attribute
2105 Sexpr := P_Simple_Expression;
2107 if Token = Tok_Apostrophe then
2108 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2109 Expr_Form := EF_Range_Attr;
2115 end P_Simple_Expression_Or_Range_Attribute;
2121 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2123 -- Error recovery: can raise Error_Resync
2125 function P_Term return Node_Id is
2126 Node1, Node2 : Node_Id;
2127 Tokptr : Source_Ptr;
2133 exit when Token not in Token_Class_Mulop;
2134 Tokptr := Token_Ptr;
2135 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
2136 Scan; -- past operator
2137 Set_Left_Opnd (Node2, Node1);
2138 Set_Right_Opnd (Node2, P_Factor);
2139 Set_Op_Name (Node2);
2150 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2152 -- Error recovery: can raise Error_Resync
2154 function P_Factor return Node_Id is
2159 if Token = Tok_Abs then
2160 Node1 := New_Node (N_Op_Abs, Token_Ptr);
2163 Style.Check_Abs_Not;
2167 Set_Right_Opnd (Node1, P_Primary);
2168 Set_Op_Name (Node1);
2171 elsif Token = Tok_Not then
2172 Node1 := New_Node (N_Op_Not, Token_Ptr);
2175 Style.Check_Abs_Not;
2179 Set_Right_Opnd (Node1, P_Primary);
2180 Set_Op_Name (Node1);
2186 if Token = Tok_Double_Asterisk then
2187 Node2 := New_Node (N_Op_Expon, Token_Ptr);
2189 Set_Left_Opnd (Node2, Node1);
2190 Set_Right_Opnd (Node2, P_Primary);
2191 Set_Op_Name (Node2);
2204 -- NUMERIC_LITERAL | null
2205 -- | STRING_LITERAL | AGGREGATE
2206 -- | NAME | QUALIFIED_EXPRESSION
2207 -- | ALLOCATOR | (EXPRESSION)
2209 -- Error recovery: can raise Error_Resync
2211 function P_Primary return Node_Id is
2212 Scan_State : Saved_Scan_State;
2216 -- The loop runs more than once only if misplaced pragmas are found
2221 -- Name token can start a name, call or qualified expression, all
2222 -- of which are acceptable possibilities for primary. Note also
2223 -- that string literal is included in name (as operator symbol)
2224 -- and type conversion is included in name (as indexed component).
2226 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2229 -- All done unless apostrophe follows
2231 if Token /= Tok_Apostrophe then
2234 -- Apostrophe following means that we have either just parsed
2235 -- the subtype mark of a qualified expression, or the prefix
2236 -- or a range attribute.
2238 else -- Token = Tok_Apostrophe
2239 Save_Scan_State (Scan_State); -- at apostrophe
2240 Scan; -- past apostrophe
2242 -- If range attribute, then this is always an error, since
2243 -- the only legitimate case (where the scanned expression is
2244 -- a qualified simple name) is handled at the level of the
2245 -- Simple_Expression processing. This case corresponds to a
2246 -- usage such as 3 + A'Range, which is always illegal.
2248 if Token = Tok_Range then
2249 Restore_Scan_State (Scan_State); -- to apostrophe
2250 Bad_Range_Attribute (Token_Ptr);
2253 -- If left paren, then we have a qualified expression.
2254 -- Note that P_Name guarantees that in this case, where
2255 -- Token = Tok_Apostrophe on return, the only two possible
2256 -- tokens following the apostrophe are left paren and
2257 -- RANGE, so we know we have a left paren here.
2259 else -- Token = Tok_Left_Paren
2260 return P_Qualified_Expression (Node1);
2265 -- Numeric or string literal
2267 when Tok_Integer_Literal |
2269 Tok_String_Literal =>
2271 Node1 := Token_Node;
2272 Scan; -- past number
2275 -- Left paren, starts aggregate or parenthesized expression
2277 when Tok_Left_Paren =>
2279 Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2282 if Nkind (Expr) = N_Attribute_Reference
2283 and then Attribute_Name (Expr) = Name_Range
2285 Bad_Range_Attribute (Sloc (Expr));
2300 return New_Node (N_Null, Prev_Token_Ptr);
2302 -- Pragma, not allowed here, so just skip past it
2305 P_Pragmas_Misplaced;
2307 -- Anything else is illegal as the first token of a primary, but
2308 -- we test for a reserved identifier so that it is treated nicely
2311 if Is_Reserved_Identifier then
2312 return P_Identifier;
2314 elsif Prev_Token = Tok_Comma then
2315 Error_Msg_SP ("extra "","" ignored");
2319 Error_Msg_AP ("missing operand");
2327 ---------------------------
2328 -- 4.5 Logical Operator --
2329 ---------------------------
2331 -- LOGICAL_OPERATOR ::= and | or | xor
2333 -- Note: AND THEN and OR ELSE are also treated as logical operators
2334 -- by the parser (even though they are not operators semantically)
2336 -- The value returned is the appropriate Node_Kind code for the operator
2337 -- On return, Token points to the token following the scanned operator.
2339 -- The caller has checked that the first token is a legitimate logical
2340 -- operator token (i.e. is either XOR, AND, OR).
2342 -- Error recovery: cannot raise Error_Resync
2344 function P_Logical_Operator return Node_Kind is
2346 if Token = Tok_And then
2348 Style.Check_Binary_Operator;
2353 if Token = Tok_Then then
2360 elsif Token = Tok_Or then
2362 Style.Check_Binary_Operator;
2367 if Token = Tok_Else then
2374 else -- Token = Tok_Xor
2376 Style.Check_Binary_Operator;
2382 end P_Logical_Operator;
2384 ------------------------------
2385 -- 4.5 Relational Operator --
2386 ------------------------------
2388 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2390 -- The value returned is the appropriate Node_Kind code for the operator.
2391 -- On return, Token points to the operator token, NOT past it.
2393 -- The caller has checked that the first token is a legitimate relational
2394 -- operator token (i.e. is one of the operator tokens listed above).
2396 -- Error recovery: cannot raise Error_Resync
2398 function P_Relational_Operator return Node_Kind is
2399 Op_Kind : Node_Kind;
2400 Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2401 (Tok_Less => N_Op_Lt,
2402 Tok_Equal => N_Op_Eq,
2403 Tok_Greater => N_Op_Gt,
2404 Tok_Not_Equal => N_Op_Ne,
2405 Tok_Greater_Equal => N_Op_Ge,
2406 Tok_Less_Equal => N_Op_Le,
2408 Tok_Not => N_Not_In,
2409 Tok_Box => N_Op_Ne);
2412 if Token = Tok_Box then
2413 Error_Msg_SC ("""'<'>"" should be ""/=""");
2416 Op_Kind := Relop_Node (Token);
2419 Style.Check_Binary_Operator;
2422 Scan; -- past operator token
2424 if Prev_Token = Tok_Not then
2429 end P_Relational_Operator;
2431 ---------------------------------
2432 -- 4.5 Binary Adding Operator --
2433 ---------------------------------
2435 -- BINARY_ADDING_OPERATOR ::= + | - | &
2437 -- The value returned is the appropriate Node_Kind code for the operator.
2438 -- On return, Token points to the operator token (NOT past it).
2440 -- The caller has checked that the first token is a legitimate adding
2441 -- operator token (i.e. is one of the operator tokens listed above).
2443 -- Error recovery: cannot raise Error_Resync
2445 function P_Binary_Adding_Operator return Node_Kind is
2446 Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2447 (Tok_Ampersand => N_Op_Concat,
2448 Tok_Minus => N_Op_Subtract,
2449 Tok_Plus => N_Op_Add);
2451 return Addop_Node (Token);
2452 end P_Binary_Adding_Operator;
2454 --------------------------------
2455 -- 4.5 Unary Adding Operator --
2456 --------------------------------
2458 -- UNARY_ADDING_OPERATOR ::= + | -
2460 -- The value returned is the appropriate Node_Kind code for the operator.
2461 -- On return, Token points to the operator token (NOT past it).
2463 -- The caller has checked that the first token is a legitimate adding
2464 -- operator token (i.e. is one of the operator tokens listed above).
2466 -- Error recovery: cannot raise Error_Resync
2468 function P_Unary_Adding_Operator return Node_Kind is
2469 Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2470 (Tok_Minus => N_Op_Minus,
2471 Tok_Plus => N_Op_Plus);
2473 return Addop_Node (Token);
2474 end P_Unary_Adding_Operator;
2476 -------------------------------
2477 -- 4.5 Multiplying Operator --
2478 -------------------------------
2480 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
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 multiplying
2486 -- operator token (i.e. is one of the operator tokens listed above).
2488 -- Error recovery: cannot raise Error_Resync
2490 function P_Multiplying_Operator return Node_Kind is
2491 Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2492 (Tok_Asterisk => N_Op_Multiply,
2493 Tok_Mod => N_Op_Mod,
2494 Tok_Rem => N_Op_Rem,
2495 Tok_Slash => N_Op_Divide);
2497 return Mulop_Node (Token);
2498 end P_Multiplying_Operator;
2500 --------------------------------------
2501 -- 4.5 Highest Precedence Operator --
2502 --------------------------------------
2504 -- Parsed by P_Factor (4.4)
2506 -- Note: this rule is not in fact used by the grammar at any point!
2508 --------------------------
2509 -- 4.6 Type Conversion --
2510 --------------------------
2512 -- Parsed by P_Primary as a Name (4.1)
2514 -------------------------------
2515 -- 4.7 Qualified Expression --
2516 -------------------------------
2518 -- QUALIFIED_EXPRESSION ::=
2519 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2521 -- The caller has scanned the name which is the Subtype_Mark parameter
2522 -- and scanned past the single quote following the subtype mark. The
2523 -- caller has not checked that this name is in fact appropriate for
2524 -- a subtype mark name (i.e. it is a selected component or identifier).
2526 -- Error_Recovery: cannot raise Error_Resync
2528 function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2529 Qual_Node : Node_Id;
2531 Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2532 Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2533 Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2535 end P_Qualified_Expression;
2537 --------------------
2539 --------------------
2542 -- new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2544 -- The caller has checked that the initial token is NEW
2546 -- Error recovery: can raise Error_Resync
2548 function P_Allocator return Node_Id is
2549 Alloc_Node : Node_Id;
2550 Type_Node : Node_Id;
2551 Null_Exclusion_Present : Boolean;
2554 Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2557 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2559 Null_Exclusion_Present := P_Null_Exclusion;
2560 Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
2561 Type_Node := P_Subtype_Mark_Resync;
2563 if Token = Tok_Apostrophe then
2564 Scan; -- past apostrophe
2565 Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2569 P_Subtype_Indication (Type_Node, Null_Exclusion_Present));