1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, 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 -- Attributes that cannot have arguments
37 Is_Parameterless_Attribute : constant Attribute_Class_Array :=
38 (Attribute_Body_Version => True,
39 Attribute_External_Tag => True,
40 Attribute_Img => True,
41 Attribute_Version => True,
42 Attribute_Base => True,
43 Attribute_Class => True,
44 Attribute_Stub_Type => True,
46 -- This map contains True for parameterless attributes that return a
47 -- string or a type. For those attributes, a left parenthesis after
48 -- the attribute should not be analyzed as the beginning of a parameters
49 -- list because it may denote a slice operation (X'Img (1 .. 2)) or
50 -- a type conversion (X'Class (Y)).
52 -- Note that this map designates the minimum set of attributes where a
53 -- construct in parentheses that is not an argument can appear right
54 -- after the attribute. For attributes like 'Size, we do not put them
55 -- in the map. If someone writes X'Size (3), that's illegal in any case,
56 -- but we get a better error message by parsing the (3) as an illegal
57 -- argument to the attribute, rather than some meaningless junk that
58 -- follows the attribute.
60 -----------------------
61 -- Local Subprograms --
62 -----------------------
64 function P_Aggregate_Or_Paren_Expr return Node_Id;
65 function P_Allocator return Node_Id;
66 function P_Case_Expression_Alternative return Node_Id;
67 function P_Record_Or_Array_Component_Association return Node_Id;
68 function P_Factor return Node_Id;
69 function P_Primary return Node_Id;
70 function P_Relation return Node_Id;
71 function P_Term return Node_Id;
73 function P_Binary_Adding_Operator return Node_Kind;
74 function P_Logical_Operator return Node_Kind;
75 function P_Multiplying_Operator return Node_Kind;
76 function P_Relational_Operator return Node_Kind;
77 function P_Unary_Adding_Operator return Node_Kind;
79 procedure Bad_Range_Attribute (Loc : Source_Ptr);
80 -- Called to place complaint about bad range attribute at the given
81 -- source location. Terminates by raising Error_Resync.
83 procedure P_Membership_Test (N : Node_Id);
84 -- N is the node for a N_In or N_Not_In node whose right operand has not
85 -- yet been processed. It is called just after scanning out the IN keyword.
86 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
88 function P_Range_Attribute_Reference (Prefix_Node : Node_Id) return Node_Id;
89 -- Scan a range attribute reference. The caller has scanned out the
90 -- prefix. The current token is known to be an apostrophe and the
91 -- following token is known to be RANGE.
93 -------------------------
94 -- Bad_Range_Attribute --
95 -------------------------
97 procedure Bad_Range_Attribute (Loc : Source_Ptr) is
99 Error_Msg ("range attribute cannot be used in expression!", Loc);
101 end Bad_Range_Attribute;
103 --------------------------
104 -- 4.1 Name (also 6.4) --
105 --------------------------
108 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
109 -- | INDEXED_COMPONENT | SLICE
110 -- | SELECTED_COMPONENT | ATTRIBUTE
111 -- | TYPE_CONVERSION | FUNCTION_CALL
112 -- | CHARACTER_LITERAL
114 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
116 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
118 -- EXPLICIT_DEREFERENCE ::= NAME . all
120 -- IMPLICIT_DEREFERENCE ::= NAME
122 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
124 -- SLICE ::= PREFIX (DISCRETE_RANGE)
126 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
128 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
130 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
132 -- ATTRIBUTE_DESIGNATOR ::=
133 -- IDENTIFIER [(static_EXPRESSION)]
134 -- | access | delta | digits
138 -- | function_PREFIX ACTUAL_PARAMETER_PART
140 -- ACTUAL_PARAMETER_PART ::=
141 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
143 -- PARAMETER_ASSOCIATION ::=
144 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
146 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
148 -- Note: syntactically a procedure call looks just like a function call,
149 -- so this routine is in practice used to scan out procedure calls as well.
151 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
153 -- Error recovery: can raise Error_Resync
155 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
156 -- followed by either a left paren (qualified expression case), or by
157 -- range (range attribute case). All other uses of apostrophe (i.e. all
158 -- other attributes) are handled in this routine.
160 -- Error recovery: can raise Error_Resync
162 function P_Name return Node_Id is
163 Scan_State : Saved_Scan_State;
165 Prefix_Node : Node_Id;
166 Ident_Node : Node_Id;
168 Range_Node : Node_Id;
171 Arg_List : List_Id := No_List; -- kill junk warning
172 Attr_Name : Name_Id := No_Name; -- kill junk warning
175 -- Case of not a name
177 if Token not in Token_Class_Name then
179 -- If it looks like start of expression, complain and scan expression
181 if Token in Token_Class_Literal
182 or else Token = Tok_Left_Paren
184 Error_Msg_SC ("name expected");
187 -- Otherwise some other junk, not much we can do
190 Error_Msg_AP ("name expected");
195 -- Loop through designators in qualified name
197 Name_Node := Token_Node;
200 Scan; -- past designator
201 exit when Token /= Tok_Dot;
202 Save_Scan_State (Scan_State); -- at dot
205 -- If we do not have another designator after the dot, then join
206 -- the normal circuit to handle a dot extension (may be .all or
207 -- character literal case). Otherwise loop back to scan the next
210 if Token not in Token_Class_Desig then
211 goto Scan_Name_Extension_Dot;
213 Prefix_Node := Name_Node;
214 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
215 Set_Prefix (Name_Node, Prefix_Node);
216 Set_Selector_Name (Name_Node, Token_Node);
220 -- We have now scanned out a qualified designator. If the last token is
221 -- an operator symbol, then we certainly do not have the Snam case, so
222 -- we can just use the normal name extension check circuit
224 if Prev_Token = Tok_Operator_Symbol then
225 goto Scan_Name_Extension;
228 -- We have scanned out a qualified simple name, check for name extension
229 -- Note that we know there is no dot here at this stage, so the only
230 -- possible cases of name extension are apostrophe and left paren.
232 if Token = Tok_Apostrophe then
233 Save_Scan_State (Scan_State); -- at apostrophe
234 Scan; -- past apostrophe
236 -- Qualified expression in Ada 2012 mode (treated as a name)
238 if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
239 goto Scan_Name_Extension_Apostrophe;
241 -- If left paren not in Ada 2012, then it is not part of the name,
242 -- since qualified expressions are not names in prior versions of
243 -- Ada, so return with Token backed up to point to the apostrophe.
244 -- The treatment for the range attribute is similar (we do not
245 -- consider x'range to be a name in this grammar).
247 elsif Token = Tok_Left_Paren or else Token = Tok_Range then
248 Restore_Scan_State (Scan_State); -- to apostrophe
249 Expr_Form := EF_Simple_Name;
252 -- Otherwise we have the case of a name extended by an attribute
255 goto Scan_Name_Extension_Apostrophe;
258 -- Check case of qualified simple name extended by a left parenthesis
260 elsif Token = Tok_Left_Paren then
261 Scan; -- past left paren
262 goto Scan_Name_Extension_Left_Paren;
264 -- Otherwise the qualified simple name is not extended, so return
267 Expr_Form := EF_Simple_Name;
271 -- Loop scanning past name extensions. A label is used for control
272 -- transfer for this loop for ease of interfacing with the finite state
273 -- machine in the parenthesis scanning circuit, and also to allow for
274 -- passing in control to the appropriate point from the above code.
276 <<Scan_Name_Extension>>
278 -- Character literal used as name cannot be extended. Also this
279 -- cannot be a call, since the name for a call must be a designator.
280 -- Return in these cases, or if there is no name extension
282 if Token not in Token_Class_Namext
283 or else Prev_Token = Tok_Char_Literal
285 Expr_Form := EF_Name;
289 -- Merge here when we know there is a name extension
291 <<Scan_Name_Extension_OK>>
293 if Token = Tok_Left_Paren then
294 Scan; -- past left paren
295 goto Scan_Name_Extension_Left_Paren;
297 elsif Token = Tok_Apostrophe then
298 Save_Scan_State (Scan_State); -- at apostrophe
299 Scan; -- past apostrophe
300 goto Scan_Name_Extension_Apostrophe;
302 else -- Token = Tok_Dot
303 Save_Scan_State (Scan_State); -- at dot
305 goto Scan_Name_Extension_Dot;
308 -- Case of name extended by dot (selection), dot is already skipped
309 -- and the scan state at the point of the dot is saved in Scan_State.
311 <<Scan_Name_Extension_Dot>>
313 -- Explicit dereference case
315 if Token = Tok_All then
316 Prefix_Node := Name_Node;
317 Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
318 Set_Prefix (Name_Node, Prefix_Node);
320 goto Scan_Name_Extension;
322 -- Selected component case
324 elsif Token in Token_Class_Name then
325 Prefix_Node := Name_Node;
326 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
327 Set_Prefix (Name_Node, Prefix_Node);
328 Set_Selector_Name (Name_Node, Token_Node);
329 Scan; -- past selector
330 goto Scan_Name_Extension;
332 -- Reserved identifier as selector
334 elsif Is_Reserved_Identifier then
335 Scan_Reserved_Identifier (Force_Msg => False);
336 Prefix_Node := Name_Node;
337 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
338 Set_Prefix (Name_Node, Prefix_Node);
339 Set_Selector_Name (Name_Node, Token_Node);
340 Scan; -- past identifier used as selector
341 goto Scan_Name_Extension;
343 -- If dot is at end of line and followed by nothing legal,
344 -- then assume end of name and quit (dot will be taken as
345 -- an erroneous form of some other punctuation by our caller).
347 elsif Token_Is_At_Start_Of_Line then
348 Restore_Scan_State (Scan_State);
351 -- Here if nothing legal after the dot
354 Error_Msg_AP ("selector expected");
358 -- Here for an apostrophe as name extension. The scan position at the
359 -- apostrophe has already been saved, and the apostrophe scanned out.
361 <<Scan_Name_Extension_Apostrophe>>
363 Scan_Apostrophe : declare
364 function Apostrophe_Should_Be_Semicolon return Boolean;
365 -- Checks for case where apostrophe should probably be
366 -- a semicolon, and if so, gives appropriate message,
367 -- resets the scan pointer to the apostrophe, changes
368 -- the current token to Tok_Semicolon, and returns True.
369 -- Otherwise returns False.
371 ------------------------------------
372 -- Apostrophe_Should_Be_Semicolon --
373 ------------------------------------
375 function Apostrophe_Should_Be_Semicolon return Boolean is
377 if Token_Is_At_Start_Of_Line then
378 Restore_Scan_State (Scan_State); -- to apostrophe
379 Error_Msg_SC ("|""''"" should be "";""");
380 Token := Tok_Semicolon;
385 end Apostrophe_Should_Be_Semicolon;
387 -- Start of processing for Scan_Apostrophe
390 -- Check for qualified expression case in Ada 2012 mode
392 if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
393 Name_Node := P_Qualified_Expression (Name_Node);
394 goto Scan_Name_Extension;
396 -- If range attribute after apostrophe, then return with Token
397 -- pointing to the apostrophe. Note that in this case the prefix
398 -- need not be a simple name (cases like A.all'range). Similarly
399 -- if there is a left paren after the apostrophe, then we also
400 -- return with Token pointing to the apostrophe (this is the
401 -- aggregate case, or some error case).
403 elsif Token = Tok_Range or else Token = Tok_Left_Paren then
404 Restore_Scan_State (Scan_State); -- to apostrophe
405 Expr_Form := EF_Name;
408 -- Here for cases where attribute designator is an identifier
410 elsif Token = Tok_Identifier then
411 Attr_Name := Token_Name;
413 if not Is_Attribute_Name (Attr_Name) then
414 if Apostrophe_Should_Be_Semicolon then
415 Expr_Form := EF_Name;
418 -- Here for a bad attribute name
421 Signal_Bad_Attribute;
422 Scan; -- past bad identifier
424 if Token = Tok_Left_Paren then
425 Scan; -- past left paren
428 Discard_Junk_Node (P_Expression_If_OK);
429 exit when not Comma_Present;
440 Style.Check_Attribute_Name (False);
443 -- Here for case of attribute designator is not an identifier
446 if Token = Tok_Delta then
447 Attr_Name := Name_Delta;
449 elsif Token = Tok_Digits then
450 Attr_Name := Name_Digits;
452 elsif Token = Tok_Access then
453 Attr_Name := Name_Access;
455 elsif Token = Tok_Mod and then Ada_Version >= Ada_95 then
456 Attr_Name := Name_Mod;
458 elsif Apostrophe_Should_Be_Semicolon then
459 Expr_Form := EF_Name;
463 Error_Msg_AP ("attribute designator expected");
468 Style.Check_Attribute_Name (True);
472 -- We come here with an OK attribute scanned, and the
473 -- corresponding Attribute identifier node stored in Ident_Node.
475 Prefix_Node := Name_Node;
476 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
477 Scan; -- past attribute designator
478 Set_Prefix (Name_Node, Prefix_Node);
479 Set_Attribute_Name (Name_Node, Attr_Name);
481 -- Scan attribute arguments/designator. We skip this if we know
482 -- that the attribute cannot have an argument.
484 if Token = Tok_Left_Paren
486 Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
488 Set_Expressions (Name_Node, New_List);
489 Scan; -- past left paren
493 Expr : constant Node_Id := P_Expression_If_OK;
496 if Token = Tok_Arrow then
498 ("named parameters not permitted for attributes");
499 Scan; -- past junk arrow
502 Append (Expr, Expressions (Name_Node));
503 exit when not Comma_Present;
511 goto Scan_Name_Extension;
514 -- Here for left parenthesis extending name (left paren skipped)
516 <<Scan_Name_Extension_Left_Paren>>
518 -- We now have to scan through a list of items, terminated by a
519 -- right parenthesis. The scan is handled by a finite state
520 -- machine. The possibilities are:
524 -- This is a slice. This case is handled in LP_State_Init
526 -- (expression, expression, ..)
528 -- This is interpreted as an indexed component, i.e. as a
529 -- case of a name which can be extended in the normal manner.
530 -- This case is handled by LP_State_Name or LP_State_Expr.
532 -- Note: conditional expressions (without an extra level of
533 -- parentheses) are permitted in this context).
535 -- (..., identifier => expression , ...)
537 -- If there is at least one occurrence of identifier => (but
538 -- none of the other cases apply), then we have a call.
540 -- Test for Id => case
542 if Token = Tok_Identifier then
543 Save_Scan_State (Scan_State); -- at Id
546 -- Test for => (allow := as an error substitute)
548 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
549 Restore_Scan_State (Scan_State); -- to Id
550 Arg_List := New_List;
554 Restore_Scan_State (Scan_State); -- to Id
558 -- Here we have an expression after all
560 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
562 -- Check cases of discrete range for a slice
564 -- First possibility: Range_Attribute_Reference
566 if Expr_Form = EF_Range_Attr then
567 Range_Node := Expr_Node;
569 -- Second possibility: Simple_expression .. Simple_expression
571 elsif Token = Tok_Dot_Dot then
572 Check_Simple_Expression (Expr_Node);
573 Range_Node := New_Node (N_Range, Token_Ptr);
574 Set_Low_Bound (Range_Node, Expr_Node);
576 Expr_Node := P_Expression;
577 Check_Simple_Expression (Expr_Node);
578 Set_High_Bound (Range_Node, Expr_Node);
580 -- Third possibility: Type_name range Range
582 elsif Token = Tok_Range then
583 if Expr_Form /= EF_Simple_Name then
584 Error_Msg_SC ("subtype mark must precede RANGE");
588 Range_Node := P_Subtype_Indication (Expr_Node);
590 -- Otherwise we just have an expression. It is true that we might
591 -- have a subtype mark without a range constraint but this case
592 -- is syntactically indistinguishable from the expression case.
595 Arg_List := New_List;
599 -- Fall through here with unmistakable Discrete range scanned,
600 -- which means that we definitely have the case of a slice. The
601 -- Discrete range is in Range_Node.
603 if Token = Tok_Comma then
604 Error_Msg_SC ("slice cannot have more than one dimension");
607 elsif Token /= Tok_Right_Paren then
612 Scan; -- past right paren
613 Prefix_Node := Name_Node;
614 Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
615 Set_Prefix (Name_Node, Prefix_Node);
616 Set_Discrete_Range (Name_Node, Range_Node);
618 -- An operator node is legal as a prefix to other names,
619 -- but not for a slice.
621 if Nkind (Prefix_Node) = N_Operator_Symbol then
622 Error_Msg_N ("illegal prefix for slice", Prefix_Node);
625 -- If we have a name extension, go scan it
627 if Token in Token_Class_Namext then
628 goto Scan_Name_Extension_OK;
630 -- Otherwise return (a slice is a name, but is not a call)
633 Expr_Form := EF_Name;
638 -- In LP_State_Expr, we have scanned one or more expressions, and
639 -- so we have a call or an indexed component which is a name. On
640 -- entry we have the expression just scanned in Expr_Node and
641 -- Arg_List contains the list of expressions encountered so far
644 Append (Expr_Node, Arg_List);
646 if Token = Tok_Arrow then
648 ("expect identifier in parameter association",
652 elsif not Comma_Present then
654 Prefix_Node := Name_Node;
655 Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
656 Set_Prefix (Name_Node, Prefix_Node);
657 Set_Expressions (Name_Node, Arg_List);
658 goto Scan_Name_Extension;
661 -- Comma present (and scanned out), test for identifier => case
662 -- Test for identifier => case
664 if Token = Tok_Identifier then
665 Save_Scan_State (Scan_State); -- at Id
668 -- Test for => (allow := as error substitute)
670 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
671 Restore_Scan_State (Scan_State); -- to Id
674 -- Otherwise it's just an expression after all, so backup
677 Restore_Scan_State (Scan_State); -- to Id
681 -- Here we have an expression after all, so stay in this state
683 Expr_Node := P_Expression_If_OK;
686 -- LP_State_Call corresponds to the situation in which at least
687 -- one instance of Id => Expression has been encountered, so we
688 -- know that we do not have a name, but rather a call. We enter
689 -- it with the scan pointer pointing to the next argument to scan,
690 -- and Arg_List containing the list of arguments scanned so far.
694 -- Test for case of Id => Expression (named parameter)
696 if Token = Tok_Identifier then
697 Save_Scan_State (Scan_State); -- at Id
698 Ident_Node := Token_Node;
701 -- Deal with => (allow := as erroneous substitute)
703 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
704 Arg_Node := 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;
719 Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
720 Set_Name (Name_Node, Prefix_Node);
721 Set_Parameter_Associations (Name_Node, Arg_List);
724 if Token in Token_Class_Namext then
725 goto Scan_Name_Extension_OK;
727 -- This is a case of a call which cannot be a name
730 Expr_Form := EF_Name;
735 -- Not named parameter: Id started an expression after all
738 Restore_Scan_State (Scan_State); -- to Id
742 -- Here if entry did not start with Id => which means that it
743 -- is a positional parameter, which is not allowed, since we
744 -- have seen at least one named parameter already.
747 ("positional parameter association " &
748 "not allowed after named one");
750 Expr_Node := P_Expression_If_OK;
752 -- Leaving the '>' in an association is not unusual, so suggest
755 if Nkind (Expr_Node) = N_Op_Eq then
756 Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
759 -- We go back to scanning out expressions, so that we do not get
760 -- multiple error messages when several positional parameters
761 -- follow a named parameter.
765 -- End of treatment for name extensions starting with left paren
767 -- End of loop through name extensions
771 -- This function parses a restricted form of Names which are either
772 -- designators, or designators preceded by a sequence of prefixes
773 -- that are direct names.
775 -- Error recovery: cannot raise Error_Resync
777 function P_Function_Name return Node_Id is
778 Designator_Node : Node_Id;
779 Prefix_Node : Node_Id;
780 Selector_Node : Node_Id;
781 Dot_Sloc : Source_Ptr := No_Location;
784 -- Prefix_Node is set to the gathered prefix so far, Empty means that
785 -- no prefix has been scanned. This allows us to build up the result
786 -- in the required right recursive manner.
788 Prefix_Node := Empty;
790 -- Loop through prefixes
793 Designator_Node := Token_Node;
795 if Token not in Token_Class_Desig then
796 return P_Identifier; -- let P_Identifier issue the error message
798 else -- Token in Token_Class_Desig
799 Scan; -- past designator
800 exit when Token /= Tok_Dot;
803 -- Here at a dot, with token just before it in Designator_Node
805 if No (Prefix_Node) then
806 Prefix_Node := Designator_Node;
808 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
809 Set_Prefix (Selector_Node, Prefix_Node);
810 Set_Selector_Name (Selector_Node, Designator_Node);
811 Prefix_Node := Selector_Node;
814 Dot_Sloc := Token_Ptr;
818 -- Fall out of the loop having just scanned a designator
820 if No (Prefix_Node) then
821 return Designator_Node;
823 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
824 Set_Prefix (Selector_Node, Prefix_Node);
825 Set_Selector_Name (Selector_Node, Designator_Node);
826 return Selector_Node;
834 -- This function parses a restricted form of Names which are either
835 -- identifiers, or identifiers preceded by a sequence of prefixes
836 -- that are direct names.
838 -- Error recovery: cannot raise Error_Resync
840 function P_Qualified_Simple_Name return Node_Id is
841 Designator_Node : Node_Id;
842 Prefix_Node : Node_Id;
843 Selector_Node : Node_Id;
844 Dot_Sloc : Source_Ptr := No_Location;
847 -- Prefix node is set to the gathered prefix so far, Empty means that
848 -- no prefix has been scanned. This allows us to build up the result
849 -- in the required right recursive manner.
851 Prefix_Node := Empty;
853 -- Loop through prefixes
856 Designator_Node := Token_Node;
858 if Token = Tok_Identifier then
859 Scan; -- past identifier
860 exit when Token /= Tok_Dot;
862 elsif Token not in Token_Class_Desig then
863 return P_Identifier; -- let P_Identifier issue the error message
866 Scan; -- past designator
868 if Token /= Tok_Dot then
869 Error_Msg_SP ("identifier expected");
874 -- Here at a dot, with token just before it in Designator_Node
876 if No (Prefix_Node) then
877 Prefix_Node := Designator_Node;
879 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
880 Set_Prefix (Selector_Node, Prefix_Node);
881 Set_Selector_Name (Selector_Node, Designator_Node);
882 Prefix_Node := Selector_Node;
885 Dot_Sloc := Token_Ptr;
889 -- Fall out of the loop having just scanned an identifier
891 if No (Prefix_Node) then
892 return Designator_Node;
894 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
895 Set_Prefix (Selector_Node, Prefix_Node);
896 Set_Selector_Name (Selector_Node, Designator_Node);
897 return Selector_Node;
903 end P_Qualified_Simple_Name;
905 -- This procedure differs from P_Qualified_Simple_Name only in that it
906 -- raises Error_Resync if any error is encountered. It only returns after
907 -- scanning a valid qualified simple name.
909 -- Error recovery: can raise Error_Resync
911 function P_Qualified_Simple_Name_Resync return Node_Id is
912 Designator_Node : Node_Id;
913 Prefix_Node : Node_Id;
914 Selector_Node : Node_Id;
915 Dot_Sloc : Source_Ptr := No_Location;
918 Prefix_Node := Empty;
920 -- Loop through prefixes
923 Designator_Node := Token_Node;
925 if Token = Tok_Identifier then
926 Scan; -- past identifier
927 exit when Token /= Tok_Dot;
929 elsif Token not in Token_Class_Desig then
930 Discard_Junk_Node (P_Identifier); -- to issue the error message
934 Scan; -- past designator
936 if Token /= Tok_Dot then
937 Error_Msg_SP ("identifier expected");
942 -- Here at a dot, with token just before it in Designator_Node
944 if No (Prefix_Node) then
945 Prefix_Node := Designator_Node;
947 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
948 Set_Prefix (Selector_Node, Prefix_Node);
949 Set_Selector_Name (Selector_Node, Designator_Node);
950 Prefix_Node := Selector_Node;
953 Dot_Sloc := Token_Ptr;
957 -- Fall out of the loop having just scanned an identifier
959 if No (Prefix_Node) then
960 return Designator_Node;
962 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
963 Set_Prefix (Selector_Node, Prefix_Node);
964 Set_Selector_Name (Selector_Node, Designator_Node);
965 return Selector_Node;
967 end P_Qualified_Simple_Name_Resync;
969 ----------------------
970 -- 4.1 Direct_Name --
971 ----------------------
973 -- Parsed by P_Name and other functions in section 4.1
979 -- Parsed by P_Name (4.1)
981 -------------------------------
982 -- 4.1 Explicit Dereference --
983 -------------------------------
985 -- Parsed by P_Name (4.1)
987 -------------------------------
988 -- 4.1 Implicit_Dereference --
989 -------------------------------
991 -- Parsed by P_Name (4.1)
993 ----------------------------
994 -- 4.1 Indexed Component --
995 ----------------------------
997 -- Parsed by P_Name (4.1)
1003 -- Parsed by P_Name (4.1)
1005 -----------------------------
1006 -- 4.1 Selected_Component --
1007 -----------------------------
1009 -- Parsed by P_Name (4.1)
1011 ------------------------
1012 -- 4.1 Selector Name --
1013 ------------------------
1015 -- Parsed by P_Name (4.1)
1017 ------------------------------
1018 -- 4.1 Attribute Reference --
1019 ------------------------------
1021 -- Parsed by P_Name (4.1)
1023 -------------------------------
1024 -- 4.1 Attribute Designator --
1025 -------------------------------
1027 -- Parsed by P_Name (4.1)
1029 --------------------------------------
1030 -- 4.1.4 Range Attribute Reference --
1031 --------------------------------------
1033 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1035 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1037 -- In the grammar, a RANGE attribute is simply a name, but its use is
1038 -- highly restricted, so in the parser, we do not regard it as a name.
1039 -- Instead, P_Name returns without scanning the 'RANGE part of the
1040 -- attribute, and the caller uses the following function to construct
1041 -- a range attribute in places where it is appropriate.
1043 -- Note that RANGE here is treated essentially as an identifier,
1044 -- rather than a reserved word.
1046 -- The caller has parsed the prefix, i.e. a name, and Token points to
1047 -- the apostrophe. The token after the apostrophe is known to be RANGE
1048 -- at this point. The prefix node becomes the prefix of the attribute.
1050 -- Error_Recovery: Cannot raise Error_Resync
1052 function P_Range_Attribute_Reference
1053 (Prefix_Node : Node_Id)
1056 Attr_Node : Node_Id;
1059 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1060 Set_Prefix (Attr_Node, Prefix_Node);
1061 Scan; -- past apostrophe
1064 Style.Check_Attribute_Name (True);
1067 Set_Attribute_Name (Attr_Node, Name_Range);
1070 if Token = Tok_Left_Paren then
1071 Scan; -- past left paren
1072 Set_Expressions (Attr_Node, New_List (P_Expression_If_OK));
1077 end P_Range_Attribute_Reference;
1079 ---------------------------------------
1080 -- 4.1.4 Range Attribute Designator --
1081 ---------------------------------------
1083 -- Parsed by P_Range_Attribute_Reference (4.4)
1085 --------------------
1087 --------------------
1089 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1091 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1092 -- an aggregate is known to be required (code statement, extension
1093 -- aggregate), in which cases this routine performs the necessary check
1094 -- that we have an aggregate rather than a parenthesized expression
1096 -- Error recovery: can raise Error_Resync
1098 function P_Aggregate return Node_Id is
1099 Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1100 Aggr_Node : constant Node_Id := P_Aggregate_Or_Paren_Expr;
1103 if Nkind (Aggr_Node) /= N_Aggregate
1105 Nkind (Aggr_Node) /= N_Extension_Aggregate
1108 ("aggregate may not have single positional component", Aggr_Sloc);
1115 ------------------------------------------------
1116 -- 4.3 Aggregate or Parenthesized Expression --
1117 ------------------------------------------------
1119 -- This procedure parses out either an aggregate or a parenthesized
1120 -- expression (these two constructs are closely related, since a
1121 -- parenthesized expression looks like an aggregate with a single
1122 -- positional component).
1125 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1127 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1129 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1130 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1133 -- RECORD_COMPONENT_ASSOCIATION ::=
1134 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1136 -- COMPONENT_CHOICE_LIST ::=
1137 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1140 -- EXTENSION_AGGREGATE ::=
1141 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1143 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1145 -- ARRAY_AGGREGATE ::=
1146 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1148 -- POSITIONAL_ARRAY_AGGREGATE ::=
1149 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1150 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1151 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1153 -- NAMED_ARRAY_AGGREGATE ::=
1154 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1156 -- PRIMARY ::= (EXPRESSION);
1158 -- Error recovery: can raise Error_Resync
1160 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1161 -- to Ada 2005 limited aggregates (AI-287)
1163 function P_Aggregate_Or_Paren_Expr return Node_Id is
1164 Aggregate_Node : Node_Id;
1165 Expr_List : List_Id;
1166 Assoc_List : List_Id;
1167 Expr_Node : Node_Id;
1168 Lparen_Sloc : Source_Ptr;
1169 Scan_State : Saved_Scan_State;
1171 procedure Box_Error;
1172 -- Called if <> is encountered as positional aggregate element. Issues
1173 -- error message and sets Expr_Node to Error.
1179 procedure Box_Error is
1181 if Ada_Version < Ada_2005 then
1182 Error_Msg_SC ("box in aggregate is an Ada 2005 extension");
1185 -- Ada 2005 (AI-287): The box notation is allowed only with named
1186 -- notation because positional notation might be error prone. For
1187 -- example, in "(X, <>, Y, <>)", there is no type associated with
1188 -- the boxes, so you might not be leaving out the components you
1189 -- thought you were leaving out.
1191 Error_Msg_SC ("(Ada 2005) box only allowed with named notation");
1196 -- Start of processsing for P_Aggregate_Or_Paren_Expr
1199 Lparen_Sloc := Token_Ptr;
1202 -- Conditional expression case
1204 if Token = Tok_If then
1205 Expr_Node := P_Conditional_Expression;
1209 -- Case expression case
1211 elsif Token = Tok_Case then
1212 Expr_Node := P_Case_Expression;
1216 -- Note: the mechanism used here of rescanning the initial expression
1217 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1218 -- out the discrete choice list.
1220 -- Deal with expression and extension aggregate cases first
1222 elsif Token /= Tok_Others then
1223 Save_Scan_State (Scan_State); -- at start of expression
1225 -- Deal with (NULL RECORD) case
1227 if Token = Tok_Null then
1230 if Token = Tok_Record then
1231 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1232 Set_Null_Record_Present (Aggregate_Node, True);
1233 Scan; -- past RECORD
1235 return Aggregate_Node;
1237 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1241 -- Scan expression, handling box appearing as positional argument
1243 if Token = Tok_Box then
1246 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1249 -- Extension aggregate case
1251 if Token = Tok_With then
1252 if Nkind (Expr_Node) = N_Attribute_Reference
1253 and then Attribute_Name (Expr_Node) = Name_Range
1255 Bad_Range_Attribute (Sloc (Expr_Node));
1259 if Ada_Version = Ada_83 then
1260 Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1263 Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1264 Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1267 -- Deal with WITH NULL RECORD case
1269 if Token = Tok_Null then
1270 Save_Scan_State (Scan_State); -- at NULL
1273 if Token = Tok_Record then
1274 Scan; -- past RECORD
1275 Set_Null_Record_Present (Aggregate_Node, True);
1277 return Aggregate_Node;
1280 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1284 if Token /= Tok_Others then
1285 Save_Scan_State (Scan_State);
1286 Expr_Node := P_Expression;
1293 elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1294 if Nkind (Expr_Node) = N_Attribute_Reference
1295 and then Attribute_Name (Expr_Node) = Name_Range
1298 ("|parentheses not allowed for range attribute", Lparen_Sloc);
1299 Scan; -- past right paren
1303 -- Bump paren count of expression
1305 if Expr_Node /= Error then
1306 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1309 T_Right_Paren; -- past right paren (error message if none)
1312 -- Normal aggregate case
1315 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1321 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1325 -- Prepare to scan list of component associations
1327 Expr_List := No_List; -- don't set yet, maybe all named entries
1328 Assoc_List := No_List; -- don't set yet, maybe all positional entries
1330 -- This loop scans through component associations. On entry to the
1331 -- loop, an expression has been scanned at the start of the current
1332 -- association unless initial token was OTHERS, in which case
1333 -- Expr_Node is set to Empty.
1336 -- Deal with others association first. This is a named association
1338 if No (Expr_Node) then
1339 if No (Assoc_List) then
1340 Assoc_List := New_List;
1343 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1345 -- Improper use of WITH
1347 elsif Token = Tok_With then
1348 Error_Msg_SC ("WITH must be preceded by single expression in " &
1349 "extension aggregate");
1352 -- Range attribute can only appear as part of a discrete choice list
1354 elsif Nkind (Expr_Node) = N_Attribute_Reference
1355 and then Attribute_Name (Expr_Node) = Name_Range
1356 and then Token /= Tok_Arrow
1357 and then Token /= Tok_Vertical_Bar
1359 Bad_Range_Attribute (Sloc (Expr_Node));
1362 -- Assume positional case if comma, right paren, or literal or
1363 -- identifier or OTHERS follows (the latter cases are missing
1364 -- comma cases). Also assume positional if a semicolon follows,
1365 -- which can happen if there are missing parens
1367 elsif Token = Tok_Comma
1368 or else Token = Tok_Right_Paren
1369 or else Token = Tok_Others
1370 or else Token in Token_Class_Lit_Or_Name
1371 or else Token = Tok_Semicolon
1373 if Present (Assoc_List) then
1374 Error_Msg_BC -- CODEFIX
1375 ("""='>"" expected (positional association cannot follow " &
1376 "named association)");
1379 if No (Expr_List) then
1380 Expr_List := New_List;
1383 Append (Expr_Node, Expr_List);
1385 -- Check for aggregate followed by left parent, maybe missing comma
1387 elsif Nkind (Expr_Node) = N_Aggregate
1388 and then Token = Tok_Left_Paren
1392 if No (Expr_List) then
1393 Expr_List := New_List;
1396 Append (Expr_Node, Expr_List);
1398 -- Anything else is assumed to be a named association
1401 Restore_Scan_State (Scan_State); -- to start of expression
1403 if No (Assoc_List) then
1404 Assoc_List := New_List;
1407 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1410 exit when not Comma_Present;
1412 -- If we are at an expression terminator, something is seriously
1413 -- wrong, so let's get out now, before we start eating up stuff
1414 -- that doesn't belong to us!
1416 if Token in Token_Class_Eterm then
1417 Error_Msg_AP ("expecting expression or component association");
1421 -- Deal with misused box
1423 if Token = Tok_Box then
1426 -- Otherwise initiate for reentry to top of loop by scanning an
1427 -- initial expression, unless the first token is OTHERS.
1429 elsif Token = Tok_Others then
1433 Save_Scan_State (Scan_State); -- at start of expression
1434 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1439 -- All component associations (positional and named) have been scanned
1442 Set_Expressions (Aggregate_Node, Expr_List);
1443 Set_Component_Associations (Aggregate_Node, Assoc_List);
1444 return Aggregate_Node;
1445 end P_Aggregate_Or_Paren_Expr;
1447 ------------------------------------------------
1448 -- 4.3 Record or Array Component Association --
1449 ------------------------------------------------
1451 -- RECORD_COMPONENT_ASSOCIATION ::=
1452 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1453 -- | COMPONENT_CHOICE_LIST => <>
1455 -- COMPONENT_CHOICE_LIST =>
1456 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1459 -- ARRAY_COMPONENT_ASSOCIATION ::=
1460 -- DISCRETE_CHOICE_LIST => EXPRESSION
1461 -- | DISCRETE_CHOICE_LIST => <>
1463 -- Note: this routine only handles the named cases, including others.
1464 -- Cases where the component choice list is not present have already
1465 -- been handled directly.
1467 -- Error recovery: can raise Error_Resync
1469 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1470 -- rules have been extended to give support to Ada 2005 limited
1471 -- aggregates (AI-287)
1473 function P_Record_Or_Array_Component_Association return Node_Id is
1474 Assoc_Node : Node_Id;
1477 Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1478 Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1479 Set_Sloc (Assoc_Node, Token_Ptr);
1482 if Token = Tok_Box then
1484 -- Ada 2005(AI-287): The box notation is used to indicate the
1485 -- default initialization of aggregate components
1487 if Ada_Version < Ada_05 then
1489 ("component association with '<'> is an Ada 2005 extension");
1490 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1493 Set_Box_Present (Assoc_Node);
1496 Set_Expression (Assoc_Node, P_Expression);
1500 end P_Record_Or_Array_Component_Association;
1502 -----------------------------
1503 -- 4.3.1 Record Aggregate --
1504 -----------------------------
1506 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1507 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1509 ----------------------------------------------
1510 -- 4.3.1 Record Component Association List --
1511 ----------------------------------------------
1513 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1515 ----------------------------------
1516 -- 4.3.1 Component Choice List --
1517 ----------------------------------
1519 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1521 --------------------------------
1522 -- 4.3.1 Extension Aggregate --
1523 --------------------------------
1525 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1527 --------------------------
1528 -- 4.3.1 Ancestor Part --
1529 --------------------------
1531 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1533 ----------------------------
1534 -- 4.3.1 Array Aggregate --
1535 ----------------------------
1537 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1539 ---------------------------------------
1540 -- 4.3.1 Positional Array Aggregate --
1541 ---------------------------------------
1543 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1545 ----------------------------------
1546 -- 4.3.1 Named Array Aggregate --
1547 ----------------------------------
1549 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1551 ----------------------------------------
1552 -- 4.3.1 Array Component Association --
1553 ----------------------------------------
1555 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1557 ---------------------
1558 -- 4.4 Expression --
1559 ---------------------
1562 -- RELATION {and RELATION} | RELATION {and then RELATION}
1563 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1564 -- | RELATION {xor RELATION}
1566 -- On return, Expr_Form indicates the categorization of the expression
1567 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1568 -- an error message is given, and Error is returned).
1570 -- Error recovery: cannot raise Error_Resync
1572 function P_Expression return Node_Id is
1573 Logical_Op : Node_Kind;
1574 Prev_Logical_Op : Node_Kind;
1575 Op_Location : Source_Ptr;
1580 Node1 := P_Relation;
1582 if Token in Token_Class_Logop then
1583 Prev_Logical_Op := N_Empty;
1586 Op_Location := Token_Ptr;
1587 Logical_Op := P_Logical_Operator;
1589 if Prev_Logical_Op /= N_Empty and then
1590 Logical_Op /= Prev_Logical_Op
1593 ("mixed logical operators in expression", Op_Location);
1594 Prev_Logical_Op := N_Empty;
1596 Prev_Logical_Op := Logical_Op;
1600 Node1 := New_Op_Node (Logical_Op, Op_Location);
1601 Set_Left_Opnd (Node1, Node2);
1602 Set_Right_Opnd (Node1, P_Relation);
1603 exit when Token not in Token_Class_Logop;
1606 Expr_Form := EF_Non_Simple;
1609 if Token = Tok_Apostrophe then
1610 Bad_Range_Attribute (Token_Ptr);
1617 -- This function is identical to the normal P_Expression, except that it
1618 -- also permits the appearence of a case of conditional expression without
1619 -- the usual surrounding parentheses.
1621 function P_Expression_If_OK return Node_Id is
1623 if Token = Tok_Case then
1624 return P_Case_Expression;
1625 elsif Token = Tok_If then
1626 return P_Conditional_Expression;
1628 return P_Expression;
1630 end P_Expression_If_OK;
1632 -- This function is identical to the normal P_Expression, except that it
1633 -- checks that the expression scan did not stop on a right paren. It is
1634 -- called in all contexts where a right parenthesis cannot legitimately
1635 -- follow an expression.
1637 -- Error recovery: can not raise Error_Resync
1639 function P_Expression_No_Right_Paren return Node_Id is
1640 Expr : constant Node_Id := P_Expression;
1642 Ignore (Tok_Right_Paren);
1644 end P_Expression_No_Right_Paren;
1646 ----------------------------------------
1647 -- 4.4 Expression_Or_Range_Attribute --
1648 ----------------------------------------
1651 -- RELATION {and RELATION} | RELATION {and then RELATION}
1652 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1653 -- | RELATION {xor RELATION}
1655 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1657 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1659 -- On return, Expr_Form indicates the categorization of the expression
1660 -- and EF_Range_Attr is one of the possibilities.
1662 -- Error recovery: cannot raise Error_Resync
1664 -- In the grammar, a RANGE attribute is simply a name, but its use is
1665 -- highly restricted, so in the parser, we do not regard it as a name.
1666 -- Instead, P_Name returns without scanning the 'RANGE part of the
1667 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1668 -- attribute reference. In the normal case where a range attribute is
1669 -- not allowed, an error message is issued by P_Expression.
1671 function P_Expression_Or_Range_Attribute return Node_Id is
1672 Logical_Op : Node_Kind;
1673 Prev_Logical_Op : Node_Kind;
1674 Op_Location : Source_Ptr;
1677 Attr_Node : Node_Id;
1680 Node1 := P_Relation;
1682 if Token = Tok_Apostrophe then
1683 Attr_Node := P_Range_Attribute_Reference (Node1);
1684 Expr_Form := EF_Range_Attr;
1687 elsif Token in Token_Class_Logop then
1688 Prev_Logical_Op := N_Empty;
1691 Op_Location := Token_Ptr;
1692 Logical_Op := P_Logical_Operator;
1694 if Prev_Logical_Op /= N_Empty and then
1695 Logical_Op /= Prev_Logical_Op
1698 ("mixed logical operators in expression", Op_Location);
1699 Prev_Logical_Op := N_Empty;
1701 Prev_Logical_Op := Logical_Op;
1705 Node1 := New_Op_Node (Logical_Op, Op_Location);
1706 Set_Left_Opnd (Node1, Node2);
1707 Set_Right_Opnd (Node1, P_Relation);
1708 exit when Token not in Token_Class_Logop;
1711 Expr_Form := EF_Non_Simple;
1714 if Token = Tok_Apostrophe then
1715 Bad_Range_Attribute (Token_Ptr);
1720 end P_Expression_Or_Range_Attribute;
1722 -- Version that allows a non-parenthesized case or conditional expression
1724 function P_Expression_Or_Range_Attribute_If_OK return Node_Id is
1726 if Token = Tok_Case then
1727 return P_Case_Expression;
1728 elsif Token = Tok_If then
1729 return P_Conditional_Expression;
1731 return P_Expression_Or_Range_Attribute;
1733 end P_Expression_Or_Range_Attribute_If_OK;
1740 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1741 -- | SIMPLE_EXPRESSION [not] in RANGE
1742 -- | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1744 -- On return, Expr_Form indicates the categorization of the expression
1746 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1747 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1749 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1750 -- expression, then tokens are scanned until either a non-expression token,
1751 -- a right paren (not matched by a left paren) or a comma, is encountered.
1753 function P_Relation return Node_Id is
1754 Node1, Node2 : Node_Id;
1758 Node1 := P_Simple_Expression;
1760 if Token not in Token_Class_Relop then
1764 -- Here we have a relational operator following. If so then scan it
1765 -- out. Note that the assignment symbol := is treated as a relational
1766 -- operator to improve the error recovery when it is misused for =.
1767 -- P_Relational_Operator also parses the IN and NOT IN operations.
1770 Node2 := New_Op_Node (P_Relational_Operator, Optok);
1771 Set_Left_Opnd (Node2, Node1);
1773 -- Case of IN or NOT IN
1775 if Prev_Token = Tok_In then
1776 P_Membership_Test (Node2);
1778 -- Case of relational operator (= /= < <= > >=)
1781 Set_Right_Opnd (Node2, P_Simple_Expression);
1784 Expr_Form := EF_Non_Simple;
1786 if Token in Token_Class_Relop then
1787 Error_Msg_SC ("unexpected relational operator");
1794 -- If any error occurs, then scan to the next expression terminator symbol
1795 -- or comma or right paren at the outer (i.e. current) parentheses level.
1796 -- The flags are set to indicate a normal simple expression.
1799 when Error_Resync =>
1801 Expr_Form := EF_Simple;
1805 ----------------------------
1806 -- 4.4 Simple Expression --
1807 ----------------------------
1809 -- SIMPLE_EXPRESSION ::=
1810 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1812 -- On return, Expr_Form indicates the categorization of the expression
1814 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1815 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1817 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1818 -- expression, then tokens are scanned until either a non-expression token,
1819 -- a right paren (not matched by a left paren) or a comma, is encountered.
1821 -- Note: P_Simple_Expression is called only internally by higher level
1822 -- expression routines. In cases in the grammar where a simple expression
1823 -- is required, the approach is to scan an expression, and then post an
1824 -- appropriate error message if the expression obtained is not simple. This
1825 -- gives better error recovery and treatment.
1827 function P_Simple_Expression return Node_Id is
1828 Scan_State : Saved_Scan_State;
1831 Tokptr : Source_Ptr;
1834 -- Check for cases starting with a name. There are two reasons for
1835 -- special casing. First speed things up by catching a common case
1836 -- without going through several routine layers. Second the caller must
1837 -- be informed via Expr_Form when the simple expression is a name.
1839 if Token in Token_Class_Name then
1842 -- Deal with apostrophe cases
1844 if Token = Tok_Apostrophe then
1845 Save_Scan_State (Scan_State); -- at apostrophe
1846 Scan; -- past apostrophe
1848 -- If qualified expression, scan it out and fall through
1850 if Token = Tok_Left_Paren then
1851 Node1 := P_Qualified_Expression (Node1);
1852 Expr_Form := EF_Simple;
1854 -- If range attribute, then we return with Token pointing to the
1855 -- apostrophe. Note: avoid the normal error check on exit. We
1856 -- know that the expression really is complete in this case!
1858 else -- Token = Tok_Range then
1859 Restore_Scan_State (Scan_State); -- to apostrophe
1860 Expr_Form := EF_Simple_Name;
1865 -- If an expression terminator follows, the previous processing
1866 -- completely scanned out the expression (a common case), and
1867 -- left Expr_Form set appropriately for returning to our caller.
1869 if Token in Token_Class_Sterm then
1872 -- If we do not have an expression terminator, then complete the
1873 -- scan of a simple expression. This code duplicates the code
1874 -- found in P_Term and P_Factor.
1877 if Token = Tok_Double_Asterisk then
1879 Style.Check_Exponentiation_Operator;
1882 Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
1884 Set_Left_Opnd (Node2, Node1);
1885 Set_Right_Opnd (Node2, P_Primary);
1890 exit when Token not in Token_Class_Mulop;
1891 Tokptr := Token_Ptr;
1892 Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
1895 Style.Check_Binary_Operator;
1898 Scan; -- past operator
1899 Set_Left_Opnd (Node2, Node1);
1900 Set_Right_Opnd (Node2, P_Factor);
1905 exit when Token not in Token_Class_Binary_Addop;
1906 Tokptr := Token_Ptr;
1907 Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
1910 Style.Check_Binary_Operator;
1913 Scan; -- past operator
1914 Set_Left_Opnd (Node2, Node1);
1915 Set_Right_Opnd (Node2, P_Term);
1919 Expr_Form := EF_Simple;
1922 -- Cases where simple expression does not start with a name
1925 -- Scan initial sign and initial Term
1927 if Token in Token_Class_Unary_Addop then
1928 Tokptr := Token_Ptr;
1929 Node1 := New_Op_Node (P_Unary_Adding_Operator, Tokptr);
1932 Style.Check_Unary_Plus_Or_Minus;
1935 Scan; -- past operator
1936 Set_Right_Opnd (Node1, P_Term);
1941 -- In the following, we special-case a sequence of concatenations of
1942 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
1943 -- else mixed in. For such a sequence, we return a tree representing
1944 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
1945 -- the number of concatenations is large. If semantic analysis
1946 -- resolves the "&" to a predefined one, then this folding gives the
1947 -- right answer. Otherwise, semantic analysis will complain about a
1948 -- capacity-exceeded error. The purpose of this trick is to avoid
1949 -- creating a deeply nested tree, which would cause deep recursion
1950 -- during semantics, causing stack overflow. This way, we can handle
1951 -- enormous concatenations in the normal case of predefined "&". We
1952 -- first build up the normal tree, and then rewrite it if
1956 Num_Concats_Threshold : constant Positive := 1000;
1957 -- Arbitrary threshold value to enable optimization
1959 First_Node : constant Node_Id := Node1;
1960 Is_Strlit_Concat : Boolean;
1961 -- True iff we've parsed a sequence of concatenations of string
1962 -- literals, with nothing else mixed in.
1964 Num_Concats : Natural;
1965 -- Number of "&" operators if Is_Strlit_Concat is True
1969 Nkind (Node1) = N_String_Literal
1970 and then Token = Tok_Ampersand;
1973 -- Scan out sequence of terms separated by binary adding operators
1976 exit when Token not in Token_Class_Binary_Addop;
1977 Tokptr := Token_Ptr;
1978 Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
1979 Scan; -- past operator
1980 Set_Left_Opnd (Node2, Node1);
1982 Set_Right_Opnd (Node2, Node1);
1984 -- Check if we're still concatenating string literals
1988 and then Nkind (Node2) = N_Op_Concat
1989 and then Nkind (Node1) = N_String_Literal;
1991 if Is_Strlit_Concat then
1992 Num_Concats := Num_Concats + 1;
1998 -- If we have an enormous series of concatenations of string
1999 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2000 -- flag tells semantic analysis that if the "&" is not predefined,
2001 -- the folded value is wrong.
2004 and then Num_Concats >= Num_Concats_Threshold
2007 Empty_String_Val : String_Id;
2010 Strlit_Concat_Val : String_Id;
2011 -- Contains the folded value (which will be correct if the
2012 -- "&" operators are the predefined ones).
2015 -- For walking up the tree
2018 -- Folded node to replace Node1
2020 Loc : constant Source_Ptr := Sloc (First_Node);
2023 -- Walk up the tree starting at the leftmost string literal
2024 -- (First_Node), building up the Strlit_Concat_Val as we
2025 -- go. Note that we do not use recursion here -- the whole
2026 -- point is to avoid recursively walking that enormous tree.
2029 Store_String_Chars (Strval (First_Node));
2031 Cur_Node := Parent (First_Node);
2032 while Present (Cur_Node) loop
2033 pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
2034 Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
2036 Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
2037 Cur_Node := Parent (Cur_Node);
2040 Strlit_Concat_Val := End_String;
2042 -- Create new folded node, and rewrite result with a concat-
2043 -- enation of an empty string literal and the folded node.
2046 Empty_String_Val := End_String;
2048 Make_Op_Concat (Loc,
2049 Make_String_Literal (Loc, Empty_String_Val),
2050 Make_String_Literal (Loc, Strlit_Concat_Val,
2051 Is_Folded_In_Parser => True));
2052 Rewrite (Node1, New_Node);
2057 -- All done, we clearly do not have name or numeric literal so this
2058 -- is a case of a simple expression which is some other possibility.
2060 Expr_Form := EF_Simple;
2063 -- Come here at end of simple expression, where we do a couple of
2064 -- special checks to improve error recovery.
2066 -- Special test to improve error recovery. If the current token
2067 -- is a period, then someone is trying to do selection on something
2068 -- that is not a name, e.g. a qualified expression.
2070 if Token = Tok_Dot then
2071 Error_Msg_SC ("prefix for selection is not a name");
2073 -- If qualified expression, comment and continue, otherwise something
2074 -- is pretty nasty so do an Error_Resync call.
2076 if Ada_Version < Ada_2012
2077 and then Nkind (Node1) = N_Qualified_Expression
2079 Error_Msg_SC ("\would be legal in Ada 2012 mode");
2085 -- Special test to improve error recovery: If the current token is
2086 -- not the first token on a line (as determined by checking the
2087 -- previous token position with the start of the current line),
2088 -- then we insist that we have an appropriate terminating token.
2089 -- Consider the following two examples:
2091 -- 1) if A nad B then ...
2096 -- In the first example, we would like to issue a binary operator
2097 -- expected message and resynchronize to the then. In the second
2098 -- example, we do not want to issue a binary operator message, so
2099 -- that instead we will get the missing semicolon message. This
2100 -- distinction is of course a heuristic which does not always work,
2101 -- but in practice it is quite effective.
2103 -- Note: the one case in which we do not go through this circuit is
2104 -- when we have scanned a range attribute and want to return with
2105 -- Token pointing to the apostrophe. The apostrophe is not normally
2106 -- an expression terminator, and is not in Token_Class_Sterm, but
2107 -- in this special case we know that the expression is complete.
2109 if not Token_Is_At_Start_Of_Line
2110 and then Token not in Token_Class_Sterm
2112 -- Normally the right error message is indeed that we expected a
2113 -- binary operator, but in the case of being between a right and left
2114 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2116 if Prev_Token = Tok_Right_Paren and then Token = Tok_Left_Paren then
2119 Error_Msg_AP ("binary operator expected");
2128 -- If any error occurs, then scan to next expression terminator symbol
2129 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2130 -- level. Expr_Form is set to indicate a normal simple expression.
2133 when Error_Resync =>
2135 Expr_Form := EF_Simple;
2137 end P_Simple_Expression;
2139 -----------------------------------------------
2140 -- 4.4 Simple Expression or Range Attribute --
2141 -----------------------------------------------
2143 -- SIMPLE_EXPRESSION ::=
2144 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2146 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2148 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2150 -- Error recovery: cannot raise Error_Resync
2152 function P_Simple_Expression_Or_Range_Attribute return Node_Id is
2154 Attr_Node : Node_Id;
2157 -- We don't just want to roar ahead and call P_Simple_Expression
2158 -- here, since we want to handle the case of a parenthesized range
2159 -- attribute cleanly.
2161 if Token = Tok_Left_Paren then
2163 Lptr : constant Source_Ptr := Token_Ptr;
2164 Scan_State : Saved_Scan_State;
2167 Save_Scan_State (Scan_State);
2168 Scan; -- past left paren
2169 Sexpr := P_Simple_Expression;
2171 if Token = Tok_Apostrophe then
2172 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2173 Expr_Form := EF_Range_Attr;
2175 if Token = Tok_Right_Paren then
2176 Scan; -- scan past right paren if present
2179 Error_Msg ("parentheses not allowed for range attribute", Lptr);
2184 Restore_Scan_State (Scan_State);
2188 -- Here after dealing with parenthesized range attribute
2190 Sexpr := P_Simple_Expression;
2192 if Token = Tok_Apostrophe then
2193 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2194 Expr_Form := EF_Range_Attr;
2200 end P_Simple_Expression_Or_Range_Attribute;
2206 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2208 -- Error recovery: can raise Error_Resync
2210 function P_Term return Node_Id is
2211 Node1, Node2 : Node_Id;
2212 Tokptr : Source_Ptr;
2218 exit when Token not in Token_Class_Mulop;
2219 Tokptr := Token_Ptr;
2220 Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
2221 Scan; -- past operator
2222 Set_Left_Opnd (Node2, Node1);
2223 Set_Right_Opnd (Node2, P_Factor);
2234 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2236 -- Error recovery: can raise Error_Resync
2238 function P_Factor return Node_Id is
2243 if Token = Tok_Abs then
2244 Node1 := New_Op_Node (N_Op_Abs, Token_Ptr);
2247 Style.Check_Abs_Not;
2251 Set_Right_Opnd (Node1, P_Primary);
2254 elsif Token = Tok_Not then
2255 Node1 := New_Op_Node (N_Op_Not, Token_Ptr);
2258 Style.Check_Abs_Not;
2262 Set_Right_Opnd (Node1, P_Primary);
2268 if Token = Tok_Double_Asterisk then
2269 Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
2271 Set_Left_Opnd (Node2, Node1);
2272 Set_Right_Opnd (Node2, P_Primary);
2285 -- NUMERIC_LITERAL | null
2286 -- | STRING_LITERAL | AGGREGATE
2287 -- | NAME | QUALIFIED_EXPRESSION
2288 -- | ALLOCATOR | (EXPRESSION)
2290 -- Error recovery: can raise Error_Resync
2292 function P_Primary return Node_Id is
2293 Scan_State : Saved_Scan_State;
2297 -- The loop runs more than once only if misplaced pragmas are found
2302 -- Name token can start a name, call or qualified expression, all
2303 -- of which are acceptable possibilities for primary. Note also
2304 -- that string literal is included in name (as operator symbol)
2305 -- and type conversion is included in name (as indexed component).
2307 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2310 -- All done unless apostrophe follows
2312 if Token /= Tok_Apostrophe then
2315 -- Apostrophe following means that we have either just parsed
2316 -- the subtype mark of a qualified expression, or the prefix
2317 -- or a range attribute.
2319 else -- Token = Tok_Apostrophe
2320 Save_Scan_State (Scan_State); -- at apostrophe
2321 Scan; -- past apostrophe
2323 -- If range attribute, then this is always an error, since
2324 -- the only legitimate case (where the scanned expression is
2325 -- a qualified simple name) is handled at the level of the
2326 -- Simple_Expression processing. This case corresponds to a
2327 -- usage such as 3 + A'Range, which is always illegal.
2329 if Token = Tok_Range then
2330 Restore_Scan_State (Scan_State); -- to apostrophe
2331 Bad_Range_Attribute (Token_Ptr);
2334 -- If left paren, then we have a qualified expression.
2335 -- Note that P_Name guarantees that in this case, where
2336 -- Token = Tok_Apostrophe on return, the only two possible
2337 -- tokens following the apostrophe are left paren and
2338 -- RANGE, so we know we have a left paren here.
2340 else -- Token = Tok_Left_Paren
2341 return P_Qualified_Expression (Node1);
2346 -- Numeric or string literal
2348 when Tok_Integer_Literal |
2350 Tok_String_Literal =>
2352 Node1 := Token_Node;
2353 Scan; -- past number
2356 -- Left paren, starts aggregate or parenthesized expression
2358 when Tok_Left_Paren =>
2360 Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2363 if Nkind (Expr) = N_Attribute_Reference
2364 and then Attribute_Name (Expr) = Name_Range
2366 Bad_Range_Attribute (Sloc (Expr));
2381 return New_Node (N_Null, Prev_Token_Ptr);
2383 -- Pragma, not allowed here, so just skip past it
2386 P_Pragmas_Misplaced;
2388 -- Deal with IF (possible unparenthesized conditional expression)
2392 -- If this looks like a real if, defined as an IF appearing at
2393 -- the start of a new line, then we consider we have a missing
2396 if Token_Is_At_Start_Of_Line then
2397 Error_Msg_AP ("missing operand");
2400 -- If this looks like a conditional expression, then treat it
2401 -- that way with an error message.
2403 elsif Ada_Version >= Ada_2012 then
2405 ("conditional expression must be parenthesized");
2406 return P_Conditional_Expression;
2408 -- Otherwise treat as misused identifier
2411 return P_Identifier;
2414 -- Deal with CASE (possible unparenthesized case expression)
2418 -- If this looks like a real case, defined as a CASE appearing
2419 -- the start of a new line, then we consider we have a missing
2422 if Token_Is_At_Start_Of_Line then
2423 Error_Msg_AP ("missing operand");
2426 -- If this looks like a case expression, then treat it that way
2427 -- with an error message.
2429 elsif Ada_Version >= Ada_2012 then
2430 Error_Msg_SC ("case expression must be parenthesized");
2431 return P_Case_Expression;
2433 -- Otherwise treat as misused identifier
2436 return P_Identifier;
2439 -- Anything else is illegal as the first token of a primary, but
2440 -- we test for a reserved identifier so that it is treated nicely
2443 if Is_Reserved_Identifier then
2444 return P_Identifier;
2446 elsif Prev_Token = Tok_Comma then
2447 Error_Msg_SP -- CODEFIX
2448 ("|extra "","" ignored");
2452 Error_Msg_AP ("missing operand");
2460 ---------------------------
2461 -- 4.5 Logical Operator --
2462 ---------------------------
2464 -- LOGICAL_OPERATOR ::= and | or | xor
2466 -- Note: AND THEN and OR ELSE are also treated as logical operators
2467 -- by the parser (even though they are not operators semantically)
2469 -- The value returned is the appropriate Node_Kind code for the operator
2470 -- On return, Token points to the token following the scanned operator.
2472 -- The caller has checked that the first token is a legitimate logical
2473 -- operator token (i.e. is either XOR, AND, OR).
2475 -- Error recovery: cannot raise Error_Resync
2477 function P_Logical_Operator return Node_Kind is
2479 if Token = Tok_And then
2481 Style.Check_Binary_Operator;
2486 if Token = Tok_Then then
2493 elsif Token = Tok_Or then
2495 Style.Check_Binary_Operator;
2500 if Token = Tok_Else then
2507 else -- Token = Tok_Xor
2509 Style.Check_Binary_Operator;
2515 end P_Logical_Operator;
2517 ------------------------------
2518 -- 4.5 Relational Operator --
2519 ------------------------------
2521 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2523 -- The value returned is the appropriate Node_Kind code for the operator.
2524 -- On return, Token points to the operator token, NOT past it.
2526 -- The caller has checked that the first token is a legitimate relational
2527 -- operator token (i.e. is one of the operator tokens listed above).
2529 -- Error recovery: cannot raise Error_Resync
2531 function P_Relational_Operator return Node_Kind is
2532 Op_Kind : Node_Kind;
2533 Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2534 (Tok_Less => N_Op_Lt,
2535 Tok_Equal => N_Op_Eq,
2536 Tok_Greater => N_Op_Gt,
2537 Tok_Not_Equal => N_Op_Ne,
2538 Tok_Greater_Equal => N_Op_Ge,
2539 Tok_Less_Equal => N_Op_Le,
2541 Tok_Not => N_Not_In,
2542 Tok_Box => N_Op_Ne);
2545 if Token = Tok_Box then
2546 Error_Msg_SC -- CODEFIX
2547 ("|""'<'>"" should be ""/=""");
2550 Op_Kind := Relop_Node (Token);
2553 Style.Check_Binary_Operator;
2556 Scan; -- past operator token
2558 if Prev_Token = Tok_Not then
2563 end P_Relational_Operator;
2565 ---------------------------------
2566 -- 4.5 Binary Adding Operator --
2567 ---------------------------------
2569 -- BINARY_ADDING_OPERATOR ::= + | - | &
2571 -- The value returned is the appropriate Node_Kind code for the operator.
2572 -- On return, Token points to the operator token (NOT past it).
2574 -- The caller has checked that the first token is a legitimate adding
2575 -- operator token (i.e. is one of the operator tokens listed above).
2577 -- Error recovery: cannot raise Error_Resync
2579 function P_Binary_Adding_Operator return Node_Kind is
2580 Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2581 (Tok_Ampersand => N_Op_Concat,
2582 Tok_Minus => N_Op_Subtract,
2583 Tok_Plus => N_Op_Add);
2585 return Addop_Node (Token);
2586 end P_Binary_Adding_Operator;
2588 --------------------------------
2589 -- 4.5 Unary Adding Operator --
2590 --------------------------------
2592 -- UNARY_ADDING_OPERATOR ::= + | -
2594 -- The value returned is the appropriate Node_Kind code for the operator.
2595 -- On return, Token points to the operator token (NOT past it).
2597 -- The caller has checked that the first token is a legitimate adding
2598 -- operator token (i.e. is one of the operator tokens listed above).
2600 -- Error recovery: cannot raise Error_Resync
2602 function P_Unary_Adding_Operator return Node_Kind is
2603 Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2604 (Tok_Minus => N_Op_Minus,
2605 Tok_Plus => N_Op_Plus);
2607 return Addop_Node (Token);
2608 end P_Unary_Adding_Operator;
2610 -------------------------------
2611 -- 4.5 Multiplying Operator --
2612 -------------------------------
2614 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2616 -- The value returned is the appropriate Node_Kind code for the operator.
2617 -- On return, Token points to the operator token (NOT past it).
2619 -- The caller has checked that the first token is a legitimate multiplying
2620 -- operator token (i.e. is one of the operator tokens listed above).
2622 -- Error recovery: cannot raise Error_Resync
2624 function P_Multiplying_Operator return Node_Kind is
2625 Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2626 (Tok_Asterisk => N_Op_Multiply,
2627 Tok_Mod => N_Op_Mod,
2628 Tok_Rem => N_Op_Rem,
2629 Tok_Slash => N_Op_Divide);
2631 return Mulop_Node (Token);
2632 end P_Multiplying_Operator;
2634 --------------------------------------
2635 -- 4.5 Highest Precedence Operator --
2636 --------------------------------------
2638 -- Parsed by P_Factor (4.4)
2640 -- Note: this rule is not in fact used by the grammar at any point!
2642 --------------------------
2643 -- 4.6 Type Conversion --
2644 --------------------------
2646 -- Parsed by P_Primary as a Name (4.1)
2648 -------------------------------
2649 -- 4.7 Qualified Expression --
2650 -------------------------------
2652 -- QUALIFIED_EXPRESSION ::=
2653 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2655 -- The caller has scanned the name which is the Subtype_Mark parameter
2656 -- and scanned past the single quote following the subtype mark. The
2657 -- caller has not checked that this name is in fact appropriate for
2658 -- a subtype mark name (i.e. it is a selected component or identifier).
2660 -- Error_Recovery: cannot raise Error_Resync
2662 function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2663 Qual_Node : Node_Id;
2665 Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2666 Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2667 Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2669 end P_Qualified_Expression;
2671 --------------------
2673 --------------------
2676 -- new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2678 -- The caller has checked that the initial token is NEW
2680 -- Error recovery: can raise Error_Resync
2682 function P_Allocator return Node_Id is
2683 Alloc_Node : Node_Id;
2684 Type_Node : Node_Id;
2685 Null_Exclusion_Present : Boolean;
2688 Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2691 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2693 Null_Exclusion_Present := P_Null_Exclusion;
2694 Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
2695 Type_Node := P_Subtype_Mark_Resync;
2697 if Token = Tok_Apostrophe then
2698 Scan; -- past apostrophe
2699 Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2703 P_Subtype_Indication (Type_Node, Null_Exclusion_Present));
2709 -----------------------
2710 -- P_Case_Expression --
2711 -----------------------
2713 function P_Case_Expression return Node_Id is
2714 Loc : constant Source_Ptr := Token_Ptr;
2715 Case_Node : Node_Id;
2716 Save_State : Saved_Scan_State;
2719 if Ada_Version < Ada_2012 then
2720 Error_Msg_SC ("|case expression is an Ada 2012 feature");
2721 Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
2726 Make_Case_Expression (Loc,
2727 Expression => P_Expression_No_Right_Paren,
2728 Alternatives => New_List);
2731 -- We now have scanned out CASE expression IS, scan alternatives
2735 Append_To (Alternatives (Case_Node), P_Case_Expression_Alternative);
2737 -- Missing comma if WHEN (more alternatives present)
2739 if Token = Tok_When then
2742 -- If comma/WHEN, skip comma and we have another alternative
2744 elsif Token = Tok_Comma then
2745 Save_Scan_State (Save_State);
2748 if Token /= Tok_When then
2749 Restore_Scan_State (Save_State);
2753 -- If no comma or WHEN, definitely done
2760 -- If we have an END CASE, diagnose as not needed
2762 if Token = Tok_End then
2763 Error_Msg_SC ("`END CASE` not allowed at end of case expression");
2766 if Token = Tok_Case then
2771 -- Return the Case_Expression node
2774 end P_Case_Expression;
2776 -----------------------------------
2777 -- P_Case_Expression_Alternative --
2778 -----------------------------------
2780 -- CASE_STATEMENT_ALTERNATIVE ::=
2781 -- when DISCRETE_CHOICE_LIST =>
2784 -- The caller has checked that and scanned past the initial WHEN token
2785 -- Error recovery: can raise Error_Resync
2787 function P_Case_Expression_Alternative return Node_Id is
2788 Case_Alt_Node : Node_Id;
2790 Case_Alt_Node := New_Node (N_Case_Expression_Alternative, Token_Ptr);
2791 Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List);
2793 Set_Expression (Case_Alt_Node, P_Expression);
2794 return Case_Alt_Node;
2795 end P_Case_Expression_Alternative;
2797 ------------------------------
2798 -- P_Conditional_Expression --
2799 ------------------------------
2801 function P_Conditional_Expression return Node_Id is
2802 Exprs : constant List_Id := New_List;
2803 Loc : constant Source_Ptr := Token_Ptr;
2805 State : Saved_Scan_State;
2808 Inside_Conditional_Expression := Inside_Conditional_Expression + 1;
2810 if Token = Tok_If and then Ada_Version < Ada_2012 then
2811 Error_Msg_SC ("|conditional expression is an Ada 2012 feature");
2812 Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
2815 Scan; -- past IF or ELSIF
2816 Append_To (Exprs, P_Condition);
2818 Append_To (Exprs, P_Expression);
2820 -- We now have scanned out IF expr THEN expr
2822 -- Check for common error of semicolon before the ELSE
2824 if Token = Tok_Semicolon then
2825 Save_Scan_State (State);
2826 Scan; -- past semicolon
2828 if Token = Tok_Else or else Token = Tok_Elsif then
2829 Error_Msg_SP -- CODEFIX
2830 ("|extra "";"" ignored");
2833 Restore_Scan_State (State);
2837 -- Scan out ELSIF sequence if present
2839 if Token = Tok_Elsif then
2840 Expr := P_Conditional_Expression;
2841 Set_Is_Elsif (Expr);
2842 Append_To (Exprs, Expr);
2844 -- Scan out ELSE phrase if present
2846 elsif Token = Tok_Else then
2848 -- Scan out ELSE expression
2851 Append_To (Exprs, P_Expression);
2853 -- Two expression case (implied True, filled in during semantics)
2859 -- If we have an END IF, diagnose as not needed
2861 if Token = Tok_End then
2863 ("`END IF` not allowed at end of conditional expression");
2866 if Token = Tok_If then
2871 Inside_Conditional_Expression := Inside_Conditional_Expression - 1;
2873 -- Return the Conditional_Expression node
2876 Make_Conditional_Expression (Loc,
2877 Expressions => Exprs);
2878 end P_Conditional_Expression;
2880 -----------------------
2881 -- P_Membership_Test --
2882 -----------------------
2884 procedure P_Membership_Test (N : Node_Id) is
2885 Alt : constant Node_Id :=
2886 P_Range_Or_Subtype_Mark
2887 (Allow_Simple_Expression => (Ada_Version >= Ada_2012));
2892 if Token = Tok_Vertical_Bar then
2893 if Ada_Version < Ada_2012 then
2894 Error_Msg_SC ("set notation is an Ada 2012 feature");
2895 Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
2898 Set_Alternatives (N, New_List (Alt));
2899 Set_Right_Opnd (N, Empty);
2901 -- Loop to accumulate alternatives
2903 while Token = Tok_Vertical_Bar loop
2904 Scan; -- past vertical bar
2907 P_Range_Or_Subtype_Mark (Allow_Simple_Expression => True));
2913 Set_Right_Opnd (N, Alt);
2914 Set_Alternatives (N, No_List);
2916 end P_Membership_Test;