1 -----------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2021, 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
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_Declare_Expression
return Node_Id
;
85 function P_Reduction_Attribute_Reference
(S
: Node_Id
)
88 function P_Binary_Adding_Operator
return Node_Kind
;
89 function P_Logical_Operator
return Node_Kind
;
90 function P_Multiplying_Operator
return Node_Kind
;
91 function P_Relational_Operator
return Node_Kind
;
92 function P_Unary_Adding_Operator
return Node_Kind
;
94 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
);
95 -- Called to place complaint about bad range attribute at the given
96 -- source location. Terminates by raising Error_Resync.
98 procedure Check_Bad_Exp
;
99 -- Called after scanning a**b, posts error if ** detected
101 procedure P_Membership_Test
(N
: Node_Id
);
102 -- N is the node for a N_In or N_Not_In node whose right operand has not
103 -- yet been processed. It is called just after scanning out the IN keyword.
104 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
106 function P_Range_Attribute_Reference
(Prefix_Node
: Node_Id
) return Node_Id
;
107 -- Scan a range attribute reference. The caller has scanned out the
108 -- prefix. The current token is known to be an apostrophe and the
109 -- following token is known to be RANGE.
111 function P_Case_Expression
return Node_Id
;
112 -- Scans out a case expression. Called with Token pointing to the CASE
113 -- keyword, and returns pointing to the terminating right parent,
114 -- semicolon, or comma, but does not consume this terminating token.
116 function P_Unparen_Cond_Expr_Etc
return Node_Id
;
117 -- This function is called with Token pointing to IF, CASE, FOR, or
118 -- DECLARE, in a context that allows a conditional (if or case) expression,
119 -- a quantified expression, an iterated component association, or a declare
120 -- expression, if it is surrounded by parentheses. If not surrounded by
121 -- parentheses, the expression is still returned, but an error message is
124 -------------------------
125 -- Bad_Range_Attribute --
126 -------------------------
128 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
130 Error_Msg
("range attribute cannot be used in expression!", Loc
);
132 end Bad_Range_Attribute
;
138 procedure Check_Bad_Exp
is
140 if Token
= Tok_Double_Asterisk
then
141 Error_Msg_SC
("parenthesization required for '*'*");
143 Discard_Junk_Node
(P_Primary
);
148 --------------------------
149 -- 4.1 Name (also 6.4) --
150 --------------------------
153 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
154 -- | INDEXED_COMPONENT | SLICE
155 -- | SELECTED_COMPONENT | ATTRIBUTE
156 -- | TYPE_CONVERSION | FUNCTION_CALL
157 -- | CHARACTER_LITERAL | TARGET_NAME
159 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
161 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
163 -- EXPLICIT_DEREFERENCE ::= NAME . all
165 -- IMPLICIT_DEREFERENCE ::= NAME
167 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
169 -- SLICE ::= PREFIX (DISCRETE_RANGE)
171 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
173 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
175 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
177 -- ATTRIBUTE_DESIGNATOR ::=
178 -- IDENTIFIER [(static_EXPRESSION)]
179 -- | access | delta | digits
183 -- | function_PREFIX ACTUAL_PARAMETER_PART
185 -- ACTUAL_PARAMETER_PART ::=
186 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
188 -- PARAMETER_ASSOCIATION ::=
189 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
191 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
193 -- TARGET_NAME ::= @ (AI12-0125-3: abbreviation for LHS)
195 -- Note: syntactically a procedure call looks just like a function call,
196 -- so this routine is in practice used to scan out procedure calls as well.
198 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
200 -- Error recovery: can raise Error_Resync
202 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
203 -- followed by either a left paren (qualified expression case), or by
204 -- range (range attribute case). All other uses of apostrophe (i.e. all
205 -- other attributes) are handled in this routine.
207 -- Error recovery: can raise Error_Resync
209 function P_Name
return Node_Id
is
210 Scan_State
: Saved_Scan_State
;
212 Prefix_Node
: Node_Id
;
213 Ident_Node
: Node_Id
;
215 Range_Node
: Node_Id
;
218 Arg_List
: List_Id
:= No_List
; -- kill junk warning
219 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
222 -- Case of not a name
224 if Token
not in Token_Class_Name
then
226 -- If it looks like start of expression, complain and scan expression
228 if Token
in Token_Class_Literal
229 or else Token
= Tok_Left_Paren
231 Error_Msg_SC
("name expected");
234 -- Otherwise some other junk, not much we can do
237 Error_Msg_AP
("name expected");
242 -- Loop through designators in qualified name
243 -- AI12-0125 : target_name
245 if Token
= Tok_At_Sign
then
246 Scan_Reserved_Identifier
(Force_Msg
=> False);
248 if Present
(Current_Assign_Node
) then
249 Set_Has_Target_Names
(Current_Assign_Node
);
253 Name_Node
:= Token_Node
;
256 Scan
; -- past designator
257 exit when Token
/= Tok_Dot
;
258 Save_Scan_State
(Scan_State
); -- at dot
261 -- If we do not have another designator after the dot, then join
262 -- the normal circuit to handle a dot extension (may be .all or
263 -- character literal case). Otherwise loop back to scan the next
266 if Token
not in Token_Class_Desig
then
267 goto Scan_Name_Extension_Dot
;
269 Prefix_Node
:= Name_Node
;
270 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
271 Set_Prefix
(Name_Node
, Prefix_Node
);
272 Set_Selector_Name
(Name_Node
, Token_Node
);
276 -- We have now scanned out a qualified designator. If the last token is
277 -- an operator symbol, then we certainly do not have the Snam case, so
278 -- we can just use the normal name extension check circuit
280 if Prev_Token
= Tok_Operator_Symbol
then
281 goto Scan_Name_Extension
;
284 -- We have scanned out a qualified simple name, check for name
285 -- extension. Note that we know there is no dot here at this stage,
286 -- so the only possible cases of name extension are apostrophe followed
289 if Token
= Tok_Apostrophe
then
290 Save_Scan_State
(Scan_State
); -- at apostrophe
291 Scan
; -- past apostrophe
293 -- Qualified expression in Ada 2012 mode (treated as a name)
295 if Ada_Version
>= Ada_2012
296 and then Token
in Tok_Left_Paren | Tok_Left_Bracket
298 goto Scan_Name_Extension_Apostrophe
;
300 -- If left paren not in Ada 2012, then it is not part of the name,
301 -- since qualified expressions are not names in prior versions of
302 -- Ada, so return with Token backed up to point to the apostrophe.
303 -- The treatment for the range attribute is similar (we do not
304 -- consider x'range to be a name in this grammar).
306 elsif Token
= Tok_Left_Paren
or else Token
= Tok_Range
then
307 Restore_Scan_State
(Scan_State
); -- to apostrophe
308 Expr_Form
:= EF_Simple_Name
;
311 -- Otherwise we have the case of a name extended by an attribute
314 goto Scan_Name_Extension_Apostrophe
;
317 -- Check case of qualified simple name extended by a left parenthesis
319 elsif Token
= Tok_Left_Paren
then
320 Scan
; -- past left paren
321 goto Scan_Name_Extension_Left_Paren
;
323 -- Otherwise the qualified simple name is not extended, so return
326 Expr_Form
:= EF_Simple_Name
;
330 -- Loop scanning past name extensions. A label is used for control
331 -- transfer for this loop for ease of interfacing with the finite state
332 -- machine in the parenthesis scanning circuit, and also to allow for
333 -- passing in control to the appropriate point from the above code.
335 <<Scan_Name_Extension
>>
337 -- Character literal used as name cannot be extended. Also this
338 -- cannot be a call, since the name for a call must be a designator.
339 -- Return in these cases, or if there is no name extension
341 if Token
not in Token_Class_Namext
342 or else Prev_Token
= Tok_Char_Literal
344 Expr_Form
:= EF_Name
;
348 -- Merge here when we know there is a name extension
350 <<Scan_Name_Extension_OK
>>
352 if Token
= Tok_Left_Paren
then
353 Scan
; -- past left paren
354 goto Scan_Name_Extension_Left_Paren
;
356 elsif Token
= Tok_Apostrophe
then
357 Save_Scan_State
(Scan_State
); -- at apostrophe
358 Scan
; -- past apostrophe
359 goto Scan_Name_Extension_Apostrophe
;
361 else -- Token = Tok_Dot
362 Save_Scan_State
(Scan_State
); -- at dot
364 goto Scan_Name_Extension_Dot
;
367 -- Case of name extended by dot (selection), dot is already skipped
368 -- and the scan state at the point of the dot is saved in Scan_State.
370 <<Scan_Name_Extension_Dot
>>
372 -- Explicit dereference case
374 if Token
= Tok_All
then
375 Prefix_Node
:= Name_Node
;
376 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
377 Set_Prefix
(Name_Node
, Prefix_Node
);
379 goto Scan_Name_Extension
;
381 -- Selected component case
383 elsif Token
in Token_Class_Name
then
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 selector
389 goto Scan_Name_Extension
;
391 -- Reserved identifier as selector
393 elsif Is_Reserved_Identifier
then
394 Scan_Reserved_Identifier
(Force_Msg
=> False);
395 Prefix_Node
:= Name_Node
;
396 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
397 Set_Prefix
(Name_Node
, Prefix_Node
);
398 Set_Selector_Name
(Name_Node
, Token_Node
);
399 Scan
; -- past identifier used as selector
400 goto Scan_Name_Extension
;
402 -- If dot is at end of line and followed by nothing legal,
403 -- then assume end of name and quit (dot will be taken as
404 -- an incorrect form of some other punctuation by our caller).
406 elsif Token_Is_At_Start_Of_Line
then
407 Restore_Scan_State
(Scan_State
);
410 -- Here if nothing legal after the dot
413 Error_Msg_AP
("selector expected");
417 -- Here for an apostrophe as name extension. The scan position at the
418 -- apostrophe has already been saved, and the apostrophe scanned out.
420 <<Scan_Name_Extension_Apostrophe
>>
422 Scan_Apostrophe
: declare
423 function Apostrophe_Should_Be_Semicolon
return Boolean;
424 -- Checks for case where apostrophe should probably be
425 -- a semicolon, and if so, gives appropriate message,
426 -- resets the scan pointer to the apostrophe, changes
427 -- the current token to Tok_Semicolon, and returns True.
428 -- Otherwise returns False.
430 ------------------------------------
431 -- Apostrophe_Should_Be_Semicolon --
432 ------------------------------------
434 function Apostrophe_Should_Be_Semicolon
return Boolean is
436 if Token_Is_At_Start_Of_Line
then
437 Restore_Scan_State
(Scan_State
); -- to apostrophe
438 Error_Msg_SC
("|""''"" should be "";""");
439 Token
:= Tok_Semicolon
;
444 end Apostrophe_Should_Be_Semicolon
;
446 -- Start of processing for Scan_Apostrophe
449 -- Check for qualified expression case in Ada 2012 mode
451 if Ada_Version
>= Ada_2012
452 and then Token
in Tok_Left_Paren | Tok_Left_Bracket
454 Name_Node
:= P_Qualified_Expression
(Name_Node
);
455 goto Scan_Name_Extension
;
457 -- If range attribute after apostrophe, then return with Token
458 -- pointing to the apostrophe. Note that in this case the prefix
459 -- need not be a simple name (cases like A.all'range). Similarly
460 -- if there is a left paren after the apostrophe, then we also
461 -- return with Token pointing to the apostrophe (this is the
462 -- aggregate case, or some error case).
464 elsif Token
= Tok_Range
or else Token
= Tok_Left_Paren
then
465 Restore_Scan_State
(Scan_State
); -- to apostrophe
466 Expr_Form
:= EF_Name
;
469 -- Here for cases where attribute designator is an identifier
471 elsif Token
= Tok_Identifier
then
472 Attr_Name
:= Token_Name
;
474 if not Is_Attribute_Name
(Attr_Name
) then
475 if Apostrophe_Should_Be_Semicolon
then
476 Expr_Form
:= EF_Name
;
479 -- Here for a bad attribute name
482 Signal_Bad_Attribute
;
483 Scan
; -- past bad identifier
485 if Token
= Tok_Left_Paren
then
486 Scan
; -- past left paren
489 Discard_Junk_Node
(P_Expression_If_OK
);
490 exit when not Comma_Present
;
501 Style
.Check_Attribute_Name
(False);
504 -- Here for case of attribute designator is not an identifier
507 if Token
= Tok_Delta
then
508 Attr_Name
:= Name_Delta
;
510 elsif Token
= Tok_Digits
then
511 Attr_Name
:= Name_Digits
;
513 elsif Token
= Tok_Access
then
514 Attr_Name
:= Name_Access
;
516 elsif Token
= Tok_Mod
and then Ada_Version
>= Ada_95
then
517 Attr_Name
:= Name_Mod
;
519 elsif Apostrophe_Should_Be_Semicolon
then
520 Expr_Form
:= EF_Name
;
524 Error_Msg_AP
("attribute designator expected");
529 Style
.Check_Attribute_Name
(True);
533 -- We come here with an OK attribute scanned, and corresponding
534 -- Attribute identifier node stored in Ident_Node.
536 Prefix_Node
:= Name_Node
;
537 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
538 Scan
; -- past attribute designator
539 Set_Prefix
(Name_Node
, Prefix_Node
);
540 Set_Attribute_Name
(Name_Node
, Attr_Name
);
542 -- Scan attribute arguments/designator. We skip this if we know
543 -- that the attribute cannot have an argument (see documentation
544 -- of Is_Parameterless_Attribute for further details).
546 if Token
= Tok_Left_Paren
548 Is_Parameterless_Attribute
(Get_Attribute_Id
(Attr_Name
))
550 -- Attribute Update contains an array or record association
551 -- list which provides new values for various components or
552 -- elements. The list is parsed as an aggregate, and we get
553 -- better error handling by knowing that in the parser.
555 if Attr_Name
= Name_Update
then
556 Set_Expressions
(Name_Node
, New_List
);
557 Append
(P_Aggregate
, Expressions
(Name_Node
));
559 -- All other cases of parsing attribute arguments
562 Set_Expressions
(Name_Node
, New_List
);
563 Scan
; -- past left paren
567 Expr
: constant Node_Id
:= P_Expression_If_OK
;
571 -- Case of => for named notation
573 if Token
= Tok_Arrow
then
575 -- Named notation allowed only for the special
576 -- case of System'Restriction_Set (No_Dependence =>
577 -- unit_NAME), in which case construct a parameter
578 -- assocation node and append to the arguments.
580 if Attr_Name
= Name_Restriction_Set
581 and then Nkind
(Expr
) = N_Identifier
582 and then Chars
(Expr
) = Name_No_Dependence
586 Append_To
(Expressions
(Name_Node
),
587 Make_Parameter_Association
(Sloc
(Rnam
),
588 Selector_Name
=> Expr
,
589 Explicit_Actual_Parameter
=> Rnam
));
592 -- For all other cases named notation is illegal
596 ("named parameters not permitted "
598 Scan
; -- past junk arrow
601 -- Here for normal case (not => for named parameter)
604 -- Special handling for 'Image in Ada 2012, where
605 -- the attribute can be parameterless and its value
606 -- can be the prefix of a slice. Rewrite name as a
607 -- slice, Expr is its low bound.
609 if Token
= Tok_Dot_Dot
610 and then Attr_Name
= Name_Image
611 and then Ada_Version
>= Ada_2012
613 Set_Expressions
(Name_Node
, No_List
);
614 Prefix_Node
:= Name_Node
;
616 New_Node
(N_Slice
, Sloc
(Prefix_Node
));
617 Set_Prefix
(Name_Node
, Prefix_Node
);
618 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
619 Set_Low_Bound
(Range_Node
, Expr
);
621 Expr_Node
:= P_Expression
;
622 Check_Simple_Expression
(Expr_Node
);
623 Set_High_Bound
(Range_Node
, Expr_Node
);
624 Set_Discrete_Range
(Name_Node
, Range_Node
);
627 goto Scan_Name_Extension
;
630 Append
(Expr
, Expressions
(Name_Node
));
631 exit when not Comma_Present
;
641 goto Scan_Name_Extension
;
644 -- Here for left parenthesis extending name (left paren skipped)
646 <<Scan_Name_Extension_Left_Paren
>>
648 -- We now have to scan through a list of items, terminated by a
649 -- right parenthesis. The scan is handled by a finite state
650 -- machine. The possibilities are:
654 -- This is a slice. This case is handled in LP_State_Init
656 -- (expression, expression, ..)
658 -- This is interpreted as an indexed component, i.e. as a
659 -- case of a name which can be extended in the normal manner.
660 -- This case is handled by LP_State_Name or LP_State_Expr.
662 -- Note: if and case expressions (without an extra level of
663 -- parentheses) are permitted in this context).
665 -- (..., identifier => expression , ...)
667 -- If there is at least one occurrence of identifier => (but
668 -- none of the other cases apply), then we have a call.
670 -- Test for Id => case
672 if Token
= Tok_Identifier
then
673 Save_Scan_State
(Scan_State
); -- at Id
676 -- Test for => (allow := as an error substitute)
678 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
679 Restore_Scan_State
(Scan_State
); -- to Id
680 Arg_List
:= New_List
;
684 Restore_Scan_State
(Scan_State
); -- to Id
688 -- Here we have an expression after all
690 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
692 -- Check cases of discrete range for a slice
694 -- First possibility: Range_Attribute_Reference
696 if Expr_Form
= EF_Range_Attr
then
697 Range_Node
:= Expr_Node
;
699 -- Second possibility: Simple_expression .. Simple_expression
701 elsif Token
= Tok_Dot_Dot
then
702 Check_Simple_Expression
(Expr_Node
);
703 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
704 Set_Low_Bound
(Range_Node
, Expr_Node
);
706 Expr_Node
:= P_Expression
;
707 Check_Simple_Expression
(Expr_Node
);
708 Set_High_Bound
(Range_Node
, Expr_Node
);
710 -- Third possibility: Type_name range Range
712 elsif Token
= Tok_Range
then
713 if Expr_Form
/= EF_Simple_Name
then
714 Error_Msg_SC
("subtype mark must precede RANGE");
718 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
720 -- Otherwise we just have an expression. It is true that we might
721 -- have a subtype mark without a range constraint but this case
722 -- is syntactically indistinguishable from the expression case.
725 Arg_List
:= New_List
;
729 -- Fall through here with unmistakable Discrete range scanned,
730 -- which means that we definitely have the case of a slice. The
731 -- Discrete range is in Range_Node.
733 if Token
= Tok_Comma
then
734 Error_Msg_SC
("slice cannot have more than one dimension");
737 elsif Token
/= Tok_Right_Paren
then
738 if Token
= Tok_Arrow
then
740 -- This may be an aggregate that is missing a qualification
743 ("context of aggregate must be a qualified expression");
752 Scan
; -- past right paren
753 Prefix_Node
:= Name_Node
;
754 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
755 Set_Prefix
(Name_Node
, Prefix_Node
);
756 Set_Discrete_Range
(Name_Node
, Range_Node
);
758 -- An operator node is legal as a prefix to other names,
759 -- but not for a slice.
761 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
762 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
765 -- If we have a name extension, go scan it
767 if Token
in Token_Class_Namext
then
768 goto Scan_Name_Extension_OK
;
770 -- Otherwise return (a slice is a name, but is not a call)
773 Expr_Form
:= EF_Name
;
778 -- In LP_State_Expr, we have scanned one or more expressions, and
779 -- so we have a call or an indexed component which is a name. On
780 -- entry we have the expression just scanned in Expr_Node and
781 -- Arg_List contains the list of expressions encountered so far
784 Append
(Expr_Node
, Arg_List
);
786 if Token
= Tok_Arrow
then
788 ("expect identifier in parameter association", Sloc
(Expr_Node
));
791 elsif not Comma_Present
then
794 Prefix_Node
:= Name_Node
;
795 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
796 Set_Prefix
(Name_Node
, Prefix_Node
);
797 Set_Expressions
(Name_Node
, Arg_List
);
799 goto Scan_Name_Extension
;
802 -- Comma present (and scanned out), test for identifier => case
803 -- Test for identifier => case
805 if Token
= Tok_Identifier
then
806 Save_Scan_State
(Scan_State
); -- at Id
809 -- Test for => (allow := as error substitute)
811 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
812 Restore_Scan_State
(Scan_State
); -- to Id
815 -- Otherwise it's just an expression after all, so backup
818 Restore_Scan_State
(Scan_State
); -- to Id
822 -- Here we have an expression after all, so stay in this state
824 Expr_Node
:= P_Expression_If_OK
;
827 -- LP_State_Call corresponds to the situation in which at least one
828 -- instance of Id => Expression has been encountered, so we know that
829 -- we do not have a name, but rather a call. We enter it with the
830 -- scan pointer pointing to the next argument to scan, and Arg_List
831 -- containing the list of arguments scanned so far.
835 -- Test for case of Id => Expression (named parameter)
837 if Token
= Tok_Identifier
then
838 Save_Scan_State
(Scan_State
); -- at Id
839 Ident_Node
:= Token_Node
;
842 -- Deal with => (allow := as incorrect substitute)
844 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
845 Arg_Node
:= New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
846 Set_Selector_Name
(Arg_Node
, Ident_Node
);
848 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
849 Append
(Arg_Node
, Arg_List
);
851 -- If a comma follows, go back and scan next entry
853 if Comma_Present
then
856 -- Otherwise we have the end of a call
859 Prefix_Node
:= Name_Node
;
860 Name_Node
:= New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
861 Set_Name
(Name_Node
, Prefix_Node
);
862 Set_Parameter_Associations
(Name_Node
, Arg_List
);
865 if Token
in Token_Class_Namext
then
866 goto Scan_Name_Extension_OK
;
868 -- This is a case of a call which cannot be a name
871 Expr_Form
:= EF_Name
;
876 -- Not named parameter: Id started an expression after all
879 Restore_Scan_State
(Scan_State
); -- to Id
883 -- Here if entry did not start with Id => which means that it
884 -- is a positional parameter, which is not allowed, since we
885 -- have seen at least one named parameter already.
888 ("positional parameter association " &
889 "not allowed after named one");
891 Expr_Node
:= P_Expression_If_OK
;
893 -- Leaving the '>' in an association is not unusual, so suggest
896 if Nkind
(Expr_Node
) = N_Op_Eq
then
897 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
900 -- We go back to scanning out expressions, so that we do not get
901 -- multiple error messages when several positional parameters
902 -- follow a named parameter.
906 -- End of treatment for name extensions starting with left paren
908 -- End of loop through name extensions
912 -- This function parses a restricted form of Names which are either
913 -- designators, or designators preceded by a sequence of prefixes
914 -- that are direct names.
916 -- Error recovery: cannot raise Error_Resync
918 function P_Function_Name
return Node_Id
is
919 Designator_Node
: Node_Id
;
920 Prefix_Node
: Node_Id
;
921 Selector_Node
: Node_Id
;
922 Dot_Sloc
: Source_Ptr
:= No_Location
;
925 -- Prefix_Node is set to the gathered prefix so far, Empty means that
926 -- no prefix has been scanned. This allows us to build up the result
927 -- in the required right recursive manner.
929 Prefix_Node
:= Empty
;
931 -- Loop through prefixes
934 Designator_Node
:= Token_Node
;
936 if Token
not in Token_Class_Desig
then
937 return P_Identifier
; -- let P_Identifier issue the error message
939 else -- Token in Token_Class_Desig
940 Scan
; -- past designator
941 exit when Token
/= Tok_Dot
;
944 -- Here at a dot, with token just before it in Designator_Node
946 if No
(Prefix_Node
) then
947 Prefix_Node
:= Designator_Node
;
949 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
950 Set_Prefix
(Selector_Node
, Prefix_Node
);
951 Set_Selector_Name
(Selector_Node
, Designator_Node
);
952 Prefix_Node
:= Selector_Node
;
955 Dot_Sloc
:= Token_Ptr
;
959 -- Fall out of the loop having just scanned a designator
961 if No
(Prefix_Node
) then
962 return Designator_Node
;
964 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
965 Set_Prefix
(Selector_Node
, Prefix_Node
);
966 Set_Selector_Name
(Selector_Node
, Designator_Node
);
967 return Selector_Node
;
975 -- This function parses a restricted form of Names which are either
976 -- identifiers, or identifiers preceded by a sequence of prefixes
977 -- that are direct names.
979 -- Error recovery: cannot raise Error_Resync
981 function P_Qualified_Simple_Name
return Node_Id
is
982 Designator_Node
: Node_Id
;
983 Prefix_Node
: Node_Id
;
984 Selector_Node
: Node_Id
;
985 Dot_Sloc
: Source_Ptr
:= No_Location
;
988 -- Prefix node is set to the gathered prefix so far, Empty means that
989 -- no prefix has been scanned. This allows us to build up the result
990 -- in the required right recursive manner.
992 Prefix_Node
:= Empty
;
994 -- Loop through prefixes
997 Designator_Node
:= Token_Node
;
999 if Token
= Tok_Identifier
then
1000 Scan
; -- past identifier
1001 exit when Token
/= Tok_Dot
;
1003 elsif Token
not in Token_Class_Desig
then
1004 return P_Identifier
; -- let P_Identifier issue the error message
1007 Scan
; -- past designator
1009 if Token
/= Tok_Dot
then
1010 Error_Msg_SP
("identifier expected");
1015 -- Here at a dot, with token just before it in Designator_Node
1017 if No
(Prefix_Node
) then
1018 Prefix_Node
:= Designator_Node
;
1020 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1021 Set_Prefix
(Selector_Node
, Prefix_Node
);
1022 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1023 Prefix_Node
:= Selector_Node
;
1026 Dot_Sloc
:= Token_Ptr
;
1030 -- Fall out of the loop having just scanned an identifier
1032 if No
(Prefix_Node
) then
1033 return Designator_Node
;
1035 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1036 Set_Prefix
(Selector_Node
, Prefix_Node
);
1037 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1038 return Selector_Node
;
1042 when Error_Resync
=>
1044 end P_Qualified_Simple_Name
;
1046 -- This procedure differs from P_Qualified_Simple_Name only in that it
1047 -- raises Error_Resync if any error is encountered. It only returns after
1048 -- scanning a valid qualified simple name.
1050 -- Error recovery: can raise Error_Resync
1052 function P_Qualified_Simple_Name_Resync
return Node_Id
is
1053 Designator_Node
: Node_Id
;
1054 Prefix_Node
: Node_Id
;
1055 Selector_Node
: Node_Id
;
1056 Dot_Sloc
: Source_Ptr
:= No_Location
;
1059 Prefix_Node
:= Empty
;
1061 -- Loop through prefixes
1064 Designator_Node
:= Token_Node
;
1066 if Token
= Tok_Identifier
then
1067 Scan
; -- past identifier
1068 exit when Token
/= Tok_Dot
;
1070 elsif Token
not in Token_Class_Desig
then
1071 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
1075 Scan
; -- past designator
1077 if Token
/= Tok_Dot
then
1078 Error_Msg_SP
("identifier expected");
1083 -- Here at a dot, with token just before it in Designator_Node
1085 if No
(Prefix_Node
) then
1086 Prefix_Node
:= Designator_Node
;
1088 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1089 Set_Prefix
(Selector_Node
, Prefix_Node
);
1090 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1091 Prefix_Node
:= Selector_Node
;
1094 Dot_Sloc
:= Token_Ptr
;
1095 Scan
; -- past period
1098 -- Fall out of the loop having just scanned an identifier
1100 if No
(Prefix_Node
) then
1101 return Designator_Node
;
1103 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1104 Set_Prefix
(Selector_Node
, Prefix_Node
);
1105 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1106 return Selector_Node
;
1108 end P_Qualified_Simple_Name_Resync
;
1110 ----------------------
1111 -- 4.1 Direct_Name --
1112 ----------------------
1114 -- Parsed by P_Name and other functions in section 4.1
1120 -- Parsed by P_Name (4.1)
1122 -------------------------------
1123 -- 4.1 Explicit Dereference --
1124 -------------------------------
1126 -- Parsed by P_Name (4.1)
1128 -------------------------------
1129 -- 4.1 Implicit_Dereference --
1130 -------------------------------
1132 -- Parsed by P_Name (4.1)
1134 ----------------------------
1135 -- 4.1 Indexed Component --
1136 ----------------------------
1138 -- Parsed by P_Name (4.1)
1144 -- Parsed by P_Name (4.1)
1146 -----------------------------
1147 -- 4.1 Selected_Component --
1148 -----------------------------
1150 -- Parsed by P_Name (4.1)
1152 ------------------------
1153 -- 4.1 Selector Name --
1154 ------------------------
1156 -- Parsed by P_Name (4.1)
1158 ------------------------------
1159 -- 4.1 Attribute Reference --
1160 ------------------------------
1162 -- Parsed by P_Name (4.1)
1164 -------------------------------
1165 -- 4.1 Attribute Designator --
1166 -------------------------------
1168 -- Parsed by P_Name (4.1)
1170 --------------------------------------
1171 -- 4.1.4 Range Attribute Reference --
1172 --------------------------------------
1174 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1176 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1178 -- In the grammar, a RANGE attribute is simply a name, but its use is
1179 -- highly restricted, so in the parser, we do not regard it as a name.
1180 -- Instead, P_Name returns without scanning the 'RANGE part of the
1181 -- attribute, and the caller uses the following function to construct
1182 -- a range attribute in places where it is appropriate.
1184 -- Note that RANGE here is treated essentially as an identifier,
1185 -- rather than a reserved word.
1187 -- The caller has parsed the prefix, i.e. a name, and Token points to
1188 -- the apostrophe. The token after the apostrophe is known to be RANGE
1189 -- at this point. The prefix node becomes the prefix of the attribute.
1191 -- Error_Recovery: Cannot raise Error_Resync
1193 function P_Range_Attribute_Reference
1194 (Prefix_Node
: Node_Id
)
1197 Attr_Node
: Node_Id
;
1200 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1201 Set_Prefix
(Attr_Node
, Prefix_Node
);
1202 Scan
; -- past apostrophe
1205 Style
.Check_Attribute_Name
(True);
1208 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1211 if Token
= Tok_Left_Paren
then
1212 Scan
; -- past left paren
1213 Set_Expressions
(Attr_Node
, New_List
(P_Expression_If_OK
));
1218 end P_Range_Attribute_Reference
;
1220 -------------------------------------
1221 -- P_Reduction_Attribute_Reference --
1222 -------------------------------------
1224 function P_Reduction_Attribute_Reference
(S
: Node_Id
)
1227 Attr_Node
: Node_Id
;
1228 Attr_Name
: Name_Id
;
1231 Attr_Name
:= Token_Name
;
1232 Scan
; -- past Reduce
1233 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1234 Set_Attribute_Name
(Attr_Node
, Attr_Name
);
1235 if Attr_Name
/= Name_Reduce
then
1236 Error_Msg
("Reduce attribute expected", Prev_Token_Ptr
);
1239 Set_Prefix
(Attr_Node
, S
);
1240 Set_Expressions
(Attr_Node
, New_List
);
1242 Append
(P_Name
, Expressions
(Attr_Node
));
1244 Append
(P_Expression
, Expressions
(Attr_Node
));
1248 end P_Reduction_Attribute_Reference
;
1250 ---------------------------------------
1251 -- 4.1.4 Range Attribute Designator --
1252 ---------------------------------------
1254 -- Parsed by P_Range_Attribute_Reference (4.4)
1256 ---------------------------------------------
1257 -- 4.1.4 (2) Reduction_Attribute_Reference --
1258 ---------------------------------------------
1260 -- parsed by P_Reduction_Attribute_Reference
1262 --------------------
1264 --------------------
1266 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1268 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1269 -- an aggregate is known to be required (code statement, extension
1270 -- aggregate), in which cases this routine performs the necessary check
1271 -- that we have an aggregate rather than a parenthesized expression
1273 -- Error recovery: can raise Error_Resync
1275 function P_Aggregate
return Node_Id
is
1276 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1277 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1280 if Nkind
(Aggr_Node
) /= N_Aggregate
1282 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1283 and then Ada_Version
< Ada_2022
1286 ("aggregate may not have single positional component", Aggr_Sloc
);
1293 ------------------------------------------------
1294 -- 4.3 Aggregate or Parenthesized Expression --
1295 ------------------------------------------------
1297 -- This procedure parses out either an aggregate or a parenthesized
1298 -- expression (these two constructs are closely related, since a
1299 -- parenthesized expression looks like an aggregate with a single
1300 -- positional component).
1303 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1305 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1307 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1308 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1311 -- RECORD_COMPONENT_ASSOCIATION ::=
1312 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1314 -- COMPONENT_CHOICE_LIST ::=
1315 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1318 -- EXTENSION_AGGREGATE ::=
1319 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1321 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1323 -- ARRAY_AGGREGATE ::=
1324 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1326 -- POSITIONAL_ARRAY_AGGREGATE ::=
1327 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1328 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1329 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1331 -- NAMED_ARRAY_AGGREGATE ::=
1332 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1334 -- PRIMARY ::= (EXPRESSION);
1336 -- Error recovery: can raise Error_Resync
1338 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1339 -- to Ada 2005 limited aggregates (AI-287)
1341 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1342 Aggregate_Node
: Node_Id
;
1343 Expr_List
: List_Id
;
1344 Assoc_List
: List_Id
;
1345 Expr_Node
: Node_Id
;
1346 Lparen_Sloc
: Source_Ptr
;
1347 Scan_State
: Saved_Scan_State
;
1349 procedure Box_Error
;
1350 -- Called if <> is encountered as positional aggregate element. Issues
1351 -- error message and sets Expr_Node to Error.
1353 function Is_Quantified_Expression
return Boolean;
1354 -- The presence of iterated component associations requires a one
1355 -- token lookahead to distinguish it from quantified expressions.
1361 procedure Box_Error
is
1363 Error_Msg_Ada_2005_Extension
("'<'> in aggregate");
1365 -- Ada 2005 (AI-287): The box notation is allowed only with named
1366 -- notation because positional notation might be error prone. For
1367 -- example, in "(X, <>, Y, <>)", there is no type associated with
1368 -- the boxes, so you might not be leaving out the components you
1369 -- thought you were leaving out.
1371 Error_Msg_SC
("(Ada 2005) box only allowed with named notation");
1376 ------------------------------
1377 -- Is_Quantified_Expression --
1378 ------------------------------
1380 function Is_Quantified_Expression
return Boolean is
1382 Scan_State
: Saved_Scan_State
;
1385 Save_Scan_State
(Scan_State
);
1387 Maybe
:= Token
= Tok_All
or else Token
= Tok_Some
;
1388 Restore_Scan_State
(Scan_State
); -- to FOR
1390 end Is_Quantified_Expression
;
1392 Start_Token
: constant Token_Type
:= Token
;
1393 -- Used to prevent mismatches (...] and [...)
1395 -- Start of processing for P_Aggregate_Or_Paren_Expr
1398 Lparen_Sloc
:= Token_Ptr
;
1399 if Token
= Tok_Left_Bracket
then
1402 -- Special case for null aggregate in Ada 2022
1404 if Token
= Tok_Right_Bracket
then
1406 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1407 Set_Expressions
(Aggregate_Node
, New_List
);
1408 Set_Is_Homogeneous_Aggregate
(Aggregate_Node
);
1409 return Aggregate_Node
;
1415 -- Note on parentheses count. For cases like an if expression, the
1416 -- parens here really count as real parentheses for the paren count,
1417 -- so we adjust the paren count accordingly after scanning the expr.
1421 if Token
= Tok_If
then
1422 Expr_Node
:= P_If_Expression
;
1424 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1429 elsif Token
= Tok_Case
then
1430 Expr_Node
:= P_Case_Expression
;
1432 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1435 -- Quantified expression
1437 elsif Token
= Tok_For
and then Is_Quantified_Expression
then
1438 Expr_Node
:= P_Quantified_Expression
;
1440 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1443 -- Note: the mechanism used here of rescanning the initial expression
1444 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1445 -- out the discrete choice list.
1447 -- Deal with expression and extension aggregates first
1449 elsif Token
/= Tok_Others
then
1450 Save_Scan_State
(Scan_State
); -- at start of expression
1452 -- Deal with (NULL RECORD)
1454 if Token
= Tok_Null
then
1457 if Token
= Tok_Record
then
1458 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1459 Set_Null_Record_Present
(Aggregate_Node
, True);
1460 Scan
; -- past RECORD
1462 return Aggregate_Node
;
1464 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1467 elsif Token
= Tok_For
then
1468 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1469 Expr_Node
:= P_Iterated_Component_Association
;
1473 -- Scan expression, handling box appearing as positional argument
1475 if Token
= Tok_Box
then
1478 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1481 -- Extension or Delta aggregate
1483 if Token
= Tok_With
then
1484 if Nkind
(Expr_Node
) = N_Attribute_Reference
1485 and then Attribute_Name
(Expr_Node
) = Name_Range
1487 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1491 if Ada_Version
= Ada_83
then
1492 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1496 if Token
= Tok_Delta
then
1498 Aggregate_Node
:= New_Node
(N_Delta_Aggregate
, Lparen_Sloc
);
1499 Set_Expression
(Aggregate_Node
, Expr_Node
);
1505 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1506 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1509 -- Deal with WITH NULL RECORD case
1511 if Token
= Tok_Null
then
1512 Save_Scan_State
(Scan_State
); -- at NULL
1515 if Token
= Tok_Record
then
1516 Scan
; -- past RECORD
1517 Set_Null_Record_Present
(Aggregate_Node
, True);
1519 return Aggregate_Node
;
1522 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1526 if Token
/= Tok_Others
then
1527 Save_Scan_State
(Scan_State
);
1528 Expr_Node
:= P_Expression
;
1535 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1536 if Nkind
(Expr_Node
) = N_Attribute_Reference
1537 and then Attribute_Name
(Expr_Node
) = Name_Range
1540 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
1541 Scan
; -- past right paren
1545 -- Bump paren count of expression
1547 if Expr_Node
/= Error
then
1548 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1551 T_Right_Paren
; -- past right paren (error message if none)
1557 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1563 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1567 -- Prepare to scan list of component associations
1569 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1570 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1572 -- This loop scans through component associations. On entry to the
1573 -- loop, an expression has been scanned at the start of the current
1574 -- association unless initial token was OTHERS, in which case
1575 -- Expr_Node is set to Empty.
1578 -- Deal with others association first. This is a named association
1580 if No
(Expr_Node
) then
1581 Append_New
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1583 -- Improper use of WITH
1585 elsif Token
= Tok_With
then
1586 Error_Msg_SC
("WITH must be preceded by single expression in " &
1587 "extension aggregate");
1590 -- Range attribute can only appear as part of a discrete choice list
1592 elsif Nkind
(Expr_Node
) = N_Attribute_Reference
1593 and then Attribute_Name
(Expr_Node
) = Name_Range
1594 and then Token
/= Tok_Arrow
1595 and then Token
/= Tok_Vertical_Bar
1597 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1600 -- Assume positional case if comma, right paren, or literal or
1601 -- identifier or OTHERS follows (the latter cases are missing
1602 -- comma cases). Also assume positional if a semicolon follows,
1603 -- which can happen if there are missing parens.
1604 -- In Ada 2012 and 2022 an iterated association can appear.
1606 elsif Nkind
(Expr_Node
) in
1607 N_Iterated_Component_Association | N_Iterated_Element_Association
1609 Append_New
(Expr_Node
, Assoc_List
);
1611 elsif Token
= Tok_Comma
1612 or else Token
= Tok_Right_Paren
1613 or else Token
= Tok_Others
1614 or else Token
in Token_Class_Lit_Or_Name
1615 or else Token
= Tok_Semicolon
1617 if Present
(Assoc_List
) then
1618 Error_Msg_BC
-- CODEFIX
1619 ("""='>"" expected (positional association cannot follow "
1620 & "named association)");
1623 Append_New
(Expr_Node
, Expr_List
);
1625 -- Check for aggregate followed by left parent, maybe missing comma
1627 elsif Nkind
(Expr_Node
) = N_Aggregate
1628 and then Token
= Tok_Left_Paren
1632 Append_New
(Expr_Node
, Expr_List
);
1634 elsif Token
= Tok_Right_Bracket
then
1635 Append_New
(Expr_Node
, Expr_List
);
1638 -- Anything else is assumed to be a named association
1641 Restore_Scan_State
(Scan_State
); -- to start of expression
1643 Append_New
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1646 exit when not Comma_Present
;
1648 -- If we are at an expression terminator, something is seriously
1649 -- wrong, so let's get out now, before we start eating up stuff
1650 -- that doesn't belong to us.
1652 if Token
in Token_Class_Eterm
and then Token
/= Tok_For
then
1654 ("expecting expression or component association");
1658 -- Deal with misused box
1660 if Token
= Tok_Box
then
1663 -- Otherwise initiate for reentry to top of loop by scanning an
1664 -- initial expression, unless the first token is OTHERS or FOR,
1665 -- which indicates an iterated component association.
1667 elsif Token
= Tok_Others
then
1670 elsif Token
= Tok_For
then
1671 Expr_Node
:= P_Iterated_Component_Association
;
1674 Save_Scan_State
(Scan_State
); -- at start of expression
1675 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1680 -- All component associations (positional and named) have been scanned.
1681 -- Scan ] or ) based on Start_Token.
1684 when Tok_Left_Bracket
=>
1685 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1686 Set_Is_Homogeneous_Aggregate
(Aggregate_Node
);
1689 if Token
= Tok_Apostrophe
then
1692 if Token
= Tok_Identifier
then
1693 return P_Reduction_Attribute_Reference
(Aggregate_Node
);
1696 when Tok_Left_Paren
=>
1698 when others => raise Program_Error
;
1701 if Nkind
(Aggregate_Node
) /= N_Delta_Aggregate
then
1702 Set_Expressions
(Aggregate_Node
, Expr_List
);
1705 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1706 return Aggregate_Node
;
1707 end P_Aggregate_Or_Paren_Expr
;
1709 ------------------------------------------------
1710 -- 4.3 Record or Array Component Association --
1711 ------------------------------------------------
1713 -- RECORD_COMPONENT_ASSOCIATION ::=
1714 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1715 -- | COMPONENT_CHOICE_LIST => <>
1717 -- COMPONENT_CHOICE_LIST =>
1718 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1721 -- ARRAY_COMPONENT_ASSOCIATION ::=
1722 -- DISCRETE_CHOICE_LIST => EXPRESSION
1723 -- | DISCRETE_CHOICE_LIST => <>
1724 -- | ITERATED_COMPONENT_ASSOCIATION
1726 -- Note: this routine only handles the named cases, including others.
1727 -- Cases where the component choice list is not present have already
1728 -- been handled directly.
1730 -- Error recovery: can raise Error_Resync
1732 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1733 -- rules have been extended to give support to Ada 2005 limited
1734 -- aggregates (AI-287)
1736 function P_Record_Or_Array_Component_Association
return Node_Id
is
1737 Assoc_Node
: Node_Id
;
1738 Box_Present
: Boolean := False;
1739 Box_With_Identifier_Present
: Boolean := False;
1741 -- A loop indicates an iterated_component_association
1743 if Token
= Tok_For
then
1744 return P_Iterated_Component_Association
;
1747 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1748 Set_Binding_Chars
(Assoc_Node
, No_Name
);
1750 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1751 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1754 if Token
= Tok_Box
then
1756 -- Ada 2005(AI-287): The box notation is used to indicate the
1757 -- default initialization of aggregate components
1759 Error_Msg_Ada_2005_Extension
("component association with '<'>");
1761 Box_Present
:= True;
1762 Set_Box_Present
(Assoc_Node
);
1764 elsif Token
= Tok_Less
then
1766 Scan_State
: Saved_Scan_State
;
1769 Save_Scan_State
(Scan_State
);
1771 if Token
= Tok_Identifier
then
1772 Id
:= P_Defining_Identifier
;
1773 if Token
= Tok_Greater
then
1774 if Extensions_Allowed
then
1775 Set_Box_Present
(Assoc_Node
);
1776 Set_Binding_Chars
(Assoc_Node
, Chars
(Id
));
1777 Box_Present
:= True;
1778 Box_With_Identifier_Present
:= True;
1782 ("Identifier within box only supported under -gnatX",
1784 Box_Present
:= True;
1785 -- Avoid cascading errors by ignoring the identifier
1789 if not Box_Present
then
1790 -- it wasn't an "is <identifier>", so restore.
1791 Restore_Scan_State
(Scan_State
);
1796 if not Box_Present
then
1797 Set_Expression
(Assoc_Node
, P_Expression
);
1800 -- Check for "is <identifier>" for aggregate that is part of
1801 -- a pattern for a general case statement.
1803 if Token
= Tok_Is
then
1805 Scan_State
: Saved_Scan_State
;
1808 Save_Scan_State
(Scan_State
);
1810 if Token
= Tok_Identifier
then
1811 Id
:= P_Defining_Identifier
;
1813 if not Extensions_Allowed
then
1815 ("IS following component association"
1816 & " only supported under -gnatX",
1818 elsif Box_With_Identifier_Present
then
1820 ("Both identifier-in-box and trailing identifier"
1821 & " specified for one component association",
1824 Set_Binding_Chars
(Assoc_Node
, Chars
(Id
));
1827 -- It wasn't an "is <identifier>", so restore.
1828 Restore_Scan_State
(Scan_State
);
1834 end P_Record_Or_Array_Component_Association
;
1836 -----------------------------
1837 -- 4.3.1 Record Aggregate --
1838 -----------------------------
1840 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1841 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1843 ----------------------------------------------
1844 -- 4.3.1 Record Component Association List --
1845 ----------------------------------------------
1847 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1849 ----------------------------------
1850 -- 4.3.1 Component Choice List --
1851 ----------------------------------
1853 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1855 --------------------------------
1856 -- 4.3.1 Extension Aggregate --
1857 --------------------------------
1859 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1861 --------------------------
1862 -- 4.3.1 Ancestor Part --
1863 --------------------------
1865 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1867 ----------------------------
1868 -- 4.3.1 Array Aggregate --
1869 ----------------------------
1871 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1873 ---------------------------------------
1874 -- 4.3.1 Positional Array Aggregate --
1875 ---------------------------------------
1877 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1879 ----------------------------------
1880 -- 4.3.1 Named Array Aggregate --
1881 ----------------------------------
1883 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1885 ----------------------------------------
1886 -- 4.3.1 Array Component Association --
1887 ----------------------------------------
1889 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1891 ---------------------
1892 -- 4.4 Expression --
1893 ---------------------
1895 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1898 -- RELATION {LOGICAL_OPERATOR RELATION}
1900 -- CHOICE_EXPRESSION ::=
1901 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1903 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1905 -- On return, Expr_Form indicates the categorization of the expression
1906 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1907 -- an error message is given, and Error is returned).
1909 -- Error recovery: cannot raise Error_Resync
1911 function P_Expression
return Node_Id
is
1912 Logical_Op
: Node_Kind
;
1913 Prev_Logical_Op
: Node_Kind
;
1914 Op_Location
: Source_Ptr
;
1919 Node1
:= P_Relation
;
1921 if Token
in Token_Class_Logop
then
1922 Prev_Logical_Op
:= N_Empty
;
1925 Op_Location
:= Token_Ptr
;
1926 Logical_Op
:= P_Logical_Operator
;
1928 if Prev_Logical_Op
/= N_Empty
and then
1929 Logical_Op
/= Prev_Logical_Op
1932 ("mixed logical operators in expression", Op_Location
);
1933 Prev_Logical_Op
:= N_Empty
;
1935 Prev_Logical_Op
:= Logical_Op
;
1939 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1940 Set_Left_Opnd
(Node1
, Node2
);
1941 Set_Right_Opnd
(Node1
, P_Relation
);
1943 -- Check for case of errant comma or semicolon
1945 if Token
= Tok_Comma
or else Token
= Tok_Semicolon
then
1947 Com
: constant Boolean := Token
= Tok_Comma
;
1948 Scan_State
: Saved_Scan_State
;
1952 Save_Scan_State
(Scan_State
); -- at comma/semicolon
1953 Scan
; -- past comma/semicolon
1955 -- Check for AND THEN or OR ELSE after comma/semicolon. We
1956 -- do not deal with AND/OR because those cases get mixed up
1957 -- with the select alternatives case.
1959 if Token
= Tok_And
or else Token
= Tok_Or
then
1960 Logop
:= P_Logical_Operator
;
1961 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1963 if Logop
in N_And_Then | N_Or_Else
then
1964 Scan
; -- past comma/semicolon
1967 Error_Msg_SP
-- CODEFIX
1968 ("|extra "","" ignored");
1970 Error_Msg_SP
-- CODEFIX
1971 ("|extra "";"" ignored");
1975 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1979 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1984 exit when Token
not in Token_Class_Logop
;
1987 Expr_Form
:= EF_Non_Simple
;
1990 if Token
= Tok_Apostrophe
then
1991 Bad_Range_Attribute
(Token_Ptr
);
1998 -- This function is identical to the normal P_Expression, except that it
1999 -- also permits the appearance of a case, conditional, or quantified
2000 -- expression if the call immediately follows a left paren, and followed
2001 -- by a right parenthesis. These forms are allowed if these conditions
2002 -- are not met, but an error message will be issued.
2004 function P_Expression_If_OK
return Node_Id
is
2006 -- Case of conditional, case or quantified expression
2009 or else Token
= Tok_If
2010 or else Token
= Tok_For
2011 or else Token
= Tok_Declare
2013 return P_Unparen_Cond_Expr_Etc
;
2015 -- Normal case, not case/conditional/quantified expression
2018 return P_Expression
;
2020 end P_Expression_If_OK
;
2022 -- This function is identical to the normal P_Expression, except that it
2023 -- checks that the expression scan did not stop on a right paren. It is
2024 -- called in all contexts where a right parenthesis cannot legitimately
2025 -- follow an expression.
2027 -- Error recovery: cannot raise Error_Resync
2029 function P_Expression_No_Right_Paren
return Node_Id
is
2030 Expr
: constant Node_Id
:= P_Expression
;
2032 Ignore
(Tok_Right_Paren
);
2034 end P_Expression_No_Right_Paren
;
2036 ----------------------------------------
2037 -- 4.4 Expression_Or_Range_Attribute --
2038 ----------------------------------------
2041 -- RELATION {and RELATION} | RELATION {and then RELATION}
2042 -- | RELATION {or RELATION} | RELATION {or else RELATION}
2043 -- | RELATION {xor RELATION}
2045 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2047 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2049 -- On return, Expr_Form indicates the categorization of the expression
2050 -- and EF_Range_Attr is one of the possibilities.
2052 -- Error recovery: cannot raise Error_Resync
2054 -- In the grammar, a RANGE attribute is simply a name, but its use is
2055 -- highly restricted, so in the parser, we do not regard it as a name.
2056 -- Instead, P_Name returns without scanning the 'RANGE part of the
2057 -- attribute, and P_Expression_Or_Range_Attribute handles the range
2058 -- attribute reference. In the normal case where a range attribute is
2059 -- not allowed, an error message is issued by P_Expression.
2061 function P_Expression_Or_Range_Attribute
return Node_Id
is
2062 Logical_Op
: Node_Kind
;
2063 Prev_Logical_Op
: Node_Kind
;
2064 Op_Location
: Source_Ptr
;
2067 Attr_Node
: Node_Id
;
2070 Node1
:= P_Relation
;
2072 if Token
= Tok_Apostrophe
then
2073 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
2074 Expr_Form
:= EF_Range_Attr
;
2077 elsif Token
in Token_Class_Logop
then
2078 Prev_Logical_Op
:= N_Empty
;
2081 Op_Location
:= Token_Ptr
;
2082 Logical_Op
:= P_Logical_Operator
;
2084 if Prev_Logical_Op
/= N_Empty
and then
2085 Logical_Op
/= Prev_Logical_Op
2088 ("mixed logical operators in expression", Op_Location
);
2089 Prev_Logical_Op
:= N_Empty
;
2091 Prev_Logical_Op
:= Logical_Op
;
2095 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
2096 Set_Left_Opnd
(Node1
, Node2
);
2097 Set_Right_Opnd
(Node1
, P_Relation
);
2098 exit when Token
not in Token_Class_Logop
;
2101 Expr_Form
:= EF_Non_Simple
;
2104 if Token
= Tok_Apostrophe
then
2105 Bad_Range_Attribute
(Token_Ptr
);
2110 end P_Expression_Or_Range_Attribute
;
2112 -- Version that allows a non-parenthesized case, conditional, or quantified
2113 -- expression if the call immediately follows a left paren, and followed
2114 -- by a right parenthesis. These forms are allowed if these conditions
2115 -- are not met, but an error message will be issued.
2117 function P_Expression_Or_Range_Attribute_If_OK
return Node_Id
is
2119 -- Case of conditional, case or quantified expression
2122 or else Token
= Tok_If
2123 or else Token
= Tok_For
2124 or else Token
= Tok_Declare
2126 return P_Unparen_Cond_Expr_Etc
;
2128 -- Normal case, not one of the above expression types
2131 return P_Expression_Or_Range_Attribute
;
2133 end P_Expression_Or_Range_Attribute_If_OK
;
2139 -- This procedure scans both relations and choice relations
2141 -- CHOICE_RELATION ::=
2142 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
2145 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
2146 -- | RAISE_EXPRESSION
2148 -- MEMBERSHIP_CHOICE_LIST ::=
2149 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
2151 -- MEMBERSHIP_CHOICE ::=
2152 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
2154 -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
2156 -- On return, Expr_Form indicates the categorization of the expression
2158 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2159 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2161 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2162 -- expression, then tokens are scanned until either a non-expression token,
2163 -- a right paren (not matched by a left paren) or a comma, is encountered.
2165 function P_Relation
return Node_Id
is
2166 Node1
, Node2
: Node_Id
;
2170 -- First check for raise expression
2172 if Token
= Tok_Raise
then
2173 Expr_Form
:= EF_Non_Simple
;
2174 return P_Raise_Expression
;
2179 Node1
:= P_Simple_Expression
;
2181 if Token
not in Token_Class_Relop
then
2185 -- Here we have a relational operator following. If so then scan it
2186 -- out. Note that the assignment symbol := is treated as a relational
2187 -- operator to improve the error recovery when it is misused for =.
2188 -- P_Relational_Operator also parses the IN and NOT IN operations.
2191 Node2
:= New_Op_Node
(P_Relational_Operator
, Optok
);
2192 Set_Left_Opnd
(Node2
, Node1
);
2194 -- Case of IN or NOT IN
2196 if Prev_Token
= Tok_In
then
2197 P_Membership_Test
(Node2
);
2199 -- Case of relational operator (= /= < <= > >=)
2202 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
2205 Expr_Form
:= EF_Non_Simple
;
2207 if Token
in Token_Class_Relop
then
2208 Error_Msg_SC
("unexpected relational operator");
2215 -- If any error occurs, then scan to the next expression terminator symbol
2216 -- or comma or right paren at the outer (i.e. current) parentheses level.
2217 -- The flags are set to indicate a normal simple expression.
2220 when Error_Resync
=>
2222 Expr_Form
:= EF_Simple
;
2226 ----------------------------
2227 -- 4.4 Simple Expression --
2228 ----------------------------
2230 -- SIMPLE_EXPRESSION ::=
2231 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2233 -- On return, Expr_Form indicates the categorization of the expression
2235 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2236 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2238 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2239 -- expression, then tokens are scanned until either a non-expression token,
2240 -- a right paren (not matched by a left paren) or a comma, is encountered.
2242 -- Note: P_Simple_Expression is called only internally by higher level
2243 -- expression routines. In cases in the grammar where a simple expression
2244 -- is required, the approach is to scan an expression, and then post an
2245 -- appropriate error message if the expression obtained is not simple. This
2246 -- gives better error recovery and treatment.
2248 function P_Simple_Expression
return Node_Id
is
2249 Scan_State
: Saved_Scan_State
;
2252 Tokptr
: Source_Ptr
;
2254 function At_Start_Of_Attribute
return Boolean;
2255 -- Tests if we have quote followed by attribute name, if so, return True
2256 -- otherwise return False.
2258 ---------------------------
2259 -- At_Start_Of_Attribute --
2260 ---------------------------
2262 function At_Start_Of_Attribute
return Boolean is
2264 if Token
/= Tok_Apostrophe
then
2269 Scan_State
: Saved_Scan_State
;
2272 Save_Scan_State
(Scan_State
);
2275 if Token
= Tok_Identifier
2276 and then Is_Attribute_Name
(Chars
(Token_Node
))
2278 Restore_Scan_State
(Scan_State
);
2281 Restore_Scan_State
(Scan_State
);
2286 end At_Start_Of_Attribute
;
2288 -- Start of processing for P_Simple_Expression
2291 -- Check for cases starting with a name. There are two reasons for
2292 -- special casing. First speed things up by catching a common case
2293 -- without going through several routine layers. Second the caller must
2294 -- be informed via Expr_Form when the simple expression is a name.
2296 if Token
in Token_Class_Name
then
2299 -- Deal with apostrophe cases
2301 if Token
= Tok_Apostrophe
then
2302 Save_Scan_State
(Scan_State
); -- at apostrophe
2303 Scan
; -- past apostrophe
2305 -- If qualified expression, scan it out and fall through
2307 if Token
= Tok_Left_Paren
then
2308 Node1
:= P_Qualified_Expression
(Node1
);
2309 Expr_Form
:= EF_Simple
;
2311 -- If range attribute, then we return with Token pointing to the
2312 -- apostrophe. Note: avoid the normal error check on exit. We
2313 -- know that the expression really is complete in this case.
2315 else -- Token = Tok_Range then
2316 Restore_Scan_State
(Scan_State
); -- to apostrophe
2317 Expr_Form
:= EF_Simple_Name
;
2322 -- If an expression terminator follows, the previous processing
2323 -- completely scanned out the expression (a common case), and
2324 -- left Expr_Form set appropriately for returning to our caller.
2326 if Token
in Token_Class_Sterm
then
2329 -- If we do not have an expression terminator, then complete the
2330 -- scan of a simple expression. This code duplicates the code
2331 -- found in P_Term and P_Factor.
2334 if Token
= Tok_Double_Asterisk
then
2336 Style
.Check_Exponentiation_Operator
;
2339 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2341 Set_Left_Opnd
(Node2
, Node1
);
2342 Set_Right_Opnd
(Node2
, P_Primary
);
2348 exit when Token
not in Token_Class_Mulop
;
2349 Tokptr
:= Token_Ptr
;
2350 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2353 Style
.Check_Binary_Operator
;
2356 Scan
; -- past operator
2357 Set_Left_Opnd
(Node2
, Node1
);
2358 Set_Right_Opnd
(Node2
, P_Factor
);
2363 exit when Token
not in Token_Class_Binary_Addop
;
2364 Tokptr
:= Token_Ptr
;
2365 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2368 Style
.Check_Binary_Operator
;
2371 Scan
; -- past operator
2372 Set_Left_Opnd
(Node2
, Node1
);
2373 Set_Right_Opnd
(Node2
, P_Term
);
2377 Expr_Form
:= EF_Simple
;
2380 -- Cases where simple expression does not start with a name
2383 -- Scan initial sign and initial Term
2385 if Token
in Token_Class_Unary_Addop
then
2386 Tokptr
:= Token_Ptr
;
2387 Node1
:= New_Op_Node
(P_Unary_Adding_Operator
, Tokptr
);
2390 Style
.Check_Unary_Plus_Or_Minus
(Inside_Depends
);
2393 Scan
; -- past operator
2394 Set_Right_Opnd
(Node1
, P_Term
);
2399 -- In the following, we special-case a sequence of concatenations of
2400 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
2401 -- else mixed in. For such a sequence, we return a tree representing
2402 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
2403 -- the number of concatenations is large. If semantic analysis
2404 -- resolves the "&" to a predefined one, then this folding gives the
2405 -- right answer. Otherwise, semantic analysis will complain about a
2406 -- capacity-exceeded error. The purpose of this trick is to avoid
2407 -- creating a deeply nested tree, which would cause deep recursion
2408 -- during semantics, causing stack overflow. This way, we can handle
2409 -- enormous concatenations in the normal case of predefined "&". We
2410 -- first build up the normal tree, and then rewrite it if
2414 Num_Concats_Threshold
: constant Positive := 1000;
2415 -- Arbitrary threshold value to enable optimization
2417 First_Node
: constant Node_Id
:= Node1
;
2418 Is_Strlit_Concat
: Boolean;
2419 -- True iff we've parsed a sequence of concatenations of string
2420 -- literals, with nothing else mixed in.
2422 Num_Concats
: Natural;
2423 -- Number of "&" operators if Is_Strlit_Concat is True
2427 Nkind
(Node1
) = N_String_Literal
2428 and then Token
= Tok_Ampersand
;
2431 -- Scan out sequence of terms separated by binary adding operators
2434 exit when Token
not in Token_Class_Binary_Addop
;
2435 Tokptr
:= Token_Ptr
;
2436 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2438 if Style_Check
and then not Debug_Flag_Dot_QQ
then
2439 Style
.Check_Binary_Operator
;
2442 Scan
; -- past operator
2443 Set_Left_Opnd
(Node2
, Node1
);
2445 Set_Right_Opnd
(Node2
, Node1
);
2447 -- Check if we're still concatenating string literals
2451 and then Nkind
(Node2
) = N_Op_Concat
2452 and then Nkind
(Node1
) = N_String_Literal
;
2454 if Is_Strlit_Concat
then
2455 Num_Concats
:= Num_Concats
+ 1;
2461 -- If we have an enormous series of concatenations of string
2462 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2463 -- flag tells semantic analysis that if the "&" is not predefined,
2464 -- the folded value is wrong.
2467 and then Num_Concats
>= Num_Concats_Threshold
2470 Empty_String_Val
: String_Id
;
2473 Strlit_Concat_Val
: String_Id
;
2474 -- Contains the folded value (which will be correct if the
2475 -- "&" operators are the predefined ones).
2478 -- For walking up the tree
2481 -- Folded node to replace Node1
2483 Loc
: constant Source_Ptr
:= Sloc
(First_Node
);
2486 -- Walk up the tree starting at the leftmost string literal
2487 -- (First_Node), building up the Strlit_Concat_Val as we
2488 -- go. Note that we do not use recursion here -- the whole
2489 -- point is to avoid recursively walking that enormous tree.
2492 Store_String_Chars
(Strval
(First_Node
));
2494 Cur_Node
:= Parent
(First_Node
);
2495 while Present
(Cur_Node
) loop
2496 pragma Assert
(Nkind
(Cur_Node
) = N_Op_Concat
and then
2497 Nkind
(Right_Opnd
(Cur_Node
)) = N_String_Literal
);
2499 Store_String_Chars
(Strval
(Right_Opnd
(Cur_Node
)));
2500 Cur_Node
:= Parent
(Cur_Node
);
2503 Strlit_Concat_Val
:= End_String
;
2505 -- Create new folded node, and rewrite result with a concat-
2506 -- enation of an empty string literal and the folded node.
2509 Empty_String_Val
:= End_String
;
2511 Make_Op_Concat
(Loc
,
2512 Make_String_Literal
(Loc
, Empty_String_Val
),
2513 Make_String_Literal
(Loc
, Strlit_Concat_Val
,
2514 Is_Folded_In_Parser
=> True));
2515 Rewrite
(Node1
, New_Node
);
2520 -- All done, we clearly do not have name or numeric literal so this
2521 -- is a case of a simple expression which is some other possibility.
2523 Expr_Form
:= EF_Simple
;
2526 -- Come here at end of simple expression, where we do a couple of
2527 -- special checks to improve error recovery.
2529 -- Special test to improve error recovery. If the current token is a
2530 -- period, then someone is trying to do selection on something that is
2531 -- not a name, e.g. a qualified expression.
2533 if Token
= Tok_Dot
then
2534 Error_Msg_SC
("prefix for selection is not a name");
2536 -- If qualified expression, comment and continue, otherwise something
2537 -- is pretty nasty so do an Error_Resync call.
2539 if Ada_Version
< Ada_2012
2540 and then Nkind
(Node1
) = N_Qualified_Expression
2542 Error_Msg_SC
("\would be legal in Ada 2012 mode");
2548 -- Special test to improve error recovery: If the current token is
2549 -- not the first token on a line (as determined by checking the
2550 -- previous token position with the start of the current line),
2551 -- then we insist that we have an appropriate terminating token.
2552 -- Consider the following two examples:
2554 -- 1) if A nad B then ...
2559 -- In the first example, we would like to issue a binary operator
2560 -- expected message and resynchronize to the then. In the second
2561 -- example, we do not want to issue a binary operator message, so
2562 -- that instead we will get the missing semicolon message. This
2563 -- distinction is of course a heuristic which does not always work,
2564 -- but in practice it is quite effective.
2566 -- Note: the one case in which we do not go through this circuit is
2567 -- when we have scanned a range attribute and want to return with
2568 -- Token pointing to the apostrophe. The apostrophe is not normally
2569 -- an expression terminator, and is not in Token_Class_Sterm, but
2570 -- in this special case we know that the expression is complete.
2572 if not Token_Is_At_Start_Of_Line
2573 and then Token
not in Token_Class_Sterm
2575 -- Normally the right error message is indeed that we expected a
2576 -- binary operator, but in the case of being between a right and left
2577 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2579 if Prev_Token
= Tok_Right_Paren
and then Token
= Tok_Left_Paren
then
2582 -- And if we have a quote, we may have a bad attribute
2584 elsif At_Start_Of_Attribute
then
2585 Error_Msg_SC
("prefix of attribute must be a name");
2587 if Ada_Version
>= Ada_2012
then
2588 Error_Msg_SC
("\qualify expression to turn it into a name");
2591 -- Normal case for binary operator expected message
2594 Error_Msg_AP
("binary operator expected");
2603 -- If any error occurs, then scan to next expression terminator symbol
2604 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2605 -- level. Expr_Form is set to indicate a normal simple expression.
2608 when Error_Resync
=>
2610 Expr_Form
:= EF_Simple
;
2612 end P_Simple_Expression
;
2614 -----------------------------------------------
2615 -- 4.4 Simple Expression or Range Attribute --
2616 -----------------------------------------------
2618 -- SIMPLE_EXPRESSION ::=
2619 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2621 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2623 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2625 -- Error recovery: cannot raise Error_Resync
2627 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
2629 Attr_Node
: Node_Id
;
2632 -- We don't just want to roar ahead and call P_Simple_Expression
2633 -- here, since we want to handle the case of a parenthesized range
2634 -- attribute cleanly.
2636 if Token
= Tok_Left_Paren
then
2638 Lptr
: constant Source_Ptr
:= Token_Ptr
;
2639 Scan_State
: Saved_Scan_State
;
2642 Save_Scan_State
(Scan_State
);
2643 Scan
; -- past left paren
2644 Sexpr
:= P_Simple_Expression
;
2646 if Token
= Tok_Apostrophe
then
2647 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2648 Expr_Form
:= EF_Range_Attr
;
2650 if Token
= Tok_Right_Paren
then
2651 Scan
; -- scan past right paren if present
2654 Error_Msg
("parentheses not allowed for range attribute", Lptr
);
2659 Restore_Scan_State
(Scan_State
);
2663 -- Here after dealing with parenthesized range attribute
2665 Sexpr
:= P_Simple_Expression
;
2667 if Token
= Tok_Apostrophe
then
2668 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2669 Expr_Form
:= EF_Range_Attr
;
2675 end P_Simple_Expression_Or_Range_Attribute
;
2681 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2683 -- Error recovery: can raise Error_Resync
2685 function P_Term
return Node_Id
is
2686 Node1
, Node2
: Node_Id
;
2687 Tokptr
: Source_Ptr
;
2693 exit when Token
not in Token_Class_Mulop
;
2694 Tokptr
:= Token_Ptr
;
2695 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2697 if Style_Check
and then not Debug_Flag_Dot_QQ
then
2698 Style
.Check_Binary_Operator
;
2701 Scan
; -- past operator
2702 Set_Left_Opnd
(Node2
, Node1
);
2703 Set_Right_Opnd
(Node2
, P_Factor
);
2714 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2716 -- Error recovery: can raise Error_Resync
2718 function P_Factor
return Node_Id
is
2723 if Token
= Tok_Abs
then
2724 Node1
:= New_Op_Node
(N_Op_Abs
, Token_Ptr
);
2727 Style
.Check_Abs_Not
;
2731 Set_Right_Opnd
(Node1
, P_Primary
);
2734 elsif Token
= Tok_Not
then
2735 Node1
:= New_Op_Node
(N_Op_Not
, Token_Ptr
);
2738 Style
.Check_Abs_Not
;
2742 Set_Right_Opnd
(Node1
, P_Primary
);
2748 if Token
= Tok_Double_Asterisk
then
2749 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2751 Set_Left_Opnd
(Node2
, Node1
);
2752 Set_Right_Opnd
(Node2
, P_Primary
);
2766 -- NUMERIC_LITERAL | null
2767 -- | STRING_LITERAL | AGGREGATE
2768 -- | NAME | QUALIFIED_EXPRESSION
2769 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2770 -- | REDUCTION_ATTRIBUTE_REFERENCE
2772 -- Error recovery: can raise Error_Resync
2774 function P_Primary
return Node_Id
is
2775 Scan_State
: Saved_Scan_State
;
2778 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
2779 -- Remember if previous token is a left parenthesis. This is used to
2780 -- deal with checking whether IF/CASE/FOR expressions appearing as
2781 -- primaries require extra parenthesization.
2784 -- The loop runs more than once only if misplaced pragmas are found
2785 -- or if a misplaced unary minus is skipped.
2790 -- Name token can start a name, call or qualified expression, all
2791 -- of which are acceptable possibilities for primary. Note also
2792 -- that string literal is included in name (as operator symbol)
2793 -- and type conversion is included in name (as indexed component).
2795 when Tok_Char_Literal
2797 | Tok_Operator_Symbol
2801 -- All done unless apostrophe follows
2803 if Token
/= Tok_Apostrophe
then
2806 -- Apostrophe following means that we have either just parsed
2807 -- the subtype mark of a qualified expression, or the prefix
2808 -- or a range attribute.
2810 else -- Token = Tok_Apostrophe
2811 Save_Scan_State
(Scan_State
); -- at apostrophe
2812 Scan
; -- past apostrophe
2814 -- If range attribute, then this is always an error, since
2815 -- the only legitimate case (where the scanned expression is
2816 -- a qualified simple name) is handled at the level of the
2817 -- Simple_Expression processing. This case corresponds to a
2818 -- usage such as 3 + A'Range, which is always illegal.
2820 if Token
= Tok_Range
then
2821 Restore_Scan_State
(Scan_State
); -- to apostrophe
2822 Bad_Range_Attribute
(Token_Ptr
);
2825 -- If left paren, then we have a qualified expression.
2826 -- Note that P_Name guarantees that in this case, where
2827 -- Token = Tok_Apostrophe on return, the only two possible
2828 -- tokens following the apostrophe are left paren and
2829 -- RANGE, so we know we have a left paren here.
2831 else -- Token = Tok_Left_Paren
2832 return P_Qualified_Expression
(Node1
);
2837 -- Numeric or string literal
2839 when Tok_Integer_Literal
2841 | Tok_String_Literal
2843 Node1
:= Token_Node
;
2844 Scan
; -- past number
2847 -- Left paren, starts aggregate or parenthesized expression
2849 when Tok_Left_Paren
=>
2851 Expr
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
2854 if Nkind
(Expr
) = N_Attribute_Reference
2855 and then Attribute_Name
(Expr
) = Name_Range
2857 Bad_Range_Attribute
(Sloc
(Expr
));
2863 when Tok_Left_Bracket
=>
2875 return New_Node
(N_Null
, Prev_Token_Ptr
);
2877 -- Pragma, not allowed here, so just skip past it
2880 P_Pragmas_Misplaced
;
2882 -- Deal with IF (possible unparenthesized if expression)
2886 -- If this looks like a real if, defined as an IF appearing at
2887 -- the start of a new line, then we consider we have a missing
2888 -- operand. If in Ada 2012 and the IF is not properly indented
2889 -- for a statement, we prefer to issue a message about an ill-
2890 -- parenthesized if expression.
2892 if Token_Is_At_Start_Of_Line
2894 (Ada_Version
>= Ada_2012
2896 (Style_Check_Indentation
= 0
2898 Start_Column
rem Style_Check_Indentation
/= 0))
2900 Error_Msg_AP
("missing operand");
2903 -- If this looks like an if expression, then treat it that way
2904 -- with an error message if not explicitly surrounded by
2907 elsif Ada_Version
>= Ada_2012
then
2908 Node1
:= P_If_Expression
;
2910 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2912 ("if expression must be parenthesized", Sloc
(Node1
));
2917 -- Otherwise treat as misused identifier
2920 return P_Identifier
;
2923 -- Deal with CASE (possible unparenthesized case expression)
2927 -- If this looks like a real case, defined as a CASE appearing
2928 -- the start of a new line, then we consider we have a missing
2929 -- operand. If in Ada 2012 and the CASE is not properly
2930 -- indented for a statement, we prefer to issue a message about
2931 -- an ill-parenthesized case expression.
2933 if Token_Is_At_Start_Of_Line
2935 (Ada_Version
>= Ada_2012
2936 and then Style_Check_Indentation
/= 0
2937 and then Start_Column
rem Style_Check_Indentation
/= 0)
2939 Error_Msg_AP
("missing operand");
2942 -- If this looks like a case expression, then treat it that way
2943 -- with an error message if not within parentheses.
2945 elsif Ada_Version
>= Ada_2012
then
2946 Node1
:= P_Case_Expression
;
2948 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2950 ("case expression must be parenthesized", Sloc
(Node1
));
2955 -- Otherwise treat as misused identifier
2958 return P_Identifier
;
2961 -- For [all | some] indicates a quantified expression
2964 if Token_Is_At_Start_Of_Line
then
2965 Error_Msg_AP
("misplaced loop");
2968 elsif Ada_Version
>= Ada_2012
then
2969 Save_Scan_State
(Scan_State
);
2972 if Token
= Tok_All
or else Token
= Tok_Some
then
2973 Restore_Scan_State
(Scan_State
); -- To FOR
2974 Node1
:= P_Quantified_Expression
;
2976 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2978 ("quantified expression must be parenthesized",
2982 Restore_Scan_State
(Scan_State
); -- To FOR
2983 Node1
:= P_Iterated_Component_Association
;
2988 -- Otherwise treat as misused identifier
2991 return P_Identifier
;
2994 -- Minus may well be an improper attempt at a unary minus. Give
2995 -- a message, skip the minus and keep going.
2998 Error_Msg_SC
("parentheses required for unary minus");
3001 when Tok_At_Sign
=> -- AI12-0125 : target_name
3002 Error_Msg_Ada_2022_Feature
("target name", Token_Ptr
);
3007 -- Anything else is illegal as the first token of a primary, but
3008 -- we test for some common errors, to improve error messages.
3011 if Is_Reserved_Identifier
then
3012 return P_Identifier
;
3014 elsif Prev_Token
= Tok_Comma
then
3015 Error_Msg_SP
-- CODEFIX
3016 ("|extra "","" ignored");
3020 Error_Msg_AP
("missing operand");
3027 -------------------------------
3028 -- 4.4 Quantified_Expression --
3029 -------------------------------
3031 -- QUANTIFIED_EXPRESSION ::=
3032 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
3033 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
3035 function P_Quantified_Expression
return Node_Id
is
3040 Error_Msg_Ada_2012_Feature
("quantified expression", Token_Ptr
);
3042 Node1
:= New_Node
(N_Quantified_Expression
, Prev_Token_Ptr
);
3044 if Token
= Tok_All
then
3045 Set_All_Present
(Node1
);
3046 elsif Token
/= Tok_Some
then
3047 Error_Msg_AP
("missing quantifier");
3051 Scan
; -- past ALL or SOME
3052 I_Spec
:= P_Loop_Parameter_Specification
;
3054 if Nkind
(I_Spec
) = N_Loop_Parameter_Specification
then
3055 Set_Loop_Parameter_Specification
(Node1
, I_Spec
);
3057 Set_Iterator_Specification
(Node1
, I_Spec
);
3060 if Token
= Tok_Arrow
then
3062 Set_Condition
(Node1
, P_Expression
);
3065 Error_Msg_AP
("missing arrow");
3068 end P_Quantified_Expression
;
3070 ---------------------------
3071 -- 4.5 Logical Operator --
3072 ---------------------------
3074 -- LOGICAL_OPERATOR ::= and | or | xor
3076 -- Note: AND THEN and OR ELSE are also treated as logical operators
3077 -- by the parser (even though they are not operators semantically)
3079 -- The value returned is the appropriate Node_Kind code for the operator
3080 -- On return, Token points to the token following the scanned operator.
3082 -- The caller has checked that the first token is a legitimate logical
3083 -- operator token (i.e. is either XOR, AND, OR).
3085 -- Error recovery: cannot raise Error_Resync
3087 function P_Logical_Operator
return Node_Kind
is
3089 if Token
= Tok_And
then
3091 Style
.Check_Binary_Operator
;
3096 if Token
= Tok_Then
then
3103 elsif Token
= Tok_Or
then
3105 Style
.Check_Binary_Operator
;
3110 if Token
= Tok_Else
then
3117 else -- Token = Tok_Xor
3119 Style
.Check_Binary_Operator
;
3125 end P_Logical_Operator
;
3127 ------------------------------
3128 -- 4.5 Relational Operator --
3129 ------------------------------
3131 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
3133 -- The value returned is the appropriate Node_Kind code for the operator.
3134 -- On return, Token points to the operator token, NOT past it.
3136 -- The caller has checked that the first token is a legitimate relational
3137 -- operator token (i.e. is one of the operator tokens listed above).
3139 -- Error recovery: cannot raise Error_Resync
3141 function P_Relational_Operator
return Node_Kind
is
3142 Op_Kind
: Node_Kind
;
3143 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
3144 (Tok_Less
=> N_Op_Lt
,
3145 Tok_Equal
=> N_Op_Eq
,
3146 Tok_Greater
=> N_Op_Gt
,
3147 Tok_Not_Equal
=> N_Op_Ne
,
3148 Tok_Greater_Equal
=> N_Op_Ge
,
3149 Tok_Less_Equal
=> N_Op_Le
,
3151 Tok_Not
=> N_Not_In
,
3152 Tok_Box
=> N_Op_Ne
);
3155 if Token
= Tok_Box
then
3156 Error_Msg_SC
-- CODEFIX
3157 ("|""'<'>"" should be ""/=""");
3160 Op_Kind
:= Relop_Node
(Token
);
3163 Style
.Check_Binary_Operator
;
3166 Scan
; -- past operator token
3168 -- Deal with NOT IN, if previous token was NOT, we must have IN now
3170 if Prev_Token
= Tok_Not
then
3172 -- Style check, for NOT IN, we require one space between NOT and IN
3174 if Style_Check
and then Token
= Tok_In
then
3182 end P_Relational_Operator
;
3184 ---------------------------------
3185 -- 4.5 Binary Adding Operator --
3186 ---------------------------------
3188 -- BINARY_ADDING_OPERATOR ::= + | - | &
3190 -- The value returned is the appropriate Node_Kind code for the operator.
3191 -- On return, Token points to the operator token (NOT past it).
3193 -- The caller has checked that the first token is a legitimate adding
3194 -- operator token (i.e. is one of the operator tokens listed above).
3196 -- Error recovery: cannot raise Error_Resync
3198 function P_Binary_Adding_Operator
return Node_Kind
is
3199 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
3200 (Tok_Ampersand
=> N_Op_Concat
,
3201 Tok_Minus
=> N_Op_Subtract
,
3202 Tok_Plus
=> N_Op_Add
);
3204 return Addop_Node
(Token
);
3205 end P_Binary_Adding_Operator
;
3207 --------------------------------
3208 -- 4.5 Unary Adding Operator --
3209 --------------------------------
3211 -- UNARY_ADDING_OPERATOR ::= + | -
3213 -- The value returned is the appropriate Node_Kind code for the operator.
3214 -- On return, Token points to the operator token (NOT past it).
3216 -- The caller has checked that the first token is a legitimate adding
3217 -- operator token (i.e. is one of the operator tokens listed above).
3219 -- Error recovery: cannot raise Error_Resync
3221 function P_Unary_Adding_Operator
return Node_Kind
is
3222 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
3223 (Tok_Minus
=> N_Op_Minus
,
3224 Tok_Plus
=> N_Op_Plus
);
3226 return Addop_Node
(Token
);
3227 end P_Unary_Adding_Operator
;
3229 -------------------------------
3230 -- 4.5 Multiplying Operator --
3231 -------------------------------
3233 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
3235 -- The value returned is the appropriate Node_Kind code for the operator.
3236 -- On return, Token points to the operator token (NOT past it).
3238 -- The caller has checked that the first token is a legitimate multiplying
3239 -- operator token (i.e. is one of the operator tokens listed above).
3241 -- Error recovery: cannot raise Error_Resync
3243 function P_Multiplying_Operator
return Node_Kind
is
3244 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
3245 (Tok_Asterisk
=> N_Op_Multiply
,
3246 Tok_Mod
=> N_Op_Mod
,
3247 Tok_Rem
=> N_Op_Rem
,
3248 Tok_Slash
=> N_Op_Divide
);
3250 return Mulop_Node
(Token
);
3251 end P_Multiplying_Operator
;
3253 --------------------------------------
3254 -- 4.5 Highest Precedence Operator --
3255 --------------------------------------
3257 -- Parsed by P_Factor (4.4)
3259 -- Note: this rule is not in fact used by the grammar at any point
3261 --------------------------
3262 -- 4.6 Type Conversion --
3263 --------------------------
3265 -- Parsed by P_Primary as a Name (4.1)
3267 -------------------------------
3268 -- 4.7 Qualified Expression --
3269 -------------------------------
3271 -- QUALIFIED_EXPRESSION ::=
3272 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
3274 -- The caller has scanned the name which is the Subtype_Mark parameter
3275 -- and scanned past the single quote following the subtype mark. The
3276 -- caller has not checked that this name is in fact appropriate for
3277 -- a subtype mark name (i.e. it is a selected component or identifier).
3279 -- Error_Recovery: cannot raise Error_Resync
3281 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
3282 Qual_Node
: Node_Id
;
3284 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
3285 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
3286 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
3288 end P_Qualified_Expression
;
3290 --------------------
3292 --------------------
3295 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
3296 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
3298 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
3300 -- The caller has checked that the initial token is NEW
3302 -- Error recovery: can raise Error_Resync
3304 function P_Allocator
return Node_Id
is
3305 Alloc_Node
: Node_Id
;
3306 Type_Node
: Node_Id
;
3307 Null_Exclusion_Present
: Boolean;
3310 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
3313 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
3315 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
3317 if Token
= Tok_Left_Paren
then
3319 Set_Subpool_Handle_Name
(Alloc_Node
, P_Name
);
3322 Error_Msg_Ada_2012_Feature
3323 ("|subpool specification",
3324 Sloc
(Subpool_Handle_Name
(Alloc_Node
)));
3327 Null_Exclusion_Present
:= P_Null_Exclusion
;
3328 Set_Null_Exclusion_Present
(Alloc_Node
, Null_Exclusion_Present
);
3329 Type_Node
:= P_Subtype_Mark_Resync
;
3331 if Token
= Tok_Apostrophe
then
3332 Scan
; -- past apostrophe
3333 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
3337 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));
3339 -- AI05-0104: An explicit null exclusion is not allowed for an
3340 -- allocator without initialization. In previous versions of the
3341 -- language it just raises constraint error.
3343 if Ada_Version
>= Ada_2012
and then Null_Exclusion_Present
then
3345 ("an allocator with a subtype indication "
3346 & "cannot have a null exclusion", Alloc_Node
);
3353 -----------------------
3354 -- P_Case_Expression --
3355 -----------------------
3357 function P_Case_Expression
return Node_Id
is
3358 Loc
: constant Source_Ptr
:= Token_Ptr
;
3359 Case_Node
: Node_Id
;
3360 Save_State
: Saved_Scan_State
;
3363 Error_Msg_Ada_2012_Feature
("|case expression", Token_Ptr
);
3366 Make_Case_Expression
(Loc
,
3367 Expression
=> P_Expression_No_Right_Paren
,
3368 Alternatives
=> New_List
);
3371 -- We now have scanned out CASE expression IS, scan alternatives
3375 Append_To
(Alternatives
(Case_Node
), P_Case_Expression_Alternative
);
3377 -- Missing comma if WHEN (more alternatives present)
3379 if Token
= Tok_When
then
3382 -- A semicolon followed by "when" is probably meant to be a comma
3384 elsif Token
= Tok_Semicolon
then
3385 Save_Scan_State
(Save_State
);
3386 Scan
; -- past the semicolon
3388 if Token
/= Tok_When
then
3389 Restore_Scan_State
(Save_State
);
3393 Error_Msg_SP
-- CODEFIX
3394 ("|"";"" should be "",""");
3396 -- If comma/WHEN, skip comma and we have another alternative
3398 elsif Token
= Tok_Comma
then
3399 Save_Scan_State
(Save_State
);
3402 if Token
/= Tok_When
then
3403 Restore_Scan_State
(Save_State
);
3407 -- If no comma or WHEN, definitely done
3414 -- If we have an END CASE, diagnose as not needed
3416 if Token
= Tok_End
then
3417 Error_Msg_SC
("`END CASE` not allowed at end of case expression");
3420 if Token
= Tok_Case
then
3425 -- Return the Case_Expression node
3428 end P_Case_Expression
;
3430 -----------------------------------
3431 -- P_Case_Expression_Alternative --
3432 -----------------------------------
3434 -- CASE_STATEMENT_ALTERNATIVE ::=
3435 -- when DISCRETE_CHOICE_LIST =>
3438 -- The caller has checked that and scanned past the initial WHEN token
3439 -- Error recovery: can raise Error_Resync
3441 function P_Case_Expression_Alternative
return Node_Id
is
3442 Case_Alt_Node
: Node_Id
;
3444 Case_Alt_Node
:= New_Node
(N_Case_Expression_Alternative
, Token_Ptr
);
3445 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
3447 Set_Expression
(Case_Alt_Node
, P_Expression
);
3448 return Case_Alt_Node
;
3449 end P_Case_Expression_Alternative
;
3451 --------------------------------------
3452 -- P_Iterated_Component_Association --
3453 --------------------------------------
3455 -- ITERATED_COMPONENT_ASSOCIATION ::=
3456 -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
3457 -- for ITERATOR_SPECIFICATION => EXPRESSION
3459 function P_Iterated_Component_Association
return Node_Id
is
3460 Assoc_Node
: Node_Id
;
3462 Filter
: Node_Id
:= Empty
;
3464 Iter_Spec
: Node_Id
;
3465 Loop_Spec
: Node_Id
;
3466 State
: Saved_Scan_State
;
3468 procedure Build_Iterated_Element_Association
;
3469 -- If the iterator includes a key expression or a filter, it is
3470 -- an Ada 2022 Iterator_Element_Association within a container
3473 ----------------------------------------
3474 -- Build_Iterated_Element_Association --
3475 ----------------------------------------
3477 procedure Build_Iterated_Element_Association
is
3479 -- Build loop_parameter_specification
3482 New_Node
(N_Loop_Parameter_Specification
, Prev_Token_Ptr
);
3483 Set_Defining_Identifier
(Loop_Spec
, Id
);
3485 Choice
:= First
(Discrete_Choices
(Assoc_Node
));
3487 New_Node
(N_Iterated_Element_Association
, Prev_Token_Ptr
);
3488 Set_Loop_Parameter_Specification
(Assoc_Node
, Loop_Spec
);
3490 if Present
(Next
(Choice
)) then
3491 Error_Msg_N
("expect loop parameter specification", Choice
);
3495 Set_Discrete_Subtype_Definition
(Loop_Spec
, Choice
);
3496 Set_Iterator_Filter
(Loop_Spec
, Filter
);
3497 end Build_Iterated_Element_Association
;
3499 -- Start of processing for P_Iterated_Component_Association
3503 Save_Scan_State
(State
);
3505 -- A lookahead is necessary to differentiate between the
3506 -- Ada 2012 form with a choice list, and the Ada 2022 element
3507 -- iterator form, recognized by the presence of "OF". Other
3508 -- disambiguation requires context and is done during semantic
3509 -- analysis. Note that "for X in E" is syntactically ambiguous:
3510 -- if E is a subtype indication this is a loop parameter spec,
3511 -- while if E a name it is an iterator_specification, and the
3512 -- disambiguation takes place during semantic analysis.
3513 -- In addition, if "use" is present after the specification,
3514 -- this is an Iterated_Element_Association that carries a
3515 -- key_expression, and we generate the appropriate node.
3516 -- Finally, the Iterated_Element form is reserved for container
3517 -- aggregates, and is illegal in array aggregates.
3519 Id
:= P_Defining_Identifier
;
3521 New_Node
(N_Iterated_Component_Association
, Prev_Token_Ptr
);
3525 Set_Defining_Identifier
(Assoc_Node
, Id
);
3527 Set_Discrete_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
3529 -- The iterator may include a filter
3531 if Token
= Tok_When
then
3533 Filter
:= P_Condition
;
3536 if Token
= Tok_Use
then
3538 -- Ada 2022 Key-expression is present, rewrite node as an
3539 -- Iterated_Element_Association.
3542 Build_Iterated_Element_Association
;
3543 Set_Key_Expression
(Assoc_Node
, P_Expression
);
3545 elsif Present
(Filter
) then
3546 -- A loop_parameter_specification also indicates an Ada 2022
3547 -- construct, in contrast with a subtype indication used in
3548 -- array aggregates.
3550 Build_Iterated_Element_Association
;
3554 Set_Expression
(Assoc_Node
, P_Expression
);
3557 Restore_Scan_State
(State
);
3559 Set_Defining_Identifier
(Assoc_Node
, Id
);
3560 Iter_Spec
:= P_Iterator_Specification
(Id
);
3561 Set_Iterator_Specification
(Assoc_Node
, Iter_Spec
);
3563 if Token
= Tok_Use
then
3565 -- This is an iterated_element_association
3568 New_Node
(N_Iterated_Element_Association
, Prev_Token_Ptr
);
3569 Set_Iterator_Specification
(Assoc_Node
, Iter_Spec
);
3570 Set_Key_Expression
(Assoc_Node
, P_Expression
);
3574 Set_Expression
(Assoc_Node
, P_Expression
);
3577 Error_Msg_AP
("missing IN or OF");
3581 end P_Iterated_Component_Association
;
3583 ---------------------
3584 -- P_If_Expression --
3585 ---------------------
3587 -- IF_EXPRESSION ::=
3588 -- if CONDITION then DEPENDENT_EXPRESSION
3589 -- {elsif CONDITION then DEPENDENT_EXPRESSION}
3590 -- [else DEPENDENT_EXPRESSION]
3592 -- DEPENDENT_EXPRESSION ::= EXPRESSION
3594 function P_If_Expression
return Node_Id
is
3595 function P_If_Expression_Internal
3597 Cond
: Node_Id
) return Node_Id
;
3598 -- This is the internal recursive routine that does all the work, it is
3599 -- recursive since it is used to process ELSIF parts, which internally
3600 -- are N_If_Expression nodes with the Is_Elsif flag set. The calling
3601 -- sequence is like the outer function except that the caller passes
3602 -- the conditional expression (scanned using P_Expression), and the
3603 -- scan pointer points just past this expression. Loc points to the
3604 -- IF or ELSIF token.
3606 ------------------------------
3607 -- P_If_Expression_Internal --
3608 ------------------------------
3610 function P_If_Expression_Internal
3612 Cond
: Node_Id
) return Node_Id
3614 Exprs
: constant List_Id
:= New_List
;
3616 State
: Saved_Scan_State
;
3620 -- All cases except where we are at right paren
3622 if Token
/= Tok_Right_Paren
then
3624 Append_To
(Exprs
, P_Condition
(Cond
));
3625 Append_To
(Exprs
, P_Expression
);
3627 -- Case of right paren (missing THEN phrase). Note that we know this
3628 -- is the IF case, since the caller dealt with this possibility in
3632 Error_Msg_BC
("missing THEN phrase");
3633 Append_To
(Exprs
, P_Condition
(Cond
));
3636 -- We now have scanned out IF expr THEN expr
3638 -- Check for common error of semicolon before the ELSE
3640 if Token
= Tok_Semicolon
then
3641 Save_Scan_State
(State
);
3642 Scan
; -- past semicolon
3644 if Token
= Tok_Else
or else Token
= Tok_Elsif
then
3645 Error_Msg_SP
-- CODEFIX
3646 ("|extra "";"" ignored");
3649 Restore_Scan_State
(State
);
3653 -- Scan out ELSIF sequence if present
3655 if Token
= Tok_Elsif
then
3658 Expr
:= P_Expression
;
3660 -- If we are at a right paren, we assume the ELSIF should be ELSE
3662 if Token
= Tok_Right_Paren
then
3663 Error_Msg
("ELSIF should be ELSE", Eptr
);
3664 Append_To
(Exprs
, Expr
);
3666 -- Otherwise we have an OK ELSIF
3669 Expr
:= P_If_Expression_Internal
(Eptr
, Expr
);
3670 Set_Is_Elsif
(Expr
);
3671 Append_To
(Exprs
, Expr
);
3674 -- Scan out ELSE phrase if present
3676 elsif Token
= Tok_Else
then
3678 -- Scan out ELSE expression
3681 Append_To
(Exprs
, P_Expression
);
3683 -- Skip redundant ELSE parts
3685 while Token
= Tok_Else
loop
3686 Error_Msg_SC
("only one ELSE part is allowed");
3688 Discard_Junk_Node
(P_Expression
);
3691 -- Two expression case (implied True, filled in during semantics)
3697 -- If we have an END IF, diagnose as not needed
3699 if Token
= Tok_End
then
3700 Error_Msg_SC
("`END IF` not allowed at end of if expression");
3703 if Token
= Tok_If
then
3708 -- Return the If_Expression node
3710 return Make_If_Expression
(Loc
, Expressions
=> Exprs
);
3711 end P_If_Expression_Internal
;
3715 Loc
: constant Source_Ptr
:= Token_Ptr
;
3718 -- Start of processing for P_If_Expression
3721 Error_Msg_Ada_2012_Feature
("|if expression", Token_Ptr
);
3723 Inside_If_Expression
:= Inside_If_Expression
+ 1;
3724 If_Expr
:= P_If_Expression_Internal
(Loc
, P_Expression
);
3725 Inside_If_Expression
:= Inside_If_Expression
- 1;
3727 end P_If_Expression
;
3729 --------------------------
3730 -- P_Declare_Expression --
3731 --------------------------
3733 -- DECLARE_EXPRESSION ::=
3734 -- DECLARE {DECLARE_ITEM}
3735 -- begin BODY_EXPRESSION
3737 -- DECLARE_ITEM ::= OBJECT_DECLARATION
3738 -- | OBJECT_RENAMING_DECLARATION
3740 function P_Declare_Expression
return Node_Id
is
3741 Loc
: constant Source_Ptr
:= Token_Ptr
;
3743 Scan
; -- past DECLARE
3746 Actions
: constant List_Id
:= P_Basic_Declarative_Items
3747 (Declare_Expression
=> True);
3748 -- Most declarative items allowed by P_Basic_Declarative_Items are
3749 -- illegal; semantic analysis will deal with that.
3751 if Token
= Tok_Begin
then
3754 Error_Msg_SC
-- CODEFIX
3755 ("BEGIN expected!");
3759 Expression
: constant Node_Id
:= P_Expression
;
3760 Result
: constant Node_Id
:=
3761 Make_Expression_With_Actions
(Loc
, Actions
, Expression
);
3763 Error_Msg_Ada_2022_Feature
("declare expression", Loc
);
3768 end P_Declare_Expression
;
3770 -----------------------
3771 -- P_Membership_Test --
3772 -----------------------
3774 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERSHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3775 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3777 procedure P_Membership_Test
(N
: Node_Id
) is
3778 Alt
: constant Node_Id
:=
3779 P_Range_Or_Subtype_Mark
3780 (Allow_Simple_Expression
=> (Ada_Version
>= Ada_2012
));
3785 if Token
= Tok_Vertical_Bar
then
3786 Error_Msg_Ada_2012_Feature
("set notation", Token_Ptr
);
3787 Set_Alternatives
(N
, New_List
(Alt
));
3788 Set_Right_Opnd
(N
, Empty
);
3790 -- Loop to accumulate alternatives
3792 while Token
= Tok_Vertical_Bar
loop
3793 Scan
; -- past vertical bar
3796 P_Range_Or_Subtype_Mark
(Allow_Simple_Expression
=> True));
3802 Set_Right_Opnd
(N
, Alt
);
3803 Set_Alternatives
(N
, No_List
);
3805 end P_Membership_Test
;
3807 -----------------------------
3808 -- P_Unparen_Cond_Expr_Etc --
3809 -----------------------------
3811 function P_Unparen_Cond_Expr_Etc
return Node_Id
is
3812 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
3815 Scan_State
: Saved_Scan_State
;
3820 if Token
= Tok_Case
then
3821 Result
:= P_Case_Expression
;
3823 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3824 Error_Msg_N
("case expression must be parenthesized!", Result
);
3829 elsif Token
= Tok_If
then
3830 Result
:= P_If_Expression
;
3832 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3833 Error_Msg_N
("if expression must be parenthesized!", Result
);
3836 -- Quantified expression or iterated component association
3838 elsif Token
= Tok_For
then
3840 Save_Scan_State
(Scan_State
);
3843 if Token
= Tok_All
or else Token
= Tok_Some
then
3844 Restore_Scan_State
(Scan_State
);
3845 Result
:= P_Quantified_Expression
;
3847 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3849 ("quantified expression must be parenthesized!", Result
);
3853 -- If no quantifier keyword, this is an iterated component in
3856 Restore_Scan_State
(Scan_State
);
3857 Result
:= P_Iterated_Component_Association
;
3860 -- Declare expression
3862 elsif Token
= Tok_Declare
then
3863 Result
:= P_Declare_Expression
;
3865 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3866 Error_Msg_N
("declare expression must be parenthesized!", Result
);
3869 -- No other possibility should exist (caller was supposed to check)
3872 raise Program_Error
;
3875 -- Return expression (possibly after having given message)
3878 end P_Unparen_Cond_Expr_Etc
;