1 -----------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2019, 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 string
51 -- or a type. For those attributes, a left parenthesis after the attribute
52 -- should not be analyzed as the beginning of a parameters list because it
53 -- may denote a slice operation (X'Img (1 .. 2)) or a type conversion
54 -- (X'Class (Y)). The Ada 2012 attribute 'Old is in this category.
56 -- Note: Loop_Entry is in this list because, although it can take an
57 -- optional argument (the loop name), we can't distinguish that at parse
58 -- time from the case where no loop name is given and a legitimate index
59 -- expression is present. So we parse the argument as an indexed component
60 -- and the semantic analysis sorts out this syntactic ambiguity based on
61 -- the type and form of the expression.
63 -- Note that this map designates the minimum set of attributes where a
64 -- construct in parentheses that is not an argument can appear right
65 -- after the attribute. For attributes like 'Size, we do not put them
66 -- in the map. If someone writes X'Size (3), that's illegal in any case,
67 -- but we get a better error message by parsing the (3) as an illegal
68 -- argument to the attribute, rather than some meaningless junk that
69 -- follows the attribute.
71 -----------------------
72 -- Local Subprograms --
73 -----------------------
75 function P_Aggregate_Or_Paren_Expr return Node_Id;
76 function P_Allocator return Node_Id;
77 function P_Case_Expression_Alternative return Node_Id;
78 function P_Iterated_Component_Association 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;
84 function P_Reduction_Attribute_Reference (S : Node_Id)
87 function P_Binary_Adding_Operator return Node_Kind;
88 function P_Logical_Operator return Node_Kind;
89 function P_Multiplying_Operator return Node_Kind;
90 function P_Relational_Operator return Node_Kind;
91 function P_Unary_Adding_Operator return Node_Kind;
93 procedure Bad_Range_Attribute (Loc : Source_Ptr);
94 -- Called to place complaint about bad range attribute at the given
95 -- source location. Terminates by raising Error_Resync.
97 procedure Check_Bad_Exp;
98 -- Called after scanning a**b, posts error if ** detected
100 procedure P_Membership_Test (N : Node_Id);
101 -- N is the node for a N_In or N_Not_In node whose right operand has not
102 -- yet been processed. It is called just after scanning out the IN keyword.
103 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
105 function P_Range_Attribute_Reference (Prefix_Node : Node_Id) return Node_Id;
106 -- Scan a range attribute reference. The caller has scanned out the
107 -- prefix. The current token is known to be an apostrophe and the
108 -- following token is known to be RANGE.
110 function P_Unparen_Cond_Case_Quant_Expression return Node_Id;
111 -- This function is called with Token pointing to IF, CASE, or FOR, in a
112 -- context that allows a case, conditional, or quantified expression if
113 -- it is surrounded by parentheses. If not surrounded by parentheses, the
114 -- expression is still returned, but an error message is issued.
116 -------------------------
117 -- Bad_Range_Attribute --
118 -------------------------
120 procedure Bad_Range_Attribute (Loc : Source_Ptr) is
122 Error_Msg ("range attribute cannot be used in expression!", Loc);
124 end Bad_Range_Attribute;
130 procedure Check_Bad_Exp is
132 if Token = Tok_Double_Asterisk then
133 Error_Msg_SC ("parenthesization required for '*'*");
135 Discard_Junk_Node (P_Primary);
140 --------------------------
141 -- 4.1 Name (also 6.4) --
142 --------------------------
145 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
146 -- | INDEXED_COMPONENT | SLICE
147 -- | SELECTED_COMPONENT | ATTRIBUTE
148 -- | TYPE_CONVERSION | FUNCTION_CALL
149 -- | CHARACTER_LITERAL | TARGET_NAME
151 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
153 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
155 -- EXPLICIT_DEREFERENCE ::= NAME . all
157 -- IMPLICIT_DEREFERENCE ::= NAME
159 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
161 -- SLICE ::= PREFIX (DISCRETE_RANGE)
163 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
165 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
167 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
169 -- ATTRIBUTE_DESIGNATOR ::=
170 -- IDENTIFIER [(static_EXPRESSION)]
171 -- | access | delta | digits
175 -- | function_PREFIX ACTUAL_PARAMETER_PART
177 -- ACTUAL_PARAMETER_PART ::=
178 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
180 -- PARAMETER_ASSOCIATION ::=
181 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
183 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
185 -- TARGET_NAME ::= @ (AI12-0125-3: abbreviation for LHS)
187 -- Note: syntactically a procedure call looks just like a function call,
188 -- so this routine is in practice used to scan out procedure calls as well.
190 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
192 -- Error recovery: can raise Error_Resync
194 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
195 -- followed by either a left paren (qualified expression case), or by
196 -- range (range attribute case). All other uses of apostrophe (i.e. all
197 -- other attributes) are handled in this routine.
199 -- Error recovery: can raise Error_Resync
201 function P_Name return Node_Id is
202 Scan_State : Saved_Scan_State;
204 Prefix_Node : Node_Id;
205 Ident_Node : Node_Id;
207 Range_Node : Node_Id;
210 Arg_List : List_Id := No_List; -- kill junk warning
211 Attr_Name : Name_Id := No_Name; -- kill junk warning
214 -- Case of not a name
216 if Token not in Token_Class_Name then
218 -- If it looks like start of expression, complain and scan expression
220 if Token in Token_Class_Literal
221 or else Token = Tok_Left_Paren
223 Error_Msg_SC ("name expected");
226 -- Otherwise some other junk, not much we can do
229 Error_Msg_AP ("name expected");
234 -- Loop through designators in qualified name
235 -- AI12-0125 : target_name
237 if Token = Tok_At_Sign then
238 Scan_Reserved_Identifier (Force_Msg => False);
240 if Present (Current_Assign_Node) then
241 Set_Has_Target_Names (Current_Assign_Node);
245 Name_Node := Token_Node;
248 Scan; -- past designator
249 exit when Token /= Tok_Dot;
250 Save_Scan_State (Scan_State); -- at dot
253 -- If we do not have another designator after the dot, then join
254 -- the normal circuit to handle a dot extension (may be .all or
255 -- character literal case). Otherwise loop back to scan the next
258 if Token not in Token_Class_Desig then
259 goto Scan_Name_Extension_Dot;
261 Prefix_Node := Name_Node;
262 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
263 Set_Prefix (Name_Node, Prefix_Node);
264 Set_Selector_Name (Name_Node, Token_Node);
268 -- We have now scanned out a qualified designator. If the last token is
269 -- an operator symbol, then we certainly do not have the Snam case, so
270 -- we can just use the normal name extension check circuit
272 if Prev_Token = Tok_Operator_Symbol then
273 goto Scan_Name_Extension;
276 -- We have scanned out a qualified simple name, check for name extension
277 -- Note that we know there is no dot here at this stage, so the only
278 -- possible cases of name extension are apostrophe and left paren.
280 if Token = Tok_Apostrophe then
281 Save_Scan_State (Scan_State); -- at apostrophe
282 Scan; -- past apostrophe
284 -- Qualified expression in Ada 2012 mode (treated as a name)
286 if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
287 goto Scan_Name_Extension_Apostrophe;
289 -- If left paren not in Ada 2012, then it is not part of the name,
290 -- since qualified expressions are not names in prior versions of
291 -- Ada, so return with Token backed up to point to the apostrophe.
292 -- The treatment for the range attribute is similar (we do not
293 -- consider x'range to be a name in this grammar).
295 elsif Token = Tok_Left_Paren or else Token = Tok_Range then
296 Restore_Scan_State (Scan_State); -- to apostrophe
297 Expr_Form := EF_Simple_Name;
300 -- Otherwise we have the case of a name extended by an attribute
303 goto Scan_Name_Extension_Apostrophe;
306 -- Check case of qualified simple name extended by a left parenthesis
308 elsif Token = Tok_Left_Paren then
309 Scan; -- past left paren
310 goto Scan_Name_Extension_Left_Paren;
312 -- Otherwise the qualified simple name is not extended, so return
315 Expr_Form := EF_Simple_Name;
319 -- Loop scanning past name extensions. A label is used for control
320 -- transfer for this loop for ease of interfacing with the finite state
321 -- machine in the parenthesis scanning circuit, and also to allow for
322 -- passing in control to the appropriate point from the above code.
324 <<Scan_Name_Extension>>
326 -- Character literal used as name cannot be extended. Also this
327 -- cannot be a call, since the name for a call must be a designator.
328 -- Return in these cases, or if there is no name extension
330 if Token not in Token_Class_Namext
331 or else Prev_Token = Tok_Char_Literal
333 Expr_Form := EF_Name;
337 -- Merge here when we know there is a name extension
339 <<Scan_Name_Extension_OK>>
341 if Token = Tok_Left_Paren then
342 Scan; -- past left paren
343 goto Scan_Name_Extension_Left_Paren;
345 elsif Token = Tok_Apostrophe then
346 Save_Scan_State (Scan_State); -- at apostrophe
347 Scan; -- past apostrophe
348 goto Scan_Name_Extension_Apostrophe;
350 else -- Token = Tok_Dot
351 Save_Scan_State (Scan_State); -- at dot
353 goto Scan_Name_Extension_Dot;
356 -- Case of name extended by dot (selection), dot is already skipped
357 -- and the scan state at the point of the dot is saved in Scan_State.
359 <<Scan_Name_Extension_Dot>>
361 -- Explicit dereference case
363 if Token = Tok_All then
364 Prefix_Node := Name_Node;
365 Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
366 Set_Prefix (Name_Node, Prefix_Node);
368 goto Scan_Name_Extension;
370 -- Selected component case
372 elsif Token in Token_Class_Name then
373 Prefix_Node := Name_Node;
374 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
375 Set_Prefix (Name_Node, Prefix_Node);
376 Set_Selector_Name (Name_Node, Token_Node);
377 Scan; -- past selector
378 goto Scan_Name_Extension;
380 -- Reserved identifier as selector
382 elsif Is_Reserved_Identifier then
383 Scan_Reserved_Identifier (Force_Msg => False);
384 Prefix_Node := Name_Node;
385 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
386 Set_Prefix (Name_Node, Prefix_Node);
387 Set_Selector_Name (Name_Node, Token_Node);
388 Scan; -- past identifier used as selector
389 goto Scan_Name_Extension;
391 -- If dot is at end of line and followed by nothing legal,
392 -- then assume end of name and quit (dot will be taken as
393 -- an incorrect form of some other punctuation by our caller).
395 elsif Token_Is_At_Start_Of_Line then
396 Restore_Scan_State (Scan_State);
399 -- Here if nothing legal after the dot
402 Error_Msg_AP ("selector expected");
406 -- Here for an apostrophe as name extension. The scan position at the
407 -- apostrophe has already been saved, and the apostrophe scanned out.
409 <<Scan_Name_Extension_Apostrophe>>
411 Scan_Apostrophe : declare
412 function Apostrophe_Should_Be_Semicolon return Boolean;
413 -- Checks for case where apostrophe should probably be
414 -- a semicolon, and if so, gives appropriate message,
415 -- resets the scan pointer to the apostrophe, changes
416 -- the current token to Tok_Semicolon, and returns True.
417 -- Otherwise returns False.
419 ------------------------------------
420 -- Apostrophe_Should_Be_Semicolon --
421 ------------------------------------
423 function Apostrophe_Should_Be_Semicolon return Boolean is
425 if Token_Is_At_Start_Of_Line then
426 Restore_Scan_State (Scan_State); -- to apostrophe
427 Error_Msg_SC ("|""''"" should be "";""");
428 Token := Tok_Semicolon;
433 end Apostrophe_Should_Be_Semicolon;
435 -- Start of processing for Scan_Apostrophe
438 -- Check for qualified expression case in Ada 2012 mode
440 if Ada_Version >= Ada_2012 and then Token = Tok_Left_Paren then
441 Name_Node := P_Qualified_Expression (Name_Node);
442 goto Scan_Name_Extension;
444 -- If range attribute after apostrophe, then return with Token
445 -- pointing to the apostrophe. Note that in this case the prefix
446 -- need not be a simple name (cases like A.all'range). Similarly
447 -- if there is a left paren after the apostrophe, then we also
448 -- return with Token pointing to the apostrophe (this is the
449 -- aggregate case, or some error case).
451 elsif Token = Tok_Range or else Token = Tok_Left_Paren then
452 Restore_Scan_State (Scan_State); -- to apostrophe
453 Expr_Form := EF_Name;
456 -- Here for cases where attribute designator is an identifier
458 elsif Token = Tok_Identifier then
459 Attr_Name := Token_Name;
461 if not Is_Attribute_Name (Attr_Name) then
462 if Apostrophe_Should_Be_Semicolon then
463 Expr_Form := EF_Name;
466 -- Here for a bad attribute name
469 Signal_Bad_Attribute;
470 Scan; -- past bad identifier
472 if Token = Tok_Left_Paren then
473 Scan; -- past left paren
476 Discard_Junk_Node (P_Expression_If_OK);
477 exit when not Comma_Present;
488 Style.Check_Attribute_Name (False);
491 -- Here for case of attribute designator is not an identifier
494 if Token = Tok_Delta then
495 Attr_Name := Name_Delta;
497 elsif Token = Tok_Digits then
498 Attr_Name := Name_Digits;
500 elsif Token = Tok_Access then
501 Attr_Name := Name_Access;
503 elsif Token = Tok_Mod and then Ada_Version >= Ada_95 then
504 Attr_Name := Name_Mod;
506 elsif Apostrophe_Should_Be_Semicolon then
507 Expr_Form := EF_Name;
511 Error_Msg_AP ("attribute designator expected");
516 Style.Check_Attribute_Name (True);
520 -- We come here with an OK attribute scanned, and corresponding
521 -- Attribute identifier node stored in Ident_Node.
523 Prefix_Node := Name_Node;
524 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
525 Scan; -- past attribute designator
526 Set_Prefix (Name_Node, Prefix_Node);
527 Set_Attribute_Name (Name_Node, Attr_Name);
529 -- Scan attribute arguments/designator. We skip this if we know
530 -- that the attribute cannot have an argument (see documentation
531 -- of Is_Parameterless_Attribute for further details).
533 if Token = Tok_Left_Paren
535 Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
537 -- Attribute Update contains an array or record association
538 -- list which provides new values for various components or
539 -- elements. The list is parsed as an aggregate, and we get
540 -- better error handling by knowing that in the parser.
542 if Attr_Name = Name_Update then
543 Set_Expressions (Name_Node, New_List);
544 Append (P_Aggregate, Expressions (Name_Node));
546 -- All other cases of parsing attribute arguments
549 Set_Expressions (Name_Node, New_List);
550 Scan; -- past left paren
554 Expr : constant Node_Id := P_Expression_If_OK;
558 -- Case of => for named notation
560 if Token = Tok_Arrow then
562 -- Named notation allowed only for the special
563 -- case of System'Restriction_Set (No_Dependence =>
564 -- unit_NAME), in which case construct a parameter
565 -- assocation node and append to the arguments.
567 if Attr_Name = Name_Restriction_Set
568 and then Nkind (Expr) = N_Identifier
569 and then Chars (Expr) = Name_No_Dependence
573 Append_To (Expressions (Name_Node),
574 Make_Parameter_Association (Sloc (Rnam),
575 Selector_Name => Expr,
576 Explicit_Actual_Parameter => Rnam));
579 -- For all other cases named notation is illegal
583 ("named parameters not permitted "
585 Scan; -- past junk arrow
588 -- Here for normal case (not => for named parameter)
591 -- Special handling for 'Image in Ada 2012, where
592 -- the attribute can be parameterless and its value
593 -- can be the prefix of a slice. Rewrite name as a
594 -- slice, Expr is its low bound.
596 if Token = Tok_Dot_Dot
597 and then Attr_Name = Name_Image
598 and then Ada_Version >= Ada_2012
600 Set_Expressions (Name_Node, No_List);
601 Prefix_Node := Name_Node;
603 New_Node (N_Slice, Sloc (Prefix_Node));
604 Set_Prefix (Name_Node, Prefix_Node);
605 Range_Node := New_Node (N_Range, Token_Ptr);
606 Set_Low_Bound (Range_Node, Expr);
608 Expr_Node := P_Expression;
609 Check_Simple_Expression (Expr_Node);
610 Set_High_Bound (Range_Node, Expr_Node);
611 Set_Discrete_Range (Name_Node, Range_Node);
614 goto Scan_Name_Extension;
617 Append (Expr, Expressions (Name_Node));
618 exit when not Comma_Present;
628 goto Scan_Name_Extension;
631 -- Here for left parenthesis extending name (left paren skipped)
633 <<Scan_Name_Extension_Left_Paren>>
635 -- We now have to scan through a list of items, terminated by a
636 -- right parenthesis. The scan is handled by a finite state
637 -- machine. The possibilities are:
641 -- This is a slice. This case is handled in LP_State_Init
643 -- (expression, expression, ..)
645 -- This is interpreted as an indexed component, i.e. as a
646 -- case of a name which can be extended in the normal manner.
647 -- This case is handled by LP_State_Name or LP_State_Expr.
649 -- Note: if and case expressions (without an extra level of
650 -- parentheses) are permitted in this context).
652 -- (..., identifier => expression , ...)
654 -- If there is at least one occurrence of identifier => (but
655 -- none of the other cases apply), then we have a call.
657 -- Test for Id => case
659 if Token = Tok_Identifier then
660 Save_Scan_State (Scan_State); -- at Id
663 -- Test for => (allow := as an error substitute)
665 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
666 Restore_Scan_State (Scan_State); -- to Id
667 Arg_List := New_List;
671 Restore_Scan_State (Scan_State); -- to Id
675 -- Here we have an expression after all
677 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
679 -- Check cases of discrete range for a slice
681 -- First possibility: Range_Attribute_Reference
683 if Expr_Form = EF_Range_Attr then
684 Range_Node := Expr_Node;
686 -- Second possibility: Simple_expression .. Simple_expression
688 elsif Token = Tok_Dot_Dot then
689 Check_Simple_Expression (Expr_Node);
690 Range_Node := New_Node (N_Range, Token_Ptr);
691 Set_Low_Bound (Range_Node, Expr_Node);
693 Expr_Node := P_Expression;
694 Check_Simple_Expression (Expr_Node);
695 Set_High_Bound (Range_Node, Expr_Node);
697 -- Third possibility: Type_name range Range
699 elsif Token = Tok_Range then
700 if Expr_Form /= EF_Simple_Name then
701 Error_Msg_SC ("subtype mark must precede RANGE");
705 Range_Node := P_Subtype_Indication (Expr_Node);
707 -- Otherwise we just have an expression. It is true that we might
708 -- have a subtype mark without a range constraint but this case
709 -- is syntactically indistinguishable from the expression case.
712 Arg_List := New_List;
716 -- Fall through here with unmistakable Discrete range scanned,
717 -- which means that we definitely have the case of a slice. The
718 -- Discrete range is in Range_Node.
720 if Token = Tok_Comma then
721 Error_Msg_SC ("slice cannot have more than one dimension");
724 elsif Token /= Tok_Right_Paren then
725 if Token = Tok_Arrow then
727 -- This may be an aggregate that is missing a qualification
730 ("context of aggregate must be a qualified expression");
739 Scan; -- past right paren
740 Prefix_Node := Name_Node;
741 Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
742 Set_Prefix (Name_Node, Prefix_Node);
743 Set_Discrete_Range (Name_Node, Range_Node);
745 -- An operator node is legal as a prefix to other names,
746 -- but not for a slice.
748 if Nkind (Prefix_Node) = N_Operator_Symbol then
749 Error_Msg_N ("illegal prefix for slice", Prefix_Node);
752 -- If we have a name extension, go scan it
754 if Token in Token_Class_Namext then
755 goto Scan_Name_Extension_OK;
757 -- Otherwise return (a slice is a name, but is not a call)
760 Expr_Form := EF_Name;
765 -- In LP_State_Expr, we have scanned one or more expressions, and
766 -- so we have a call or an indexed component which is a name. On
767 -- entry we have the expression just scanned in Expr_Node and
768 -- Arg_List contains the list of expressions encountered so far
771 Append (Expr_Node, Arg_List);
773 if Token = Tok_Arrow then
775 ("expect identifier in parameter association", Sloc (Expr_Node));
778 elsif not Comma_Present then
781 Prefix_Node := Name_Node;
782 Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
783 Set_Prefix (Name_Node, Prefix_Node);
784 Set_Expressions (Name_Node, Arg_List);
786 goto Scan_Name_Extension;
789 -- Comma present (and scanned out), test for identifier => case
790 -- Test for identifier => case
792 if Token = Tok_Identifier then
793 Save_Scan_State (Scan_State); -- at Id
796 -- Test for => (allow := as error substitute)
798 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
799 Restore_Scan_State (Scan_State); -- to Id
802 -- Otherwise it's just an expression after all, so backup
805 Restore_Scan_State (Scan_State); -- to Id
809 -- Here we have an expression after all, so stay in this state
811 Expr_Node := P_Expression_If_OK;
814 -- LP_State_Call corresponds to the situation in which at least one
815 -- instance of Id => Expression has been encountered, so we know that
816 -- we do not have a name, but rather a call. We enter it with the
817 -- scan pointer pointing to the next argument to scan, and Arg_List
818 -- containing the list of arguments scanned so far.
822 -- Test for case of Id => Expression (named parameter)
824 if Token = Tok_Identifier then
825 Save_Scan_State (Scan_State); -- at Id
826 Ident_Node := Token_Node;
829 -- Deal with => (allow := as incorrect substitute)
831 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
832 Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);
833 Set_Selector_Name (Arg_Node, Ident_Node);
835 Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
836 Append (Arg_Node, Arg_List);
838 -- If a comma follows, go back and scan next entry
840 if Comma_Present then
843 -- Otherwise we have the end of a call
846 Prefix_Node := Name_Node;
847 Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
848 Set_Name (Name_Node, Prefix_Node);
849 Set_Parameter_Associations (Name_Node, Arg_List);
852 if Token in Token_Class_Namext then
853 goto Scan_Name_Extension_OK;
855 -- This is a case of a call which cannot be a name
858 Expr_Form := EF_Name;
863 -- Not named parameter: Id started an expression after all
866 Restore_Scan_State (Scan_State); -- to Id
870 -- Here if entry did not start with Id => which means that it
871 -- is a positional parameter, which is not allowed, since we
872 -- have seen at least one named parameter already.
875 ("positional parameter association " &
876 "not allowed after named one");
878 Expr_Node := P_Expression_If_OK;
880 -- Leaving the '>' in an association is not unusual, so suggest
883 if Nkind (Expr_Node) = N_Op_Eq then
884 Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
887 -- We go back to scanning out expressions, so that we do not get
888 -- multiple error messages when several positional parameters
889 -- follow a named parameter.
893 -- End of treatment for name extensions starting with left paren
895 -- End of loop through name extensions
899 -- This function parses a restricted form of Names which are either
900 -- designators, or designators preceded by a sequence of prefixes
901 -- that are direct names.
903 -- Error recovery: cannot raise Error_Resync
905 function P_Function_Name return Node_Id is
906 Designator_Node : Node_Id;
907 Prefix_Node : Node_Id;
908 Selector_Node : Node_Id;
909 Dot_Sloc : Source_Ptr := No_Location;
912 -- Prefix_Node is set to the gathered prefix so far, Empty means that
913 -- no prefix has been scanned. This allows us to build up the result
914 -- in the required right recursive manner.
916 Prefix_Node := Empty;
918 -- Loop through prefixes
921 Designator_Node := Token_Node;
923 if Token not in Token_Class_Desig then
924 return P_Identifier; -- let P_Identifier issue the error message
926 else -- Token in Token_Class_Desig
927 Scan; -- past designator
928 exit when Token /= Tok_Dot;
931 -- Here at a dot, with token just before it in Designator_Node
933 if No (Prefix_Node) then
934 Prefix_Node := Designator_Node;
936 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
937 Set_Prefix (Selector_Node, Prefix_Node);
938 Set_Selector_Name (Selector_Node, Designator_Node);
939 Prefix_Node := Selector_Node;
942 Dot_Sloc := Token_Ptr;
946 -- Fall out of the loop having just scanned a designator
948 if No (Prefix_Node) then
949 return Designator_Node;
951 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
952 Set_Prefix (Selector_Node, Prefix_Node);
953 Set_Selector_Name (Selector_Node, Designator_Node);
954 return Selector_Node;
962 -- This function parses a restricted form of Names which are either
963 -- identifiers, or identifiers preceded by a sequence of prefixes
964 -- that are direct names.
966 -- Error recovery: cannot raise Error_Resync
968 function P_Qualified_Simple_Name return Node_Id is
969 Designator_Node : Node_Id;
970 Prefix_Node : Node_Id;
971 Selector_Node : Node_Id;
972 Dot_Sloc : Source_Ptr := No_Location;
975 -- Prefix node is set to the gathered prefix so far, Empty means that
976 -- no prefix has been scanned. This allows us to build up the result
977 -- in the required right recursive manner.
979 Prefix_Node := Empty;
981 -- Loop through prefixes
984 Designator_Node := Token_Node;
986 if Token = Tok_Identifier then
987 Scan; -- past identifier
988 exit when Token /= Tok_Dot;
990 elsif Token not in Token_Class_Desig then
991 return P_Identifier; -- let P_Identifier issue the error message
994 Scan; -- past designator
996 if Token /= Tok_Dot then
997 Error_Msg_SP ("identifier expected");
1002 -- Here at a dot, with token just before it in Designator_Node
1004 if No (Prefix_Node) then
1005 Prefix_Node := Designator_Node;
1007 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1008 Set_Prefix (Selector_Node, Prefix_Node);
1009 Set_Selector_Name (Selector_Node, Designator_Node);
1010 Prefix_Node := Selector_Node;
1013 Dot_Sloc := Token_Ptr;
1017 -- Fall out of the loop having just scanned an identifier
1019 if No (Prefix_Node) then
1020 return Designator_Node;
1022 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1023 Set_Prefix (Selector_Node, Prefix_Node);
1024 Set_Selector_Name (Selector_Node, Designator_Node);
1025 return Selector_Node;
1029 when Error_Resync =>
1031 end P_Qualified_Simple_Name;
1033 -- This procedure differs from P_Qualified_Simple_Name only in that it
1034 -- raises Error_Resync if any error is encountered. It only returns after
1035 -- scanning a valid qualified simple name.
1037 -- Error recovery: can raise Error_Resync
1039 function P_Qualified_Simple_Name_Resync return Node_Id is
1040 Designator_Node : Node_Id;
1041 Prefix_Node : Node_Id;
1042 Selector_Node : Node_Id;
1043 Dot_Sloc : Source_Ptr := No_Location;
1046 Prefix_Node := Empty;
1048 -- Loop through prefixes
1051 Designator_Node := Token_Node;
1053 if Token = Tok_Identifier then
1054 Scan; -- past identifier
1055 exit when Token /= Tok_Dot;
1057 elsif Token not in Token_Class_Desig then
1058 Discard_Junk_Node (P_Identifier); -- to issue the error message
1062 Scan; -- past designator
1064 if Token /= Tok_Dot then
1065 Error_Msg_SP ("identifier expected");
1070 -- Here at a dot, with token just before it in Designator_Node
1072 if No (Prefix_Node) then
1073 Prefix_Node := Designator_Node;
1075 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1076 Set_Prefix (Selector_Node, Prefix_Node);
1077 Set_Selector_Name (Selector_Node, Designator_Node);
1078 Prefix_Node := Selector_Node;
1081 Dot_Sloc := Token_Ptr;
1082 Scan; -- past period
1085 -- Fall out of the loop having just scanned an identifier
1087 if No (Prefix_Node) then
1088 return Designator_Node;
1090 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
1091 Set_Prefix (Selector_Node, Prefix_Node);
1092 Set_Selector_Name (Selector_Node, Designator_Node);
1093 return Selector_Node;
1095 end P_Qualified_Simple_Name_Resync;
1097 ----------------------
1098 -- 4.1 Direct_Name --
1099 ----------------------
1101 -- Parsed by P_Name and other functions in section 4.1
1107 -- Parsed by P_Name (4.1)
1109 -------------------------------
1110 -- 4.1 Explicit Dereference --
1111 -------------------------------
1113 -- Parsed by P_Name (4.1)
1115 -------------------------------
1116 -- 4.1 Implicit_Dereference --
1117 -------------------------------
1119 -- Parsed by P_Name (4.1)
1121 ----------------------------
1122 -- 4.1 Indexed Component --
1123 ----------------------------
1125 -- Parsed by P_Name (4.1)
1131 -- Parsed by P_Name (4.1)
1133 -----------------------------
1134 -- 4.1 Selected_Component --
1135 -----------------------------
1137 -- Parsed by P_Name (4.1)
1139 ------------------------
1140 -- 4.1 Selector Name --
1141 ------------------------
1143 -- Parsed by P_Name (4.1)
1145 ------------------------------
1146 -- 4.1 Attribute Reference --
1147 ------------------------------
1149 -- Parsed by P_Name (4.1)
1151 -------------------------------
1152 -- 4.1 Attribute Designator --
1153 -------------------------------
1155 -- Parsed by P_Name (4.1)
1157 --------------------------------------
1158 -- 4.1.4 Range Attribute Reference --
1159 --------------------------------------
1161 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1163 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1165 -- In the grammar, a RANGE attribute is simply a name, but its use is
1166 -- highly restricted, so in the parser, we do not regard it as a name.
1167 -- Instead, P_Name returns without scanning the 'RANGE part of the
1168 -- attribute, and the caller uses the following function to construct
1169 -- a range attribute in places where it is appropriate.
1171 -- Note that RANGE here is treated essentially as an identifier,
1172 -- rather than a reserved word.
1174 -- The caller has parsed the prefix, i.e. a name, and Token points to
1175 -- the apostrophe. The token after the apostrophe is known to be RANGE
1176 -- at this point. The prefix node becomes the prefix of the attribute.
1178 -- Error_Recovery: Cannot raise Error_Resync
1180 function P_Range_Attribute_Reference
1181 (Prefix_Node : Node_Id)
1184 Attr_Node : Node_Id;
1187 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1188 Set_Prefix (Attr_Node, Prefix_Node);
1189 Scan; -- past apostrophe
1192 Style.Check_Attribute_Name (True);
1195 Set_Attribute_Name (Attr_Node, Name_Range);
1198 if Token = Tok_Left_Paren then
1199 Scan; -- past left paren
1200 Set_Expressions (Attr_Node, New_List (P_Expression_If_OK));
1205 end P_Range_Attribute_Reference;
1207 -------------------------------------
1208 -- P_Reduction_Attribute_Reference --
1209 -------------------------------------
1211 function P_Reduction_Attribute_Reference (S : Node_Id)
1214 Attr_Node : Node_Id;
1215 Attr_Name : Name_Id;
1218 Attr_Name := Token_Name;
1219 Scan; -- past Reduce
1220 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1221 Set_Attribute_Name (Attr_Node, Attr_Name);
1222 if Attr_Name /= Name_Reduce then
1223 Error_Msg ("reduce attribute expected", Prev_Token_Ptr);
1226 Set_Prefix (Attr_Node, S);
1227 Set_Expressions (Attr_Node, New_List);
1229 Append (P_Name, Expressions (Attr_Node));
1231 Append (P_Expression, Expressions (Attr_Node));
1235 end P_Reduction_Attribute_Reference;
1237 ---------------------------------------
1238 -- 4.1.4 Range Attribute Designator --
1239 ---------------------------------------
1241 -- Parsed by P_Range_Attribute_Reference (4.4)
1243 ---------------------------------------------
1244 -- 4.1.4 (2) Reduction_Attribute_Reference --
1245 ---------------------------------------------
1247 -- parsed by P_Reduction_Attribute_Reference
1249 --------------------
1251 --------------------
1253 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1255 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1256 -- an aggregate is known to be required (code statement, extension
1257 -- aggregate), in which cases this routine performs the necessary check
1258 -- that we have an aggregate rather than a parenthesized expression
1260 -- Error recovery: can raise Error_Resync
1262 function P_Aggregate return Node_Id is
1263 Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1264 Aggr_Node : constant Node_Id := P_Aggregate_Or_Paren_Expr;
1267 if Nkind (Aggr_Node) /= N_Aggregate
1269 Nkind (Aggr_Node) /= N_Extension_Aggregate
1270 and then Ada_Version < Ada_2020
1273 ("aggregate may not have single positional component", Aggr_Sloc);
1280 ------------------------------------------------
1281 -- 4.3 Aggregate or Parenthesized Expression --
1282 ------------------------------------------------
1284 -- This procedure parses out either an aggregate or a parenthesized
1285 -- expression (these two constructs are closely related, since a
1286 -- parenthesized expression looks like an aggregate with a single
1287 -- positional component).
1290 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1292 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1294 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1295 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1298 -- RECORD_COMPONENT_ASSOCIATION ::=
1299 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1301 -- COMPONENT_CHOICE_LIST ::=
1302 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1305 -- EXTENSION_AGGREGATE ::=
1306 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1308 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1310 -- ARRAY_AGGREGATE ::=
1311 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1313 -- POSITIONAL_ARRAY_AGGREGATE ::=
1314 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1315 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1316 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1318 -- NAMED_ARRAY_AGGREGATE ::=
1319 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1321 -- PRIMARY ::= (EXPRESSION);
1323 -- Error recovery: can raise Error_Resync
1325 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1326 -- to Ada 2005 limited aggregates (AI-287)
1328 function P_Aggregate_Or_Paren_Expr return Node_Id is
1329 Aggregate_Node : Node_Id;
1330 Expr_List : List_Id;
1331 Assoc_List : List_Id;
1332 Expr_Node : Node_Id;
1333 Lparen_Sloc : Source_Ptr;
1334 Scan_State : Saved_Scan_State;
1336 procedure Box_Error;
1337 -- Called if <> is encountered as positional aggregate element. Issues
1338 -- error message and sets Expr_Node to Error.
1340 function Is_Quantified_Expression return Boolean;
1341 -- The presence of iterated component associations requires a one
1342 -- token lookahead to distinguish it from quantified expressions.
1348 procedure Box_Error is
1350 if Ada_Version < Ada_2005 then
1351 Error_Msg_SC ("box in aggregate is an Ada 2005 extension");
1354 -- Ada 2005 (AI-287): The box notation is allowed only with named
1355 -- notation because positional notation might be error prone. For
1356 -- example, in "(X, <>, Y, <>)", there is no type associated with
1357 -- the boxes, so you might not be leaving out the components you
1358 -- thought you were leaving out.
1360 Error_Msg_SC ("(Ada 2005) box only allowed with named notation");
1365 ------------------------------
1366 -- Is_Quantified_Expression --
1367 ------------------------------
1369 function Is_Quantified_Expression return Boolean is
1371 Scan_State : Saved_Scan_State;
1374 Save_Scan_State (Scan_State);
1376 Maybe := Token = Tok_All or else Token = Tok_Some;
1377 Restore_Scan_State (Scan_State); -- to FOR
1379 end Is_Quantified_Expression;
1381 -- Start of processing for P_Aggregate_Or_Paren_Expr
1384 Lparen_Sloc := Token_Ptr;
1385 if Token = Tok_Left_Bracket and then Ada_Version >= Ada_2020 then
1388 -- Special case for null aggregate in Ada 2020
1390 if Token = Tok_Right_Bracket then
1392 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1393 Set_Expressions (Aggregate_Node, New_List);
1394 Set_Is_Homogeneous_Aggregate (Aggregate_Node);
1395 return Aggregate_Node;
1401 -- Note on parentheses count. For cases like an if expression, the
1402 -- parens here really count as real parentheses for the paren count,
1403 -- so we adjust the paren count accordingly after scanning the expr.
1407 if Token = Tok_If then
1408 Expr_Node := P_If_Expression;
1410 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1415 elsif Token = Tok_Case then
1416 Expr_Node := P_Case_Expression;
1418 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1421 -- Quantified expression
1423 elsif Token = Tok_For and then Is_Quantified_Expression then
1424 Expr_Node := P_Quantified_Expression;
1426 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1429 -- Note: the mechanism used here of rescanning the initial expression
1430 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1431 -- out the discrete choice list.
1433 -- Deal with expression and extension aggregates first
1435 elsif Token /= Tok_Others then
1436 Save_Scan_State (Scan_State); -- at start of expression
1438 -- Deal with (NULL RECORD)
1440 if Token = Tok_Null then
1443 if Token = Tok_Record then
1444 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1445 Set_Null_Record_Present (Aggregate_Node, True);
1446 Scan; -- past RECORD
1448 return Aggregate_Node;
1450 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1453 elsif Token = Tok_For then
1454 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1455 Expr_Node := P_Iterated_Component_Association;
1459 -- Scan expression, handling box appearing as positional argument
1461 if Token = Tok_Box then
1464 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1467 -- Extension or Delta aggregate
1469 if Token = Tok_With then
1470 if Nkind (Expr_Node) = N_Attribute_Reference
1471 and then Attribute_Name (Expr_Node) = Name_Range
1473 Bad_Range_Attribute (Sloc (Expr_Node));
1477 if Ada_Version = Ada_83 then
1478 Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1482 if Token = Tok_Delta then
1484 Aggregate_Node := New_Node (N_Delta_Aggregate, Lparen_Sloc);
1485 Set_Expression (Aggregate_Node, Expr_Node);
1491 Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1492 Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1495 -- Deal with WITH NULL RECORD case
1497 if Token = Tok_Null then
1498 Save_Scan_State (Scan_State); -- at NULL
1501 if Token = Tok_Record then
1502 Scan; -- past RECORD
1503 Set_Null_Record_Present (Aggregate_Node, True);
1505 return Aggregate_Node;
1508 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1512 if Token /= Tok_Others then
1513 Save_Scan_State (Scan_State);
1514 Expr_Node := P_Expression;
1521 elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1522 if Nkind (Expr_Node) = N_Attribute_Reference
1523 and then Attribute_Name (Expr_Node) = Name_Range
1526 ("|parentheses not allowed for range attribute", Lparen_Sloc);
1527 Scan; -- past right paren
1531 -- Bump paren count of expression
1533 if Expr_Node /= Error then
1534 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1537 T_Right_Paren; -- past right paren (error message if none)
1543 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1549 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1553 -- Prepare to scan list of component associations
1555 Expr_List := No_List; -- don't set yet, maybe all named entries
1556 Assoc_List := No_List; -- don't set yet, maybe all positional entries
1558 -- This loop scans through component associations. On entry to the
1559 -- loop, an expression has been scanned at the start of the current
1560 -- association unless initial token was OTHERS, in which case
1561 -- Expr_Node is set to Empty.
1564 -- Deal with others association first. This is a named association
1566 if No (Expr_Node) then
1567 if No (Assoc_List) then
1568 Assoc_List := New_List;
1571 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1573 -- Improper use of WITH
1575 elsif Token = Tok_With then
1576 Error_Msg_SC ("WITH must be preceded by single expression in " &
1577 "extension aggregate");
1580 -- Range attribute can only appear as part of a discrete choice list
1582 elsif Nkind (Expr_Node) = N_Attribute_Reference
1583 and then Attribute_Name (Expr_Node) = Name_Range
1584 and then Token /= Tok_Arrow
1585 and then Token /= Tok_Vertical_Bar
1587 Bad_Range_Attribute (Sloc (Expr_Node));
1590 -- Assume positional case if comma, right paren, or literal or
1591 -- identifier or OTHERS follows (the latter cases are missing
1592 -- comma cases). Also assume positional if a semicolon follows,
1593 -- which can happen if there are missing parens.
1595 elsif Nkind (Expr_Node) = N_Iterated_Component_Association then
1596 if No (Assoc_List) then
1597 Assoc_List := New_List (Expr_Node);
1599 Append_To (Assoc_List, Expr_Node);
1602 elsif Token = Tok_Comma
1603 or else Token = Tok_Right_Paren
1604 or else Token = Tok_Others
1605 or else Token in Token_Class_Lit_Or_Name
1606 or else Token = Tok_Semicolon
1608 if Present (Assoc_List) then
1609 Error_Msg_BC -- CODEFIX
1610 ("""='>"" expected (positional association cannot follow "
1611 & "named association)");
1614 if No (Expr_List) then
1615 Expr_List := New_List;
1618 Append (Expr_Node, Expr_List);
1620 -- Check for aggregate followed by left parent, maybe missing comma
1622 elsif Nkind (Expr_Node) = N_Aggregate
1623 and then Token = Tok_Left_Paren
1627 if No (Expr_List) then
1628 Expr_List := New_List;
1631 Append (Expr_Node, Expr_List);
1633 elsif Token = Tok_Right_Bracket then
1634 if No (Expr_List) then
1635 Expr_List := New_List;
1638 Append (Expr_Node, Expr_List);
1641 -- Anything else is assumed to be a named association
1644 Restore_Scan_State (Scan_State); -- to start of expression
1646 if No (Assoc_List) then
1647 Assoc_List := New_List;
1650 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1653 exit when not Comma_Present;
1655 -- If we are at an expression terminator, something is seriously
1656 -- wrong, so let's get out now, before we start eating up stuff
1657 -- that doesn't belong to us.
1659 if Token in Token_Class_Eterm and then Token /= Tok_For then
1661 ("expecting expression or component association");
1665 -- Deal with misused box
1667 if Token = Tok_Box then
1670 -- Otherwise initiate for reentry to top of loop by scanning an
1671 -- initial expression, unless the first token is OTHERS or FOR,
1672 -- which indicates an iterated component association.
1674 elsif Token = Tok_Others then
1677 elsif Token = Tok_For then
1678 Expr_Node := P_Iterated_Component_Association;
1681 Save_Scan_State (Scan_State); -- at start of expression
1682 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1687 -- All component associations (positional and named) have been scanned
1689 if Token = Tok_Right_Bracket and then Ada_Version >= Ada_2020 then
1690 Set_Component_Associations (Aggregate_Node, Assoc_List);
1691 Set_Is_Homogeneous_Aggregate (Aggregate_Node);
1692 Scan; -- past right bracket
1693 if Token = Tok_Apostrophe then
1695 if Token = Tok_Identifier then
1696 return P_Reduction_Attribute_Reference (Aggregate_Node);
1703 if Nkind (Aggregate_Node) /= N_Delta_Aggregate then
1704 Set_Expressions (Aggregate_Node, Expr_List);
1707 Set_Component_Associations (Aggregate_Node, Assoc_List);
1708 return Aggregate_Node;
1709 end P_Aggregate_Or_Paren_Expr;
1711 ------------------------------------------------
1712 -- 4.3 Record or Array Component Association --
1713 ------------------------------------------------
1715 -- RECORD_COMPONENT_ASSOCIATION ::=
1716 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1717 -- | COMPONENT_CHOICE_LIST => <>
1719 -- COMPONENT_CHOICE_LIST =>
1720 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1723 -- ARRAY_COMPONENT_ASSOCIATION ::=
1724 -- DISCRETE_CHOICE_LIST => EXPRESSION
1725 -- | DISCRETE_CHOICE_LIST => <>
1726 -- | ITERATED_COMPONENT_ASSOCIATION
1728 -- Note: this routine only handles the named cases, including others.
1729 -- Cases where the component choice list is not present have already
1730 -- been handled directly.
1732 -- Error recovery: can raise Error_Resync
1734 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1735 -- rules have been extended to give support to Ada 2005 limited
1736 -- aggregates (AI-287)
1738 function P_Record_Or_Array_Component_Association return Node_Id is
1739 Assoc_Node : Node_Id;
1742 -- A loop indicates an iterated_component_association
1744 if Token = Tok_For then
1745 return P_Iterated_Component_Association;
1748 Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1749 Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1750 Set_Sloc (Assoc_Node, Token_Ptr);
1753 if Token = Tok_Box then
1755 -- Ada 2005(AI-287): The box notation is used to indicate the
1756 -- default initialization of aggregate components
1758 if Ada_Version < Ada_2005 then
1760 ("component association with '<'> is an Ada 2005 extension");
1761 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1764 Set_Box_Present (Assoc_Node);
1767 Set_Expression (Assoc_Node, P_Expression);
1771 end P_Record_Or_Array_Component_Association;
1773 -----------------------------
1774 -- 4.3.1 Record Aggregate --
1775 -----------------------------
1777 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1778 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1780 ----------------------------------------------
1781 -- 4.3.1 Record Component Association List --
1782 ----------------------------------------------
1784 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1786 ----------------------------------
1787 -- 4.3.1 Component Choice List --
1788 ----------------------------------
1790 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1792 --------------------------------
1793 -- 4.3.1 Extension Aggregate --
1794 --------------------------------
1796 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1798 --------------------------
1799 -- 4.3.1 Ancestor Part --
1800 --------------------------
1802 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1804 ----------------------------
1805 -- 4.3.1 Array Aggregate --
1806 ----------------------------
1808 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1810 ---------------------------------------
1811 -- 4.3.1 Positional Array Aggregate --
1812 ---------------------------------------
1814 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1816 ----------------------------------
1817 -- 4.3.1 Named Array Aggregate --
1818 ----------------------------------
1820 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1822 ----------------------------------------
1823 -- 4.3.1 Array Component Association --
1824 ----------------------------------------
1826 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1828 ---------------------
1829 -- 4.4 Expression --
1830 ---------------------
1832 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1835 -- RELATION {LOGICAL_OPERATOR RELATION}
1837 -- CHOICE_EXPRESSION ::=
1838 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1840 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1842 -- On return, Expr_Form indicates the categorization of the expression
1843 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1844 -- an error message is given, and Error is returned).
1846 -- Error recovery: cannot raise Error_Resync
1848 function P_Expression return Node_Id is
1849 Logical_Op : Node_Kind;
1850 Prev_Logical_Op : Node_Kind;
1851 Op_Location : Source_Ptr;
1856 Node1 := P_Relation;
1858 if Token in Token_Class_Logop then
1859 Prev_Logical_Op := N_Empty;
1862 Op_Location := Token_Ptr;
1863 Logical_Op := P_Logical_Operator;
1865 if Prev_Logical_Op /= N_Empty and then
1866 Logical_Op /= Prev_Logical_Op
1869 ("mixed logical operators in expression", Op_Location);
1870 Prev_Logical_Op := N_Empty;
1872 Prev_Logical_Op := Logical_Op;
1876 Node1 := New_Op_Node (Logical_Op, Op_Location);
1877 Set_Left_Opnd (Node1, Node2);
1878 Set_Right_Opnd (Node1, P_Relation);
1880 -- Check for case of errant comma or semicolon
1882 if Token = Tok_Comma or else Token = Tok_Semicolon then
1884 Com : constant Boolean := Token = Tok_Comma;
1885 Scan_State : Saved_Scan_State;
1889 Save_Scan_State (Scan_State); -- at comma/semicolon
1890 Scan; -- past comma/semicolon
1892 -- Check for AND THEN or OR ELSE after comma/semicolon. We
1893 -- do not deal with AND/OR because those cases get mixed up
1894 -- with the select alternatives case.
1896 if Token = Tok_And or else Token = Tok_Or then
1897 Logop := P_Logical_Operator;
1898 Restore_Scan_State (Scan_State); -- to comma/semicolon
1900 if Nkind_In (Logop, N_And_Then, N_Or_Else) then
1901 Scan; -- past comma/semicolon
1904 Error_Msg_SP -- CODEFIX
1905 ("|extra "","" ignored");
1907 Error_Msg_SP -- CODEFIX
1908 ("|extra "";"" ignored");
1912 Restore_Scan_State (Scan_State); -- to comma/semicolon
1916 Restore_Scan_State (Scan_State); -- to comma/semicolon
1921 exit when Token not in Token_Class_Logop;
1924 Expr_Form := EF_Non_Simple;
1927 if Token = Tok_Apostrophe then
1928 Bad_Range_Attribute (Token_Ptr);
1935 -- This function is identical to the normal P_Expression, except that it
1936 -- also permits the appearance of a case, conditional, or quantified
1937 -- expression if the call immediately follows a left paren, and followed
1938 -- by a right parenthesis. These forms are allowed if these conditions
1939 -- are not met, but an error message will be issued.
1941 function P_Expression_If_OK return Node_Id is
1943 -- Case of conditional, case or quantified expression
1945 if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
1946 return P_Unparen_Cond_Case_Quant_Expression;
1948 -- Normal case, not case/conditional/quantified expression
1951 return P_Expression;
1953 end P_Expression_If_OK;
1955 -- This function is identical to the normal P_Expression, except that it
1956 -- checks that the expression scan did not stop on a right paren. It is
1957 -- called in all contexts where a right parenthesis cannot legitimately
1958 -- follow an expression.
1960 -- Error recovery: cannot raise Error_Resync
1962 function P_Expression_No_Right_Paren return Node_Id is
1963 Expr : constant Node_Id := P_Expression;
1965 Ignore (Tok_Right_Paren);
1967 end P_Expression_No_Right_Paren;
1969 ----------------------------------------
1970 -- 4.4 Expression_Or_Range_Attribute --
1971 ----------------------------------------
1974 -- RELATION {and RELATION} | RELATION {and then RELATION}
1975 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1976 -- | RELATION {xor RELATION}
1978 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1980 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1982 -- On return, Expr_Form indicates the categorization of the expression
1983 -- and EF_Range_Attr is one of the possibilities.
1985 -- Error recovery: cannot raise Error_Resync
1987 -- In the grammar, a RANGE attribute is simply a name, but its use is
1988 -- highly restricted, so in the parser, we do not regard it as a name.
1989 -- Instead, P_Name returns without scanning the 'RANGE part of the
1990 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1991 -- attribute reference. In the normal case where a range attribute is
1992 -- not allowed, an error message is issued by P_Expression.
1994 function P_Expression_Or_Range_Attribute return Node_Id is
1995 Logical_Op : Node_Kind;
1996 Prev_Logical_Op : Node_Kind;
1997 Op_Location : Source_Ptr;
2000 Attr_Node : Node_Id;
2003 Node1 := P_Relation;
2005 if Token = Tok_Apostrophe then
2006 Attr_Node := P_Range_Attribute_Reference (Node1);
2007 Expr_Form := EF_Range_Attr;
2010 elsif Token in Token_Class_Logop then
2011 Prev_Logical_Op := N_Empty;
2014 Op_Location := Token_Ptr;
2015 Logical_Op := P_Logical_Operator;
2017 if Prev_Logical_Op /= N_Empty and then
2018 Logical_Op /= Prev_Logical_Op
2021 ("mixed logical operators in expression", Op_Location);
2022 Prev_Logical_Op := N_Empty;
2024 Prev_Logical_Op := Logical_Op;
2028 Node1 := New_Op_Node (Logical_Op, Op_Location);
2029 Set_Left_Opnd (Node1, Node2);
2030 Set_Right_Opnd (Node1, P_Relation);
2031 exit when Token not in Token_Class_Logop;
2034 Expr_Form := EF_Non_Simple;
2037 if Token = Tok_Apostrophe then
2038 Bad_Range_Attribute (Token_Ptr);
2043 end P_Expression_Or_Range_Attribute;
2045 -- Version that allows a non-parenthesized case, conditional, or quantified
2046 -- expression if the call immediately follows a left paren, and followed
2047 -- by a right parenthesis. These forms are allowed if these conditions
2048 -- are not met, but an error message will be issued.
2050 function P_Expression_Or_Range_Attribute_If_OK return Node_Id is
2052 -- Case of conditional, case or quantified expression
2054 if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
2055 return P_Unparen_Cond_Case_Quant_Expression;
2057 -- Normal case, not one of the above expression types
2060 return P_Expression_Or_Range_Attribute;
2062 end P_Expression_Or_Range_Attribute_If_OK;
2068 -- This procedure scans both relations and choice relations
2070 -- CHOICE_RELATION ::=
2071 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
2074 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
2075 -- | RAISE_EXPRESSION
2077 -- MEMBERSHIP_CHOICE_LIST ::=
2078 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
2080 -- MEMBERSHIP_CHOICE ::=
2081 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
2083 -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
2085 -- On return, Expr_Form indicates the categorization of the expression
2087 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2088 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2090 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2091 -- expression, then tokens are scanned until either a non-expression token,
2092 -- a right paren (not matched by a left paren) or a comma, is encountered.
2094 function P_Relation return Node_Id is
2095 Node1, Node2 : Node_Id;
2099 -- First check for raise expression
2101 if Token = Tok_Raise then
2102 Expr_Form := EF_Non_Simple;
2103 return P_Raise_Expression;
2108 Node1 := P_Simple_Expression;
2110 if Token not in Token_Class_Relop then
2114 -- Here we have a relational operator following. If so then scan it
2115 -- out. Note that the assignment symbol := is treated as a relational
2116 -- operator to improve the error recovery when it is misused for =.
2117 -- P_Relational_Operator also parses the IN and NOT IN operations.
2120 Node2 := New_Op_Node (P_Relational_Operator, Optok);
2121 Set_Left_Opnd (Node2, Node1);
2123 -- Case of IN or NOT IN
2125 if Prev_Token = Tok_In then
2126 P_Membership_Test (Node2);
2128 -- Case of relational operator (= /= < <= > >=)
2131 Set_Right_Opnd (Node2, P_Simple_Expression);
2134 Expr_Form := EF_Non_Simple;
2136 if Token in Token_Class_Relop then
2137 Error_Msg_SC ("unexpected relational operator");
2144 -- If any error occurs, then scan to the next expression terminator symbol
2145 -- or comma or right paren at the outer (i.e. current) parentheses level.
2146 -- The flags are set to indicate a normal simple expression.
2149 when Error_Resync =>
2151 Expr_Form := EF_Simple;
2155 ----------------------------
2156 -- 4.4 Simple Expression --
2157 ----------------------------
2159 -- SIMPLE_EXPRESSION ::=
2160 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2162 -- On return, Expr_Form indicates the categorization of the expression
2164 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2165 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2167 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2168 -- expression, then tokens are scanned until either a non-expression token,
2169 -- a right paren (not matched by a left paren) or a comma, is encountered.
2171 -- Note: P_Simple_Expression is called only internally by higher level
2172 -- expression routines. In cases in the grammar where a simple expression
2173 -- is required, the approach is to scan an expression, and then post an
2174 -- appropriate error message if the expression obtained is not simple. This
2175 -- gives better error recovery and treatment.
2177 function P_Simple_Expression return Node_Id is
2178 Scan_State : Saved_Scan_State;
2181 Tokptr : Source_Ptr;
2183 function At_Start_Of_Attribute return Boolean;
2184 -- Tests if we have quote followed by attribute name, if so, return True
2185 -- otherwise return False.
2187 ---------------------------
2188 -- At_Start_Of_Attribute --
2189 ---------------------------
2191 function At_Start_Of_Attribute return Boolean is
2193 if Token /= Tok_Apostrophe then
2198 Scan_State : Saved_Scan_State;
2201 Save_Scan_State (Scan_State);
2204 if Token = Tok_Identifier
2205 and then Is_Attribute_Name (Chars (Token_Node))
2207 Restore_Scan_State (Scan_State);
2210 Restore_Scan_State (Scan_State);
2215 end At_Start_Of_Attribute;
2217 -- Start of processing for P_Simple_Expression
2220 -- Check for cases starting with a name. There are two reasons for
2221 -- special casing. First speed things up by catching a common case
2222 -- without going through several routine layers. Second the caller must
2223 -- be informed via Expr_Form when the simple expression is a name.
2225 if Token in Token_Class_Name then
2228 -- Deal with apostrophe cases
2230 if Token = Tok_Apostrophe then
2231 Save_Scan_State (Scan_State); -- at apostrophe
2232 Scan; -- past apostrophe
2234 -- If qualified expression, scan it out and fall through
2236 if Token = Tok_Left_Paren then
2237 Node1 := P_Qualified_Expression (Node1);
2238 Expr_Form := EF_Simple;
2240 -- If range attribute, then we return with Token pointing to the
2241 -- apostrophe. Note: avoid the normal error check on exit. We
2242 -- know that the expression really is complete in this case.
2244 else -- Token = Tok_Range then
2245 Restore_Scan_State (Scan_State); -- to apostrophe
2246 Expr_Form := EF_Simple_Name;
2251 -- If an expression terminator follows, the previous processing
2252 -- completely scanned out the expression (a common case), and
2253 -- left Expr_Form set appropriately for returning to our caller.
2255 if Token in Token_Class_Sterm then
2258 -- If we do not have an expression terminator, then complete the
2259 -- scan of a simple expression. This code duplicates the code
2260 -- found in P_Term and P_Factor.
2263 if Token = Tok_Double_Asterisk then
2265 Style.Check_Exponentiation_Operator;
2268 Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
2270 Set_Left_Opnd (Node2, Node1);
2271 Set_Right_Opnd (Node2, P_Primary);
2277 exit when Token not in Token_Class_Mulop;
2278 Tokptr := Token_Ptr;
2279 Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
2282 Style.Check_Binary_Operator;
2285 Scan; -- past operator
2286 Set_Left_Opnd (Node2, Node1);
2287 Set_Right_Opnd (Node2, P_Factor);
2292 exit when Token not in Token_Class_Binary_Addop;
2293 Tokptr := Token_Ptr;
2294 Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
2297 Style.Check_Binary_Operator;
2300 Scan; -- past operator
2301 Set_Left_Opnd (Node2, Node1);
2302 Set_Right_Opnd (Node2, P_Term);
2306 Expr_Form := EF_Simple;
2309 -- Cases where simple expression does not start with a name
2312 -- Scan initial sign and initial Term
2314 if Token in Token_Class_Unary_Addop then
2315 Tokptr := Token_Ptr;
2316 Node1 := New_Op_Node (P_Unary_Adding_Operator, Tokptr);
2319 Style.Check_Unary_Plus_Or_Minus (Inside_Depends);
2322 Scan; -- past operator
2323 Set_Right_Opnd (Node1, P_Term);
2328 -- In the following, we special-case a sequence of concatenations of
2329 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
2330 -- else mixed in. For such a sequence, we return a tree representing
2331 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
2332 -- the number of concatenations is large. If semantic analysis
2333 -- resolves the "&" to a predefined one, then this folding gives the
2334 -- right answer. Otherwise, semantic analysis will complain about a
2335 -- capacity-exceeded error. The purpose of this trick is to avoid
2336 -- creating a deeply nested tree, which would cause deep recursion
2337 -- during semantics, causing stack overflow. This way, we can handle
2338 -- enormous concatenations in the normal case of predefined "&". We
2339 -- first build up the normal tree, and then rewrite it if
2343 Num_Concats_Threshold : constant Positive := 1000;
2344 -- Arbitrary threshold value to enable optimization
2346 First_Node : constant Node_Id := Node1;
2347 Is_Strlit_Concat : Boolean;
2348 -- True iff we've parsed a sequence of concatenations of string
2349 -- literals, with nothing else mixed in.
2351 Num_Concats : Natural;
2352 -- Number of "&" operators if Is_Strlit_Concat is True
2356 Nkind (Node1) = N_String_Literal
2357 and then Token = Tok_Ampersand;
2360 -- Scan out sequence of terms separated by binary adding operators
2363 exit when Token not in Token_Class_Binary_Addop;
2364 Tokptr := Token_Ptr;
2365 Node2 := New_Op_Node (P_Binary_Adding_Operator, Tokptr);
2367 if Style_Check and then not Debug_Flag_Dot_QQ then
2368 Style.Check_Binary_Operator;
2371 Scan; -- past operator
2372 Set_Left_Opnd (Node2, Node1);
2374 Set_Right_Opnd (Node2, Node1);
2376 -- Check if we're still concatenating string literals
2380 and then Nkind (Node2) = N_Op_Concat
2381 and then Nkind (Node1) = N_String_Literal;
2383 if Is_Strlit_Concat then
2384 Num_Concats := Num_Concats + 1;
2390 -- If we have an enormous series of concatenations of string
2391 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2392 -- flag tells semantic analysis that if the "&" is not predefined,
2393 -- the folded value is wrong.
2396 and then Num_Concats >= Num_Concats_Threshold
2399 Empty_String_Val : String_Id;
2402 Strlit_Concat_Val : String_Id;
2403 -- Contains the folded value (which will be correct if the
2404 -- "&" operators are the predefined ones).
2407 -- For walking up the tree
2410 -- Folded node to replace Node1
2412 Loc : constant Source_Ptr := Sloc (First_Node);
2415 -- Walk up the tree starting at the leftmost string literal
2416 -- (First_Node), building up the Strlit_Concat_Val as we
2417 -- go. Note that we do not use recursion here -- the whole
2418 -- point is to avoid recursively walking that enormous tree.
2421 Store_String_Chars (Strval (First_Node));
2423 Cur_Node := Parent (First_Node);
2424 while Present (Cur_Node) loop
2425 pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
2426 Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
2428 Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
2429 Cur_Node := Parent (Cur_Node);
2432 Strlit_Concat_Val := End_String;
2434 -- Create new folded node, and rewrite result with a concat-
2435 -- enation of an empty string literal and the folded node.
2438 Empty_String_Val := End_String;
2440 Make_Op_Concat (Loc,
2441 Make_String_Literal (Loc, Empty_String_Val),
2442 Make_String_Literal (Loc, Strlit_Concat_Val,
2443 Is_Folded_In_Parser => True));
2444 Rewrite (Node1, New_Node);
2449 -- All done, we clearly do not have name or numeric literal so this
2450 -- is a case of a simple expression which is some other possibility.
2452 Expr_Form := EF_Simple;
2455 -- Come here at end of simple expression, where we do a couple of
2456 -- special checks to improve error recovery.
2458 -- Special test to improve error recovery. If the current token is a
2459 -- period, then someone is trying to do selection on something that is
2460 -- not a name, e.g. a qualified expression.
2462 if Token = Tok_Dot then
2463 Error_Msg_SC ("prefix for selection is not a name");
2465 -- If qualified expression, comment and continue, otherwise something
2466 -- is pretty nasty so do an Error_Resync call.
2468 if Ada_Version < Ada_2012
2469 and then Nkind (Node1) = N_Qualified_Expression
2471 Error_Msg_SC ("\would be legal in Ada 2012 mode");
2477 -- Special test to improve error recovery: If the current token is
2478 -- not the first token on a line (as determined by checking the
2479 -- previous token position with the start of the current line),
2480 -- then we insist that we have an appropriate terminating token.
2481 -- Consider the following two examples:
2483 -- 1) if A nad B then ...
2488 -- In the first example, we would like to issue a binary operator
2489 -- expected message and resynchronize to the then. In the second
2490 -- example, we do not want to issue a binary operator message, so
2491 -- that instead we will get the missing semicolon message. This
2492 -- distinction is of course a heuristic which does not always work,
2493 -- but in practice it is quite effective.
2495 -- Note: the one case in which we do not go through this circuit is
2496 -- when we have scanned a range attribute and want to return with
2497 -- Token pointing to the apostrophe. The apostrophe is not normally
2498 -- an expression terminator, and is not in Token_Class_Sterm, but
2499 -- in this special case we know that the expression is complete.
2501 if not Token_Is_At_Start_Of_Line
2502 and then Token not in Token_Class_Sterm
2504 -- Normally the right error message is indeed that we expected a
2505 -- binary operator, but in the case of being between a right and left
2506 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2508 if Prev_Token = Tok_Right_Paren and then Token = Tok_Left_Paren then
2511 -- And if we have a quote, we may have a bad attribute
2513 elsif At_Start_Of_Attribute then
2514 Error_Msg_SC ("prefix of attribute must be a name");
2516 if Ada_Version >= Ada_2012 then
2517 Error_Msg_SC ("\qualify expression to turn it into a name");
2520 -- Normal case for binary operator expected message
2523 Error_Msg_AP ("binary operator expected");
2532 -- If any error occurs, then scan to next expression terminator symbol
2533 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2534 -- level. Expr_Form is set to indicate a normal simple expression.
2537 when Error_Resync =>
2539 Expr_Form := EF_Simple;
2541 end P_Simple_Expression;
2543 -----------------------------------------------
2544 -- 4.4 Simple Expression or Range Attribute --
2545 -----------------------------------------------
2547 -- SIMPLE_EXPRESSION ::=
2548 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2550 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2552 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2554 -- Error recovery: cannot raise Error_Resync
2556 function P_Simple_Expression_Or_Range_Attribute return Node_Id is
2558 Attr_Node : Node_Id;
2561 -- We don't just want to roar ahead and call P_Simple_Expression
2562 -- here, since we want to handle the case of a parenthesized range
2563 -- attribute cleanly.
2565 if Token = Tok_Left_Paren then
2567 Lptr : constant Source_Ptr := Token_Ptr;
2568 Scan_State : Saved_Scan_State;
2571 Save_Scan_State (Scan_State);
2572 Scan; -- past left paren
2573 Sexpr := P_Simple_Expression;
2575 if Token = Tok_Apostrophe then
2576 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2577 Expr_Form := EF_Range_Attr;
2579 if Token = Tok_Right_Paren then
2580 Scan; -- scan past right paren if present
2583 Error_Msg ("parentheses not allowed for range attribute", Lptr);
2588 Restore_Scan_State (Scan_State);
2592 -- Here after dealing with parenthesized range attribute
2594 Sexpr := P_Simple_Expression;
2596 if Token = Tok_Apostrophe then
2597 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2598 Expr_Form := EF_Range_Attr;
2604 end P_Simple_Expression_Or_Range_Attribute;
2610 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2612 -- Error recovery: can raise Error_Resync
2614 function P_Term return Node_Id is
2615 Node1, Node2 : Node_Id;
2616 Tokptr : Source_Ptr;
2622 exit when Token not in Token_Class_Mulop;
2623 Tokptr := Token_Ptr;
2624 Node2 := New_Op_Node (P_Multiplying_Operator, Tokptr);
2626 if Style_Check and then not Debug_Flag_Dot_QQ then
2627 Style.Check_Binary_Operator;
2630 Scan; -- past operator
2631 Set_Left_Opnd (Node2, Node1);
2632 Set_Right_Opnd (Node2, P_Factor);
2643 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2645 -- Error recovery: can raise Error_Resync
2647 function P_Factor return Node_Id is
2652 if Token = Tok_Abs then
2653 Node1 := New_Op_Node (N_Op_Abs, Token_Ptr);
2656 Style.Check_Abs_Not;
2660 Set_Right_Opnd (Node1, P_Primary);
2663 elsif Token = Tok_Not then
2664 Node1 := New_Op_Node (N_Op_Not, Token_Ptr);
2667 Style.Check_Abs_Not;
2671 Set_Right_Opnd (Node1, P_Primary);
2677 if Token = Tok_Double_Asterisk then
2678 Node2 := New_Op_Node (N_Op_Expon, Token_Ptr);
2680 Set_Left_Opnd (Node2, Node1);
2681 Set_Right_Opnd (Node2, P_Primary);
2695 -- NUMERIC_LITERAL | null
2696 -- | STRING_LITERAL | AGGREGATE
2697 -- | NAME | QUALIFIED_EXPRESSION
2698 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2699 -- | REDUCTION_ATTRIBUTE_REFERENCE
2701 -- Error recovery: can raise Error_Resync
2703 function P_Primary return Node_Id is
2704 Scan_State : Saved_Scan_State;
2707 Lparen : constant Boolean := Prev_Token = Tok_Left_Paren;
2708 -- Remember if previous token is a left parenthesis. This is used to
2709 -- deal with checking whether IF/CASE/FOR expressions appearing as
2710 -- primaries require extra parenthesization.
2713 -- The loop runs more than once only if misplaced pragmas are found
2714 -- or if a misplaced unary minus is skipped.
2719 -- Name token can start a name, call or qualified expression, all
2720 -- of which are acceptable possibilities for primary. Note also
2721 -- that string literal is included in name (as operator symbol)
2722 -- and type conversion is included in name (as indexed component).
2724 when Tok_Char_Literal
2726 | Tok_Operator_Symbol
2730 -- All done unless apostrophe follows
2732 if Token /= Tok_Apostrophe then
2735 -- Apostrophe following means that we have either just parsed
2736 -- the subtype mark of a qualified expression, or the prefix
2737 -- or a range attribute.
2739 else -- Token = Tok_Apostrophe
2740 Save_Scan_State (Scan_State); -- at apostrophe
2741 Scan; -- past apostrophe
2743 -- If range attribute, then this is always an error, since
2744 -- the only legitimate case (where the scanned expression is
2745 -- a qualified simple name) is handled at the level of the
2746 -- Simple_Expression processing. This case corresponds to a
2747 -- usage such as 3 + A'Range, which is always illegal.
2749 if Token = Tok_Range then
2750 Restore_Scan_State (Scan_State); -- to apostrophe
2751 Bad_Range_Attribute (Token_Ptr);
2754 -- If left paren, then we have a qualified expression.
2755 -- Note that P_Name guarantees that in this case, where
2756 -- Token = Tok_Apostrophe on return, the only two possible
2757 -- tokens following the apostrophe are left paren and
2758 -- RANGE, so we know we have a left paren here.
2760 else -- Token = Tok_Left_Paren
2761 return P_Qualified_Expression (Node1);
2766 -- Numeric or string literal
2768 when Tok_Integer_Literal
2770 | Tok_String_Literal
2772 Node1 := Token_Node;
2773 Scan; -- past number
2776 -- Left paren, starts aggregate or parenthesized expression
2778 when Tok_Left_Paren =>
2780 Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2783 if Nkind (Expr) = N_Attribute_Reference
2784 and then Attribute_Name (Expr) = Name_Range
2786 Bad_Range_Attribute (Sloc (Expr));
2792 when Tok_Left_Bracket =>
2804 return New_Node (N_Null, Prev_Token_Ptr);
2806 -- Pragma, not allowed here, so just skip past it
2809 P_Pragmas_Misplaced;
2811 -- Deal with IF (possible unparenthesized if expression)
2815 -- If this looks like a real if, defined as an IF appearing at
2816 -- the start of a new line, then we consider we have a missing
2817 -- operand. If in Ada 2012 and the IF is not properly indented
2818 -- for a statement, we prefer to issue a message about an ill-
2819 -- parenthesized if expression.
2821 if Token_Is_At_Start_Of_Line
2823 (Ada_Version >= Ada_2012
2824 and then Style_Check_Indentation /= 0
2825 and then Start_Column rem Style_Check_Indentation /= 0)
2827 Error_Msg_AP ("missing operand");
2830 -- If this looks like an if expression, then treat it that way
2831 -- with an error message if not explicitly surrounded by
2834 elsif Ada_Version >= Ada_2012 then
2835 Node1 := P_If_Expression;
2837 if not (Lparen and then Token = Tok_Right_Paren) then
2839 ("if expression must be parenthesized", Sloc (Node1));
2844 -- Otherwise treat as misused identifier
2847 return P_Identifier;
2850 -- Deal with CASE (possible unparenthesized case expression)
2854 -- If this looks like a real case, defined as a CASE appearing
2855 -- the start of a new line, then we consider we have a missing
2856 -- operand. If in Ada 2012 and the CASE is not properly
2857 -- indented for a statement, we prefer to issue a message about
2858 -- an ill-parenthesized case expression.
2860 if Token_Is_At_Start_Of_Line
2862 (Ada_Version >= Ada_2012
2863 and then Style_Check_Indentation /= 0
2864 and then Start_Column rem Style_Check_Indentation /= 0)
2866 Error_Msg_AP ("missing operand");
2869 -- If this looks like a case expression, then treat it that way
2870 -- with an error message if not within parentheses.
2872 elsif Ada_Version >= Ada_2012 then
2873 Node1 := P_Case_Expression;
2875 if not (Lparen and then Token = Tok_Right_Paren) then
2877 ("case expression must be parenthesized", Sloc (Node1));
2882 -- Otherwise treat as misused identifier
2885 return P_Identifier;
2888 -- For [all | some] indicates a quantified expression
2891 if Token_Is_At_Start_Of_Line then
2892 Error_Msg_AP ("misplaced loop");
2895 elsif Ada_Version >= Ada_2012 then
2896 Save_Scan_State (Scan_State);
2899 if Token = Tok_All or else Token = Tok_Some then
2900 Restore_Scan_State (Scan_State); -- To FOR
2901 Node1 := P_Quantified_Expression;
2903 if not (Lparen and then Token = Tok_Right_Paren) then
2905 ("quantified expression must be parenthesized",
2909 Restore_Scan_State (Scan_State); -- To FOR
2910 Node1 := P_Iterated_Component_Association;
2915 -- Otherwise treat as misused identifier
2918 return P_Identifier;
2921 -- Minus may well be an improper attempt at a unary minus. Give
2922 -- a message, skip the minus and keep going.
2925 Error_Msg_SC ("parentheses required for unary minus");
2928 when Tok_At_Sign => -- AI12-0125 : target_name
2929 if Ada_Version < Ada_2020 then
2930 Error_Msg_SC ("target name is an Ada 202x feature");
2931 Error_Msg_SC ("\compile with -gnatX");
2937 -- Anything else is illegal as the first token of a primary, but
2938 -- we test for some common errors, to improve error messages.
2941 if Is_Reserved_Identifier then
2942 return P_Identifier;
2944 elsif Prev_Token = Tok_Comma then
2945 Error_Msg_SP -- CODEFIX
2946 ("|extra "","" ignored");
2950 Error_Msg_AP ("missing operand");
2957 -------------------------------
2958 -- 4.4 Quantified_Expression --
2959 -------------------------------
2961 -- QUANTIFIED_EXPRESSION ::=
2962 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2963 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2965 function P_Quantified_Expression return Node_Id is
2970 Error_Msg_Ada_2012_Feature ("quantified expression", Token_Ptr);
2972 Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr);
2974 if Token = Tok_All then
2975 Set_All_Present (Node1);
2976 elsif Token /= Tok_Some then
2977 Error_Msg_AP ("missing quantifier");
2981 Scan; -- past ALL or SOME
2982 I_Spec := P_Loop_Parameter_Specification;
2984 if Nkind (I_Spec) = N_Loop_Parameter_Specification then
2985 Set_Loop_Parameter_Specification (Node1, I_Spec);
2987 Set_Iterator_Specification (Node1, I_Spec);
2990 if Token = Tok_Arrow then
2992 Set_Condition (Node1, P_Expression);
2995 Error_Msg_AP ("missing arrow");
2998 end P_Quantified_Expression;
3000 ---------------------------
3001 -- 4.5 Logical Operator --
3002 ---------------------------
3004 -- LOGICAL_OPERATOR ::= and | or | xor
3006 -- Note: AND THEN and OR ELSE are also treated as logical operators
3007 -- by the parser (even though they are not operators semantically)
3009 -- The value returned is the appropriate Node_Kind code for the operator
3010 -- On return, Token points to the token following the scanned operator.
3012 -- The caller has checked that the first token is a legitimate logical
3013 -- operator token (i.e. is either XOR, AND, OR).
3015 -- Error recovery: cannot raise Error_Resync
3017 function P_Logical_Operator return Node_Kind is
3019 if Token = Tok_And then
3021 Style.Check_Binary_Operator;
3026 if Token = Tok_Then then
3033 elsif Token = Tok_Or then
3035 Style.Check_Binary_Operator;
3040 if Token = Tok_Else then
3047 else -- Token = Tok_Xor
3049 Style.Check_Binary_Operator;
3055 end P_Logical_Operator;
3057 ------------------------------
3058 -- 4.5 Relational Operator --
3059 ------------------------------
3061 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
3063 -- The value returned is the appropriate Node_Kind code for the operator.
3064 -- On return, Token points to the operator token, NOT past it.
3066 -- The caller has checked that the first token is a legitimate relational
3067 -- operator token (i.e. is one of the operator tokens listed above).
3069 -- Error recovery: cannot raise Error_Resync
3071 function P_Relational_Operator return Node_Kind is
3072 Op_Kind : Node_Kind;
3073 Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
3074 (Tok_Less => N_Op_Lt,
3075 Tok_Equal => N_Op_Eq,
3076 Tok_Greater => N_Op_Gt,
3077 Tok_Not_Equal => N_Op_Ne,
3078 Tok_Greater_Equal => N_Op_Ge,
3079 Tok_Less_Equal => N_Op_Le,
3081 Tok_Not => N_Not_In,
3082 Tok_Box => N_Op_Ne);
3085 if Token = Tok_Box then
3086 Error_Msg_SC -- CODEFIX
3087 ("|""'<'>"" should be ""/=""");
3090 Op_Kind := Relop_Node (Token);
3093 Style.Check_Binary_Operator;
3096 Scan; -- past operator token
3098 -- Deal with NOT IN, if previous token was NOT, we must have IN now
3100 if Prev_Token = Tok_Not then
3102 -- Style check, for NOT IN, we require one space between NOT and IN
3104 if Style_Check and then Token = Tok_In then
3112 end P_Relational_Operator;
3114 ---------------------------------
3115 -- 4.5 Binary Adding Operator --
3116 ---------------------------------
3118 -- BINARY_ADDING_OPERATOR ::= + | - | &
3120 -- The value returned is the appropriate Node_Kind code for the operator.
3121 -- On return, Token points to the operator token (NOT past it).
3123 -- The caller has checked that the first token is a legitimate adding
3124 -- operator token (i.e. is one of the operator tokens listed above).
3126 -- Error recovery: cannot raise Error_Resync
3128 function P_Binary_Adding_Operator return Node_Kind is
3129 Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
3130 (Tok_Ampersand => N_Op_Concat,
3131 Tok_Minus => N_Op_Subtract,
3132 Tok_Plus => N_Op_Add);
3134 return Addop_Node (Token);
3135 end P_Binary_Adding_Operator;
3137 --------------------------------
3138 -- 4.5 Unary Adding Operator --
3139 --------------------------------
3141 -- UNARY_ADDING_OPERATOR ::= + | -
3143 -- The value returned is the appropriate Node_Kind code for the operator.
3144 -- On return, Token points to the operator token (NOT past it).
3146 -- The caller has checked that the first token is a legitimate adding
3147 -- operator token (i.e. is one of the operator tokens listed above).
3149 -- Error recovery: cannot raise Error_Resync
3151 function P_Unary_Adding_Operator return Node_Kind is
3152 Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
3153 (Tok_Minus => N_Op_Minus,
3154 Tok_Plus => N_Op_Plus);
3156 return Addop_Node (Token);
3157 end P_Unary_Adding_Operator;
3159 -------------------------------
3160 -- 4.5 Multiplying Operator --
3161 -------------------------------
3163 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
3165 -- The value returned is the appropriate Node_Kind code for the operator.
3166 -- On return, Token points to the operator token (NOT past it).
3168 -- The caller has checked that the first token is a legitimate multiplying
3169 -- operator token (i.e. is one of the operator tokens listed above).
3171 -- Error recovery: cannot raise Error_Resync
3173 function P_Multiplying_Operator return Node_Kind is
3174 Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
3175 (Tok_Asterisk => N_Op_Multiply,
3176 Tok_Mod => N_Op_Mod,
3177 Tok_Rem => N_Op_Rem,
3178 Tok_Slash => N_Op_Divide);
3180 return Mulop_Node (Token);
3181 end P_Multiplying_Operator;
3183 --------------------------------------
3184 -- 4.5 Highest Precedence Operator --
3185 --------------------------------------
3187 -- Parsed by P_Factor (4.4)
3189 -- Note: this rule is not in fact used by the grammar at any point
3191 --------------------------
3192 -- 4.6 Type Conversion --
3193 --------------------------
3195 -- Parsed by P_Primary as a Name (4.1)
3197 -------------------------------
3198 -- 4.7 Qualified Expression --
3199 -------------------------------
3201 -- QUALIFIED_EXPRESSION ::=
3202 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
3204 -- The caller has scanned the name which is the Subtype_Mark parameter
3205 -- and scanned past the single quote following the subtype mark. The
3206 -- caller has not checked that this name is in fact appropriate for
3207 -- a subtype mark name (i.e. it is a selected component or identifier).
3209 -- Error_Recovery: cannot raise Error_Resync
3211 function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
3212 Qual_Node : Node_Id;
3214 Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
3215 Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
3216 Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
3218 end P_Qualified_Expression;
3220 --------------------
3222 --------------------
3225 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
3226 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
3228 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
3230 -- The caller has checked that the initial token is NEW
3232 -- Error recovery: can raise Error_Resync
3234 function P_Allocator return Node_Id is
3235 Alloc_Node : Node_Id;
3236 Type_Node : Node_Id;
3237 Null_Exclusion_Present : Boolean;
3240 Alloc_Node := New_Node (N_Allocator, Token_Ptr);
3243 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
3245 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
3247 if Token = Tok_Left_Paren then
3249 Set_Subpool_Handle_Name (Alloc_Node, P_Name);
3252 Error_Msg_Ada_2012_Feature
3253 ("|subpool specification",
3254 Sloc (Subpool_Handle_Name (Alloc_Node)));
3257 Null_Exclusion_Present := P_Null_Exclusion;
3258 Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
3259 Type_Node := P_Subtype_Mark_Resync;
3261 if Token = Tok_Apostrophe then
3262 Scan; -- past apostrophe
3263 Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
3267 P_Subtype_Indication (Type_Node, Null_Exclusion_Present));
3269 -- AI05-0104: An explicit null exclusion is not allowed for an
3270 -- allocator without initialization. In previous versions of the
3271 -- language it just raises constraint error.
3273 if Ada_Version >= Ada_2012 and then Null_Exclusion_Present then
3275 ("an allocator with a subtype indication "
3276 & "cannot have a null exclusion", Alloc_Node);
3283 -----------------------
3284 -- P_Case_Expression --
3285 -----------------------
3287 function P_Case_Expression return Node_Id is
3288 Loc : constant Source_Ptr := Token_Ptr;
3289 Case_Node : Node_Id;
3290 Save_State : Saved_Scan_State;
3293 Error_Msg_Ada_2012_Feature ("|case expression", Token_Ptr);
3296 Make_Case_Expression (Loc,
3297 Expression => P_Expression_No_Right_Paren,
3298 Alternatives => New_List);
3301 -- We now have scanned out CASE expression IS, scan alternatives
3305 Append_To (Alternatives (Case_Node), P_Case_Expression_Alternative);
3307 -- Missing comma if WHEN (more alternatives present)
3309 if Token = Tok_When then
3312 -- A semicolon followed by "when" is probably meant to be a comma
3314 elsif Token = Tok_Semicolon then
3315 Save_Scan_State (Save_State);
3316 Scan; -- past the semicolon
3318 if Token /= Tok_When then
3319 Restore_Scan_State (Save_State);
3323 Error_Msg_SP -- CODEFIX
3324 ("|"";"" should be "",""");
3326 -- If comma/WHEN, skip comma and we have another alternative
3328 elsif Token = Tok_Comma then
3329 Save_Scan_State (Save_State);
3332 if Token /= Tok_When then
3333 Restore_Scan_State (Save_State);
3337 -- If no comma or WHEN, definitely done
3344 -- If we have an END CASE, diagnose as not needed
3346 if Token = Tok_End then
3347 Error_Msg_SC ("`END CASE` not allowed at end of case expression");
3350 if Token = Tok_Case then
3355 -- Return the Case_Expression node
3358 end P_Case_Expression;
3360 -----------------------------------
3361 -- P_Case_Expression_Alternative --
3362 -----------------------------------
3364 -- CASE_STATEMENT_ALTERNATIVE ::=
3365 -- when DISCRETE_CHOICE_LIST =>
3368 -- The caller has checked that and scanned past the initial WHEN token
3369 -- Error recovery: can raise Error_Resync
3371 function P_Case_Expression_Alternative return Node_Id is
3372 Case_Alt_Node : Node_Id;
3374 Case_Alt_Node := New_Node (N_Case_Expression_Alternative, Token_Ptr);
3375 Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List);
3377 Set_Expression (Case_Alt_Node, P_Expression);
3378 return Case_Alt_Node;
3379 end P_Case_Expression_Alternative;
3381 --------------------------------------
3382 -- P_Iterated_Component_Association --
3383 --------------------------------------
3385 -- ITERATED_COMPONENT_ASSOCIATION ::=
3386 -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
3388 function P_Iterated_Component_Association return Node_Id is
3389 Assoc_Node : Node_Id;
3391 -- Start of processing for P_Iterated_Component_Association
3396 New_Node (N_Iterated_Component_Association, Prev_Token_Ptr);
3398 Set_Defining_Identifier (Assoc_Node, P_Defining_Identifier);
3400 Set_Discrete_Choices (Assoc_Node, P_Discrete_Choice_List);
3402 Set_Expression (Assoc_Node, P_Expression);
3404 if Ada_Version < Ada_2020 then
3405 Error_Msg_SC ("iterated component is an Ada 202x feature");
3406 Error_Msg_SC ("\compile with -gnatX");
3410 end P_Iterated_Component_Association;
3412 ---------------------
3413 -- P_If_Expression --
3414 ---------------------
3416 -- IF_EXPRESSION ::=
3417 -- if CONDITION then DEPENDENT_EXPRESSION
3418 -- {elsif CONDITION then DEPENDENT_EXPRESSION}
3419 -- [else DEPENDENT_EXPRESSION]
3421 -- DEPENDENT_EXPRESSION ::= EXPRESSION
3423 function P_If_Expression return Node_Id is
3424 function P_If_Expression_Internal
3426 Cond : Node_Id) return Node_Id;
3427 -- This is the internal recursive routine that does all the work, it is
3428 -- recursive since it is used to process ELSIF parts, which internally
3429 -- are N_If_Expression nodes with the Is_Elsif flag set. The calling
3430 -- sequence is like the outer function except that the caller passes
3431 -- the conditional expression (scanned using P_Expression), and the
3432 -- scan pointer points just past this expression. Loc points to the
3433 -- IF or ELSIF token.
3435 ------------------------------
3436 -- P_If_Expression_Internal --
3437 ------------------------------
3439 function P_If_Expression_Internal
3441 Cond : Node_Id) return Node_Id
3443 Exprs : constant List_Id := New_List;
3445 State : Saved_Scan_State;
3449 -- All cases except where we are at right paren
3451 if Token /= Tok_Right_Paren then
3453 Append_To (Exprs, P_Condition (Cond));
3454 Append_To (Exprs, P_Expression);
3456 -- Case of right paren (missing THEN phrase). Note that we know this
3457 -- is the IF case, since the caller dealt with this possibility in
3461 Error_Msg_BC ("missing THEN phrase");
3462 Append_To (Exprs, P_Condition (Cond));
3465 -- We now have scanned out IF expr THEN expr
3467 -- Check for common error of semicolon before the ELSE
3469 if Token = Tok_Semicolon then
3470 Save_Scan_State (State);
3471 Scan; -- past semicolon
3473 if Token = Tok_Else or else Token = Tok_Elsif then
3474 Error_Msg_SP -- CODEFIX
3475 ("|extra "";"" ignored");
3478 Restore_Scan_State (State);
3482 -- Scan out ELSIF sequence if present
3484 if Token = Tok_Elsif then
3487 Expr := P_Expression;
3489 -- If we are at a right paren, we assume the ELSIF should be ELSE
3491 if Token = Tok_Right_Paren then
3492 Error_Msg ("ELSIF should be ELSE", Eptr);
3493 Append_To (Exprs, Expr);
3495 -- Otherwise we have an OK ELSIF
3498 Expr := P_If_Expression_Internal (Eptr, Expr);
3499 Set_Is_Elsif (Expr);
3500 Append_To (Exprs, Expr);
3503 -- Scan out ELSE phrase if present
3505 elsif Token = Tok_Else then
3507 -- Scan out ELSE expression
3510 Append_To (Exprs, P_Expression);
3512 -- Skip redundant ELSE parts
3514 while Token = Tok_Else loop
3515 Error_Msg_SC ("only one ELSE part is allowed");
3517 Discard_Junk_Node (P_Expression);
3520 -- Two expression case (implied True, filled in during semantics)
3526 -- If we have an END IF, diagnose as not needed
3528 if Token = Tok_End then
3529 Error_Msg_SC ("`END IF` not allowed at end of if expression");
3532 if Token = Tok_If then
3537 -- Return the If_Expression node
3539 return Make_If_Expression (Loc, Expressions => Exprs);
3540 end P_If_Expression_Internal;
3544 Loc : constant Source_Ptr := Token_Ptr;
3547 -- Start of processing for P_If_Expression
3550 Error_Msg_Ada_2012_Feature ("|if expression", Token_Ptr);
3552 Inside_If_Expression := Inside_If_Expression + 1;
3553 If_Expr := P_If_Expression_Internal (Loc, P_Expression);
3554 Inside_If_Expression := Inside_If_Expression - 1;
3556 end P_If_Expression;
3558 -----------------------
3559 -- P_Membership_Test --
3560 -----------------------
3562 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3563 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3565 procedure P_Membership_Test (N : Node_Id) is
3566 Alt : constant Node_Id :=
3567 P_Range_Or_Subtype_Mark
3568 (Allow_Simple_Expression => (Ada_Version >= Ada_2012));
3573 if Token = Tok_Vertical_Bar then
3574 Error_Msg_Ada_2012_Feature ("set notation", Token_Ptr);
3575 Set_Alternatives (N, New_List (Alt));
3576 Set_Right_Opnd (N, Empty);
3578 -- Loop to accumulate alternatives
3580 while Token = Tok_Vertical_Bar loop
3581 Scan; -- past vertical bar
3584 P_Range_Or_Subtype_Mark (Allow_Simple_Expression => True));
3590 Set_Right_Opnd (N, Alt);
3591 Set_Alternatives (N, No_List);
3593 end P_Membership_Test;
3595 ------------------------------------------
3596 -- P_Unparen_Cond_Case_Quant_Expression --
3597 ------------------------------------------
3599 function P_Unparen_Cond_Case_Quant_Expression return Node_Id is
3600 Lparen : constant Boolean := Prev_Token = Tok_Left_Paren;
3603 Scan_State : Saved_Scan_State;
3608 if Token = Tok_Case then
3609 Result := P_Case_Expression;
3611 if not (Lparen and then Token = Tok_Right_Paren) then
3612 Error_Msg_N ("case expression must be parenthesized!", Result);
3617 elsif Token = Tok_If then
3618 Result := P_If_Expression;
3620 if not (Lparen and then Token = Tok_Right_Paren) then
3621 Error_Msg_N ("if expression must be parenthesized!", Result);
3624 -- Quantified expression or iterated component association
3626 elsif Token = Tok_For then
3628 Save_Scan_State (Scan_State);
3631 if Token = Tok_All or else Token = Tok_Some then
3632 Restore_Scan_State (Scan_State);
3633 Result := P_Quantified_Expression;
3635 if not (Lparen and then Token = Tok_Right_Paren) then
3637 ("quantified expression must be parenthesized!", Result);
3641 -- If no quantifier keyword, this is an iterated component in
3644 Restore_Scan_State (Scan_State);
3645 Result := P_Iterated_Component_Association;
3648 -- No other possibility should exist (caller was supposed to check)
3651 raise Program_Error;
3654 -- Return expression (possibly after having given message)
3657 end P_Unparen_Cond_Case_Quant_Expression;