1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2014, 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_Base => True,
39 Attribute_Body_Version => True,
40 Attribute_Class => True,
41 Attribute_External_Tag => True,
42 Attribute_Img => True,
43 Attribute_Loop_Entry => True,
44 Attribute_Old => True,
45 Attribute_Result => True,
46 Attribute_Stub_Type => True,
47 Attribute_Version => True,
48 Attribute_Type_Key => True,
50 -- This map contains True for parameterless attributes that return a
51 -- string or a type. For those attributes, a left parenthesis after
52 -- the attribute should not be analyzed as the beginning of a parameters
53 -- list because it may denote a slice operation (X'Img (1 .. 2)) or
54 -- a type conversion (X'Class (Y)). The Ada2012 attribute 'Old is in
57 -- Note: Loop_Entry is in this list because, although it can take an
58 -- optional argument (the loop name), we can't distinguish that at parse
59 -- time from the case where no loop name is given and a legitimate index
60 -- expression is present. So we parse the argument as an indexed component
61 -- and the semantic analysis sorts out this syntactic ambiguity based on
62 -- the type and form of the expression.
64 -- Note that this map designates the minimum set of attributes where a
65 -- construct in parentheses that is not an argument can appear right
66 -- after the attribute. For attributes like 'Size, we do not put them
67 -- in the map. If someone writes X'Size (3), that's illegal in any case,
68 -- but we get a better error message by parsing the (3) as an illegal
69 -- argument to the attribute, rather than some meaningless junk that
70 -- follows the attribute.
72 -----------------------
73 -- Local Subprograms --
74 -----------------------
76 function P_Aggregate_Or_Paren_Expr return Node_Id;
77 function P_Allocator return Node_Id;
78 function P_Case_Expression_Alternative return Node_Id;
79 function P_Record_Or_Array_Component_Association return Node_Id;
80 function P_Factor return Node_Id;
81 function P_Primary return Node_Id;
82 function P_Relation return Node_Id;
83 function P_Term return Node_Id;
85 function P_Binary_Adding_Operator return Node_Kind;
86 function P_Logical_Operator return Node_Kind;
87 function P_Multiplying_Operator return Node_Kind;
88 function P_Relational_Operator return Node_Kind;
89 function P_Unary_Adding_Operator return Node_Kind;
91 procedure Bad_Range_Attribute (Loc : Source_Ptr);
92 -- Called to place complaint about bad range attribute at the given
93 -- source location. Terminates by raising Error_Resync.
95 procedure Check_Bad_Exp;
96 -- Called after scanning a**b, posts error if ** detected
98 procedure P_Membership_Test (N : Node_Id);
99 -- N is the node for a N_In or N_Not_In node whose right operand has not
100 -- yet been processed. It is called just after scanning out the IN keyword.
101 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
103 function P_Range_Attribute_Reference (Prefix_Node : Node_Id) return Node_Id;
104 -- Scan a range attribute reference. The caller has scanned out the
105 -- prefix. The current token is known to be an apostrophe and the
106 -- following token is known to be RANGE.
108 function P_Unparen_Cond_Case_Quant_Expression return Node_Id;
109 -- This function is called with Token pointing to IF, CASE, or FOR, in a
110 -- context that allows a case, conditional, or quantified expression if
111 -- it is surrounded by parentheses. If not surrounded by parentheses, the
112 -- expression is still returned, but an error message is issued.
114 -------------------------
115 -- Bad_Range_Attribute --
116 -------------------------
118 procedure Bad_Range_Attribute (Loc : Source_Ptr) is
120 Error_Msg ("range attribute cannot be used in expression!", Loc);
122 end Bad_Range_Attribute;
128 procedure Check_Bad_Exp is
130 if Token = Tok_Double_Asterisk then
131 Error_Msg_SC ("parenthesization required for '*'*");
133 Discard_Junk_Node (P_Primary);
138 --------------------------
139 -- 4.1 Name (also 6.4) --
140 --------------------------
143 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
144 -- | INDEXED_COMPONENT | SLICE
145 -- | SELECTED_COMPONENT | ATTRIBUTE
146 -- | TYPE_CONVERSION | FUNCTION_CALL
147 -- | CHARACTER_LITERAL
149 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
151 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
153 -- EXPLICIT_DEREFERENCE ::= NAME . all
155 -- IMPLICIT_DEREFERENCE ::= NAME
157 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
159 -- SLICE ::= PREFIX (DISCRETE_RANGE)
161 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
163 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
165 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
167 -- ATTRIBUTE_DESIGNATOR ::=
168 -- IDENTIFIER [(static_EXPRESSION)]
169 -- | access | delta | digits
173 -- | function_PREFIX ACTUAL_PARAMETER_PART
175 -- ACTUAL_PARAMETER_PART ::=
176 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
178 -- PARAMETER_ASSOCIATION ::=
179 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
181 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
183 -- Note: syntactically a procedure call looks just like a function call,
184 -- so this routine is in practice used to scan out procedure calls as well.
186 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
188 -- Error recovery: can raise Error_Resync
190 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
191 -- followed by either a left paren (qualified expression case), or by
192 -- range (range attribute case). All other uses of apostrophe (i.e. all
193 -- other attributes) are handled in this routine.
195 -- Error recovery: can raise Error_Resync
197 function P_Name return Node_Id is
198 Scan_State : Saved_Scan_State;
200 Prefix_Node : Node_Id;
201 Ident_Node : Node_Id;
203 Range_Node : Node_Id;
206 Arg_List : List_Id := No_List; -- kill junk warning
207 Attr_Name : Name_Id := No_Name; -- kill junk warning
210 -- Case of not a name
212 if Token not in Token_Class_Name then
214 -- If it looks like start of expression, complain and scan expression
216 if Token in Token_Class_Literal
217 or else Token = Tok_Left_Paren
219 Error_Msg_SC ("name expected");
222 -- Otherwise some other junk, not much we can do
225 Error_Msg_AP ("name expected");
230 -- Loop through designators in qualified name
232 Name_Node := Token_Node;
235 Scan; -- past designator
236 exit when Token /= Tok_Dot;
237 Save_Scan_State (Scan_State); -- at dot
240 -- If we do not have another designator after the dot, then join
241 -- the normal circuit to handle a dot extension (may be .all or
242 -- character literal case). Otherwise loop back to scan the next
245 if Token not in Token_Class_Desig then
246 goto Scan_Name_Extension_Dot;
248 Prefix_Node := Name_Node;
249 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
250 Set_Prefix (Name_Node, Prefix_Node);
251 Set_Selector_Name (Name_Node, Token_Node);
255 -- We have now scanned out a qualified designator. If the last token is
256 -- an operator symbol, then we certainly do not have the Snam case, so
257 -- we can just use the normal name extension check circuit
259 if Prev_Token = Tok_Operator_Symbol then
260 goto Scan_Name_Extension;
263 -- We have scanned out a qualified simple name, check for name extension
264 -- Note that we know there is no dot here at this stage, so the only
265 -- possible cases of name extension are apostrophe and left paren.
267 if Token = Tok_Apostrophe then
268 Save_Scan_State (Scan_State); -- at apostrophe
269 Scan; -- past apostrophe
271 -- Qualified expression in Ada 2012 mode (treated as a name)
273 if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
274 goto Scan_Name_Extension_Apostrophe;
276 -- If left paren not in Ada 2012, then it is not part of the name,
277 -- since qualified expressions are not names in prior versions of
278 -- Ada, so return with Token backed up to point to the apostrophe.
279 -- The treatment for the range attribute is similar (we do not
280 -- consider x'range to be a name in this grammar).
282 elsif Token = Tok_Left_Paren or else Token = Tok_Range then
283 Restore_Scan_State (Scan_State); -- to apostrophe
284 Expr_Form := EF_Simple_Name;
287 -- Otherwise we have the case of a name extended by an attribute
290 goto Scan_Name_Extension_Apostrophe;
293 -- Check case of qualified simple name extended by a left parenthesis
295 elsif Token = Tok_Left_Paren then
296 Scan; -- past left paren
297 goto Scan_Name_Extension_Left_Paren;
299 -- Otherwise the qualified simple name is not extended, so return
302 Expr_Form := EF_Simple_Name;
306 -- Loop scanning past name extensions. A label is used for control
307 -- transfer for this loop for ease of interfacing with the finite state
308 -- machine in the parenthesis scanning circuit, and also to allow for
309 -- passing in control to the appropriate point from the above code.
311 <<Scan_Name_Extension>>
313 -- Character literal used as name cannot be extended. Also this
314 -- cannot be a call, since the name for a call must be a designator.
315 -- Return in these cases, or if there is no name extension
317 if Token not in Token_Class_Namext
318 or else Prev_Token = Tok_Char_Literal
320 Expr_Form := EF_Name;
324 -- Merge here when we know there is a name extension
326 <<Scan_Name_Extension_OK>>
328 if Token = Tok_Left_Paren then
329 Scan; -- past left paren
330 goto Scan_Name_Extension_Left_Paren;
332 elsif Token = Tok_Apostrophe then
333 Save_Scan_State (Scan_State); -- at apostrophe
334 Scan; -- past apostrophe
335 goto Scan_Name_Extension_Apostrophe;
337 else -- Token = Tok_Dot
338 Save_Scan_State (Scan_State); -- at dot
340 goto Scan_Name_Extension_Dot;
343 -- Case of name extended by dot (selection), dot is already skipped
344 -- and the scan state at the point of the dot is saved in Scan_State.
346 <<Scan_Name_Extension_Dot>>
348 -- Explicit dereference case
350 if Token = Tok_All then
351 Prefix_Node := Name_Node;
352 Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
353 Set_Prefix (Name_Node, Prefix_Node);
355 goto Scan_Name_Extension;
357 -- Selected component case
359 elsif Token in Token_Class_Name then
360 Prefix_Node := Name_Node;
361 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
362 Set_Prefix (Name_Node, Prefix_Node);
363 Set_Selector_Name (Name_Node, Token_Node);
364 Scan; -- past selector
365 goto Scan_Name_Extension;
367 -- Reserved identifier as selector
369 elsif Is_Reserved_Identifier then
370 Scan_Reserved_Identifier (Force_Msg => False);
371 Prefix_Node := Name_Node;
372 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
373 Set_Prefix (Name_Node, Prefix_Node);
374 Set_Selector_Name (Name_Node, Token_Node);
375 Scan; -- past identifier used as selector
376 goto Scan_Name_Extension;
378 -- If dot is at end of line and followed by nothing legal,
379 -- then assume end of name and quit (dot will be taken as
380 -- an incorrect form of some other punctuation by our caller).
382 elsif Token_Is_At_Start_Of_Line then
383 Restore_Scan_State (Scan_State);
386 -- Here if nothing legal after the dot
389 Error_Msg_AP ("selector expected");
393 -- Here for an apostrophe as name extension. The scan position at the
394 -- apostrophe has already been saved, and the apostrophe scanned out.
396 <<Scan_Name_Extension_Apostrophe>>
398 Scan_Apostrophe : declare
399 function Apostrophe_Should_Be_Semicolon return Boolean;
400 -- Checks for case where apostrophe should probably be
401 -- a semicolon, and if so, gives appropriate message,
402 -- resets the scan pointer to the apostrophe, changes
403 -- the current token to Tok_Semicolon, and returns True.
404 -- Otherwise returns False.
406 ------------------------------------
407 -- Apostrophe_Should_Be_Semicolon --
408 ------------------------------------
410 function Apostrophe_Should_Be_Semicolon return Boolean is
412 if Token_Is_At_Start_Of_Line then
413 Restore_Scan_State (Scan_State); -- to apostrophe
414 Error_Msg_SC ("|""''"" should be "";""");
415 Token := Tok_Semicolon;
420 end Apostrophe_Should_Be_Semicolon;
422 -- Start of processing for Scan_Apostrophe
425 -- Check for qualified expression case in Ada 2012 mode
427 if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
428 Name_Node := P_Qualified_Expression (Name_Node);
429 goto Scan_Name_Extension;
431 -- If range attribute after apostrophe, then return with Token
432 -- pointing to the apostrophe. Note that in this case the prefix
433 -- need not be a simple name (cases like A.all'range). Similarly
434 -- if there is a left paren after the apostrophe, then we also
435 -- return with Token pointing to the apostrophe (this is the
436 -- aggregate case, or some error case).
438 elsif Token = Tok_Range or else Token = Tok_Left_Paren then
439 Restore_Scan_State (Scan_State); -- to apostrophe
440 Expr_Form := EF_Name;
443 -- Here for cases where attribute designator is an identifier
445 elsif Token = Tok_Identifier then
446 Attr_Name := Token_Name;
448 if not Is_Attribute_Name (Attr_Name) then
449 if Apostrophe_Should_Be_Semicolon then
450 Expr_Form := EF_Name;
453 -- Here for a bad attribute name
456 Signal_Bad_Attribute;
457 Scan; -- past bad identifier
459 if Token = Tok_Left_Paren then
460 Scan; -- past left paren
463 Discard_Junk_Node (P_Expression_If_OK);
464 exit when not Comma_Present;
475 Style.Check_Attribute_Name (False);
478 -- Here for case of attribute designator is not an identifier
481 if Token = Tok_Delta then
482 Attr_Name := Name_Delta;
484 elsif Token = Tok_Digits then
485 Attr_Name := Name_Digits;
487 elsif Token = Tok_Access then
488 Attr_Name := Name_Access;
490 elsif Token = Tok_Mod and then Ada_Version >= Ada_95 then
491 Attr_Name := Name_Mod;
493 elsif Apostrophe_Should_Be_Semicolon then
494 Expr_Form := EF_Name;
498 Error_Msg_AP ("attribute designator expected");
503 Style.Check_Attribute_Name (True);
507 -- We come here with an OK attribute scanned, and corresponding
508 -- Attribute identifier node stored in Ident_Node.
510 Prefix_Node := Name_Node;
511 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
512 Scan; -- past attribute designator
513 Set_Prefix (Name_Node, Prefix_Node);
514 Set_Attribute_Name (Name_Node, Attr_Name);
516 -- Scan attribute arguments/designator. We skip this if we know
517 -- that the attribute cannot have an argument (see documentation
518 -- of Is_Parameterless_Attribute for further details).
520 if Token = Tok_Left_Paren
522 Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
524 -- Attribute Update contains an array or record association
525 -- list which provides new values for various components or
526 -- elements. The list is parsed as an aggregate, and we get
527 -- better error handling by knowing that in the parser.
529 if Attr_Name = Name_Update then
530 Set_Expressions (Name_Node, New_List);
531 Append (P_Aggregate, Expressions (Name_Node));
533 -- All other cases of parsing attribute arguments
536 Set_Expressions (Name_Node, New_List);
537 Scan; -- past left paren
541 Expr : constant Node_Id := P_Expression_If_OK;
545 -- Case of => for named notation
547 if Token = Tok_Arrow then
549 -- Named notation allowed only for the special
550 -- case of System'Restriction_Set (No_Dependence =>
551 -- unit_NAME), in which case construct a parameter
552 -- assocation node and append to the arguments.
554 if Attr_Name = Name_Restriction_Set
555 and then Nkind (Expr) = N_Identifier
556 and then Chars (Expr) = Name_No_Dependence
560 Append_To (Expressions (Name_Node),
561 Make_Parameter_Association (Sloc (Rnam),
562 Selector_Name => Expr,
563 Explicit_Actual_Parameter => Rnam));
566 -- For all other cases named notation is illegal
570 ("named parameters not permitted "
572 Scan; -- past junk arrow
575 -- Here for normal case (not => for named parameter)
578 Append (Expr, Expressions (Name_Node));
579 exit when not Comma_Present;
588 goto Scan_Name_Extension;
591 -- Here for left parenthesis extending name (left paren skipped)
593 <<Scan_Name_Extension_Left_Paren>>
595 -- We now have to scan through a list of items, terminated by a
596 -- right parenthesis. The scan is handled by a finite state
597 -- machine. The possibilities are:
601 -- This is a slice. This case is handled in LP_State_Init
603 -- (expression, expression, ..)
605 -- This is interpreted as an indexed component, i.e. as a
606 -- case of a name which can be extended in the normal manner.
607 -- This case is handled by LP_State_Name or LP_State_Expr.
609 -- Note: if and case expressions (without an extra level of
610 -- parentheses) are permitted in this context).
612 -- (..., identifier => expression , ...)
614 -- If there is at least one occurrence of identifier => (but
615 -- none of the other cases apply), then we have a call.
617 -- Test for Id => case
619 if Token = Tok_Identifier then
620 Save_Scan_State (Scan_State); -- at Id
623 -- Test for => (allow := as an error substitute)
625 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
626 Restore_Scan_State (Scan_State); -- to Id
627 Arg_List := New_List;
631 Restore_Scan_State (Scan_State); -- to Id
635 -- Here we have an expression after all
637 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
639 -- Check cases of discrete range for a slice
641 -- First possibility: Range_Attribute_Reference
643 if Expr_Form = EF_Range_Attr then
644 Range_Node := Expr_Node;
646 -- Second possibility: Simple_expression .. Simple_expression
648 elsif Token = Tok_Dot_Dot then
649 Check_Simple_Expression (Expr_Node);
650 Range_Node := New_Node (N_Range, Token_Ptr);
651 Set_Low_Bound (Range_Node, Expr_Node);
653 Expr_Node := P_Expression;
654 Check_Simple_Expression (Expr_Node);
655 Set_High_Bound (Range_Node, Expr_Node);
657 -- Third possibility: Type_name range Range
659 elsif Token = Tok_Range then
660 if Expr_Form /= EF_Simple_Name then
661 Error_Msg_SC ("subtype mark must precede RANGE");
665 Range_Node := P_Subtype_Indication (Expr_Node);
667 -- Otherwise we just have an expression. It is true that we might
668 -- have a subtype mark without a range constraint but this case
669 -- is syntactically indistinguishable from the expression case.
672 Arg_List := New_List;
676 -- Fall through here with unmistakable Discrete range scanned,
677 -- which means that we definitely have the case of a slice. The
678 -- Discrete range is in Range_Node.
680 if Token = Tok_Comma then
681 Error_Msg_SC ("slice cannot have more than one dimension");
684 elsif Token /= Tok_Right_Paren then
685 if Token = Tok_Arrow then
687 -- This may be an aggregate that is missing a qualification
690 ("context of aggregate must be a qualified expression");
699 Scan; -- past right paren
700 Prefix_Node := Name_Node;
701 Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
702 Set_Prefix (Name_Node, Prefix_Node);
703 Set_Discrete_Range (Name_Node, Range_Node);
705 -- An operator node is legal as a prefix to other names,
706 -- but not for a slice.
708 if Nkind (Prefix_Node) = N_Operator_Symbol then
709 Error_Msg_N ("illegal prefix for slice", Prefix_Node);
712 -- If we have a name extension, go scan it
714 if Token in Token_Class_Namext then
715 goto Scan_Name_Extension_OK;
717 -- Otherwise return (a slice is a name, but is not a call)
720 Expr_Form := EF_Name;
725 -- In LP_State_Expr, we have scanned one or more expressions, and
726 -- so we have a call or an indexed component which is a name. On
727 -- entry we have the expression just scanned in Expr_Node and
728 -- Arg_List contains the list of expressions encountered so far
731 Append (Expr_Node, Arg_List);
733 if Token = Tok_Arrow then
735 ("expect identifier in parameter association", Sloc (Expr_Node));
738 elsif not Comma_Present then
741 Prefix_Node := Name_Node;
742 Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
743 Set_Prefix (Name_Node, Prefix_Node);
744 Set_Expressions (Name_Node, Arg_List);
746 goto Scan_Name_Extension;
749 -- Comma present (and scanned out), test for identifier => case
750 -- Test for identifier => case
752 if Token = Tok_Identifier then
753 Save_Scan_State (Scan_State); -- at Id
756 -- Test for => (allow := as error substitute)
758 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
759 Restore_Scan_State (Scan_State); -- to Id
762 -- Otherwise it's just an expression after all, so backup
765 Restore_Scan_State (Scan_State); -- to Id
769 -- Here we have an expression after all, so stay in this state
771 Expr_Node := P_Expression_If_OK;
774 -- LP_State_Call corresponds to the situation in which at least one
775 -- instance of Id => Expression has been encountered, so we know that
776 -- we do not have a name, but rather a call. We enter it with the
777 -- scan pointer pointing to the next argument to scan, and Arg_List
778 -- containing the list of arguments scanned so far.
782 -- Test for case of Id => Expression (named parameter)
784 if Token = Tok_Identifier then
785 Save_Scan_State (Scan_State); -- at Id
786 Ident_Node := Token_Node;
789 -- Deal with => (allow := as incorrect substitute)
791 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
792 Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);
793 Set_Selector_Name (Arg_Node, Ident_Node);
795 Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
796 Append (Arg_Node, Arg_List);
798 -- If a comma follows, go back and scan next entry
800 if Comma_Present then
803 -- Otherwise we have the end of a call
806 Prefix_Node := Name_Node;
807 Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
808 Set_Name (Name_Node, Prefix_Node);
809 Set_Parameter_Associations (Name_Node, Arg_List);
812 if Token in Token_Class_Namext then
813 goto Scan_Name_Extension_OK;
815 -- This is a case of a call which cannot be a name
818 Expr_Form := EF_Name;
823 -- Not named parameter: Id started an expression after all
826 Restore_Scan_State (Scan_State); -- to Id
830 -- Here if entry did not start with Id => which means that it
831 -- is a positional parameter, which is not allowed, since we
832 -- have seen at least one named parameter already.
835 ("positional parameter association " &
836 "not allowed after named one");
838 Expr_Node := P_Expression_If_OK;
840 -- Leaving the '>' in an association is not unusual, so suggest
843 if Nkind (Expr_Node) = N_Op_Eq then
844 Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
847 -- We go back to scanning out expressions, so that we do not get
848 -- multiple error messages when several positional parameters
849 -- follow a named parameter.
853 -- End of treatment for name extensions starting with left paren
855 -- End of loop through name extensions
859 -- This function parses a restricted form of Names which are either
860 -- designators, or designators preceded by a sequence of prefixes
861 -- that are direct names.
863 -- Error recovery: cannot raise Error_Resync
865 function P_Function_Name return Node_Id is
866 Designator_Node : Node_Id;
867 Prefix_Node : Node_Id;
868 Selector_Node : Node_Id;
869 Dot_Sloc : Source_Ptr := No_Location;
872 -- Prefix_Node is set to the gathered prefix so far, Empty means that
873 -- no prefix has been scanned. This allows us to build up the result
874 -- in the required right recursive manner.
876 Prefix_Node := Empty;
878 -- Loop through prefixes
881 Designator_Node := Token_Node;
883 if Token not in Token_Class_Desig then
884 return P_Identifier; -- let P_Identifier issue the error message
886 else -- Token in Token_Class_Desig
887 Scan; -- past designator
888 exit when Token /= Tok_Dot;
891 -- Here at a dot, with token just before it in Designator_Node
893 if No (Prefix_Node) then
894 Prefix_Node := 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 Prefix_Node := Selector_Node;
902 Dot_Sloc := Token_Ptr;
906 -- Fall out of the loop having just scanned a designator
908 if No (Prefix_Node) then
909 return Designator_Node;
911 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
912 Set_Prefix (Selector_Node, Prefix_Node);
913 Set_Selector_Name (Selector_Node, Designator_Node);
914 return Selector_Node;
922 -- This function parses a restricted form of Names which are either
923 -- identifiers, or identifiers preceded by a sequence of prefixes
924 -- that are direct names.
926 -- Error recovery: cannot raise Error_Resync
928 function P_Qualified_Simple_Name return Node_Id is
929 Designator_Node : Node_Id;
930 Prefix_Node : Node_Id;
931 Selector_Node : Node_Id;
932 Dot_Sloc : Source_Ptr := No_Location;
935 -- Prefix node is set to the gathered prefix so far, Empty means that
936 -- no prefix has been scanned. This allows us to build up the result
937 -- in the required right recursive manner.
939 Prefix_Node := Empty;
941 -- Loop through prefixes
944 Designator_Node := Token_Node;
946 if Token = Tok_Identifier then
947 Scan; -- past identifier
948 exit when Token /= Tok_Dot;
950 elsif Token not in Token_Class_Desig then
951 return P_Identifier; -- let P_Identifier issue the error message
954 Scan; -- past designator
956 if Token /= Tok_Dot then
957 Error_Msg_SP ("identifier expected");
962 -- Here at a dot, with token just before it in Designator_Node
964 if No (Prefix_Node) then
965 Prefix_Node := Designator_Node;
967 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
968 Set_Prefix (Selector_Node, Prefix_Node);
969 Set_Selector_Name (Selector_Node, Designator_Node);
970 Prefix_Node := Selector_Node;
973 Dot_Sloc := Token_Ptr;
977 -- Fall out of the loop having just scanned an identifier
979 if No (Prefix_Node) then
980 return Designator_Node;
982 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
983 Set_Prefix (Selector_Node, Prefix_Node);
984 Set_Selector_Name (Selector_Node, Designator_Node);
985 return Selector_Node;
991 end P_Qualified_Simple_Name;
993 -- This procedure differs from P_Qualified_Simple_Name only in that it
994 -- raises Error_Resync if any error is encountered. It only returns after
995 -- scanning a valid qualified simple name.
997 -- Error recovery: can raise Error_Resync
999 function P_Qualified_Simple_Name_Resync return Node_Id is
1000 Designator_Node : Node_Id;
1001 Prefix_Node : Node_Id;
1002 Selector_Node : Node_Id;
1003 Dot_Sloc : Source_Ptr := No_Location;
1006 Prefix_Node := Empty;
1008 -- Loop through prefixes
1011 Designator_Node := Token_Node;
1013 if Token = Tok_Identifier then
1014 Scan; -- past identifier
1015 exit when Token /= Tok_Dot;
1017 elsif Token not in Token_Class_Desig then
1018 Discard_Junk_Node (P_Identifier); -- to issue the error message
1022 Scan; -- past designator
1024 if Token /= Tok_Dot then
1025 Error_Msg_SP ("identifier expected");
1030 -- Here at a dot, with token just before it in Designator_Node
1032 if No (Prefix_Node) then
1033 Prefix_Node := Designator_Node;
1035 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1036 Set_Prefix (Selector_Node, Prefix_Node);
1037 Set_Selector_Name (Selector_Node, Designator_Node);
1038 Prefix_Node := Selector_Node;
1041 Dot_Sloc := Token_Ptr;
1042 Scan; -- past period
1045 -- Fall out of the loop having just scanned an identifier
1047 if No (Prefix_Node) then
1048 return Designator_Node;
1050 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1051 Set_Prefix (Selector_Node, Prefix_Node);
1052 Set_Selector_Name (Selector_Node, Designator_Node);
1053 return Selector_Node;
1055 end P_Qualified_Simple_Name_Resync;
1057 ----------------------
1058 -- 4.1 Direct_Name --
1059 ----------------------
1061 -- Parsed by P_Name and other functions in section 4.1
1067 -- Parsed by P_Name (4.1)
1069 -------------------------------
1070 -- 4.1 Explicit Dereference --
1071 -------------------------------
1073 -- Parsed by P_Name (4.1)
1075 -------------------------------
1076 -- 4.1 Implicit_Dereference --
1077 -------------------------------
1079 -- Parsed by P_Name (4.1)
1081 ----------------------------
1082 -- 4.1 Indexed Component --
1083 ----------------------------
1085 -- Parsed by P_Name (4.1)
1091 -- Parsed by P_Name (4.1)
1093 -----------------------------
1094 -- 4.1 Selected_Component --
1095 -----------------------------
1097 -- Parsed by P_Name (4.1)
1099 ------------------------
1100 -- 4.1 Selector Name --
1101 ------------------------
1103 -- Parsed by P_Name (4.1)
1105 ------------------------------
1106 -- 4.1 Attribute Reference --
1107 ------------------------------
1109 -- Parsed by P_Name (4.1)
1111 -------------------------------
1112 -- 4.1 Attribute Designator --
1113 -------------------------------
1115 -- Parsed by P_Name (4.1)
1117 --------------------------------------
1118 -- 4.1.4 Range Attribute Reference --
1119 --------------------------------------
1121 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1123 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1125 -- In the grammar, a RANGE attribute is simply a name, but its use is
1126 -- highly restricted, so in the parser, we do not regard it as a name.
1127 -- Instead, P_Name returns without scanning the 'RANGE part of the
1128 -- attribute, and the caller uses the following function to construct
1129 -- a range attribute in places where it is appropriate.
1131 -- Note that RANGE here is treated essentially as an identifier,
1132 -- rather than a reserved word.
1134 -- The caller has parsed the prefix, i.e. a name, and Token points to
1135 -- the apostrophe. The token after the apostrophe is known to be RANGE
1136 -- at this point. The prefix node becomes the prefix of the attribute.
1138 -- Error_Recovery: Cannot raise Error_Resync
1140 function P_Range_Attribute_Reference
1141 (Prefix_Node : Node_Id)
1144 Attr_Node : Node_Id;
1147 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1148 Set_Prefix (Attr_Node, Prefix_Node);
1149 Scan; -- past apostrophe
1152 Style.Check_Attribute_Name (True);
1155 Set_Attribute_Name (Attr_Node, Name_Range);
1158 if Token = Tok_Left_Paren then
1159 Scan; -- past left paren
1160 Set_Expressions (Attr_Node, New_List (P_Expression_If_OK));
1165 end P_Range_Attribute_Reference;
1167 ---------------------------------------
1168 -- 4.1.4 Range Attribute Designator --
1169 ---------------------------------------
1171 -- Parsed by P_Range_Attribute_Reference (4.4)
1173 --------------------
1175 --------------------
1177 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1179 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1180 -- an aggregate is known to be required (code statement, extension
1181 -- aggregate), in which cases this routine performs the necessary check
1182 -- that we have an aggregate rather than a parenthesized expression
1184 -- Error recovery: can raise Error_Resync
1186 function P_Aggregate return Node_Id is
1187 Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1188 Aggr_Node : constant Node_Id := P_Aggregate_Or_Paren_Expr;
1191 if Nkind (Aggr_Node) /= N_Aggregate
1193 Nkind (Aggr_Node) /= N_Extension_Aggregate
1196 ("aggregate may not have single positional component", Aggr_Sloc);
1203 ------------------------------------------------
1204 -- 4.3 Aggregate or Parenthesized Expression --
1205 ------------------------------------------------
1207 -- This procedure parses out either an aggregate or a parenthesized
1208 -- expression (these two constructs are closely related, since a
1209 -- parenthesized expression looks like an aggregate with a single
1210 -- positional component).
1213 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1215 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1217 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1218 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1221 -- RECORD_COMPONENT_ASSOCIATION ::=
1222 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1224 -- COMPONENT_CHOICE_LIST ::=
1225 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1228 -- EXTENSION_AGGREGATE ::=
1229 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1231 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1233 -- ARRAY_AGGREGATE ::=
1234 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1236 -- POSITIONAL_ARRAY_AGGREGATE ::=
1237 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1238 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1239 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1241 -- NAMED_ARRAY_AGGREGATE ::=
1242 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1244 -- PRIMARY ::= (EXPRESSION);
1246 -- Error recovery: can raise Error_Resync
1248 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1249 -- to Ada 2005 limited aggregates (AI-287)
1251 function P_Aggregate_Or_Paren_Expr return Node_Id is
1252 Aggregate_Node : Node_Id;
1253 Expr_List : List_Id;
1254 Assoc_List : List_Id;
1255 Expr_Node : Node_Id;
1256 Lparen_Sloc : Source_Ptr;
1257 Scan_State : Saved_Scan_State;
1259 procedure Box_Error;
1260 -- Called if <> is encountered as positional aggregate element. Issues
1261 -- error message and sets Expr_Node to Error.
1267 procedure Box_Error is
1269 if Ada_Version < Ada_2005 then
1270 Error_Msg_SC ("box in aggregate is an Ada 2005 extension");
1273 -- Ada 2005 (AI-287): The box notation is allowed only with named
1274 -- notation because positional notation might be error prone. For
1275 -- example, in "(X, <>, Y, <>)", there is no type associated with
1276 -- the boxes, so you might not be leaving out the components you
1277 -- thought you were leaving out.
1279 Error_Msg_SC ("(Ada 2005) box only allowed with named notation");
1284 -- Start of processing for P_Aggregate_Or_Paren_Expr
1287 Lparen_Sloc := Token_Ptr;
1290 -- Note on parentheses count. For cases like an if expression, the
1291 -- parens here really count as real parentheses for the paren count,
1292 -- so we adjust the paren count accordingly after scanning the expr.
1296 if Token = Tok_If then
1297 Expr_Node := P_If_Expression;
1299 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1304 elsif Token = Tok_Case then
1305 Expr_Node := P_Case_Expression;
1307 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1310 -- Quantified expression
1312 elsif Token = Tok_For then
1313 Expr_Node := P_Quantified_Expression;
1315 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1318 -- Note: the mechanism used here of rescanning the initial expression
1319 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1320 -- out the discrete choice list.
1322 -- Deal with expression and extension aggregates first
1324 elsif Token /= Tok_Others then
1325 Save_Scan_State (Scan_State); -- at start of expression
1327 -- Deal with (NULL RECORD)
1329 if Token = Tok_Null then
1332 if Token = Tok_Record then
1333 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1334 Set_Null_Record_Present (Aggregate_Node, True);
1335 Scan; -- past RECORD
1337 return Aggregate_Node;
1339 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1343 -- Scan expression, handling box appearing as positional argument
1345 if Token = Tok_Box then
1348 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1351 -- Extension aggregate
1353 if Token = Tok_With then
1354 if Nkind (Expr_Node) = N_Attribute_Reference
1355 and then Attribute_Name (Expr_Node) = Name_Range
1357 Bad_Range_Attribute (Sloc (Expr_Node));
1361 if Ada_Version = Ada_83 then
1362 Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1365 Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1366 Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1369 -- Deal with WITH NULL RECORD case
1371 if Token = Tok_Null then
1372 Save_Scan_State (Scan_State); -- at NULL
1375 if Token = Tok_Record then
1376 Scan; -- past RECORD
1377 Set_Null_Record_Present (Aggregate_Node, True);
1379 return Aggregate_Node;
1382 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1386 if Token /= Tok_Others then
1387 Save_Scan_State (Scan_State);
1388 Expr_Node := P_Expression;
1395 elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1396 if Nkind (Expr_Node) = N_Attribute_Reference
1397 and then Attribute_Name (Expr_Node) = Name_Range
1400 ("|parentheses not allowed for range attribute", Lparen_Sloc);
1401 Scan; -- past right paren
1405 -- Bump paren count of expression
1407 if Expr_Node /= Error then
1408 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1411 T_Right_Paren; -- past right paren (error message if none)
1417 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1423 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1427 -- Prepare to scan list of component associations
1429 Expr_List := No_List; -- don't set yet, maybe all named entries
1430 Assoc_List := No_List; -- don't set yet, maybe all positional entries
1432 -- This loop scans through component associations. On entry to the
1433 -- loop, an expression has been scanned at the start of the current
1434 -- association unless initial token was OTHERS, in which case
1435 -- Expr_Node is set to Empty.
1438 -- Deal with others association first. This is a named association
1440 if No (Expr_Node) then
1441 if No (Assoc_List) then
1442 Assoc_List := New_List;
1445 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1447 -- Improper use of WITH
1449 elsif Token = Tok_With then
1450 Error_Msg_SC ("WITH must be preceded by single expression in " &
1451 "extension aggregate");
1454 -- Range attribute can only appear as part of a discrete choice list
1456 elsif Nkind (Expr_Node) = N_Attribute_Reference
1457 and then Attribute_Name (Expr_Node) = Name_Range
1458 and then Token /= Tok_Arrow
1459 and then Token /= Tok_Vertical_Bar
1461 Bad_Range_Attribute (Sloc (Expr_Node));
1464 -- Assume positional case if comma, right paren, or literal or
1465 -- identifier or OTHERS follows (the latter cases are missing
1466 -- comma cases). Also assume positional if a semicolon follows,
1467 -- which can happen if there are missing parens
1469 elsif Token = Tok_Comma
1470 or else Token = Tok_Right_Paren
1471 or else Token = Tok_Others
1472 or else Token in Token_Class_Lit_Or_Name
1473 or else Token = Tok_Semicolon
1475 if Present (Assoc_List) then
1476 Error_Msg_BC -- CODEFIX
1477 ("""='>"" expected (positional association cannot follow " &
1478 "named association)");
1481 if No (Expr_List) then
1482 Expr_List := New_List;
1485 Append (Expr_Node, Expr_List);
1487 -- Check for aggregate followed by left parent, maybe missing comma
1489 elsif Nkind (Expr_Node) = N_Aggregate
1490 and then Token = Tok_Left_Paren
1494 if No (Expr_List) then
1495 Expr_List := New_List;
1498 Append (Expr_Node, Expr_List);
1500 -- Anything else is assumed to be a named association
1503 Restore_Scan_State (Scan_State); -- to start of expression
1505 if No (Assoc_List) then
1506 Assoc_List := New_List;
1509 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1512 exit when not Comma_Present;
1514 -- If we are at an expression terminator, something is seriously
1515 -- wrong, so let's get out now, before we start eating up stuff
1516 -- that doesn't belong to us.
1518 if Token in Token_Class_Eterm then
1520 ("expecting expression or component association");
1524 -- Deal with misused box
1526 if Token = Tok_Box then
1529 -- Otherwise initiate for reentry to top of loop by scanning an
1530 -- initial expression, unless the first token is OTHERS.
1532 elsif Token = Tok_Others then
1536 Save_Scan_State (Scan_State); -- at start of expression
1537 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1542 -- All component associations (positional and named) have been scanned
1545 Set_Expressions (Aggregate_Node, Expr_List);
1546 Set_Component_Associations (Aggregate_Node, Assoc_List);
1547 return Aggregate_Node;
1548 end P_Aggregate_Or_Paren_Expr;
1550 ------------------------------------------------
1551 -- 4.3 Record or Array Component Association --
1552 ------------------------------------------------
1554 -- RECORD_COMPONENT_ASSOCIATION ::=
1555 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1556 -- | COMPONENT_CHOICE_LIST => <>
1558 -- COMPONENT_CHOICE_LIST =>
1559 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1562 -- ARRAY_COMPONENT_ASSOCIATION ::=
1563 -- DISCRETE_CHOICE_LIST => EXPRESSION
1564 -- | DISCRETE_CHOICE_LIST => <>
1566 -- Note: this routine only handles the named cases, including others.
1567 -- Cases where the component choice list is not present have already
1568 -- been handled directly.
1570 -- Error recovery: can raise Error_Resync
1572 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1573 -- rules have been extended to give support to Ada 2005 limited
1574 -- aggregates (AI-287)
1576 function P_Record_Or_Array_Component_Association return Node_Id is
1577 Assoc_Node : Node_Id;
1580 Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1581 Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1582 Set_Sloc (Assoc_Node, Token_Ptr);
1585 if Token = Tok_Box then
1587 -- Ada 2005(AI-287): The box notation is used to indicate the
1588 -- default initialization of aggregate components
1590 if Ada_Version < Ada_2005 then
1592 ("component association with '<'> is an Ada 2005 extension");
1593 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1596 Set_Box_Present (Assoc_Node);
1599 Set_Expression (Assoc_Node, P_Expression);
1603 end P_Record_Or_Array_Component_Association;
1605 -----------------------------
1606 -- 4.3.1 Record Aggregate --
1607 -----------------------------
1609 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1610 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1612 ----------------------------------------------
1613 -- 4.3.1 Record Component Association List --
1614 ----------------------------------------------
1616 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1618 ----------------------------------
1619 -- 4.3.1 Component Choice List --
1620 ----------------------------------
1622 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1624 --------------------------------
1625 -- 4.3.1 Extension Aggregate --
1626 --------------------------------
1628 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1630 --------------------------
1631 -- 4.3.1 Ancestor Part --
1632 --------------------------
1634 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1636 ----------------------------
1637 -- 4.3.1 Array Aggregate --
1638 ----------------------------
1640 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1642 ---------------------------------------
1643 -- 4.3.1 Positional Array Aggregate --
1644 ---------------------------------------
1646 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1648 ----------------------------------
1649 -- 4.3.1 Named Array Aggregate --
1650 ----------------------------------
1652 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1654 ----------------------------------------
1655 -- 4.3.1 Array Component Association --
1656 ----------------------------------------
1658 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1660 ---------------------
1661 -- 4.4 Expression --
1662 ---------------------
1664 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1667 -- RELATION {LOGICAL_OPERATOR RELATION}
1669 -- CHOICE_EXPRESSION ::=
1670 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1672 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1674 -- On return, Expr_Form indicates the categorization of the expression
1675 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1676 -- an error message is given, and Error is returned).
1678 -- Error recovery: cannot raise Error_Resync
1680 function P_Expression return Node_Id is
1681 Logical_Op : Node_Kind;
1682 Prev_Logical_Op : Node_Kind;
1683 Op_Location : Source_Ptr;
1688 Node1 := P_Relation;
1690 if Token in Token_Class_Logop then
1691 Prev_Logical_Op := N_Empty;
1694 Op_Location := Token_Ptr;
1695 Logical_Op := P_Logical_Operator;
1697 if Prev_Logical_Op /= N_Empty and then
1698 Logical_Op /= Prev_Logical_Op
1701 ("mixed logical operators in expression", Op_Location);
1702 Prev_Logical_Op := N_Empty;
1704 Prev_Logical_Op := Logical_Op;
1708 Node1 := New_Op_Node (Logical_Op, Op_Location);
1709 Set_Left_Opnd (Node1, Node2);
1710 Set_Right_Opnd (Node1, P_Relation);
1712 -- Check for case of errant comma or semicolon
1714 if Token = Tok_Comma or else Token = Tok_Semicolon then
1716 Com : constant Boolean := Token = Tok_Comma;
1717 Scan_State : Saved_Scan_State;
1721 Save_Scan_State (Scan_State); -- at comma/semicolon
1722 Scan; -- past comma/semicolon
1724 -- Check for AND THEN or OR ELSE after comma/semicolon. We
1725 -- do not deal with AND/OR because those cases get mixed up
1726 -- with the select alternatives case.
1728 if Token = Tok_And or else Token = Tok_Or then
1729 Logop := P_Logical_Operator;
1730 Restore_Scan_State (Scan_State); -- to comma/semicolon
1732 if Nkind_In (Logop, N_And_Then, N_Or_Else) then
1733 Scan; -- past comma/semicolon
1736 Error_Msg_SP -- CODEFIX
1737 ("|extra "","" ignored");
1739 Error_Msg_SP -- CODEFIX
1740 ("|extra "";"" ignored");
1744 Restore_Scan_State (Scan_State); -- to comma/semicolon
1748 Restore_Scan_State (Scan_State); -- to comma/semicolon
1753 exit when Token not in Token_Class_Logop;
1756 Expr_Form := EF_Non_Simple;
1759 if Token = Tok_Apostrophe then
1760 Bad_Range_Attribute (Token_Ptr);
1767 -- This function is identical to the normal P_Expression, except that it
1768 -- also permits the appearance of a case, conditional, or quantified
1769 -- expression if the call immediately follows a left paren, and followed
1770 -- by a right parenthesis. These forms are allowed if these conditions
1771 -- are not met, but an error message will be issued.
1773 function P_Expression_If_OK return Node_Id is
1775 -- Case of conditional, case or quantified expression
1777 if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
1778 return P_Unparen_Cond_Case_Quant_Expression;
1780 -- Normal case, not case/conditional/quantified expression
1783 return P_Expression;
1785 end P_Expression_If_OK;
1787 -- This function is identical to the normal P_Expression, except that it
1788 -- checks that the expression scan did not stop on a right paren. It is
1789 -- called in all contexts where a right parenthesis cannot legitimately
1790 -- follow an expression.
1792 -- Error recovery: can not raise Error_Resync
1794 function P_Expression_No_Right_Paren return Node_Id is
1795 Expr : constant Node_Id := P_Expression;
1797 Ignore (Tok_Right_Paren);
1799 end P_Expression_No_Right_Paren;
1801 ----------------------------------------
1802 -- 4.4 Expression_Or_Range_Attribute --
1803 ----------------------------------------
1806 -- RELATION {and RELATION} | RELATION {and then RELATION}
1807 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1808 -- | RELATION {xor RELATION}
1810 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1812 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1814 -- On return, Expr_Form indicates the categorization of the expression
1815 -- and EF_Range_Attr is one of the possibilities.
1817 -- Error recovery: cannot raise Error_Resync
1819 -- In the grammar, a RANGE attribute is simply a name, but its use is
1820 -- highly restricted, so in the parser, we do not regard it as a name.
1821 -- Instead, P_Name returns without scanning the 'RANGE part of the
1822 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1823 -- attribute reference. In the normal case where a range attribute is
1824 -- not allowed, an error message is issued by P_Expression.
1826 function P_Expression_Or_Range_Attribute return Node_Id is
1827 Logical_Op : Node_Kind;
1828 Prev_Logical_Op : Node_Kind;
1829 Op_Location : Source_Ptr;
1832 Attr_Node : Node_Id;
1835 Node1 := P_Relation;
1837 if Token = Tok_Apostrophe then
1838 Attr_Node := P_Range_Attribute_Reference (Node1);
1839 Expr_Form := EF_Range_Attr;
1842 elsif Token in Token_Class_Logop then
1843 Prev_Logical_Op := N_Empty;
1846 Op_Location := Token_Ptr;
1847 Logical_Op := P_Logical_Operator;
1849 if Prev_Logical_Op /= N_Empty and then
1850 Logical_Op /= Prev_Logical_Op
1853 ("mixed logical operators in expression", Op_Location);
1854 Prev_Logical_Op := N_Empty;
1856 Prev_Logical_Op := Logical_Op;
1860 Node1 := New_Op_Node (Logical_Op, Op_Location);
1861 Set_Left_Opnd (Node1, Node2);
1862 Set_Right_Opnd (Node1, P_Relation);
1863 exit when Token not in Token_Class_Logop;
1866 Expr_Form := EF_Non_Simple;
1869 if Token = Tok_Apostrophe then
1870 Bad_Range_Attribute (Token_Ptr);
1875 end P_Expression_Or_Range_Attribute;
1877 -- Version that allows a non-parenthesized case, conditional, or quantified
1878 -- expression if the call immediately follows a left paren, and followed
1879 -- by a right parenthesis. These forms are allowed if these conditions
1880 -- are not met, but an error message will be issued.
1882 function P_Expression_Or_Range_Attribute_If_OK return Node_Id is
1884 -- Case of conditional, case or quantified expression
1886 if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
1887 return P_Unparen_Cond_Case_Quant_Expression;
1889 -- Normal case, not one of the above expression types
1892 return P_Expression_Or_Range_Attribute;
1894 end P_Expression_Or_Range_Attribute_If_OK;
1900 -- This procedure scans both relations and choice relations
1902 -- CHOICE_RELATION ::=
1903 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1906 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
1907 -- | RAISE_EXPRESSION
1909 -- MEMBERSHIP_CHOICE_LIST ::=
1910 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
1912 -- MEMBERSHIP_CHOICE ::=
1913 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
1915 -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
1917 -- On return, Expr_Form indicates the categorization of the expression
1919 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1920 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1922 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1923 -- expression, then tokens are scanned until either a non-expression token,
1924 -- a right paren (not matched by a left paren) or a comma, is encountered.
1926 function P_Relation return Node_Id is
1927 Node1, Node2 : Node_Id;
1931 -- First check for raise expression
1933 if Token = Tok_Raise then
1934 Expr_Form := EF_Non_Simple;
1935 return P_Raise_Expression;
1940 Node1 := P_Simple_Expression;
1942 if Token not in Token_Class_Relop then
1946 -- Here we have a relational operator following. If so then scan it
1947 -- out. Note that the assignment symbol := is treated as a relational
1948 -- operator to improve the error recovery when it is misused for =.
1949 -- P_Relational_Operator also parses the IN and NOT IN operations.
1952 Node2 := New_Op_Node (P_Relational_Operator, Optok);
1953 Set_Left_Opnd (Node2, Node1);
1955 -- Case of IN or NOT IN
1957 if Prev_Token = Tok_In then
1958 P_Membership_Test (Node2);
1960 -- Case of relational operator (= /= < <= > >=)
1963 Set_Right_Opnd (Node2, P_Simple_Expression);
1966 Expr_Form := EF_Non_Simple;
1968 if Token in Token_Class_Relop then
1969 Error_Msg_SC ("unexpected relational operator");
1976 -- If any error occurs, then scan to the next expression terminator symbol
1977 -- or comma or right paren at the outer (i.e. current) parentheses level.
1978 -- The flags are set to indicate a normal simple expression.
1981 when Error_Resync =>
1983 Expr_Form := EF_Simple;
1987 ----------------------------
1988 -- 4.4 Simple Expression --
1989 ----------------------------
1991 -- SIMPLE_EXPRESSION ::=
1992 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1994 -- On return, Expr_Form indicates the categorization of the expression
1996 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1997 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1999 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2000 -- expression, then tokens are scanned until either a non-expression token,
2001 -- a right paren (not matched by a left paren) or a comma, is encountered.
2003 -- Note: P_Simple_Expression is called only internally by higher level
2004 -- expression routines. In cases in the grammar where a simple expression
2005 -- is required, the approach is to scan an expression, and then post an
2006 -- appropriate error message if the expression obtained is not simple. This
2007 -- gives better error recovery and treatment.
2009 function P_Simple_Expression return Node_Id is
2010 Scan_State : Saved_Scan_State;
2013 Tokptr : Source_Ptr;
2015 function At_Start_Of_Attribute return Boolean;
2016 -- Tests if we have quote followed by attribute name, if so, return True
2017 -- otherwise return False.
2019 ---------------------------
2020 -- At_Start_Of_Attribute --
2021 ---------------------------
2023 function At_Start_Of_Attribute return Boolean is
2025 if Token /= Tok_Apostrophe then
2030 Scan_State : Saved_Scan_State;
2033 Save_Scan_State (Scan_State);
2036 if Token = Tok_Identifier
2037 and then Is_Attribute_Name (Chars (Token_Node))
2039 Restore_Scan_State (Scan_State);
2042 Restore_Scan_State (Scan_State);
2047 end At_Start_Of_Attribute;
2049 -- Start of processing for P_Simple_Expression
2052 -- Check for cases starting with a name. There are two reasons for
2053 -- special casing. First speed things up by catching a common case
2054 -- without going through several routine layers. Second the caller must
2055 -- be informed via Expr_Form when the simple expression is a name.
2057 if Token in Token_Class_Name then
2060 -- Deal with apostrophe cases
2062 if Token = Tok_Apostrophe then
2063 Save_Scan_State (Scan_State); -- at apostrophe
2064 Scan; -- past apostrophe
2066 -- If qualified expression, scan it out and fall through
2068 if Token = Tok_Left_Paren then
2069 Node1 := P_Qualified_Expression (Node1);
2070 Expr_Form := EF_Simple;
2072 -- If range attribute, then we return with Token pointing to the
2073 -- apostrophe. Note: avoid the normal error check on exit. We
2074 -- know that the expression really is complete in this case.
2076 else -- Token = Tok_Range then
2077 Restore_Scan_State (Scan_State); -- to apostrophe
2078 Expr_Form := EF_Simple_Name;
2083 -- If an expression terminator follows, the previous processing
2084 -- completely scanned out the expression (a common case), and
2085 -- left Expr_Form set appropriately for returning to our caller.
2087 if Token in Token_Class_Sterm then
2090 -- If we do not have an expression terminator, then complete the
2091 -- scan of a simple expression. This code duplicates the code
2092 -- found in P_Term and P_Factor.
2095 if Token = Tok_Double_Asterisk then
2097 Style.Check_Exponentiation_Operator;
2100 Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
2102 Set_Left_Opnd (Node2, Node1);
2103 Set_Right_Opnd (Node2, P_Primary);
2109 exit when Token not in Token_Class_Mulop;
2110 Tokptr := Token_Ptr;
2111 Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
2114 Style.Check_Binary_Operator;
2117 Scan; -- past operator
2118 Set_Left_Opnd (Node2, Node1);
2119 Set_Right_Opnd (Node2, P_Factor);
2124 exit when Token not in Token_Class_Binary_Addop;
2125 Tokptr := Token_Ptr;
2126 Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
2129 Style.Check_Binary_Operator;
2132 Scan; -- past operator
2133 Set_Left_Opnd (Node2, Node1);
2134 Set_Right_Opnd (Node2, P_Term);
2138 Expr_Form := EF_Simple;
2141 -- Cases where simple expression does not start with a name
2144 -- Scan initial sign and initial Term
2146 if Token in Token_Class_Unary_Addop then
2147 Tokptr := Token_Ptr;
2148 Node1 := New_Op_Node (P_Unary_Adding_Operator, Tokptr);
2151 Style.Check_Unary_Plus_Or_Minus (Inside_Depends);
2154 Scan; -- past operator
2155 Set_Right_Opnd (Node1, P_Term);
2160 -- In the following, we special-case a sequence of concatenations of
2161 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
2162 -- else mixed in. For such a sequence, we return a tree representing
2163 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
2164 -- the number of concatenations is large. If semantic analysis
2165 -- resolves the "&" to a predefined one, then this folding gives the
2166 -- right answer. Otherwise, semantic analysis will complain about a
2167 -- capacity-exceeded error. The purpose of this trick is to avoid
2168 -- creating a deeply nested tree, which would cause deep recursion
2169 -- during semantics, causing stack overflow. This way, we can handle
2170 -- enormous concatenations in the normal case of predefined "&". We
2171 -- first build up the normal tree, and then rewrite it if
2175 Num_Concats_Threshold : constant Positive := 1000;
2176 -- Arbitrary threshold value to enable optimization
2178 First_Node : constant Node_Id := Node1;
2179 Is_Strlit_Concat : Boolean;
2180 -- True iff we've parsed a sequence of concatenations of string
2181 -- literals, with nothing else mixed in.
2183 Num_Concats : Natural;
2184 -- Number of "&" operators if Is_Strlit_Concat is True
2188 Nkind (Node1) = N_String_Literal
2189 and then Token = Tok_Ampersand;
2192 -- Scan out sequence of terms separated by binary adding operators
2195 exit when Token not in Token_Class_Binary_Addop;
2196 Tokptr := Token_Ptr;
2197 Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
2199 if Style_Check and then not Debug_Flag_Dot_QQ then
2200 Style.Check_Binary_Operator;
2203 Scan; -- past operator
2204 Set_Left_Opnd (Node2, Node1);
2206 Set_Right_Opnd (Node2, Node1);
2208 -- Check if we're still concatenating string literals
2212 and then Nkind (Node2) = N_Op_Concat
2213 and then Nkind (Node1) = N_String_Literal;
2215 if Is_Strlit_Concat then
2216 Num_Concats := Num_Concats + 1;
2222 -- If we have an enormous series of concatenations of string
2223 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2224 -- flag tells semantic analysis that if the "&" is not predefined,
2225 -- the folded value is wrong.
2228 and then Num_Concats >= Num_Concats_Threshold
2231 Empty_String_Val : String_Id;
2234 Strlit_Concat_Val : String_Id;
2235 -- Contains the folded value (which will be correct if the
2236 -- "&" operators are the predefined ones).
2239 -- For walking up the tree
2242 -- Folded node to replace Node1
2244 Loc : constant Source_Ptr := Sloc (First_Node);
2247 -- Walk up the tree starting at the leftmost string literal
2248 -- (First_Node), building up the Strlit_Concat_Val as we
2249 -- go. Note that we do not use recursion here -- the whole
2250 -- point is to avoid recursively walking that enormous tree.
2253 Store_String_Chars (Strval (First_Node));
2255 Cur_Node := Parent (First_Node);
2256 while Present (Cur_Node) loop
2257 pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
2258 Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
2260 Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
2261 Cur_Node := Parent (Cur_Node);
2264 Strlit_Concat_Val := End_String;
2266 -- Create new folded node, and rewrite result with a concat-
2267 -- enation of an empty string literal and the folded node.
2270 Empty_String_Val := End_String;
2272 Make_Op_Concat (Loc,
2273 Make_String_Literal (Loc, Empty_String_Val),
2274 Make_String_Literal (Loc, Strlit_Concat_Val,
2275 Is_Folded_In_Parser => True));
2276 Rewrite (Node1, New_Node);
2281 -- All done, we clearly do not have name or numeric literal so this
2282 -- is a case of a simple expression which is some other possibility.
2284 Expr_Form := EF_Simple;
2287 -- Come here at end of simple expression, where we do a couple of
2288 -- special checks to improve error recovery.
2290 -- Special test to improve error recovery. If the current token
2291 -- is a period, then someone is trying to do selection on something
2292 -- that is not a name, e.g. a qualified expression.
2294 if Token = Tok_Dot then
2295 Error_Msg_SC ("prefix for selection is not a name");
2297 -- If qualified expression, comment and continue, otherwise something
2298 -- is pretty nasty so do an Error_Resync call.
2300 if Ada_Version < Ada_2012
2301 and then Nkind (Node1) = N_Qualified_Expression
2303 Error_Msg_SC ("\would be legal in Ada 2012 mode");
2309 -- Special test to improve error recovery: If the current token is
2310 -- not the first token on a line (as determined by checking the
2311 -- previous token position with the start of the current line),
2312 -- then we insist that we have an appropriate terminating token.
2313 -- Consider the following two examples:
2315 -- 1) if A nad B then ...
2320 -- In the first example, we would like to issue a binary operator
2321 -- expected message and resynchronize to the then. In the second
2322 -- example, we do not want to issue a binary operator message, so
2323 -- that instead we will get the missing semicolon message. This
2324 -- distinction is of course a heuristic which does not always work,
2325 -- but in practice it is quite effective.
2327 -- Note: the one case in which we do not go through this circuit is
2328 -- when we have scanned a range attribute and want to return with
2329 -- Token pointing to the apostrophe. The apostrophe is not normally
2330 -- an expression terminator, and is not in Token_Class_Sterm, but
2331 -- in this special case we know that the expression is complete.
2333 if not Token_Is_At_Start_Of_Line
2334 and then Token not in Token_Class_Sterm
2336 -- Normally the right error message is indeed that we expected a
2337 -- binary operator, but in the case of being between a right and left
2338 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2340 if Prev_Token = Tok_Right_Paren and then Token = Tok_Left_Paren then
2343 -- And if we have a quote, we may have a bad attribute
2345 elsif At_Start_Of_Attribute then
2346 Error_Msg_SC ("prefix of attribute must be a name");
2348 if Ada_Version >= Ada_2012 then
2349 Error_Msg_SC ("\qualify expression to turn it into a name");
2352 -- Normal case for binary operator expected message
2355 Error_Msg_AP ("binary operator expected");
2364 -- If any error occurs, then scan to next expression terminator symbol
2365 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2366 -- level. Expr_Form is set to indicate a normal simple expression.
2369 when Error_Resync =>
2371 Expr_Form := EF_Simple;
2373 end P_Simple_Expression;
2375 -----------------------------------------------
2376 -- 4.4 Simple Expression or Range Attribute --
2377 -----------------------------------------------
2379 -- SIMPLE_EXPRESSION ::=
2380 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2382 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2384 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2386 -- Error recovery: cannot raise Error_Resync
2388 function P_Simple_Expression_Or_Range_Attribute return Node_Id is
2390 Attr_Node : Node_Id;
2393 -- We don't just want to roar ahead and call P_Simple_Expression
2394 -- here, since we want to handle the case of a parenthesized range
2395 -- attribute cleanly.
2397 if Token = Tok_Left_Paren then
2399 Lptr : constant Source_Ptr := Token_Ptr;
2400 Scan_State : Saved_Scan_State;
2403 Save_Scan_State (Scan_State);
2404 Scan; -- past left paren
2405 Sexpr := P_Simple_Expression;
2407 if Token = Tok_Apostrophe then
2408 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2409 Expr_Form := EF_Range_Attr;
2411 if Token = Tok_Right_Paren then
2412 Scan; -- scan past right paren if present
2415 Error_Msg ("parentheses not allowed for range attribute", Lptr);
2420 Restore_Scan_State (Scan_State);
2424 -- Here after dealing with parenthesized range attribute
2426 Sexpr := P_Simple_Expression;
2428 if Token = Tok_Apostrophe then
2429 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2430 Expr_Form := EF_Range_Attr;
2436 end P_Simple_Expression_Or_Range_Attribute;
2442 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2444 -- Error recovery: can raise Error_Resync
2446 function P_Term return Node_Id is
2447 Node1, Node2 : Node_Id;
2448 Tokptr : Source_Ptr;
2454 exit when Token not in Token_Class_Mulop;
2455 Tokptr := Token_Ptr;
2456 Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
2458 if Style_Check and then not Debug_Flag_Dot_QQ then
2459 Style.Check_Binary_Operator;
2462 Scan; -- past operator
2463 Set_Left_Opnd (Node2, Node1);
2464 Set_Right_Opnd (Node2, P_Factor);
2475 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2477 -- Error recovery: can raise Error_Resync
2479 function P_Factor return Node_Id is
2484 if Token = Tok_Abs then
2485 Node1 := New_Op_Node (N_Op_Abs, Token_Ptr);
2488 Style.Check_Abs_Not;
2492 Set_Right_Opnd (Node1, P_Primary);
2495 elsif Token = Tok_Not then
2496 Node1 := New_Op_Node (N_Op_Not, Token_Ptr);
2499 Style.Check_Abs_Not;
2503 Set_Right_Opnd (Node1, P_Primary);
2509 if Token = Tok_Double_Asterisk then
2510 Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
2512 Set_Left_Opnd (Node2, Node1);
2513 Set_Right_Opnd (Node2, P_Primary);
2527 -- NUMERIC_LITERAL | null
2528 -- | STRING_LITERAL | AGGREGATE
2529 -- | NAME | QUALIFIED_EXPRESSION
2530 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2532 -- Error recovery: can raise Error_Resync
2534 function P_Primary return Node_Id is
2535 Scan_State : Saved_Scan_State;
2538 Lparen : constant Boolean := Prev_Token = Tok_Left_Paren;
2539 -- Remember if previous token is a left parenthesis. This is used to
2540 -- deal with checking whether IF/CASE/FOR expressions appearing as
2541 -- primaries require extra parenthesization.
2544 -- The loop runs more than once only if misplaced pragmas are found
2545 -- or if a misplaced unary minus is skipped.
2550 -- Name token can start a name, call or qualified expression, all
2551 -- of which are acceptable possibilities for primary. Note also
2552 -- that string literal is included in name (as operator symbol)
2553 -- and type conversion is included in name (as indexed component).
2555 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2558 -- All done unless apostrophe follows
2560 if Token /= Tok_Apostrophe then
2563 -- Apostrophe following means that we have either just parsed
2564 -- the subtype mark of a qualified expression, or the prefix
2565 -- or a range attribute.
2567 else -- Token = Tok_Apostrophe
2568 Save_Scan_State (Scan_State); -- at apostrophe
2569 Scan; -- past apostrophe
2571 -- If range attribute, then this is always an error, since
2572 -- the only legitimate case (where the scanned expression is
2573 -- a qualified simple name) is handled at the level of the
2574 -- Simple_Expression processing. This case corresponds to a
2575 -- usage such as 3 + A'Range, which is always illegal.
2577 if Token = Tok_Range then
2578 Restore_Scan_State (Scan_State); -- to apostrophe
2579 Bad_Range_Attribute (Token_Ptr);
2582 -- If left paren, then we have a qualified expression.
2583 -- Note that P_Name guarantees that in this case, where
2584 -- Token = Tok_Apostrophe on return, the only two possible
2585 -- tokens following the apostrophe are left paren and
2586 -- RANGE, so we know we have a left paren here.
2588 else -- Token = Tok_Left_Paren
2589 return P_Qualified_Expression (Node1);
2594 -- Numeric or string literal
2596 when Tok_Integer_Literal |
2598 Tok_String_Literal =>
2600 Node1 := Token_Node;
2601 Scan; -- past number
2604 -- Left paren, starts aggregate or parenthesized expression
2606 when Tok_Left_Paren =>
2608 Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2611 if Nkind (Expr) = N_Attribute_Reference
2612 and then Attribute_Name (Expr) = Name_Range
2614 Bad_Range_Attribute (Sloc (Expr));
2629 return New_Node (N_Null, Prev_Token_Ptr);
2631 -- Pragma, not allowed here, so just skip past it
2634 P_Pragmas_Misplaced;
2636 -- Deal with IF (possible unparenthesized if expression)
2640 -- If this looks like a real if, defined as an IF appearing at
2641 -- the start of a new line, then we consider we have a missing
2642 -- operand. If in Ada 2012 and the IF is not properly indented
2643 -- for a statement, we prefer to issue a message about an ill-
2644 -- parenthesized if expression.
2646 if Token_Is_At_Start_Of_Line
2648 (Ada_Version >= Ada_2012
2649 and then Style_Check_Indentation /= 0
2650 and then Start_Column rem Style_Check_Indentation /= 0)
2652 Error_Msg_AP ("missing operand");
2655 -- If this looks like an if expression, then treat it that way
2656 -- with an error message if not explicitly surrounded by
2659 elsif Ada_Version >= Ada_2012 then
2660 Node1 := P_If_Expression;
2662 if not (Lparen and then Token = Tok_Right_Paren) then
2664 ("if expression must be parenthesized", Sloc (Node1));
2669 -- Otherwise treat as misused identifier
2672 return P_Identifier;
2675 -- Deal with CASE (possible unparenthesized case expression)
2679 -- If this looks like a real case, defined as a CASE appearing
2680 -- the start of a new line, then we consider we have a missing
2681 -- operand. If in Ada 2012 and the CASE is not properly
2682 -- indented for a statement, we prefer to issue a message about
2683 -- an ill-parenthesized case expression.
2685 if Token_Is_At_Start_Of_Line
2687 (Ada_Version >= Ada_2012
2688 and then Style_Check_Indentation /= 0
2689 and then Start_Column rem Style_Check_Indentation /= 0)
2691 Error_Msg_AP ("missing operand");
2694 -- If this looks like a case expression, then treat it that way
2695 -- with an error message if not within parentheses.
2697 elsif Ada_Version >= Ada_2012 then
2698 Node1 := P_Case_Expression;
2700 if not (Lparen and then Token = Tok_Right_Paren) then
2702 ("case expression must be parenthesized", Sloc (Node1));
2707 -- Otherwise treat as misused identifier
2710 return P_Identifier;
2713 -- For [all | some] indicates a quantified expression
2716 if Token_Is_At_Start_Of_Line then
2717 Error_Msg_AP ("misplaced loop");
2720 elsif Ada_Version >= Ada_2012 then
2721 Node1 := P_Quantified_Expression;
2723 if not (Lparen and then Token = Tok_Right_Paren) then
2725 ("quantified expression must be parenthesized",
2731 -- Otherwise treat as misused identifier
2734 return P_Identifier;
2737 -- Minus may well be an improper attempt at a unary minus. Give
2738 -- a message, skip the minus and keep going.
2741 Error_Msg_SC ("parentheses required for unary minus");
2744 -- Anything else is illegal as the first token of a primary, but
2745 -- we test for some common errors, to improve error messages.
2748 if Is_Reserved_Identifier then
2749 return P_Identifier;
2751 elsif Prev_Token = Tok_Comma then
2752 Error_Msg_SP -- CODEFIX
2753 ("|extra "","" ignored");
2757 Error_Msg_AP ("missing operand");
2765 -------------------------------
2766 -- 4.4 Quantified_Expression --
2767 -------------------------------
2769 -- QUANTIFIED_EXPRESSION ::=
2770 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2771 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2773 function P_Quantified_Expression return Node_Id is
2778 Error_Msg_Ada_2012_Feature ("quantified expression", Token_Ptr);
2780 Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr);
2782 if Token = Tok_All then
2783 Set_All_Present (Node1);
2784 elsif Token /= Tok_Some then
2785 Error_Msg_AP ("missing quantifier");
2790 I_Spec := P_Loop_Parameter_Specification;
2792 if Nkind (I_Spec) = N_Loop_Parameter_Specification then
2793 Set_Loop_Parameter_Specification (Node1, I_Spec);
2795 Set_Iterator_Specification (Node1, I_Spec);
2798 if Token = Tok_Arrow then
2800 Set_Condition (Node1, P_Expression);
2803 Error_Msg_AP ("missing arrow");
2806 end P_Quantified_Expression;
2808 ---------------------------
2809 -- 4.5 Logical Operator --
2810 ---------------------------
2812 -- LOGICAL_OPERATOR ::= and | or | xor
2814 -- Note: AND THEN and OR ELSE are also treated as logical operators
2815 -- by the parser (even though they are not operators semantically)
2817 -- The value returned is the appropriate Node_Kind code for the operator
2818 -- On return, Token points to the token following the scanned operator.
2820 -- The caller has checked that the first token is a legitimate logical
2821 -- operator token (i.e. is either XOR, AND, OR).
2823 -- Error recovery: cannot raise Error_Resync
2825 function P_Logical_Operator return Node_Kind is
2827 if Token = Tok_And then
2829 Style.Check_Binary_Operator;
2834 if Token = Tok_Then then
2841 elsif Token = Tok_Or then
2843 Style.Check_Binary_Operator;
2848 if Token = Tok_Else then
2855 else -- Token = Tok_Xor
2857 Style.Check_Binary_Operator;
2863 end P_Logical_Operator;
2865 ------------------------------
2866 -- 4.5 Relational Operator --
2867 ------------------------------
2869 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2871 -- The value returned is the appropriate Node_Kind code for the operator.
2872 -- On return, Token points to the operator token, NOT past it.
2874 -- The caller has checked that the first token is a legitimate relational
2875 -- operator token (i.e. is one of the operator tokens listed above).
2877 -- Error recovery: cannot raise Error_Resync
2879 function P_Relational_Operator return Node_Kind is
2880 Op_Kind : Node_Kind;
2881 Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2882 (Tok_Less => N_Op_Lt,
2883 Tok_Equal => N_Op_Eq,
2884 Tok_Greater => N_Op_Gt,
2885 Tok_Not_Equal => N_Op_Ne,
2886 Tok_Greater_Equal => N_Op_Ge,
2887 Tok_Less_Equal => N_Op_Le,
2889 Tok_Not => N_Not_In,
2890 Tok_Box => N_Op_Ne);
2893 if Token = Tok_Box then
2894 Error_Msg_SC -- CODEFIX
2895 ("|""'<'>"" should be ""/=""");
2898 Op_Kind := Relop_Node (Token);
2901 Style.Check_Binary_Operator;
2904 Scan; -- past operator token
2906 -- Deal with NOT IN, if previous token was NOT, we must have IN now
2908 if Prev_Token = Tok_Not then
2910 -- Style check, for NOT IN, we require one space between NOT and IN
2912 if Style_Check and then Token = Tok_In then
2920 end P_Relational_Operator;
2922 ---------------------------------
2923 -- 4.5 Binary Adding Operator --
2924 ---------------------------------
2926 -- BINARY_ADDING_OPERATOR ::= + | - | &
2928 -- The value returned is the appropriate Node_Kind code for the operator.
2929 -- On return, Token points to the operator token (NOT past it).
2931 -- The caller has checked that the first token is a legitimate adding
2932 -- operator token (i.e. is one of the operator tokens listed above).
2934 -- Error recovery: cannot raise Error_Resync
2936 function P_Binary_Adding_Operator return Node_Kind is
2937 Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2938 (Tok_Ampersand => N_Op_Concat,
2939 Tok_Minus => N_Op_Subtract,
2940 Tok_Plus => N_Op_Add);
2942 return Addop_Node (Token);
2943 end P_Binary_Adding_Operator;
2945 --------------------------------
2946 -- 4.5 Unary Adding Operator --
2947 --------------------------------
2949 -- UNARY_ADDING_OPERATOR ::= + | -
2951 -- The value returned is the appropriate Node_Kind code for the operator.
2952 -- On return, Token points to the operator token (NOT past it).
2954 -- The caller has checked that the first token is a legitimate adding
2955 -- operator token (i.e. is one of the operator tokens listed above).
2957 -- Error recovery: cannot raise Error_Resync
2959 function P_Unary_Adding_Operator return Node_Kind is
2960 Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2961 (Tok_Minus => N_Op_Minus,
2962 Tok_Plus => N_Op_Plus);
2964 return Addop_Node (Token);
2965 end P_Unary_Adding_Operator;
2967 -------------------------------
2968 -- 4.5 Multiplying Operator --
2969 -------------------------------
2971 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2973 -- The value returned is the appropriate Node_Kind code for the operator.
2974 -- On return, Token points to the operator token (NOT past it).
2976 -- The caller has checked that the first token is a legitimate multiplying
2977 -- operator token (i.e. is one of the operator tokens listed above).
2979 -- Error recovery: cannot raise Error_Resync
2981 function P_Multiplying_Operator return Node_Kind is
2982 Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2983 (Tok_Asterisk => N_Op_Multiply,
2984 Tok_Mod => N_Op_Mod,
2985 Tok_Rem => N_Op_Rem,
2986 Tok_Slash => N_Op_Divide);
2988 return Mulop_Node (Token);
2989 end P_Multiplying_Operator;
2991 --------------------------------------
2992 -- 4.5 Highest Precedence Operator --
2993 --------------------------------------
2995 -- Parsed by P_Factor (4.4)
2997 -- Note: this rule is not in fact used by the grammar at any point
2999 --------------------------
3000 -- 4.6 Type Conversion --
3001 --------------------------
3003 -- Parsed by P_Primary as a Name (4.1)
3005 -------------------------------
3006 -- 4.7 Qualified Expression --
3007 -------------------------------
3009 -- QUALIFIED_EXPRESSION ::=
3010 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
3012 -- The caller has scanned the name which is the Subtype_Mark parameter
3013 -- and scanned past the single quote following the subtype mark. The
3014 -- caller has not checked that this name is in fact appropriate for
3015 -- a subtype mark name (i.e. it is a selected component or identifier).
3017 -- Error_Recovery: cannot raise Error_Resync
3019 function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
3020 Qual_Node : Node_Id;
3022 Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
3023 Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
3024 Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
3026 end P_Qualified_Expression;
3028 --------------------
3030 --------------------
3033 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
3034 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
3036 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
3038 -- The caller has checked that the initial token is NEW
3040 -- Error recovery: can raise Error_Resync
3042 function P_Allocator return Node_Id is
3043 Alloc_Node : Node_Id;
3044 Type_Node : Node_Id;
3045 Null_Exclusion_Present : Boolean;
3048 Alloc_Node := New_Node (N_Allocator, Token_Ptr);
3051 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
3053 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
3055 if Token = Tok_Left_Paren then
3057 Set_Subpool_Handle_Name (Alloc_Node, P_Name);
3060 Error_Msg_Ada_2012_Feature
3061 ("|subpool specification",
3062 Sloc (Subpool_Handle_Name (Alloc_Node)));
3065 Null_Exclusion_Present := P_Null_Exclusion;
3066 Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
3067 Type_Node := P_Subtype_Mark_Resync;
3069 if Token = Tok_Apostrophe then
3070 Scan; -- past apostrophe
3071 Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
3075 P_Subtype_Indication (Type_Node, Null_Exclusion_Present));
3077 -- AI05-0104: An explicit null exclusion is not allowed for an
3078 -- allocator without initialization. In previous versions of the
3079 -- language it just raises constraint error.
3081 if Ada_Version >= Ada_2012 and then Null_Exclusion_Present then
3083 ("an allocator with a subtype indication "
3084 & "cannot have a null exclusion", Alloc_Node);
3091 -----------------------
3092 -- P_Case_Expression --
3093 -----------------------
3095 function P_Case_Expression return Node_Id is
3096 Loc : constant Source_Ptr := Token_Ptr;
3097 Case_Node : Node_Id;
3098 Save_State : Saved_Scan_State;
3101 Error_Msg_Ada_2012_Feature ("|case expression", Token_Ptr);
3104 Make_Case_Expression (Loc,
3105 Expression => P_Expression_No_Right_Paren,
3106 Alternatives => New_List);
3109 -- We now have scanned out CASE expression IS, scan alternatives
3113 Append_To (Alternatives (Case_Node), P_Case_Expression_Alternative);
3115 -- Missing comma if WHEN (more alternatives present)
3117 if Token = Tok_When then
3120 -- If comma/WHEN, skip comma and we have another alternative
3122 elsif Token = Tok_Comma then
3123 Save_Scan_State (Save_State);
3126 if Token /= Tok_When then
3127 Restore_Scan_State (Save_State);
3131 -- If no comma or WHEN, definitely done
3138 -- If we have an END CASE, diagnose as not needed
3140 if Token = Tok_End then
3141 Error_Msg_SC ("`END CASE` not allowed at end of case expression");
3144 if Token = Tok_Case then
3149 -- Return the Case_Expression node
3152 end P_Case_Expression;
3154 -----------------------------------
3155 -- P_Case_Expression_Alternative --
3156 -----------------------------------
3158 -- CASE_STATEMENT_ALTERNATIVE ::=
3159 -- when DISCRETE_CHOICE_LIST =>
3162 -- The caller has checked that and scanned past the initial WHEN token
3163 -- Error recovery: can raise Error_Resync
3165 function P_Case_Expression_Alternative return Node_Id is
3166 Case_Alt_Node : Node_Id;
3168 Case_Alt_Node := New_Node (N_Case_Expression_Alternative, Token_Ptr);
3169 Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List);
3171 Set_Expression (Case_Alt_Node, P_Expression);
3172 return Case_Alt_Node;
3173 end P_Case_Expression_Alternative;
3175 ---------------------
3176 -- P_If_Expression --
3177 ---------------------
3179 function P_If_Expression return Node_Id is
3181 function P_If_Expression_Internal
3183 Cond : Node_Id) return Node_Id;
3184 -- This is the internal recursive routine that does all the work, it is
3185 -- recursive since it is used to process ELSIF parts, which internally
3186 -- are N_If_Expression nodes with the Is_Elsif flag set. The calling
3187 -- sequence is like the outer function except that the caller passes
3188 -- the conditional expression (scanned using P_Expression), and the
3189 -- scan pointer points just past this expression. Loc points to the
3190 -- IF or ELSIF token.
3192 ------------------------------
3193 -- P_If_Expression_Internal --
3194 ------------------------------
3196 function P_If_Expression_Internal
3198 Cond : Node_Id) return Node_Id
3200 Exprs : constant List_Id := New_List;
3202 State : Saved_Scan_State;
3206 -- All cases except where we are at right paren
3208 if Token /= Tok_Right_Paren then
3210 Append_To (Exprs, P_Condition (Cond));
3211 Append_To (Exprs, P_Expression);
3213 -- Case of right paren (missing THEN phrase). Note that we know this
3214 -- is the IF case, since the caller dealt with this possibility in
3218 Error_Msg_BC ("missing THEN phrase");
3219 Append_To (Exprs, P_Condition (Cond));
3222 -- We now have scanned out IF expr THEN expr
3224 -- Check for common error of semicolon before the ELSE
3226 if Token = Tok_Semicolon then
3227 Save_Scan_State (State);
3228 Scan; -- past semicolon
3230 if Token = Tok_Else or else Token = Tok_Elsif then
3231 Error_Msg_SP -- CODEFIX
3232 ("|extra "";"" ignored");
3235 Restore_Scan_State (State);
3239 -- Scan out ELSIF sequence if present
3241 if Token = Tok_Elsif then
3244 Expr := P_Expression;
3246 -- If we are at a right paren, we assume the ELSIF should be ELSE
3248 if Token = Tok_Right_Paren then
3249 Error_Msg ("ELSIF should be ELSE", Eptr);
3250 Append_To (Exprs, Expr);
3252 -- Otherwise we have an OK ELSIF
3255 Expr := P_If_Expression_Internal (Eptr, Expr);
3256 Set_Is_Elsif (Expr);
3257 Append_To (Exprs, Expr);
3260 -- Scan out ELSE phrase if present
3262 elsif Token = Tok_Else then
3264 -- Scan out ELSE expression
3267 Append_To (Exprs, P_Expression);
3269 -- Skip redundant ELSE parts
3271 while Token = Tok_Else loop
3272 Error_Msg_SC ("only one ELSE part is allowed");
3274 Discard_Junk_Node (P_Expression);
3277 -- Two expression case (implied True, filled in during semantics)
3283 -- If we have an END IF, diagnose as not needed
3285 if Token = Tok_End then
3286 Error_Msg_SC ("`END IF` not allowed at end of if expression");
3289 if Token = Tok_If then
3294 -- Return the If_Expression node
3296 return Make_If_Expression (Loc, Expressions => Exprs);
3297 end P_If_Expression_Internal;
3301 Loc : constant Source_Ptr := Token_Ptr;
3304 -- Start of processing for P_If_Expression
3307 Error_Msg_Ada_2012_Feature ("|if expression", Token_Ptr);
3309 Inside_If_Expression := Inside_If_Expression + 1;
3310 If_Expr := P_If_Expression_Internal (Loc, P_Expression);
3311 Inside_If_Expression := Inside_If_Expression - 1;
3313 end P_If_Expression;
3315 -----------------------
3316 -- P_Membership_Test --
3317 -----------------------
3319 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3320 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3322 procedure P_Membership_Test (N : Node_Id) is
3323 Alt : constant Node_Id :=
3324 P_Range_Or_Subtype_Mark
3325 (Allow_Simple_Expression => (Ada_Version >= Ada_2012));
3330 if Token = Tok_Vertical_Bar then
3331 Error_Msg_Ada_2012_Feature ("set notation", Token_Ptr);
3332 Set_Alternatives (N, New_List (Alt));
3333 Set_Right_Opnd (N, Empty);
3335 -- Loop to accumulate alternatives
3337 while Token = Tok_Vertical_Bar loop
3338 Scan; -- past vertical bar
3341 P_Range_Or_Subtype_Mark (Allow_Simple_Expression => True));
3347 Set_Right_Opnd (N, Alt);
3348 Set_Alternatives (N, No_List);
3350 end P_Membership_Test;
3352 ------------------------------------------
3353 -- P_Unparen_Cond_Case_Quant_Expression --
3354 ------------------------------------------
3356 function P_Unparen_Cond_Case_Quant_Expression return Node_Id is
3357 Lparen : constant Boolean := Prev_Token = Tok_Left_Paren;
3363 if Token = Tok_Case then
3364 Result := P_Case_Expression;
3366 if not (Lparen and then Token = Tok_Right_Paren) then
3367 Error_Msg_N ("case expression must be parenthesized!", Result);
3372 elsif Token = Tok_If then
3373 Result := P_If_Expression;
3375 if not (Lparen and then Token = Tok_Right_Paren) then
3376 Error_Msg_N ("if expression must be parenthesized!", Result);
3379 -- Quantified expression
3381 elsif Token = Tok_For then
3382 Result := P_Quantified_Expression;
3384 if not (Lparen and then Token = Tok_Right_Paren) then
3386 ("quantified expression must be parenthesized!", Result);
3389 -- No other possibility should exist (caller was supposed to check)
3392 raise Program_Error;
3395 -- Return expression (possibly after having given message)
3398 end P_Unparen_Cond_Case_Quant_Expression;