1 -----------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2023, 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_Set
:=
39 Attribute_Body_Version |
41 Attribute_External_Tag |
43 Attribute_Loop_Entry |
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 | Tok_Left_Paren
then
229 Error_Msg_SC
("name expected");
232 -- Otherwise some other junk, not much we can do
235 Error_Msg_AP
("name expected");
240 -- Loop through designators in qualified name
241 -- AI12-0125 : target_name
243 if Token
= Tok_At_Sign
then
244 Scan_Reserved_Identifier
(Force_Msg
=> False);
246 if Present
(Current_Assign_Node
) then
247 Set_Has_Target_Names
(Current_Assign_Node
);
251 Name_Node
:= Token_Node
;
254 Scan
; -- past designator
255 exit when Token
/= Tok_Dot
;
256 Save_Scan_State
(Scan_State
); -- at dot
259 -- If we do not have another designator after the dot, then join
260 -- the normal circuit to handle a dot extension (may be .all or
261 -- character literal case). Otherwise loop back to scan the next
264 if Token
not in Token_Class_Desig
then
265 goto Scan_Name_Extension_Dot
;
267 Prefix_Node
:= Name_Node
;
268 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
269 Set_Prefix
(Name_Node
, Prefix_Node
);
270 Set_Selector_Name
(Name_Node
, Token_Node
);
274 -- We have now scanned out a qualified designator. If the last token is
275 -- an operator symbol, then we certainly do not have the Snam case, so
276 -- we can just use the normal name extension check circuit
278 if Prev_Token
= Tok_Operator_Symbol
then
279 goto Scan_Name_Extension
;
282 -- We have scanned out a qualified simple name, check for name
283 -- extension. Note that we know there is no dot here at this stage,
284 -- so the only possible cases of name extension are apostrophe followed
287 if Token
= Tok_Apostrophe
then
288 Save_Scan_State
(Scan_State
); -- at apostrophe
289 Scan
; -- past apostrophe
291 -- Qualified expression in Ada 2012 mode (treated as a name)
293 if Ada_Version
>= Ada_2012
294 and then Token
in Tok_Left_Paren | Tok_Left_Bracket
296 goto Scan_Name_Extension_Apostrophe
;
298 -- If left paren not in Ada 2012, then it is not part of the name,
299 -- since qualified expressions are not names in prior versions of
300 -- Ada, so return with Token backed up to point to the apostrophe.
301 -- The treatment for the range attribute is similar (we do not
302 -- consider x'range to be a name in this grammar).
304 elsif Token
in Tok_Left_Paren | Tok_Range
then
305 Restore_Scan_State
(Scan_State
); -- to apostrophe
306 Expr_Form
:= EF_Simple_Name
;
309 -- Otherwise we have the case of a name extended by an attribute
312 goto Scan_Name_Extension_Apostrophe
;
315 -- Check case of qualified simple name extended by a left parenthesis
317 elsif Token
= Tok_Left_Paren
then
318 Scan
; -- past left paren
319 goto Scan_Name_Extension_Left_Paren
;
321 -- Otherwise the qualified simple name is not extended, so return
324 Expr_Form
:= EF_Simple_Name
;
328 -- Loop scanning past name extensions. A label is used for control
329 -- transfer for this loop for ease of interfacing with the finite state
330 -- machine in the parenthesis scanning circuit, and also to allow for
331 -- passing in control to the appropriate point from the above code.
333 <<Scan_Name_Extension
>>
335 -- Character literal used as name cannot be extended. Also this
336 -- cannot be a call, since the name for a call must be a designator.
337 -- Return in these cases, or if there is no name extension
339 if Token
not in Token_Class_Namext
340 or else Prev_Token
= Tok_Char_Literal
342 Expr_Form
:= EF_Name
;
346 -- Merge here when we know there is a name extension
348 <<Scan_Name_Extension_OK
>>
351 when Tok_Left_Paren
=>
352 Scan
; -- past left paren
353 goto Scan_Name_Extension_Left_Paren
;
355 when Tok_Apostrophe
=>
356 Save_Scan_State
(Scan_State
); -- at apostrophe
357 Scan
; -- past apostrophe
358 goto Scan_Name_Extension_Apostrophe
;
361 Save_Scan_State
(Scan_State
); -- at dot
363 goto Scan_Name_Extension_Dot
;
365 when others => raise Program_Error
;
368 -- Case of name extended by dot (selection), dot is already skipped
369 -- and the scan state at the point of the dot is saved in Scan_State.
371 <<Scan_Name_Extension_Dot
>>
373 -- Explicit dereference case
375 if Token
= Tok_All
then
376 Prefix_Node
:= Name_Node
;
377 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
378 Set_Prefix
(Name_Node
, Prefix_Node
);
380 goto Scan_Name_Extension
;
382 -- Selected component case
384 elsif Token
in Token_Class_Name
then
385 Prefix_Node
:= Name_Node
;
386 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
387 Set_Prefix
(Name_Node
, Prefix_Node
);
388 Set_Selector_Name
(Name_Node
, Token_Node
);
389 Scan
; -- past selector
390 goto Scan_Name_Extension
;
392 -- Reserved identifier as selector
394 elsif Is_Reserved_Identifier
then
395 Scan_Reserved_Identifier
(Force_Msg
=> False);
396 Prefix_Node
:= Name_Node
;
397 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
398 Set_Prefix
(Name_Node
, Prefix_Node
);
399 Set_Selector_Name
(Name_Node
, Token_Node
);
400 Scan
; -- past identifier used as selector
401 goto Scan_Name_Extension
;
403 -- If dot is at end of line and followed by nothing legal,
404 -- then assume end of name and quit (dot will be taken as
405 -- an incorrect form of some other punctuation by our caller).
407 elsif Token_Is_At_Start_Of_Line
then
408 Restore_Scan_State
(Scan_State
);
411 -- Here if nothing legal after the dot
414 Error_Msg_AP
("selector expected");
418 -- Here for an apostrophe as name extension. The scan position at the
419 -- apostrophe has already been saved, and the apostrophe scanned out.
421 <<Scan_Name_Extension_Apostrophe
>>
423 Scan_Apostrophe
: declare
424 function Apostrophe_Should_Be_Semicolon
return Boolean;
425 -- Checks for case where apostrophe should probably be
426 -- a semicolon, and if so, gives appropriate message,
427 -- resets the scan pointer to the apostrophe, changes
428 -- the current token to Tok_Semicolon, and returns True.
429 -- Otherwise returns False.
431 ------------------------------------
432 -- Apostrophe_Should_Be_Semicolon --
433 ------------------------------------
435 function Apostrophe_Should_Be_Semicolon
return Boolean is
437 if Token_Is_At_Start_Of_Line
then
438 Restore_Scan_State
(Scan_State
); -- to apostrophe
439 Error_Msg_SC
("|""''"" should be "";""");
440 Token
:= Tok_Semicolon
;
445 end Apostrophe_Should_Be_Semicolon
;
447 -- Start of processing for Scan_Apostrophe
450 -- Check for qualified expression case in Ada 2012 mode
452 if Ada_Version
>= Ada_2012
453 and then Token
in Tok_Left_Paren | Tok_Left_Bracket
455 Name_Node
:= P_Qualified_Expression
(Name_Node
);
456 goto Scan_Name_Extension
;
458 -- If range attribute after apostrophe, then return with Token
459 -- pointing to the apostrophe. Note that in this case the prefix
460 -- need not be a simple name (cases like A.all'range). Similarly
461 -- if there is a left paren after the apostrophe, then we also
462 -- return with Token pointing to the apostrophe (this is the
463 -- aggregate case, or some error case).
465 elsif Token
in Tok_Range | Tok_Left_Paren
then
466 Restore_Scan_State
(Scan_State
); -- to apostrophe
467 Expr_Form
:= EF_Name
;
470 -- Here for cases where attribute designator is an identifier
472 elsif Token
= Tok_Identifier
then
473 Attr_Name
:= Token_Name
;
475 if not Is_Attribute_Name
(Attr_Name
) then
476 if Apostrophe_Should_Be_Semicolon
then
477 Expr_Form
:= EF_Name
;
480 -- Here for a bad attribute name
483 Signal_Bad_Attribute
;
484 Scan
; -- past bad identifier
486 if Token
= Tok_Left_Paren
then
487 Scan
; -- past left paren
490 Discard_Junk_Node
(P_Expression_If_OK
);
491 exit when not Comma_Present
;
502 Style
.Check_Attribute_Name
(False);
505 -- Here for case of attribute designator is not an identifier
508 if Token
= Tok_Delta
then
509 Attr_Name
:= Name_Delta
;
511 elsif Token
= Tok_Digits
then
512 Attr_Name
:= Name_Digits
;
514 elsif Token
= Tok_Access
then
515 Attr_Name
:= Name_Access
;
517 elsif Token
= Tok_Mod
and then Ada_Version
>= Ada_95
then
518 Attr_Name
:= Name_Mod
;
520 elsif Apostrophe_Should_Be_Semicolon
then
521 Expr_Form
:= EF_Name
;
525 Error_Msg_AP
("attribute designator expected");
530 Style
.Check_Attribute_Name
(True);
534 -- We come here with an OK attribute scanned, and corresponding
535 -- Attribute identifier node stored in Ident_Node.
537 Prefix_Node
:= Name_Node
;
538 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
539 Scan
; -- past attribute designator
540 Set_Prefix
(Name_Node
, Prefix_Node
);
541 Set_Attribute_Name
(Name_Node
, Attr_Name
);
543 -- Scan attribute arguments/designator. We skip this if we know
544 -- that the attribute cannot have an argument (see documentation
545 -- of Is_Parameterless_Attribute for further details).
547 if Token
= Tok_Left_Paren
549 Is_Parameterless_Attribute
(Get_Attribute_Id
(Attr_Name
))
551 -- Attribute Update contains an array or record association
552 -- list which provides new values for various components or
553 -- elements. The list is parsed as an aggregate, and we get
554 -- better error handling by knowing that in the parser.
556 if Attr_Name
= Name_Update
then
557 Set_Expressions
(Name_Node
, New_List
);
558 Append
(P_Aggregate
, Expressions
(Name_Node
));
560 -- All other cases of parsing attribute arguments
563 Set_Expressions
(Name_Node
, New_List
);
564 Scan
; -- past left paren
568 Expr
: constant Node_Id
:= P_Expression_If_OK
;
572 -- Case of => for named notation
574 if Token
= Tok_Arrow
then
576 -- Named notation allowed only for the special
577 -- case of System'Restriction_Set (No_Dependence =>
578 -- unit_NAME), in which case construct a parameter
579 -- assocation node and append to the arguments.
581 if Attr_Name
= Name_Restriction_Set
582 and then Nkind
(Expr
) = N_Identifier
583 and then Chars
(Expr
) = Name_No_Dependence
587 Append_To
(Expressions
(Name_Node
),
588 Make_Parameter_Association
(Sloc
(Rnam
),
589 Selector_Name
=> Expr
,
590 Explicit_Actual_Parameter
=> Rnam
));
593 -- For all other cases named notation is illegal
597 ("named parameters not permitted "
599 Scan
; -- past junk arrow
602 -- Here for normal case (not => for named parameter)
605 -- Special handling for 'Image in Ada 2012, where
606 -- the attribute can be parameterless and its value
607 -- can be the prefix of a slice. Rewrite name as a
608 -- slice, Expr is its low bound.
610 if Token
= Tok_Dot_Dot
611 and then Attr_Name
= Name_Image
612 and then Ada_Version
>= Ada_2012
614 Set_Expressions
(Name_Node
, No_List
);
615 Prefix_Node
:= Name_Node
;
617 New_Node
(N_Slice
, Sloc
(Prefix_Node
));
618 Set_Prefix
(Name_Node
, Prefix_Node
);
619 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
620 Set_Low_Bound
(Range_Node
, Expr
);
622 Expr_Node
:= P_Expression
;
623 Check_Simple_Expression
(Expr_Node
);
624 Set_High_Bound
(Range_Node
, Expr_Node
);
625 Set_Discrete_Range
(Name_Node
, Range_Node
);
628 goto Scan_Name_Extension
;
631 Append
(Expr
, Expressions
(Name_Node
));
632 exit when not Comma_Present
;
642 goto Scan_Name_Extension
;
645 -- Here for left parenthesis extending name (left paren skipped)
647 <<Scan_Name_Extension_Left_Paren
>>
649 -- We now have to scan through a list of items, terminated by a
650 -- right parenthesis. The scan is handled by a finite state
651 -- machine. The possibilities are:
655 -- This is a slice. This case is handled in LP_State_Init
657 -- (expression, expression, ..)
659 -- This is interpreted as an indexed component, i.e. as a
660 -- case of a name which can be extended in the normal manner.
661 -- This case is handled by LP_State_Name or LP_State_Expr.
663 -- Note: if and case expressions (without an extra level of
664 -- parentheses) are permitted in this context).
666 -- (..., identifier => expression , ...)
668 -- If there is at least one occurrence of identifier => (but
669 -- none of the other cases apply), then we have a call.
671 -- Test for Id => case
673 if Token
= Tok_Identifier
then
674 Save_Scan_State
(Scan_State
); -- at Id
677 -- Test for => (allow := as an error substitute)
679 if Token
in Tok_Arrow | Tok_Colon_Equal
then
680 Restore_Scan_State
(Scan_State
); -- to Id
681 Arg_List
:= New_List
;
685 Restore_Scan_State
(Scan_State
); -- to Id
689 -- Here we have an expression after all
691 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
693 -- Check cases of discrete range for a slice
695 -- First possibility: Range_Attribute_Reference
697 if Expr_Form
= EF_Range_Attr
then
698 Range_Node
:= Expr_Node
;
700 -- Second possibility: Simple_expression .. Simple_expression
702 elsif Token
= Tok_Dot_Dot
then
703 Check_Simple_Expression
(Expr_Node
);
704 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
705 Set_Low_Bound
(Range_Node
, Expr_Node
);
707 Expr_Node
:= P_Expression
;
708 Check_Simple_Expression
(Expr_Node
);
709 Set_High_Bound
(Range_Node
, Expr_Node
);
711 -- Third possibility: Type_name range Range
713 elsif Token
= Tok_Range
then
714 if Expr_Form
/= EF_Simple_Name
then
715 Error_Msg_SC
("subtype mark must precede RANGE");
719 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
721 -- Otherwise we just have an expression. It is true that we might
722 -- have a subtype mark without a range constraint but this case
723 -- is syntactically indistinguishable from the expression case.
726 Arg_List
:= New_List
;
730 -- Fall through here with unmistakable Discrete range scanned,
731 -- which means that we definitely have the case of a slice. The
732 -- Discrete range is in Range_Node.
734 if Token
= Tok_Comma
then
735 Error_Msg_SC
("slice cannot have more than one dimension");
738 elsif Token
/= Tok_Right_Paren
then
739 if Token
= Tok_Arrow
then
741 -- This may be an aggregate that is missing a qualification
744 ("context of aggregate must be a qualified expression");
753 Scan
; -- past right paren
754 Prefix_Node
:= Name_Node
;
755 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
756 Set_Prefix
(Name_Node
, Prefix_Node
);
757 Set_Discrete_Range
(Name_Node
, Range_Node
);
759 -- An operator node is legal as a prefix to other names,
760 -- but not for a slice.
762 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
763 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
766 -- If we have a name extension, go scan it
768 if Token
in Token_Class_Namext
then
769 goto Scan_Name_Extension_OK
;
771 -- Otherwise return (a slice is a name, but is not a call)
774 Expr_Form
:= EF_Name
;
779 -- In LP_State_Expr, we have scanned one or more expressions, and
780 -- so we have a call or an indexed component which is a name. On
781 -- entry we have the expression just scanned in Expr_Node and
782 -- Arg_List contains the list of expressions encountered so far
785 Append
(Expr_Node
, Arg_List
);
787 if Token
= Tok_Arrow
then
789 ("expect identifier in parameter association", Sloc
(Expr_Node
));
792 elsif not Comma_Present
then
795 Prefix_Node
:= Name_Node
;
796 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
797 Set_Prefix
(Name_Node
, Prefix_Node
);
798 Set_Expressions
(Name_Node
, Arg_List
);
800 goto Scan_Name_Extension
;
803 -- Comma present (and scanned out), test for identifier => case
804 -- Test for identifier => case
806 if Token
= Tok_Identifier
then
807 Save_Scan_State
(Scan_State
); -- at Id
810 -- Test for => (allow := as error substitute)
812 if Token
in Tok_Arrow | Tok_Colon_Equal
then
813 Restore_Scan_State
(Scan_State
); -- to Id
816 -- Otherwise it's just an expression after all, so backup
819 Restore_Scan_State
(Scan_State
); -- to Id
823 -- Here we have an expression after all, so stay in this state
825 Expr_Node
:= P_Expression_If_OK
;
828 -- LP_State_Call corresponds to the situation in which at least one
829 -- instance of Id => Expression has been encountered, so we know that
830 -- we do not have a name, but rather a call. We enter it with the
831 -- scan pointer pointing to the next argument to scan, and Arg_List
832 -- containing the list of arguments scanned so far.
836 -- Test for case of Id => Expression (named parameter)
838 if Token
= Tok_Identifier
then
839 Save_Scan_State
(Scan_State
); -- at Id
840 Ident_Node
:= Token_Node
;
843 -- Deal with => (allow := as incorrect substitute)
845 if Token
in Tok_Arrow | Tok_Colon_Equal
then
846 Arg_Node
:= New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
847 Set_Selector_Name
(Arg_Node
, Ident_Node
);
849 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
850 Append
(Arg_Node
, Arg_List
);
852 -- If a comma follows, go back and scan next entry
854 if Comma_Present
then
857 -- Otherwise we have the end of a call
860 Prefix_Node
:= Name_Node
;
861 Name_Node
:= New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
862 Set_Name
(Name_Node
, Prefix_Node
);
863 Set_Parameter_Associations
(Name_Node
, Arg_List
);
866 if Token
in Token_Class_Namext
then
867 goto Scan_Name_Extension_OK
;
869 -- This is a case of a call which cannot be a name
872 Expr_Form
:= EF_Name
;
877 -- Not named parameter: Id started an expression after all
880 Restore_Scan_State
(Scan_State
); -- to Id
884 -- Here if entry did not start with Id => which means that it
885 -- is a positional parameter, which is not allowed, since we
886 -- have seen at least one named parameter already.
889 ("positional parameter association " &
890 "not allowed after named one");
892 Expr_Node
:= P_Expression_If_OK
;
894 -- Leaving the '>' in an association is not unusual, so suggest
897 if Nkind
(Expr_Node
) = N_Op_Eq
then
898 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
901 -- We go back to scanning out expressions, so that we do not get
902 -- multiple error messages when several positional parameters
903 -- follow a named parameter.
907 -- End of treatment for name extensions starting with left paren
909 -- End of loop through name extensions
913 -- This function parses a restricted form of Names which are either
914 -- designators, or designators preceded by a sequence of prefixes
915 -- that are direct names.
917 -- Error recovery: cannot raise Error_Resync
919 function P_Function_Name
return Node_Id
is
920 Designator_Node
: Node_Id
;
921 Prefix_Node
: Node_Id
;
922 Selector_Node
: Node_Id
;
923 Dot_Sloc
: Source_Ptr
:= No_Location
;
926 -- Prefix_Node is set to the gathered prefix so far, Empty means that
927 -- no prefix has been scanned. This allows us to build up the result
928 -- in the required right recursive manner.
930 Prefix_Node
:= Empty
;
932 -- Loop through prefixes
935 Designator_Node
:= Token_Node
;
937 if Token
not in Token_Class_Desig
then
938 return P_Identifier
; -- let P_Identifier issue the error message
940 else -- Token in Token_Class_Desig
941 Scan
; -- past designator
942 exit when Token
/= Tok_Dot
;
945 -- Here at a dot, with token just before it in Designator_Node
947 if No
(Prefix_Node
) then
948 Prefix_Node
:= Designator_Node
;
950 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
951 Set_Prefix
(Selector_Node
, Prefix_Node
);
952 Set_Selector_Name
(Selector_Node
, Designator_Node
);
953 Prefix_Node
:= Selector_Node
;
956 Dot_Sloc
:= Token_Ptr
;
960 -- Fall out of the loop having just scanned a designator
962 if No
(Prefix_Node
) then
963 return Designator_Node
;
965 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
966 Set_Prefix
(Selector_Node
, Prefix_Node
);
967 Set_Selector_Name
(Selector_Node
, Designator_Node
);
968 return Selector_Node
;
976 -- This function parses a restricted form of Names which are either
977 -- identifiers, or identifiers preceded by a sequence of prefixes
978 -- that are direct names.
980 -- Error recovery: cannot raise Error_Resync
982 function P_Qualified_Simple_Name
return Node_Id
is
983 Designator_Node
: Node_Id
;
984 Prefix_Node
: Node_Id
;
985 Selector_Node
: Node_Id
;
986 Dot_Sloc
: Source_Ptr
:= No_Location
;
989 -- Prefix node is set to the gathered prefix so far, Empty means that
990 -- no prefix has been scanned. This allows us to build up the result
991 -- in the required right recursive manner.
993 Prefix_Node
:= Empty
;
995 -- Loop through prefixes
998 Designator_Node
:= Token_Node
;
1000 if Token
= Tok_Identifier
then
1001 Scan
; -- past identifier
1002 exit when Token
/= Tok_Dot
;
1004 elsif Token
not in Token_Class_Desig
then
1005 return P_Identifier
; -- let P_Identifier issue the error message
1008 Scan
; -- past designator
1010 if Token
/= Tok_Dot
then
1011 Error_Msg_SP
("identifier expected");
1016 -- Here at a dot, with token just before it in Designator_Node
1018 if No
(Prefix_Node
) then
1019 Prefix_Node
:= Designator_Node
;
1021 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1022 Set_Prefix
(Selector_Node
, Prefix_Node
);
1023 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1024 Prefix_Node
:= Selector_Node
;
1027 Dot_Sloc
:= Token_Ptr
;
1031 -- Fall out of the loop having just scanned an identifier
1033 if No
(Prefix_Node
) then
1034 return Designator_Node
;
1036 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1037 Set_Prefix
(Selector_Node
, Prefix_Node
);
1038 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1039 return Selector_Node
;
1043 when Error_Resync
=>
1045 end P_Qualified_Simple_Name
;
1047 -- This procedure differs from P_Qualified_Simple_Name only in that it
1048 -- raises Error_Resync if any error is encountered. It only returns after
1049 -- scanning a valid qualified simple name.
1051 -- Error recovery: can raise Error_Resync
1053 function P_Qualified_Simple_Name_Resync
return Node_Id
is
1054 Designator_Node
: Node_Id
;
1055 Prefix_Node
: Node_Id
;
1056 Selector_Node
: Node_Id
;
1057 Dot_Sloc
: Source_Ptr
:= No_Location
;
1060 Prefix_Node
:= Empty
;
1062 -- Loop through prefixes
1065 Designator_Node
:= Token_Node
;
1067 if Token
= Tok_Identifier
then
1068 Scan
; -- past identifier
1069 exit when Token
/= Tok_Dot
;
1071 elsif Token
not in Token_Class_Desig
then
1072 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
1076 Scan
; -- past designator
1078 if Token
/= Tok_Dot
then
1079 Error_Msg_SP
("identifier expected");
1084 -- Here at a dot, with token just before it in Designator_Node
1086 if No
(Prefix_Node
) then
1087 Prefix_Node
:= Designator_Node
;
1089 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1090 Set_Prefix
(Selector_Node
, Prefix_Node
);
1091 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1092 Prefix_Node
:= Selector_Node
;
1095 Dot_Sloc
:= Token_Ptr
;
1096 Scan
; -- past period
1099 -- Fall out of the loop having just scanned an identifier
1101 if No
(Prefix_Node
) then
1102 return Designator_Node
;
1104 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1105 Set_Prefix
(Selector_Node
, Prefix_Node
);
1106 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1107 return Selector_Node
;
1109 end P_Qualified_Simple_Name_Resync
;
1111 ----------------------
1112 -- 4.1 Direct_Name --
1113 ----------------------
1115 -- Parsed by P_Name and other functions in section 4.1
1121 -- Parsed by P_Name (4.1)
1123 -------------------------------
1124 -- 4.1 Explicit Dereference --
1125 -------------------------------
1127 -- Parsed by P_Name (4.1)
1129 -------------------------------
1130 -- 4.1 Implicit_Dereference --
1131 -------------------------------
1133 -- Parsed by P_Name (4.1)
1135 ----------------------------
1136 -- 4.1 Indexed Component --
1137 ----------------------------
1139 -- Parsed by P_Name (4.1)
1145 -- Parsed by P_Name (4.1)
1147 -----------------------------
1148 -- 4.1 Selected_Component --
1149 -----------------------------
1151 -- Parsed by P_Name (4.1)
1153 ------------------------
1154 -- 4.1 Selector Name --
1155 ------------------------
1157 -- Parsed by P_Name (4.1)
1159 ------------------------------
1160 -- 4.1 Attribute Reference --
1161 ------------------------------
1163 -- Parsed by P_Name (4.1)
1165 -------------------------------
1166 -- 4.1 Attribute Designator --
1167 -------------------------------
1169 -- Parsed by P_Name (4.1)
1171 --------------------------------------
1172 -- 4.1.4 Range Attribute Reference --
1173 --------------------------------------
1175 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1177 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1179 -- In the grammar, a RANGE attribute is simply a name, but its use is
1180 -- highly restricted, so in the parser, we do not regard it as a name.
1181 -- Instead, P_Name returns without scanning the 'RANGE part of the
1182 -- attribute, and the caller uses the following function to construct
1183 -- a range attribute in places where it is appropriate.
1185 -- Note that RANGE here is treated essentially as an identifier,
1186 -- rather than a reserved word.
1188 -- The caller has parsed the prefix, i.e. a name, and Token points to
1189 -- the apostrophe. The token after the apostrophe is known to be RANGE
1190 -- at this point. The prefix node becomes the prefix of the attribute.
1192 -- Error_Recovery: Cannot raise Error_Resync
1194 function P_Range_Attribute_Reference
1195 (Prefix_Node
: Node_Id
)
1198 Attr_Node
: Node_Id
;
1201 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1202 Set_Prefix
(Attr_Node
, Prefix_Node
);
1203 Scan
; -- past apostrophe
1206 Style
.Check_Attribute_Name
(True);
1209 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1212 if Token
= Tok_Left_Paren
then
1213 Scan
; -- past left paren
1214 Set_Expressions
(Attr_Node
, New_List
(P_Expression_If_OK
));
1219 end P_Range_Attribute_Reference
;
1221 -------------------------------------
1222 -- P_Reduction_Attribute_Reference --
1223 -------------------------------------
1225 function P_Reduction_Attribute_Reference
(S
: Node_Id
)
1228 Attr_Node
: Node_Id
;
1229 Attr_Name
: Name_Id
;
1232 Attr_Name
:= Token_Name
;
1233 Scan
; -- past Reduce
1234 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1235 Set_Attribute_Name
(Attr_Node
, Attr_Name
);
1236 if Attr_Name
/= Name_Reduce
then
1237 Error_Msg
("Reduce attribute expected", Prev_Token_Ptr
);
1240 Set_Prefix
(Attr_Node
, S
);
1241 Set_Expressions
(Attr_Node
, New_List
);
1243 Append
(P_Name
, Expressions
(Attr_Node
));
1245 Append
(P_Expression
, Expressions
(Attr_Node
));
1249 end P_Reduction_Attribute_Reference
;
1251 ---------------------------------------
1252 -- 4.1.4 Range Attribute Designator --
1253 ---------------------------------------
1255 -- Parsed by P_Range_Attribute_Reference (4.4)
1257 ---------------------------------------------
1258 -- 4.1.4 (2) Reduction_Attribute_Reference --
1259 ---------------------------------------------
1261 -- parsed by P_Reduction_Attribute_Reference
1263 --------------------
1265 --------------------
1267 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1269 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1270 -- an aggregate is known to be required (code statement, extension
1271 -- aggregate), in which cases this routine performs the necessary check
1272 -- that we have an aggregate rather than a parenthesized expression
1274 -- Error recovery: can raise Error_Resync
1276 function P_Aggregate
return Node_Id
is
1277 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1278 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1281 if Nkind
(Aggr_Node
) /= N_Aggregate
1283 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1284 and then Ada_Version
< Ada_2022
1287 ("aggregate may not have single positional component", Aggr_Sloc
);
1294 ------------------------------------------------
1295 -- 4.3 Aggregate or Parenthesized Expression --
1296 ------------------------------------------------
1298 -- This procedure parses out either an aggregate or a parenthesized
1299 -- expression (these two constructs are closely related, since a
1300 -- parenthesized expression looks like an aggregate with a single
1301 -- positional component).
1304 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1306 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1308 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1309 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1312 -- RECORD_COMPONENT_ASSOCIATION ::=
1313 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1315 -- COMPONENT_CHOICE_LIST ::=
1316 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1319 -- EXTENSION_AGGREGATE ::=
1320 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1322 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1324 -- ARRAY_AGGREGATE ::=
1325 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1327 -- POSITIONAL_ARRAY_AGGREGATE ::=
1328 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1329 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1330 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1332 -- NAMED_ARRAY_AGGREGATE ::=
1333 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1335 -- PRIMARY ::= (EXPRESSION);
1337 -- Error recovery: can raise Error_Resync
1339 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1340 -- to Ada 2005 limited aggregates (AI-287)
1342 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1343 Aggregate_Node
: Node_Id
;
1344 Expr_List
: List_Id
;
1345 Assoc_List
: List_Id
;
1346 Expr_Node
: Node_Id
;
1347 Lparen_Sloc
: Source_Ptr
;
1348 Scan_State
: Saved_Scan_State
;
1350 procedure Box_Error
;
1351 -- Called if <> is encountered as positional aggregate element. Issues
1352 -- error message and sets Expr_Node to Error.
1354 function Is_Quantified_Expression
return Boolean;
1355 -- The presence of iterated component associations requires a one
1356 -- token lookahead to distinguish it from quantified expressions.
1362 procedure Box_Error
is
1364 Error_Msg_Ada_2005_Extension
("'<'> in aggregate");
1366 -- Ada 2005 (AI-287): The box notation is allowed only with named
1367 -- notation because positional notation might be error prone. For
1368 -- example, in "(X, <>, Y, <>)", there is no type associated with
1369 -- the boxes, so you might not be leaving out the components you
1370 -- thought you were leaving out.
1372 Error_Msg_SC
("(Ada 2005) box only allowed with named notation");
1377 ------------------------------
1378 -- Is_Quantified_Expression --
1379 ------------------------------
1381 function Is_Quantified_Expression
return Boolean is
1383 Scan_State
: Saved_Scan_State
;
1386 Save_Scan_State
(Scan_State
);
1388 Maybe
:= Token
in Tok_All | Tok_Some
;
1389 Restore_Scan_State
(Scan_State
); -- to FOR
1391 end Is_Quantified_Expression
;
1393 Start_Token
: constant Token_Type
:= Token
;
1394 -- Used to prevent mismatches (...] and [...)
1396 Saved_Delta_Aggregate_Flag
: constant Boolean := Inside_Delta_Aggregate
;
1398 -- Start of processing for P_Aggregate_Or_Paren_Expr
1401 Lparen_Sloc
:= Token_Ptr
;
1402 if Token
= Tok_Left_Bracket
then
1405 -- Special case for null aggregate in Ada 2022
1407 if Token
= Tok_Right_Bracket
then
1409 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1410 Set_Expressions
(Aggregate_Node
, New_List
);
1411 Set_Component_Associations
(Aggregate_Node
, New_List
);
1412 Set_Is_Homogeneous_Aggregate
(Aggregate_Node
);
1413 return Aggregate_Node
;
1419 -- Note on parentheses count. For cases like an if expression, the
1420 -- parens here really count as real parentheses for the paren count,
1421 -- so we adjust the paren count accordingly after scanning the expr.
1425 if Token
= Tok_If
then
1426 Expr_Node
:= P_If_Expression
;
1428 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1433 elsif Token
= Tok_Case
then
1434 Expr_Node
:= P_Case_Expression
;
1436 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1439 -- Quantified expression
1441 elsif Token
= Tok_For
and then Is_Quantified_Expression
then
1442 Expr_Node
:= P_Quantified_Expression
;
1444 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1447 -- Note: the mechanism used here of rescanning the initial expression
1448 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1449 -- out the discrete choice list.
1451 -- Deal with expression and extension aggregates first
1453 elsif Token
/= Tok_Others
then
1454 Save_Scan_State
(Scan_State
); -- at start of expression
1456 -- Deal with (NULL RECORD)
1458 if Token
= Tok_Null
then
1461 if Token
= Tok_Record
then
1462 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1463 Set_Null_Record_Present
(Aggregate_Node
, True);
1464 Scan
; -- past RECORD
1466 return Aggregate_Node
;
1468 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1471 elsif Token
= Tok_For
then
1472 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1473 Expr_Node
:= P_Iterated_Component_Association
;
1477 -- Scan expression, handling box appearing as positional argument
1479 if Token
= Tok_Box
then
1482 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1485 -- Extension or Delta aggregate
1487 if Token
= Tok_With
then
1488 if Nkind
(Expr_Node
) = N_Attribute_Reference
1489 and then Attribute_Name
(Expr_Node
) = Name_Range
1491 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1495 if Ada_Version
= Ada_83
then
1496 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1500 if Token
= Tok_Delta
then
1502 Inside_Delta_Aggregate
:= True;
1503 Aggregate_Node
:= New_Node
(N_Delta_Aggregate
, Lparen_Sloc
);
1504 Set_Expression
(Aggregate_Node
, Expr_Node
);
1510 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1511 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1514 -- Deal with WITH NULL RECORD case
1516 if Token
= Tok_Null
then
1517 Save_Scan_State
(Scan_State
); -- at NULL
1520 if Token
= Tok_Record
then
1521 Scan
; -- past RECORD
1522 Set_Null_Record_Present
(Aggregate_Node
, True);
1524 return Aggregate_Node
;
1527 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1531 if Token
/= Tok_Others
then
1532 Save_Scan_State
(Scan_State
);
1533 Expr_Node
:= P_Expression
;
1540 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1541 if Nkind
(Expr_Node
) = N_Attribute_Reference
1542 and then Attribute_Name
(Expr_Node
) = Name_Range
1545 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
1546 Scan
; -- past right paren
1550 -- Bump paren count of expression
1552 if Expr_Node
/= Error
then
1553 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1556 T_Right_Paren
; -- past right paren (error message if none)
1562 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1568 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1572 -- Prepare to scan list of component associations
1574 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1575 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1577 -- This loop scans through component associations. On entry to the
1578 -- loop, an expression has been scanned at the start of the current
1579 -- association unless initial token was OTHERS, in which case
1580 -- Expr_Node is set to Empty.
1583 -- Deal with others association first. This is a named association
1585 if No
(Expr_Node
) then
1586 Append_New
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1588 -- Improper use of WITH
1590 elsif Token
= Tok_With
then
1591 Error_Msg_SC
("WITH must be preceded by single expression in " &
1592 "extension aggregate");
1595 -- Range attribute can only appear as part of a discrete choice list
1597 elsif Nkind
(Expr_Node
) = N_Attribute_Reference
1598 and then Attribute_Name
(Expr_Node
) = Name_Range
1599 and then Token
/= Tok_Arrow
1600 and then Token
/= Tok_Vertical_Bar
1602 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1605 -- Assume positional case if comma, right paren, or literal or
1606 -- identifier or OTHERS follows (the latter cases are missing
1607 -- comma cases). Also assume positional if a semicolon follows,
1608 -- which can happen if there are missing parens.
1609 -- In Ada 2012 and 2022 an iterated association can appear.
1611 elsif Nkind
(Expr_Node
) in
1612 N_Iterated_Component_Association | N_Iterated_Element_Association
1614 Append_New
(Expr_Node
, Assoc_List
);
1616 elsif Token
in Tok_Comma | Tok_Right_Paren | Tok_Others
1617 | Token_Class_Lit_Or_Name | Tok_Semicolon
1619 if Present
(Assoc_List
) then
1620 Error_Msg_BC
-- CODEFIX
1621 ("""='>"" expected (positional association cannot follow "
1622 & "named association)");
1625 Append_New
(Expr_Node
, Expr_List
);
1627 -- Check for aggregate followed by left parent, maybe missing comma
1629 elsif Nkind
(Expr_Node
) = N_Aggregate
1630 and then Token
= Tok_Left_Paren
1634 Append_New
(Expr_Node
, Expr_List
);
1636 elsif Token
= Tok_Right_Bracket
then
1637 Append_New
(Expr_Node
, Expr_List
);
1640 -- Anything else is assumed to be a named association
1643 Restore_Scan_State
(Scan_State
); -- to start of expression
1645 Append_New
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1648 exit when not Comma_Present
;
1650 -- If we are at an expression terminator, something is seriously
1651 -- wrong, so let's get out now, before we start eating up stuff
1652 -- that doesn't belong to us.
1654 if Token
in Token_Class_Eterm
and then Token
/= Tok_For
then
1656 ("expecting expression or component association");
1660 -- Deal with misused box
1662 if Token
= Tok_Box
then
1665 -- Otherwise initiate for reentry to top of loop by scanning an
1666 -- initial expression, unless the first token is OTHERS or FOR,
1667 -- which indicates an iterated component association.
1669 elsif Token
= Tok_Others
then
1672 elsif Token
= Tok_For
then
1673 Expr_Node
:= P_Iterated_Component_Association
;
1676 Save_Scan_State
(Scan_State
); -- at start of expression
1677 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1682 -- All component associations (positional and named) have been scanned.
1683 -- Scan ] or ) based on Start_Token.
1686 when Tok_Left_Bracket
=>
1688 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1689 Set_Is_Homogeneous_Aggregate
(Aggregate_Node
);
1692 if Token
= Tok_Apostrophe
then
1695 if Token
= Tok_Identifier
then
1696 return P_Reduction_Attribute_Reference
(Aggregate_Node
);
1699 when Tok_Left_Paren
=>
1700 if Nkind
(Aggregate_Node
) = N_Aggregate
then
1701 Set_Is_Parenthesis_Aggregate
(Aggregate_Node
);
1705 when others => raise Program_Error
;
1708 if Nkind
(Aggregate_Node
) /= N_Delta_Aggregate
then
1709 Set_Expressions
(Aggregate_Node
, Expr_List
);
1712 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1714 -- Inside_Delta_Aggregate is only tested if Serious_Errors = 0, so
1715 -- it is ok if we fail to restore the saved I_D_A value in an error
1716 -- path. In particular, it is ok that we do not restore it if
1717 -- Error_Resync is propagated. Earlier return statements (which return
1718 -- without restoring the saved I_D_A value) should either be in error
1719 -- paths or in paths where I_D_A could not have been modified.
1721 Inside_Delta_Aggregate
:= Saved_Delta_Aggregate_Flag
;
1723 return Aggregate_Node
;
1724 end P_Aggregate_Or_Paren_Expr
;
1726 ------------------------------------------------
1727 -- 4.3 Record or Array Component Association --
1728 ------------------------------------------------
1730 -- RECORD_COMPONENT_ASSOCIATION ::=
1731 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1732 -- | COMPONENT_CHOICE_LIST => <>
1734 -- COMPONENT_CHOICE_LIST =>
1735 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1738 -- ARRAY_COMPONENT_ASSOCIATION ::=
1739 -- DISCRETE_CHOICE_LIST => EXPRESSION
1740 -- | DISCRETE_CHOICE_LIST => <>
1741 -- | ITERATED_COMPONENT_ASSOCIATION
1743 -- Note: this routine only handles the named cases, including others.
1744 -- Cases where the component choice list is not present have already
1745 -- been handled directly.
1747 -- Error recovery: can raise Error_Resync
1749 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1750 -- rules have been extended to give support to Ada 2005 limited
1751 -- aggregates (AI-287)
1753 function P_Record_Or_Array_Component_Association
return Node_Id
is
1754 Assoc_Node
: Node_Id
;
1755 Box_Present
: Boolean := False;
1756 Box_With_Identifier_Present
: Boolean := False;
1758 -- A loop indicates an iterated_component_association
1760 if Token
= Tok_For
then
1761 return P_Iterated_Component_Association
;
1764 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1765 Set_Binding_Chars
(Assoc_Node
, No_Name
);
1767 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1768 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1771 if Token
= Tok_Box
then
1773 -- Ada 2005(AI-287): The box notation is used to indicate the
1774 -- default initialization of aggregate components
1776 Error_Msg_Ada_2005_Extension
("component association with '<'>");
1778 Box_Present
:= True;
1779 Set_Box_Present
(Assoc_Node
);
1781 elsif Token
= Tok_Less
then
1783 Scan_State
: Saved_Scan_State
;
1786 Save_Scan_State
(Scan_State
);
1788 if Token
= Tok_Identifier
then
1789 Id
:= P_Defining_Identifier
;
1790 if Token
= Tok_Greater
then
1791 if Core_Extensions_Allowed
then
1792 Set_Box_Present
(Assoc_Node
);
1793 Set_Binding_Chars
(Assoc_Node
, Chars
(Id
));
1794 Box_Present
:= True;
1795 Box_With_Identifier_Present
:= True;
1798 Error_Msg_GNAT_Extension
1799 ("identifier within box", Token_Ptr
);
1800 Box_Present
:= True;
1801 -- Avoid cascading errors by ignoring the identifier
1805 if not Box_Present
then
1806 -- it wasn't an "is <identifier>", so restore.
1807 Restore_Scan_State
(Scan_State
);
1812 if not Box_Present
then
1813 Set_Expression
(Assoc_Node
, P_Expression
);
1816 -- Check for "is <identifier>" for aggregate that is part of
1817 -- a pattern for a general case statement.
1819 if Token
= Tok_Is
then
1821 Scan_State
: Saved_Scan_State
;
1824 Save_Scan_State
(Scan_State
);
1826 if Token
= Tok_Identifier
then
1827 Id
:= P_Defining_Identifier
;
1829 if not Core_Extensions_Allowed
then
1830 Error_Msg_GNAT_Extension
1831 ("IS following component association", Token_Ptr
);
1832 elsif Box_With_Identifier_Present
then
1834 ("Both identifier-in-box and trailing identifier"
1835 & " specified for one component association",
1838 Set_Binding_Chars
(Assoc_Node
, Chars
(Id
));
1841 -- It wasn't an "is <identifier>", so restore.
1842 Restore_Scan_State
(Scan_State
);
1848 end P_Record_Or_Array_Component_Association
;
1850 -----------------------------
1851 -- 4.3.1 Record Aggregate --
1852 -----------------------------
1854 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1855 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1857 ----------------------------------------------
1858 -- 4.3.1 Record Component Association List --
1859 ----------------------------------------------
1861 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1863 ----------------------------------
1864 -- 4.3.1 Component Choice List --
1865 ----------------------------------
1867 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1869 --------------------------------
1870 -- 4.3.1 Extension Aggregate --
1871 --------------------------------
1873 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1875 --------------------------
1876 -- 4.3.1 Ancestor Part --
1877 --------------------------
1879 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1881 ----------------------------
1882 -- 4.3.1 Array Aggregate --
1883 ----------------------------
1885 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1887 ---------------------------------------
1888 -- 4.3.1 Positional Array Aggregate --
1889 ---------------------------------------
1891 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1893 ----------------------------------
1894 -- 4.3.1 Named Array Aggregate --
1895 ----------------------------------
1897 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1899 ----------------------------------------
1900 -- 4.3.1 Array Component Association --
1901 ----------------------------------------
1903 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1905 ---------------------
1906 -- 4.4 Expression --
1907 ---------------------
1909 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1912 -- RELATION {LOGICAL_OPERATOR RELATION}
1914 -- CHOICE_EXPRESSION ::=
1915 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1917 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1919 -- On return, Expr_Form indicates the categorization of the expression
1920 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1921 -- an error message is given, and Error is returned).
1923 -- Error recovery: cannot raise Error_Resync
1925 function P_Expression
return Node_Id
is
1926 Logical_Op
: Node_Kind
;
1927 Prev_Logical_Op
: Node_Kind
;
1928 Op_Location
: Source_Ptr
;
1933 Node1
:= P_Relation
;
1935 if Token
in Token_Class_Logop
then
1936 Prev_Logical_Op
:= N_Empty
;
1939 Op_Location
:= Token_Ptr
;
1940 Logical_Op
:= P_Logical_Operator
;
1942 if Prev_Logical_Op
/= N_Empty
and then
1943 Logical_Op
/= Prev_Logical_Op
1946 ("mixed logical operators in expression", Op_Location
);
1947 Prev_Logical_Op
:= N_Empty
;
1949 Prev_Logical_Op
:= Logical_Op
;
1953 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1954 Set_Left_Opnd
(Node1
, Node2
);
1955 Set_Right_Opnd
(Node1
, P_Relation
);
1957 -- Check for case of errant comma or semicolon
1959 if Token
in Tok_Comma | Tok_Semicolon
then
1961 Com
: constant Boolean := Token
= Tok_Comma
;
1962 Scan_State
: Saved_Scan_State
;
1966 Save_Scan_State
(Scan_State
); -- at comma/semicolon
1967 Scan
; -- past comma/semicolon
1969 -- Check for AND THEN or OR ELSE after comma/semicolon. We
1970 -- do not deal with AND/OR because those cases get mixed up
1971 -- with the select alternatives case.
1973 if Token
in Tok_And | Tok_Or
then
1974 Logop
:= P_Logical_Operator
;
1975 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1977 if Logop
in N_And_Then | N_Or_Else
then
1978 Scan
; -- past comma/semicolon
1981 Error_Msg_SP
-- CODEFIX
1982 ("|extra "","" ignored");
1984 Error_Msg_SP
-- CODEFIX
1985 ("|extra "";"" ignored");
1989 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1993 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1998 exit when Token
not in Token_Class_Logop
;
2001 Expr_Form
:= EF_Non_Simple
;
2004 if Token
= Tok_Apostrophe
then
2005 Bad_Range_Attribute
(Token_Ptr
);
2012 -- This function is identical to the normal P_Expression, except that it
2013 -- also permits the appearance of a case, conditional, or quantified
2014 -- expression if the call immediately follows a left paren, and followed
2015 -- by a right parenthesis. These forms are allowed if these conditions
2016 -- are not met, but an error message will be issued.
2018 function P_Expression_If_OK
return Node_Id
is
2020 -- Case of conditional, case or quantified expression
2022 if Token
in Tok_Case | Tok_If | Tok_For | Tok_Declare
then
2023 return P_Unparen_Cond_Expr_Etc
;
2025 -- Normal case, not case/conditional/quantified expression
2028 return P_Expression
;
2030 end P_Expression_If_OK
;
2032 -- This function is identical to the normal P_Expression, except that it
2033 -- checks that the expression scan did not stop on a right paren. It is
2034 -- called in all contexts where a right parenthesis cannot legitimately
2035 -- follow an expression.
2037 -- Error recovery: cannot raise Error_Resync
2039 function P_Expression_No_Right_Paren
return Node_Id
is
2040 Expr
: constant Node_Id
:= P_Expression
;
2042 Ignore
(Tok_Right_Paren
);
2044 end P_Expression_No_Right_Paren
;
2046 ----------------------------------------
2047 -- 4.4 Expression_Or_Range_Attribute --
2048 ----------------------------------------
2051 -- RELATION {and RELATION} | RELATION {and then RELATION}
2052 -- | RELATION {or RELATION} | RELATION {or else RELATION}
2053 -- | RELATION {xor RELATION}
2055 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2057 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2059 -- On return, Expr_Form indicates the categorization of the expression
2060 -- and EF_Range_Attr is one of the possibilities.
2062 -- Error recovery: cannot raise Error_Resync
2064 -- In the grammar, a RANGE attribute is simply a name, but its use is
2065 -- highly restricted, so in the parser, we do not regard it as a name.
2066 -- Instead, P_Name returns without scanning the 'RANGE part of the
2067 -- attribute, and P_Expression_Or_Range_Attribute handles the range
2068 -- attribute reference. In the normal case where a range attribute is
2069 -- not allowed, an error message is issued by P_Expression.
2071 function P_Expression_Or_Range_Attribute
return Node_Id
is
2072 Logical_Op
: Node_Kind
;
2073 Prev_Logical_Op
: Node_Kind
;
2074 Op_Location
: Source_Ptr
;
2077 Attr_Node
: Node_Id
;
2080 Node1
:= P_Relation
;
2082 if Token
= Tok_Apostrophe
then
2083 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
2084 Expr_Form
:= EF_Range_Attr
;
2087 elsif Token
in Token_Class_Logop
then
2088 Prev_Logical_Op
:= N_Empty
;
2091 Op_Location
:= Token_Ptr
;
2092 Logical_Op
:= P_Logical_Operator
;
2094 if Prev_Logical_Op
/= N_Empty
and then
2095 Logical_Op
/= Prev_Logical_Op
2098 ("mixed logical operators in expression", Op_Location
);
2099 Prev_Logical_Op
:= N_Empty
;
2101 Prev_Logical_Op
:= Logical_Op
;
2105 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
2106 Set_Left_Opnd
(Node1
, Node2
);
2107 Set_Right_Opnd
(Node1
, P_Relation
);
2108 exit when Token
not in Token_Class_Logop
;
2111 Expr_Form
:= EF_Non_Simple
;
2114 if Token
= Tok_Apostrophe
then
2115 Bad_Range_Attribute
(Token_Ptr
);
2120 end P_Expression_Or_Range_Attribute
;
2122 -- Version that allows a non-parenthesized case, conditional, or quantified
2123 -- expression if the call immediately follows a left paren, and followed
2124 -- by a right parenthesis. These forms are allowed if these conditions
2125 -- are not met, but an error message will be issued.
2127 function P_Expression_Or_Range_Attribute_If_OK
return Node_Id
is
2129 -- Case of conditional, case or quantified expression
2131 if Token
in Tok_Case | Tok_If | Tok_For | Tok_Declare
then
2132 return P_Unparen_Cond_Expr_Etc
;
2134 -- Normal case, not one of the above expression types
2137 return P_Expression_Or_Range_Attribute
;
2139 end P_Expression_Or_Range_Attribute_If_OK
;
2145 -- This procedure scans both relations and choice relations
2147 -- CHOICE_RELATION ::=
2148 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
2151 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
2152 -- | RAISE_EXPRESSION
2154 -- MEMBERSHIP_CHOICE_LIST ::=
2155 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
2157 -- MEMBERSHIP_CHOICE ::=
2158 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
2160 -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
2162 -- On return, Expr_Form indicates the categorization of the expression
2164 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2165 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2167 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2168 -- expression, then tokens are scanned until either a non-expression token,
2169 -- a right paren (not matched by a left paren) or a comma, is encountered.
2171 function P_Relation
return Node_Id
is
2172 Node1
, Node2
: Node_Id
;
2176 -- First check for raise expression
2178 if Token
= Tok_Raise
then
2179 Expr_Form
:= EF_Non_Simple
;
2180 return P_Raise_Expression
;
2185 Node1
:= P_Simple_Expression
;
2187 if Token
not in Token_Class_Relop
then
2191 -- Here we have a relational operator following. If so then scan it
2192 -- out. Note that the assignment symbol := is treated as a relational
2193 -- operator to improve the error recovery when it is misused for =.
2194 -- P_Relational_Operator also parses the IN and NOT IN operations.
2197 Node2
:= New_Op_Node
(P_Relational_Operator
, Optok
);
2198 Set_Left_Opnd
(Node2
, Node1
);
2200 -- Case of IN or NOT IN
2202 if Prev_Token
= Tok_In
then
2203 P_Membership_Test
(Node2
);
2205 -- Case of relational operator (= /= < <= > >=)
2208 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
2211 Expr_Form
:= EF_Non_Simple
;
2213 if Token
in Token_Class_Relop
then
2214 Error_Msg_SC
("unexpected relational operator");
2221 -- If any error occurs, then scan to the next expression terminator symbol
2222 -- or comma or right paren at the outer (i.e. current) parentheses level.
2223 -- The flags are set to indicate a normal simple expression.
2226 when Error_Resync
=>
2228 Expr_Form
:= EF_Simple
;
2232 ----------------------------
2233 -- 4.4 Simple Expression --
2234 ----------------------------
2236 -- SIMPLE_EXPRESSION ::=
2237 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2239 -- On return, Expr_Form indicates the categorization of the expression
2241 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2242 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2244 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2245 -- expression, then tokens are scanned until either a non-expression token,
2246 -- a right paren (not matched by a left paren) or a comma, is encountered.
2248 -- Note: P_Simple_Expression is called only internally by higher level
2249 -- expression routines. In cases in the grammar where a simple expression
2250 -- is required, the approach is to scan an expression, and then post an
2251 -- appropriate error message if the expression obtained is not simple. This
2252 -- gives better error recovery and treatment.
2254 function P_Simple_Expression
return Node_Id
is
2255 Scan_State
: Saved_Scan_State
;
2258 Tokptr
: Source_Ptr
;
2260 function At_Start_Of_Attribute
return Boolean;
2261 -- Tests if we have quote followed by attribute name, if so, return True
2262 -- otherwise return False.
2264 ---------------------------
2265 -- At_Start_Of_Attribute --
2266 ---------------------------
2268 function At_Start_Of_Attribute
return Boolean is
2270 if Token
/= Tok_Apostrophe
then
2275 Scan_State
: Saved_Scan_State
;
2278 Save_Scan_State
(Scan_State
);
2281 if Token
= Tok_Identifier
2282 and then Is_Attribute_Name
(Chars
(Token_Node
))
2284 Restore_Scan_State
(Scan_State
);
2287 Restore_Scan_State
(Scan_State
);
2292 end At_Start_Of_Attribute
;
2294 -- Start of processing for P_Simple_Expression
2297 -- Check for cases starting with a name. There are two reasons for
2298 -- special casing. First speed things up by catching a common case
2299 -- without going through several routine layers. Second the caller must
2300 -- be informed via Expr_Form when the simple expression is a name.
2302 if Token
in Token_Class_Name
then
2305 -- Deal with apostrophe cases
2307 if Token
= Tok_Apostrophe
then
2308 Save_Scan_State
(Scan_State
); -- at apostrophe
2309 Scan
; -- past apostrophe
2311 -- If qualified expression, scan it out and fall through
2313 if Token
= Tok_Left_Paren
then
2314 Node1
:= P_Qualified_Expression
(Node1
);
2315 Expr_Form
:= EF_Simple
;
2317 -- If range attribute, then we return with Token pointing to the
2318 -- apostrophe. Note: avoid the normal error check on exit. We
2319 -- know that the expression really is complete in this case.
2321 else -- Token = Tok_Range then
2322 Restore_Scan_State
(Scan_State
); -- to apostrophe
2323 Expr_Form
:= EF_Simple_Name
;
2328 -- If an expression terminator follows, the previous processing
2329 -- completely scanned out the expression (a common case), and
2330 -- left Expr_Form set appropriately for returning to our caller.
2332 if Token
in Token_Class_Sterm
then
2335 -- Handle '}' as expression terminator of an interpolated
2338 elsif Inside_Interpolated_String_Literal
2339 and then Token
= Tok_Right_Curly_Bracket
2343 -- If we do not have an expression terminator, then complete the
2344 -- scan of a simple expression. This code duplicates the code
2345 -- found in P_Term and P_Factor.
2348 if Token
= Tok_Double_Asterisk
then
2350 Style
.Check_Exponentiation_Operator
;
2353 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2355 Set_Left_Opnd
(Node2
, Node1
);
2356 Set_Right_Opnd
(Node2
, P_Primary
);
2362 exit when Token
not in Token_Class_Mulop
;
2363 Tokptr
:= Token_Ptr
;
2364 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2367 Style
.Check_Binary_Operator
;
2370 Scan
; -- past operator
2371 Set_Left_Opnd
(Node2
, Node1
);
2372 Set_Right_Opnd
(Node2
, P_Factor
);
2377 exit when Token
not in Token_Class_Binary_Addop
;
2378 Tokptr
:= Token_Ptr
;
2379 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2382 Style
.Check_Binary_Operator
;
2385 Scan
; -- past operator
2386 Set_Left_Opnd
(Node2
, Node1
);
2387 Set_Right_Opnd
(Node2
, P_Term
);
2391 Expr_Form
:= EF_Simple
;
2394 -- Cases where simple expression does not start with a name
2397 -- Scan initial sign and initial Term
2399 if Token
in Token_Class_Unary_Addop
then
2400 Tokptr
:= Token_Ptr
;
2401 Node1
:= New_Op_Node
(P_Unary_Adding_Operator
, Tokptr
);
2404 Style
.Check_Unary_Plus_Or_Minus
(Inside_Depends
);
2407 Scan
; -- past operator
2408 Set_Right_Opnd
(Node1
, P_Term
);
2413 -- In the following, we special-case a sequence of concatenations of
2414 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
2415 -- else mixed in. For such a sequence, we return a tree representing
2416 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
2417 -- the number of concatenations is large. If semantic analysis
2418 -- resolves the "&" to a predefined one, then this folding gives the
2419 -- right answer. Otherwise, semantic analysis will complain about a
2420 -- capacity-exceeded error. The purpose of this trick is to avoid
2421 -- creating a deeply nested tree, which would cause deep recursion
2422 -- during semantics, causing stack overflow. This way, we can handle
2423 -- enormous concatenations in the normal case of predefined "&". We
2424 -- first build up the normal tree, and then rewrite it if
2428 Num_Concats_Threshold
: constant Positive := 1000;
2429 -- Arbitrary threshold value to enable optimization
2431 First_Node
: constant Node_Id
:= Node1
;
2432 Is_Strlit_Concat
: Boolean;
2433 -- True iff we've parsed a sequence of concatenations of string
2434 -- literals, with nothing else mixed in.
2436 Num_Concats
: Natural;
2437 -- Number of "&" operators if Is_Strlit_Concat is True
2441 Nkind
(Node1
) = N_String_Literal
2442 and then Token
= Tok_Ampersand
;
2445 -- Scan out sequence of terms separated by binary adding operators
2448 exit when Token
not in Token_Class_Binary_Addop
;
2449 Tokptr
:= Token_Ptr
;
2450 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2452 if Style_Check
and then not Debug_Flag_Dot_QQ
then
2453 Style
.Check_Binary_Operator
;
2456 Scan
; -- past operator
2457 Set_Left_Opnd
(Node2
, Node1
);
2459 Set_Right_Opnd
(Node2
, Node1
);
2461 -- Check if we're still concatenating string literals
2465 and then Nkind
(Node2
) = N_Op_Concat
2466 and then Nkind
(Node1
) = N_String_Literal
;
2468 if Is_Strlit_Concat
then
2469 Num_Concats
:= Num_Concats
+ 1;
2475 -- If we have an enormous series of concatenations of string
2476 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2477 -- flag tells semantic analysis that if the "&" is not predefined,
2478 -- the folded value is wrong.
2481 and then Num_Concats
>= Num_Concats_Threshold
2484 Strlit_Concat_Val
: String_Id
;
2485 -- Contains the folded value (which will be correct if the
2486 -- "&" operators are the predefined ones).
2489 -- For walking up the tree
2492 -- Folded node to replace Node1
2494 Loc
: constant Source_Ptr
:= Sloc
(First_Node
);
2497 -- Walk up the tree starting at the leftmost string literal
2498 -- (First_Node), building up the Strlit_Concat_Val as we
2499 -- go. Note that we do not use recursion here -- the whole
2500 -- point is to avoid recursively walking that enormous tree.
2503 Store_String_Chars
(Strval
(First_Node
));
2505 Cur_Node
:= Parent
(First_Node
);
2506 while Present
(Cur_Node
) loop
2507 pragma Assert
(Nkind
(Cur_Node
) = N_Op_Concat
and then
2508 Nkind
(Right_Opnd
(Cur_Node
)) = N_String_Literal
);
2510 Store_String_Chars
(Strval
(Right_Opnd
(Cur_Node
)));
2511 Cur_Node
:= Parent
(Cur_Node
);
2514 Strlit_Concat_Val
:= End_String
;
2516 -- Create new folded node, and rewrite result with a concat-
2517 -- enation of an empty string literal and the folded node.
2520 Make_Op_Concat
(Loc
,
2521 Make_String_Literal
(Loc
, Null_String_Id
),
2522 Make_String_Literal
(Loc
, Strlit_Concat_Val
,
2523 Is_Folded_In_Parser
=> True));
2524 Rewrite
(Node1
, New_Node
);
2529 -- All done, we clearly do not have name or numeric literal so this
2530 -- is a case of a simple expression which is some other possibility.
2532 Expr_Form
:= EF_Simple
;
2535 -- If all extensions are enabled and we have a deep delta aggregate
2536 -- whose type is an array type with an element type that is a
2537 -- record type, then we can encounter legal things like
2538 -- with delta (Some_Index_Expression).Some_Component
2539 -- where a parenthesized expression precedes a dot.
2540 -- Similarly, if the element type is an array type then we can see
2541 -- with delta (Some_Index_Expression)(Another_Index_Expression)
2542 -- where a parenthesized expression precedes a left parenthesis.
2544 if Token
in Tok_Dot | Tok_Left_Paren
2545 and then Prev_Token
= Tok_Right_Paren
2546 and then Serious_Errors_Detected
= 0
2547 and then Inside_Delta_Aggregate
2548 and then All_Extensions_Allowed
2550 if Token
= Tok_Dot
then
2551 Node2
:= New_Node
(N_Selected_Component
, Token_Ptr
);
2554 Tail
: constant Node_Id
:= P_Simple_Expression
;
2555 -- remaining selectors occurring after the dot
2557 Rover
: Node_Id
:= Tail
;
2558 Prev
: Node_Id
:= Empty
;
2560 -- If Tail already has a prefix, then we want to prepend
2561 -- Node1 onto that prefix and then return Tail.
2562 -- Otherwise, Tail should simply be an identifier so
2563 -- we want to build a Selected_Component with Tail as the
2564 -- selector name and return that.
2566 Set_Prefix
(Node2
, Node1
);
2569 in N_Indexed_Component | N_Selected_Component
loop
2571 Rover
:= Prefix
(Rover
);
2574 case Nkind
(Prev
) is
2575 when N_Selected_Component | N_Indexed_Component
=>
2576 -- We've scanned a dot, so an identifier should follow
2577 if Nkind
(Prefix
(Prev
)) = N_Identifier
then
2578 Set_Selector_Name
(Node2
, Prefix
(Prev
));
2579 Set_Prefix
(Prev
, Node2
);
2584 -- We've scanned a dot, so an identifier should follow
2585 if Nkind
(Tail
) = N_Identifier
then
2586 Set_Selector_Name
(Node2
, Tail
);
2594 -- fall through to error case
2597 Node2
:= New_Node
(N_Indexed_Component
, Token_Ptr
);
2599 Tail
: constant Node_Id
:= P_Simple_Expression
;
2600 -- remaining selectors
2602 Rover
: Node_Id
:= Tail
;
2603 Prev
: Node_Id
:= Empty
;
2605 -- If Tail already has a prefix, then we want to prepend
2606 -- Node1 onto that prefix and then return Tail.
2607 -- Otherwise, Tail should be an index expression and
2608 -- we want to build an Indexed_Component with Tail as the
2609 -- index value and return that.
2611 Set_Prefix
(Node2
, Node1
);
2614 in N_Indexed_Component | N_Selected_Component
loop
2616 Rover
:= Prefix
(Rover
);
2619 case Nkind
(Prev
) is
2620 when N_Selected_Component | N_Indexed_Component
=>
2621 Set_Expressions
(Node2
, New_List
(Prefix
(Prev
)));
2622 Set_Prefix
(Prev
, Node2
);
2626 Set_Expressions
(Node2
, New_List
(Tail
));
2633 -- fall through to error case
2638 -- Come here at end of simple expression, where we do a couple of
2639 -- special checks to improve error recovery.
2641 -- Special test to improve error recovery. If the current token is a
2642 -- period, then someone is trying to do selection on something that is
2643 -- not a name, e.g. a qualified expression.
2645 if Token
= Tok_Dot
then
2646 Error_Msg_SC
("prefix for selection is not a name");
2648 -- If qualified expression, comment and continue, otherwise
2649 -- something is pretty nasty so do an Error_Resync call.
2651 if Ada_Version
< Ada_2012
2652 and then Nkind
(Node1
) = N_Qualified_Expression
2654 Error_Msg_SC
("\would be legal in Ada 2012 mode");
2660 -- Special test to improve error recovery: If the current token is
2661 -- not the first token on a line (as determined by checking the
2662 -- previous token position with the start of the current line),
2663 -- then we insist that we have an appropriate terminating token.
2664 -- Consider the following two examples:
2666 -- 1) if A nad B then ...
2671 -- In the first example, we would like to issue a binary operator
2672 -- expected message and resynchronize to the then. In the second
2673 -- example, we do not want to issue a binary operator message, so
2674 -- that instead we will get the missing semicolon message. This
2675 -- distinction is of course a heuristic which does not always work,
2676 -- but in practice it is quite effective.
2678 -- Note: the one case in which we do not go through this circuit is
2679 -- when we have scanned a range attribute and want to return with
2680 -- Token pointing to the apostrophe. The apostrophe is not normally
2681 -- an expression terminator, and is not in Token_Class_Sterm, but
2682 -- in this special case we know that the expression is complete.
2684 -- We disable this error recovery machinery when we are processing an
2685 -- interpolated string and we reach the expression terminator '}'.
2687 if not Token_Is_At_Start_Of_Line
2688 and then Token
not in Token_Class_Sterm
2689 and then not (Inside_Interpolated_String_Literal
2690 and then Token
= Tok_Right_Curly_Bracket
)
2692 -- Normally the right error message is indeed that we expected a
2693 -- binary operator, but in the case of being between a right and left
2694 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2696 if Prev_Token
= Tok_Right_Paren
and then Token
= Tok_Left_Paren
then
2699 -- And if we have a quote, we may have a bad attribute
2701 elsif At_Start_Of_Attribute
then
2702 Error_Msg_SC
("prefix of attribute must be a name");
2704 if Ada_Version
>= Ada_2012
then
2705 Error_Msg_SC
("\qualify expression to turn it into a name");
2708 -- Normal case for binary operator expected message
2711 Error_Msg_AP
("binary operator expected");
2720 -- If any error occurs, then scan to next expression terminator symbol
2721 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2722 -- level. Expr_Form is set to indicate a normal simple expression.
2725 when Error_Resync
=>
2727 Expr_Form
:= EF_Simple
;
2729 end P_Simple_Expression
;
2731 -----------------------------------------------
2732 -- 4.4 Simple Expression or Range Attribute --
2733 -----------------------------------------------
2735 -- SIMPLE_EXPRESSION ::=
2736 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2738 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2740 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2742 -- Error recovery: cannot raise Error_Resync
2744 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
2746 Attr_Node
: Node_Id
;
2749 -- We don't just want to roar ahead and call P_Simple_Expression
2750 -- here, since we want to handle the case of a parenthesized range
2751 -- attribute cleanly.
2753 if Token
= Tok_Left_Paren
then
2755 Lptr
: constant Source_Ptr
:= Token_Ptr
;
2756 Scan_State
: Saved_Scan_State
;
2759 Save_Scan_State
(Scan_State
);
2760 Scan
; -- past left paren
2761 Sexpr
:= P_Simple_Expression
;
2763 if Token
= Tok_Apostrophe
then
2764 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2765 Expr_Form
:= EF_Range_Attr
;
2767 if Token
= Tok_Right_Paren
then
2768 Scan
; -- scan past right paren if present
2771 Error_Msg
("parentheses not allowed for range attribute", Lptr
);
2776 Restore_Scan_State
(Scan_State
);
2780 -- Here after dealing with parenthesized range attribute
2782 Sexpr
:= P_Simple_Expression
;
2784 if Token
= Tok_Apostrophe
then
2785 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2786 Expr_Form
:= EF_Range_Attr
;
2792 end P_Simple_Expression_Or_Range_Attribute
;
2798 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2800 -- Error recovery: can raise Error_Resync
2802 function P_Term
return Node_Id
is
2803 Node1
, Node2
: Node_Id
;
2804 Tokptr
: Source_Ptr
;
2810 exit when Token
not in Token_Class_Mulop
;
2811 Tokptr
:= Token_Ptr
;
2812 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2814 if Style_Check
and then not Debug_Flag_Dot_QQ
then
2815 Style
.Check_Binary_Operator
;
2818 Scan
; -- past operator
2819 Set_Left_Opnd
(Node2
, Node1
);
2820 Set_Right_Opnd
(Node2
, P_Factor
);
2831 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2833 -- Error recovery: can raise Error_Resync
2835 function P_Factor
return Node_Id
is
2840 if Token
= Tok_Abs
then
2841 Node1
:= New_Op_Node
(N_Op_Abs
, Token_Ptr
);
2844 Style
.Check_Abs_Not
;
2848 Set_Right_Opnd
(Node1
, P_Primary
);
2851 elsif Token
= Tok_Not
then
2852 Node1
:= New_Op_Node
(N_Op_Not
, Token_Ptr
);
2855 Style
.Check_Abs_Not
;
2859 Set_Right_Opnd
(Node1
, P_Primary
);
2865 if Token
= Tok_Double_Asterisk
then
2866 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2868 Set_Left_Opnd
(Node2
, Node1
);
2869 Set_Right_Opnd
(Node2
, P_Primary
);
2883 -- NUMERIC_LITERAL | null
2884 -- | STRING_LITERAL | AGGREGATE
2885 -- | NAME | QUALIFIED_EXPRESSION
2886 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2887 -- | REDUCTION_ATTRIBUTE_REFERENCE
2889 -- Error recovery: can raise Error_Resync
2891 function P_Primary
return Node_Id
is
2892 Scan_State
: Saved_Scan_State
;
2895 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
2896 -- Remember if previous token is a left parenthesis. This is used to
2897 -- deal with checking whether IF/CASE/FOR expressions appearing as
2898 -- primaries require extra parenthesization.
2901 -- The loop runs more than once only if misplaced pragmas are found
2902 -- or if a misplaced unary minus is skipped.
2907 -- Name token can start a name, call or qualified expression, all
2908 -- of which are acceptable possibilities for primary. Note also
2909 -- that string literal is included in name (as operator symbol)
2910 -- and type conversion is included in name (as indexed component).
2912 when Tok_Char_Literal
2914 | Tok_Operator_Symbol
2918 -- All done unless apostrophe follows
2920 if Token
/= Tok_Apostrophe
then
2923 -- Apostrophe following means that we have either just parsed
2924 -- the subtype mark of a qualified expression, or the prefix
2925 -- or a range attribute.
2927 else -- Token = Tok_Apostrophe
2928 Save_Scan_State
(Scan_State
); -- at apostrophe
2929 Scan
; -- past apostrophe
2931 -- If range attribute, then this is always an error, since
2932 -- the only legitimate case (where the scanned expression is
2933 -- a qualified simple name) is handled at the level of the
2934 -- Simple_Expression processing. This case corresponds to a
2935 -- usage such as 3 + A'Range, which is always illegal.
2937 if Token
= Tok_Range
then
2938 Restore_Scan_State
(Scan_State
); -- to apostrophe
2939 Bad_Range_Attribute
(Token_Ptr
);
2942 -- If left paren, then we have a qualified expression.
2943 -- Note that P_Name guarantees that in this case, where
2944 -- Token = Tok_Apostrophe on return, the only two possible
2945 -- tokens following the apostrophe are left paren and
2946 -- RANGE, so we know we have a left paren here.
2948 else -- Token = Tok_Left_Paren
2949 return P_Qualified_Expression
(Node1
);
2954 -- Numeric or string literal
2956 when Tok_Integer_Literal
2958 | Tok_String_Literal
2960 Node1
:= Token_Node
;
2961 Scan
; -- past number
2964 -- Left paren, starts aggregate or parenthesized expression
2966 when Tok_Left_Paren
=>
2968 Expr
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
2971 if Nkind
(Expr
) = N_Attribute_Reference
2972 and then Attribute_Name
(Expr
) = Name_Range
2974 Bad_Range_Attribute
(Sloc
(Expr
));
2980 when Tok_Left_Bracket
=>
2983 when Tok_Left_Interpolated_String
=>
2984 return P_Interpolated_String_Literal
;
2995 return New_Node
(N_Null
, Prev_Token_Ptr
);
2997 -- Pragma, not allowed here, so just skip past it
3000 P_Pragmas_Misplaced
;
3002 -- Deal with IF (possible unparenthesized if expression)
3006 -- If this looks like a real if, defined as an IF appearing at
3007 -- the start of a new line, then we consider we have a missing
3008 -- operand. If in Ada 2012 and the IF is not properly indented
3009 -- for a statement, we prefer to issue a message about an ill-
3010 -- parenthesized if expression.
3012 if Token_Is_At_Start_Of_Line
3014 (Ada_Version
>= Ada_2012
3016 (Style_Check_Indentation
= 0
3018 Start_Column
rem Style_Check_Indentation
/= 0))
3020 Error_Msg_AP
("missing operand");
3023 -- If this looks like an if expression, then treat it that way
3024 -- with an error message if not explicitly surrounded by
3027 elsif Ada_Version
>= Ada_2012
then
3028 Node1
:= P_If_Expression
;
3030 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3032 ("if expression must be parenthesized", Sloc
(Node1
));
3037 -- Otherwise treat as misused identifier
3040 return P_Identifier
;
3043 -- Deal with CASE (possible unparenthesized case expression)
3047 -- If this looks like a real case, defined as a CASE appearing
3048 -- the start of a new line, then we consider we have a missing
3049 -- operand. If in Ada 2012 and the CASE is not properly
3050 -- indented for a statement, we prefer to issue a message about
3051 -- an ill-parenthesized case expression.
3053 if Token_Is_At_Start_Of_Line
3055 (Ada_Version
>= Ada_2012
3056 and then Style_Check_Indentation
/= 0
3057 and then Start_Column
rem Style_Check_Indentation
/= 0)
3059 Error_Msg_AP
("missing operand");
3062 -- If this looks like a case expression, then treat it that way
3063 -- with an error message if not within parentheses.
3065 elsif Ada_Version
>= Ada_2012
then
3066 Node1
:= P_Case_Expression
;
3068 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3070 ("case expression must be parenthesized", Sloc
(Node1
));
3075 -- Otherwise treat as misused identifier
3078 return P_Identifier
;
3081 -- For [all | some] indicates a quantified expression
3084 if Token_Is_At_Start_Of_Line
then
3085 Error_Msg_AP
("misplaced loop");
3088 elsif Ada_Version
>= Ada_2012
then
3089 Save_Scan_State
(Scan_State
);
3092 if Token
in Tok_All | Tok_Some
then
3093 Restore_Scan_State
(Scan_State
); -- To FOR
3094 Node1
:= P_Quantified_Expression
;
3096 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3098 ("quantified expression must be parenthesized",
3102 Restore_Scan_State
(Scan_State
); -- To FOR
3103 Node1
:= P_Iterated_Component_Association
;
3108 -- Otherwise treat as misused identifier
3111 return P_Identifier
;
3114 -- Minus may well be an improper attempt at a unary minus. Give
3115 -- a message, skip the minus and keep going.
3118 Error_Msg_SC
("parentheses required for unary minus");
3121 when Tok_At_Sign
=> -- AI12-0125 : target_name
3122 Error_Msg_Ada_2022_Feature
("target name", Token_Ptr
);
3127 -- Anything else is illegal as the first token of a primary, but
3128 -- we test for some common errors, to improve error messages.
3131 if Is_Reserved_Identifier
then
3132 return P_Identifier
;
3134 elsif Prev_Token
= Tok_Comma
then
3135 Error_Msg_SP
-- CODEFIX
3136 ("|extra "","" ignored");
3140 Error_Msg_AP
("missing operand");
3147 -------------------------------
3148 -- 4.4 Quantified_Expression --
3149 -------------------------------
3151 -- QUANTIFIED_EXPRESSION ::=
3152 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
3153 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
3155 function P_Quantified_Expression
return Node_Id
is
3160 Error_Msg_Ada_2012_Feature
("quantified expression", Token_Ptr
);
3162 Node1
:= New_Node
(N_Quantified_Expression
, Prev_Token_Ptr
);
3164 if Token
= Tok_All
then
3165 Set_All_Present
(Node1
);
3166 elsif Token
/= Tok_Some
then
3167 Error_Msg_AP
("missing quantifier");
3171 Scan
; -- past ALL or SOME
3172 I_Spec
:= P_Loop_Parameter_Specification
;
3174 if Nkind
(I_Spec
) = N_Loop_Parameter_Specification
then
3175 Set_Loop_Parameter_Specification
(Node1
, I_Spec
);
3177 Set_Iterator_Specification
(Node1
, I_Spec
);
3180 if Token
= Tok_Arrow
then
3182 Set_Condition
(Node1
, P_Expression
);
3185 Error_Msg_AP
("missing arrow");
3188 end P_Quantified_Expression
;
3190 ---------------------------
3191 -- 4.5 Logical Operator --
3192 ---------------------------
3194 -- LOGICAL_OPERATOR ::= and | or | xor
3196 -- Note: AND THEN and OR ELSE are also treated as logical operators
3197 -- by the parser (even though they are not operators semantically)
3199 -- The value returned is the appropriate Node_Kind code for the operator
3200 -- On return, Token points to the token following the scanned operator.
3202 -- The caller has checked that the first token is a legitimate logical
3203 -- operator token (i.e. is either XOR, AND, OR).
3205 -- Error recovery: cannot raise Error_Resync
3207 function P_Logical_Operator
return Node_Kind
is
3209 if Token
= Tok_And
then
3211 Style
.Check_Binary_Operator
;
3216 if Token
= Tok_Then
then
3223 elsif Token
= Tok_Or
then
3225 Style
.Check_Binary_Operator
;
3230 if Token
= Tok_Else
then
3237 else -- Token = Tok_Xor
3239 Style
.Check_Binary_Operator
;
3245 end P_Logical_Operator
;
3247 ------------------------------
3248 -- 4.5 Relational Operator --
3249 ------------------------------
3251 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
3253 -- The value returned is the appropriate Node_Kind code for the operator.
3254 -- On return, Token points to the operator token, NOT past it.
3256 -- The caller has checked that the first token is a legitimate relational
3257 -- operator token (i.e. is one of the operator tokens listed above).
3259 -- Error recovery: cannot raise Error_Resync
3261 function P_Relational_Operator
return Node_Kind
is
3262 Op_Kind
: Node_Kind
;
3263 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
3264 (Tok_Less
=> N_Op_Lt
,
3265 Tok_Equal
=> N_Op_Eq
,
3266 Tok_Greater
=> N_Op_Gt
,
3267 Tok_Not_Equal
=> N_Op_Ne
,
3268 Tok_Greater_Equal
=> N_Op_Ge
,
3269 Tok_Less_Equal
=> N_Op_Le
,
3271 Tok_Not
=> N_Not_In
,
3272 Tok_Box
=> N_Op_Ne
);
3275 if Token
= Tok_Box
then
3276 Error_Msg_SC
-- CODEFIX
3277 ("|""'<'>"" should be ""/=""");
3280 Op_Kind
:= Relop_Node
(Token
);
3283 Style
.Check_Binary_Operator
;
3286 Scan
; -- past operator token
3288 -- Deal with NOT IN, if previous token was NOT, we must have IN now
3290 if Prev_Token
= Tok_Not
then
3292 -- Style check, for NOT IN, we require one space between NOT and IN
3294 if Style_Check
and then Token
= Tok_In
then
3302 end P_Relational_Operator
;
3304 ---------------------------------
3305 -- 4.5 Binary Adding Operator --
3306 ---------------------------------
3308 -- BINARY_ADDING_OPERATOR ::= + | - | &
3310 -- The value returned is the appropriate Node_Kind code for the operator.
3311 -- On return, Token points to the operator token (NOT past it).
3313 -- The caller has checked that the first token is a legitimate adding
3314 -- operator token (i.e. is one of the operator tokens listed above).
3316 -- Error recovery: cannot raise Error_Resync
3318 function P_Binary_Adding_Operator
return Node_Kind
is
3319 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
3320 (Tok_Ampersand
=> N_Op_Concat
,
3321 Tok_Minus
=> N_Op_Subtract
,
3322 Tok_Plus
=> N_Op_Add
);
3324 return Addop_Node
(Token
);
3325 end P_Binary_Adding_Operator
;
3327 --------------------------------
3328 -- 4.5 Unary Adding Operator --
3329 --------------------------------
3331 -- UNARY_ADDING_OPERATOR ::= + | -
3333 -- The value returned is the appropriate Node_Kind code for the operator.
3334 -- On return, Token points to the operator token (NOT past it).
3336 -- The caller has checked that the first token is a legitimate adding
3337 -- operator token (i.e. is one of the operator tokens listed above).
3339 -- Error recovery: cannot raise Error_Resync
3341 function P_Unary_Adding_Operator
return Node_Kind
is
3342 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
3343 (Tok_Minus
=> N_Op_Minus
,
3344 Tok_Plus
=> N_Op_Plus
);
3346 return Addop_Node
(Token
);
3347 end P_Unary_Adding_Operator
;
3349 -------------------------------
3350 -- 4.5 Multiplying Operator --
3351 -------------------------------
3353 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
3355 -- The value returned is the appropriate Node_Kind code for the operator.
3356 -- On return, Token points to the operator token (NOT past it).
3358 -- The caller has checked that the first token is a legitimate multiplying
3359 -- operator token (i.e. is one of the operator tokens listed above).
3361 -- Error recovery: cannot raise Error_Resync
3363 function P_Multiplying_Operator
return Node_Kind
is
3364 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
3365 (Tok_Asterisk
=> N_Op_Multiply
,
3366 Tok_Mod
=> N_Op_Mod
,
3367 Tok_Rem
=> N_Op_Rem
,
3368 Tok_Slash
=> N_Op_Divide
);
3370 return Mulop_Node
(Token
);
3371 end P_Multiplying_Operator
;
3373 --------------------------------------
3374 -- 4.5 Highest Precedence Operator --
3375 --------------------------------------
3377 -- Parsed by P_Factor (4.4)
3379 -- Note: this rule is not in fact used by the grammar at any point
3381 --------------------------
3382 -- 4.6 Type Conversion --
3383 --------------------------
3385 -- Parsed by P_Primary as a Name (4.1)
3387 -------------------------------
3388 -- 4.7 Qualified Expression --
3389 -------------------------------
3391 -- QUALIFIED_EXPRESSION ::=
3392 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
3394 -- The caller has scanned the name which is the Subtype_Mark parameter
3395 -- and scanned past the single quote following the subtype mark. The
3396 -- caller has not checked that this name is in fact appropriate for
3397 -- a subtype mark name (i.e. it is a selected component or identifier).
3399 -- Error_Recovery: cannot raise Error_Resync
3401 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
3402 Qual_Node
: Node_Id
;
3404 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
3405 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
3406 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
3408 end P_Qualified_Expression
;
3410 --------------------
3412 --------------------
3415 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
3416 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
3418 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
3420 -- The caller has checked that the initial token is NEW
3422 -- Error recovery: can raise Error_Resync
3424 function P_Allocator
return Node_Id
is
3425 Alloc_Node
: Node_Id
;
3426 Type_Node
: Node_Id
;
3427 Null_Exclusion_Present
: Boolean;
3430 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
3433 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
3435 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
3437 if Token
= Tok_Left_Paren
then
3439 Set_Subpool_Handle_Name
(Alloc_Node
, P_Name
);
3442 Error_Msg_Ada_2012_Feature
3443 ("|subpool specification",
3444 Sloc
(Subpool_Handle_Name
(Alloc_Node
)));
3447 Null_Exclusion_Present
:= P_Null_Exclusion
;
3448 Set_Null_Exclusion_Present
(Alloc_Node
, Null_Exclusion_Present
);
3449 Type_Node
:= P_Subtype_Mark_Resync
;
3451 if Token
= Tok_Apostrophe
then
3452 Scan
; -- past apostrophe
3453 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
3457 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));
3459 -- AI05-0104: An explicit null exclusion is not allowed for an
3460 -- allocator without initialization. In previous versions of the
3461 -- language it just raises constraint error.
3463 if Ada_Version
>= Ada_2012
and then Null_Exclusion_Present
then
3465 ("an allocator with a subtype indication "
3466 & "cannot have a null exclusion", Alloc_Node
);
3473 -----------------------
3474 -- P_Case_Expression --
3475 -----------------------
3477 function P_Case_Expression
return Node_Id
is
3478 Loc
: constant Source_Ptr
:= Token_Ptr
;
3479 Case_Node
: Node_Id
;
3480 Save_State
: Saved_Scan_State
;
3483 Error_Msg_Ada_2012_Feature
("|case expression", Token_Ptr
);
3486 Make_Case_Expression
(Loc
,
3487 Expression
=> P_Expression_No_Right_Paren
,
3488 Alternatives
=> New_List
);
3491 -- We now have scanned out CASE expression IS, scan alternatives
3495 Append_To
(Alternatives
(Case_Node
), P_Case_Expression_Alternative
);
3497 -- Missing comma if WHEN (more alternatives present)
3499 if Token
= Tok_When
then
3502 -- A semicolon followed by "when" is probably meant to be a comma
3504 elsif Token
= Tok_Semicolon
then
3505 Save_Scan_State
(Save_State
);
3506 Scan
; -- past the semicolon
3508 if Token
/= Tok_When
then
3509 Restore_Scan_State
(Save_State
);
3513 Error_Msg_SP
-- CODEFIX
3514 ("|"";"" should be "",""");
3516 -- If comma/WHEN, skip comma and we have another alternative
3518 elsif Token
= Tok_Comma
then
3519 Save_Scan_State
(Save_State
);
3522 if Token
/= Tok_When
then
3523 Restore_Scan_State
(Save_State
);
3527 -- If no comma or WHEN, definitely done
3534 -- If we have an END CASE, diagnose as not needed
3536 if Token
= Tok_End
then
3537 Error_Msg_SC
("`END CASE` not allowed at end of case expression");
3540 if Token
= Tok_Case
then
3545 -- Return the Case_Expression node
3548 end P_Case_Expression
;
3550 -----------------------------------
3551 -- P_Case_Expression_Alternative --
3552 -----------------------------------
3554 -- CASE_STATEMENT_ALTERNATIVE ::=
3555 -- when DISCRETE_CHOICE_LIST =>
3558 -- The caller has checked that and scanned past the initial WHEN token
3559 -- Error recovery: can raise Error_Resync
3561 function P_Case_Expression_Alternative
return Node_Id
is
3562 Case_Alt_Node
: Node_Id
;
3564 Case_Alt_Node
:= New_Node
(N_Case_Expression_Alternative
, Token_Ptr
);
3565 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
3567 Set_Expression
(Case_Alt_Node
, P_Expression
);
3568 return Case_Alt_Node
;
3569 end P_Case_Expression_Alternative
;
3571 --------------------------------------
3572 -- P_Iterated_Component_Association --
3573 --------------------------------------
3575 -- ITERATED_COMPONENT_ASSOCIATION ::=
3576 -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
3577 -- for ITERATOR_SPECIFICATION => EXPRESSION
3579 function P_Iterated_Component_Association
return Node_Id
is
3580 Assoc_Node
: Node_Id
;
3582 Filter
: Node_Id
:= Empty
;
3584 Iter_Spec
: Node_Id
;
3585 Loop_Spec
: Node_Id
;
3586 State
: Saved_Scan_State
;
3588 procedure Build_Iterated_Element_Association
;
3589 -- If the iterator includes a key expression or a filter, it is
3590 -- an Ada 2022 Iterator_Element_Association within a container
3593 ----------------------------------------
3594 -- Build_Iterated_Element_Association --
3595 ----------------------------------------
3597 procedure Build_Iterated_Element_Association
is
3599 -- Build loop_parameter_specification
3602 New_Node
(N_Loop_Parameter_Specification
, Prev_Token_Ptr
);
3603 Set_Defining_Identifier
(Loop_Spec
, Id
);
3605 Choice
:= First
(Discrete_Choices
(Assoc_Node
));
3607 New_Node
(N_Iterated_Element_Association
, Prev_Token_Ptr
);
3608 Set_Loop_Parameter_Specification
(Assoc_Node
, Loop_Spec
);
3610 if Present
(Next
(Choice
)) then
3611 Error_Msg_N
("expect loop parameter specification", Choice
);
3615 Set_Discrete_Subtype_Definition
(Loop_Spec
, Choice
);
3616 Set_Iterator_Filter
(Loop_Spec
, Filter
);
3617 end Build_Iterated_Element_Association
;
3619 -- Start of processing for P_Iterated_Component_Association
3623 Save_Scan_State
(State
);
3625 -- A lookahead is necessary to differentiate between the
3626 -- Ada 2012 form with a choice list, and the Ada 2022 element
3627 -- iterator form, recognized by the presence of "OF". Other
3628 -- disambiguation requires context and is done during semantic
3629 -- analysis. Note that "for X in E" is syntactically ambiguous:
3630 -- if E is a subtype indication this is a loop parameter spec,
3631 -- while if E a name it is an iterator_specification, and the
3632 -- disambiguation takes place during semantic analysis.
3633 -- In addition, if "use" is present after the specification,
3634 -- this is an Iterated_Element_Association that carries a
3635 -- key_expression, and we generate the appropriate node.
3636 -- Finally, the Iterated_Element form is reserved for container
3637 -- aggregates, and is illegal in array aggregates.
3639 Id
:= P_Defining_Identifier
;
3641 New_Node
(N_Iterated_Component_Association
, Prev_Token_Ptr
);
3645 Set_Defining_Identifier
(Assoc_Node
, Id
);
3647 Set_Discrete_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
3649 -- The iterator may include a filter
3651 if Token
= Tok_When
then
3653 Filter
:= P_Condition
;
3656 if Token
= Tok_Use
then
3658 -- Ada 2022 Key-expression is present, rewrite node as an
3659 -- Iterated_Element_Association.
3662 Build_Iterated_Element_Association
;
3663 Set_Key_Expression
(Assoc_Node
, P_Expression
);
3665 elsif Present
(Filter
) then
3666 -- A loop_parameter_specification also indicates an Ada 2022
3667 -- construct, in contrast with a subtype indication used in
3668 -- array aggregates.
3670 Build_Iterated_Element_Association
;
3674 Set_Expression
(Assoc_Node
, P_Expression
);
3677 Restore_Scan_State
(State
);
3679 Iter_Spec
:= P_Iterator_Specification
(Id
);
3680 Set_Iterator_Specification
(Assoc_Node
, Iter_Spec
);
3682 if Token
= Tok_Use
then
3684 -- This is an iterated_element_association
3687 New_Node
(N_Iterated_Element_Association
, Prev_Token_Ptr
);
3688 Set_Iterator_Specification
(Assoc_Node
, Iter_Spec
);
3689 Set_Key_Expression
(Assoc_Node
, P_Expression
);
3693 Set_Expression
(Assoc_Node
, P_Expression
);
3696 Error_Msg_AP
("missing IN or OF");
3700 end P_Iterated_Component_Association
;
3702 ---------------------
3703 -- P_If_Expression --
3704 ---------------------
3706 -- IF_EXPRESSION ::=
3707 -- if CONDITION then DEPENDENT_EXPRESSION
3708 -- {elsif CONDITION then DEPENDENT_EXPRESSION}
3709 -- [else DEPENDENT_EXPRESSION]
3711 -- DEPENDENT_EXPRESSION ::= EXPRESSION
3713 function P_If_Expression
return Node_Id
is
3714 function P_If_Expression_Internal
3716 Cond
: Node_Id
) return Node_Id
;
3717 -- This is the internal recursive routine that does all the work, it is
3718 -- recursive since it is used to process ELSIF parts, which internally
3719 -- are N_If_Expression nodes with the Is_Elsif flag set. The calling
3720 -- sequence is like the outer function except that the caller passes
3721 -- the conditional expression (scanned using P_Expression), and the
3722 -- scan pointer points just past this expression. Loc points to the
3723 -- IF or ELSIF token.
3725 ------------------------------
3726 -- P_If_Expression_Internal --
3727 ------------------------------
3729 function P_If_Expression_Internal
3731 Cond
: Node_Id
) return Node_Id
3733 Exprs
: constant List_Id
:= New_List
;
3735 State
: Saved_Scan_State
;
3739 -- All cases except where we are at right paren
3741 if Token
/= Tok_Right_Paren
then
3743 Append_To
(Exprs
, P_Condition
(Cond
));
3744 Append_To
(Exprs
, P_Expression
);
3746 -- Case of right paren (missing THEN phrase). Note that we know this
3747 -- is the IF case, since the caller dealt with this possibility in
3751 Error_Msg_BC
("missing THEN phrase");
3752 Append_To
(Exprs
, P_Condition
(Cond
));
3755 -- We now have scanned out IF expr THEN expr
3757 -- Check for common error of semicolon before the ELSE
3759 if Token
= Tok_Semicolon
then
3760 Save_Scan_State
(State
);
3761 Scan
; -- past semicolon
3763 if Token
in Tok_Else | Tok_Elsif
then
3764 Error_Msg_SP
-- CODEFIX
3765 ("|extra "";"" ignored");
3768 Restore_Scan_State
(State
);
3772 -- Scan out ELSIF sequence if present
3774 if Token
= Tok_Elsif
then
3777 Expr
:= P_Expression
;
3779 -- If we are at a right paren, we assume the ELSIF should be ELSE
3781 if Token
= Tok_Right_Paren
then
3782 Error_Msg
("ELSIF should be ELSE", Eptr
);
3783 Append_To
(Exprs
, Expr
);
3785 -- Otherwise we have an OK ELSIF
3788 Expr
:= P_If_Expression_Internal
(Eptr
, Expr
);
3789 Set_Is_Elsif
(Expr
);
3790 Append_To
(Exprs
, Expr
);
3793 -- Scan out ELSE phrase if present
3795 elsif Token
= Tok_Else
then
3797 -- Scan out ELSE expression
3800 Append_To
(Exprs
, P_Expression
);
3802 -- Skip redundant ELSE parts
3804 while Token
= Tok_Else
loop
3805 Error_Msg_SC
("only one ELSE part is allowed");
3807 Discard_Junk_Node
(P_Expression
);
3810 -- Two expression case (implied True, filled in during semantics)
3816 -- If we have an END IF, diagnose as not needed
3818 if Token
= Tok_End
then
3819 Error_Msg_SC
("`END IF` not allowed at end of if expression");
3822 if Token
= Tok_If
then
3827 -- Return the If_Expression node
3829 return Make_If_Expression
(Loc
, Expressions
=> Exprs
);
3830 end P_If_Expression_Internal
;
3834 Loc
: constant Source_Ptr
:= Token_Ptr
;
3837 -- Start of processing for P_If_Expression
3840 Error_Msg_Ada_2012_Feature
("|if expression", Token_Ptr
);
3842 Inside_If_Expression
:= Inside_If_Expression
+ 1;
3843 If_Expr
:= P_If_Expression_Internal
(Loc
, P_Expression
);
3844 Inside_If_Expression
:= Inside_If_Expression
- 1;
3846 end P_If_Expression
;
3848 --------------------------
3849 -- P_Declare_Expression --
3850 --------------------------
3852 -- DECLARE_EXPRESSION ::=
3853 -- DECLARE {DECLARE_ITEM}
3854 -- begin BODY_EXPRESSION
3856 -- DECLARE_ITEM ::= OBJECT_DECLARATION
3857 -- | OBJECT_RENAMING_DECLARATION
3859 function P_Declare_Expression
return Node_Id
is
3860 Loc
: constant Source_Ptr
:= Token_Ptr
;
3862 Scan
; -- past DECLARE
3865 Actions
: constant List_Id
:= P_Basic_Declarative_Items
3866 (Declare_Expression
=> True);
3867 -- Most declarative items allowed by P_Basic_Declarative_Items are
3868 -- illegal; semantic analysis will deal with that.
3870 if Token
= Tok_Begin
then
3873 Error_Msg_SC
-- CODEFIX
3874 ("BEGIN expected!");
3878 Expression
: constant Node_Id
:= P_Expression
;
3879 Result
: constant Node_Id
:=
3880 Make_Expression_With_Actions
(Loc
, Actions
, Expression
);
3882 Error_Msg_Ada_2022_Feature
("declare expression", Loc
);
3887 end P_Declare_Expression
;
3889 -----------------------
3890 -- P_Membership_Test --
3891 -----------------------
3893 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERSHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3894 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3896 procedure P_Membership_Test
(N
: Node_Id
) is
3897 Alt
: constant Node_Id
:=
3898 P_Range_Or_Subtype_Mark
3899 (Allow_Simple_Expression
=> (Ada_Version
>= Ada_2012
));
3904 if Token
= Tok_Vertical_Bar
then
3905 Error_Msg_Ada_2012_Feature
("set notation", Token_Ptr
);
3906 Set_Alternatives
(N
, New_List
(Alt
));
3907 Set_Right_Opnd
(N
, Empty
);
3909 -- Loop to accumulate alternatives
3911 while Token
= Tok_Vertical_Bar
loop
3912 Scan
; -- past vertical bar
3915 P_Range_Or_Subtype_Mark
(Allow_Simple_Expression
=> True));
3921 Set_Right_Opnd
(N
, Alt
);
3922 Set_Alternatives
(N
, No_List
);
3924 end P_Membership_Test
;
3926 -----------------------------
3927 -- P_Unparen_Cond_Expr_Etc --
3928 -----------------------------
3930 function P_Unparen_Cond_Expr_Etc
return Node_Id
is
3931 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
3934 Scan_State
: Saved_Scan_State
;
3939 if Token
= Tok_Case
then
3940 Result
:= P_Case_Expression
;
3942 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3943 Error_Msg_N
("case expression must be parenthesized!", Result
);
3948 elsif Token
= Tok_If
then
3949 Result
:= P_If_Expression
;
3951 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3952 Error_Msg_N
("if expression must be parenthesized!", Result
);
3955 -- Quantified expression or iterated component association
3957 elsif Token
= Tok_For
then
3959 Save_Scan_State
(Scan_State
);
3962 if Token
in Tok_All | Tok_Some
then
3963 Restore_Scan_State
(Scan_State
);
3964 Result
:= P_Quantified_Expression
;
3966 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3968 ("quantified expression must be parenthesized!", Result
);
3972 -- If no quantifier keyword, this is an iterated component in
3975 Restore_Scan_State
(Scan_State
);
3976 Result
:= P_Iterated_Component_Association
;
3979 -- Declare expression
3981 elsif Token
= Tok_Declare
then
3982 Result
:= P_Declare_Expression
;
3984 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3985 Error_Msg_N
("declare expression must be parenthesized!", Result
);
3988 -- No other possibility should exist (caller was supposed to check)
3991 raise Program_Error
;
3994 -- Return expression (possibly after having given message)
3997 end P_Unparen_Cond_Expr_Etc
;