1 -----------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 pragma Style_Checks
(All_Checks
);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
30 with Stringt
; use Stringt
;
35 -- Attributes that cannot have arguments
37 Is_Parameterless_Attribute
: constant Attribute_Class_Array
:=
38 (Attribute_Base
=> True,
39 Attribute_Body_Version
=> True,
40 Attribute_Class
=> True,
41 Attribute_External_Tag
=> True,
42 Attribute_Img
=> True,
43 Attribute_Loop_Entry
=> True,
44 Attribute_Old
=> True,
45 Attribute_Result
=> True,
46 Attribute_Stub_Type
=> True,
47 Attribute_Version
=> True,
48 Attribute_Type_Key
=> True,
50 -- This map contains True for parameterless attributes that return a string
51 -- or a type. For those attributes, a left parenthesis after the attribute
52 -- should not be analyzed as the beginning of a parameters list because it
53 -- may denote a slice operation (X'Img (1 .. 2)) or a type conversion
54 -- (X'Class (Y)). The Ada 2012 attribute 'Old is in this category.
56 -- Note: Loop_Entry is in this list because, although it can take an
57 -- optional argument (the loop name), we can't distinguish that at parse
58 -- time from the case where no loop name is given and a legitimate index
59 -- expression is present. So we parse the argument as an indexed component
60 -- and the semantic analysis sorts out this syntactic ambiguity based on
61 -- the type and form of the expression.
63 -- Note that this map designates the minimum set of attributes where a
64 -- construct in parentheses that is not an argument can appear right
65 -- after the attribute. For attributes like 'Size, we do not put them
66 -- in the map. If someone writes X'Size (3), that's illegal in any case,
67 -- but we get a better error message by parsing the (3) as an illegal
68 -- argument to the attribute, rather than some meaningless junk that
69 -- follows the attribute.
71 -----------------------
72 -- Local Subprograms --
73 -----------------------
75 function P_Aggregate_Or_Paren_Expr
return Node_Id
;
76 function P_Allocator
return Node_Id
;
77 function P_Case_Expression_Alternative
return Node_Id
;
78 function P_Iterated_Component_Association
return Node_Id
;
79 function P_Record_Or_Array_Component_Association
return Node_Id
;
80 function P_Factor
return Node_Id
;
81 function P_Primary
return Node_Id
;
82 function P_Relation
return Node_Id
;
83 function P_Term
return Node_Id
;
85 function P_Binary_Adding_Operator
return Node_Kind
;
86 function P_Logical_Operator
return Node_Kind
;
87 function P_Multiplying_Operator
return Node_Kind
;
88 function P_Relational_Operator
return Node_Kind
;
89 function P_Unary_Adding_Operator
return Node_Kind
;
91 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
);
92 -- Called to place complaint about bad range attribute at the given
93 -- source location. Terminates by raising Error_Resync.
95 procedure Check_Bad_Exp
;
96 -- Called after scanning a**b, posts error if ** detected
98 procedure P_Membership_Test
(N
: Node_Id
);
99 -- N is the node for a N_In or N_Not_In node whose right operand has not
100 -- yet been processed. It is called just after scanning out the IN keyword.
101 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
103 function P_Range_Attribute_Reference
(Prefix_Node
: Node_Id
) return Node_Id
;
104 -- Scan a range attribute reference. The caller has scanned out the
105 -- prefix. The current token is known to be an apostrophe and the
106 -- following token is known to be RANGE.
108 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
;
109 -- This function is called with Token pointing to IF, CASE, or FOR, in a
110 -- context that allows a case, conditional, or quantified expression if
111 -- it is surrounded by parentheses. If not surrounded by parentheses, the
112 -- expression is still returned, but an error message is issued.
114 -------------------------
115 -- Bad_Range_Attribute --
116 -------------------------
118 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
120 Error_Msg
("range attribute cannot be used in expression!", Loc
);
122 end Bad_Range_Attribute
;
128 procedure Check_Bad_Exp
is
130 if Token
= Tok_Double_Asterisk
then
131 Error_Msg_SC
("parenthesization required for '*'*");
133 Discard_Junk_Node
(P_Primary
);
138 --------------------------
139 -- 4.1 Name (also 6.4) --
140 --------------------------
143 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
144 -- | INDEXED_COMPONENT | SLICE
145 -- | SELECTED_COMPONENT | ATTRIBUTE
146 -- | TYPE_CONVERSION | FUNCTION_CALL
147 -- | CHARACTER_LITERAL | TARGET_NAME
149 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
151 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
153 -- EXPLICIT_DEREFERENCE ::= NAME . all
155 -- IMPLICIT_DEREFERENCE ::= NAME
157 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
159 -- SLICE ::= PREFIX (DISCRETE_RANGE)
161 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
163 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
165 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
167 -- ATTRIBUTE_DESIGNATOR ::=
168 -- IDENTIFIER [(static_EXPRESSION)]
169 -- | access | delta | digits
173 -- | function_PREFIX ACTUAL_PARAMETER_PART
175 -- ACTUAL_PARAMETER_PART ::=
176 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
178 -- PARAMETER_ASSOCIATION ::=
179 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
181 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
183 -- TARGET_NAME ::= @ (AI12-0125-3: abbreviation for LHS)
185 -- Note: syntactically a procedure call looks just like a function call,
186 -- so this routine is in practice used to scan out procedure calls as well.
188 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
190 -- Error recovery: can raise Error_Resync
192 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
193 -- followed by either a left paren (qualified expression case), or by
194 -- range (range attribute case). All other uses of apostrophe (i.e. all
195 -- other attributes) are handled in this routine.
197 -- Error recovery: can raise Error_Resync
199 function P_Name
return Node_Id
is
200 Scan_State
: Saved_Scan_State
;
202 Prefix_Node
: Node_Id
;
203 Ident_Node
: Node_Id
;
205 Range_Node
: Node_Id
;
208 Arg_List
: List_Id
:= No_List
; -- kill junk warning
209 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
212 -- Case of not a name
214 if Token
not in Token_Class_Name
then
216 -- If it looks like start of expression, complain and scan expression
218 if Token
in Token_Class_Literal
219 or else Token
= Tok_Left_Paren
221 Error_Msg_SC
("name expected");
224 -- Otherwise some other junk, not much we can do
227 Error_Msg_AP
("name expected");
232 -- Loop through designators in qualified name
233 -- AI12-0125 : target_name
235 if Token
= Tok_At_Sign
then
236 Scan_Reserved_Identifier
(Force_Msg
=> False);
238 if Present
(Current_Assign_Node
) then
239 Set_Has_Target_Names
(Current_Assign_Node
);
243 Name_Node
:= Token_Node
;
246 Scan
; -- past designator
247 exit when Token
/= Tok_Dot
;
248 Save_Scan_State
(Scan_State
); -- at dot
251 -- If we do not have another designator after the dot, then join
252 -- the normal circuit to handle a dot extension (may be .all or
253 -- character literal case). Otherwise loop back to scan the next
256 if Token
not in Token_Class_Desig
then
257 goto Scan_Name_Extension_Dot
;
259 Prefix_Node
:= Name_Node
;
260 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
261 Set_Prefix
(Name_Node
, Prefix_Node
);
262 Set_Selector_Name
(Name_Node
, Token_Node
);
266 -- We have now scanned out a qualified designator. If the last token is
267 -- an operator symbol, then we certainly do not have the Snam case, so
268 -- we can just use the normal name extension check circuit
270 if Prev_Token
= Tok_Operator_Symbol
then
271 goto Scan_Name_Extension
;
274 -- We have scanned out a qualified simple name, check for name extension
275 -- Note that we know there is no dot here at this stage, so the only
276 -- possible cases of name extension are apostrophe and left paren.
278 if Token
= Tok_Apostrophe
then
279 Save_Scan_State
(Scan_State
); -- at apostrophe
280 Scan
; -- past apostrophe
282 -- Qualified expression in Ada 2012 mode (treated as a name)
284 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
285 goto Scan_Name_Extension_Apostrophe
;
287 -- If left paren not in Ada 2012, then it is not part of the name,
288 -- since qualified expressions are not names in prior versions of
289 -- Ada, so return with Token backed up to point to the apostrophe.
290 -- The treatment for the range attribute is similar (we do not
291 -- consider x'range to be a name in this grammar).
293 elsif Token
= Tok_Left_Paren
or else Token
= Tok_Range
then
294 Restore_Scan_State
(Scan_State
); -- to apostrophe
295 Expr_Form
:= EF_Simple_Name
;
298 -- Otherwise we have the case of a name extended by an attribute
301 goto Scan_Name_Extension_Apostrophe
;
304 -- Check case of qualified simple name extended by a left parenthesis
306 elsif Token
= Tok_Left_Paren
then
307 Scan
; -- past left paren
308 goto Scan_Name_Extension_Left_Paren
;
310 -- Otherwise the qualified simple name is not extended, so return
313 Expr_Form
:= EF_Simple_Name
;
317 -- Loop scanning past name extensions. A label is used for control
318 -- transfer for this loop for ease of interfacing with the finite state
319 -- machine in the parenthesis scanning circuit, and also to allow for
320 -- passing in control to the appropriate point from the above code.
322 <<Scan_Name_Extension
>>
324 -- Character literal used as name cannot be extended. Also this
325 -- cannot be a call, since the name for a call must be a designator.
326 -- Return in these cases, or if there is no name extension
328 if Token
not in Token_Class_Namext
329 or else Prev_Token
= Tok_Char_Literal
331 Expr_Form
:= EF_Name
;
335 -- Merge here when we know there is a name extension
337 <<Scan_Name_Extension_OK
>>
339 if Token
= Tok_Left_Paren
then
340 Scan
; -- past left paren
341 goto Scan_Name_Extension_Left_Paren
;
343 elsif Token
= Tok_Apostrophe
then
344 Save_Scan_State
(Scan_State
); -- at apostrophe
345 Scan
; -- past apostrophe
346 goto Scan_Name_Extension_Apostrophe
;
348 else -- Token = Tok_Dot
349 Save_Scan_State
(Scan_State
); -- at dot
351 goto Scan_Name_Extension_Dot
;
354 -- Case of name extended by dot (selection), dot is already skipped
355 -- and the scan state at the point of the dot is saved in Scan_State.
357 <<Scan_Name_Extension_Dot
>>
359 -- Explicit dereference case
361 if Token
= Tok_All
then
362 Prefix_Node
:= Name_Node
;
363 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
364 Set_Prefix
(Name_Node
, Prefix_Node
);
366 goto Scan_Name_Extension
;
368 -- Selected component case
370 elsif Token
in Token_Class_Name
then
371 Prefix_Node
:= Name_Node
;
372 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
373 Set_Prefix
(Name_Node
, Prefix_Node
);
374 Set_Selector_Name
(Name_Node
, Token_Node
);
375 Scan
; -- past selector
376 goto Scan_Name_Extension
;
378 -- Reserved identifier as selector
380 elsif Is_Reserved_Identifier
then
381 Scan_Reserved_Identifier
(Force_Msg
=> False);
382 Prefix_Node
:= Name_Node
;
383 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
384 Set_Prefix
(Name_Node
, Prefix_Node
);
385 Set_Selector_Name
(Name_Node
, Token_Node
);
386 Scan
; -- past identifier used as selector
387 goto Scan_Name_Extension
;
389 -- If dot is at end of line and followed by nothing legal,
390 -- then assume end of name and quit (dot will be taken as
391 -- an incorrect form of some other punctuation by our caller).
393 elsif Token_Is_At_Start_Of_Line
then
394 Restore_Scan_State
(Scan_State
);
397 -- Here if nothing legal after the dot
400 Error_Msg_AP
("selector expected");
404 -- Here for an apostrophe as name extension. The scan position at the
405 -- apostrophe has already been saved, and the apostrophe scanned out.
407 <<Scan_Name_Extension_Apostrophe
>>
409 Scan_Apostrophe
: declare
410 function Apostrophe_Should_Be_Semicolon
return Boolean;
411 -- Checks for case where apostrophe should probably be
412 -- a semicolon, and if so, gives appropriate message,
413 -- resets the scan pointer to the apostrophe, changes
414 -- the current token to Tok_Semicolon, and returns True.
415 -- Otherwise returns False.
417 ------------------------------------
418 -- Apostrophe_Should_Be_Semicolon --
419 ------------------------------------
421 function Apostrophe_Should_Be_Semicolon
return Boolean is
423 if Token_Is_At_Start_Of_Line
then
424 Restore_Scan_State
(Scan_State
); -- to apostrophe
425 Error_Msg_SC
("|""''"" should be "";""");
426 Token
:= Tok_Semicolon
;
431 end Apostrophe_Should_Be_Semicolon
;
433 -- Start of processing for Scan_Apostrophe
436 -- Check for qualified expression case in Ada 2012 mode
438 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
439 Name_Node
:= P_Qualified_Expression
(Name_Node
);
440 goto Scan_Name_Extension
;
442 -- If range attribute after apostrophe, then return with Token
443 -- pointing to the apostrophe. Note that in this case the prefix
444 -- need not be a simple name (cases like A.all'range). Similarly
445 -- if there is a left paren after the apostrophe, then we also
446 -- return with Token pointing to the apostrophe (this is the
447 -- aggregate case, or some error case).
449 elsif Token
= Tok_Range
or else Token
= Tok_Left_Paren
then
450 Restore_Scan_State
(Scan_State
); -- to apostrophe
451 Expr_Form
:= EF_Name
;
454 -- Here for cases where attribute designator is an identifier
456 elsif Token
= Tok_Identifier
then
457 Attr_Name
:= Token_Name
;
459 if not Is_Attribute_Name
(Attr_Name
) then
460 if Apostrophe_Should_Be_Semicolon
then
461 Expr_Form
:= EF_Name
;
464 -- Here for a bad attribute name
467 Signal_Bad_Attribute
;
468 Scan
; -- past bad identifier
470 if Token
= Tok_Left_Paren
then
471 Scan
; -- past left paren
474 Discard_Junk_Node
(P_Expression_If_OK
);
475 exit when not Comma_Present
;
486 Style
.Check_Attribute_Name
(False);
489 -- Here for case of attribute designator is not an identifier
492 if Token
= Tok_Delta
then
493 Attr_Name
:= Name_Delta
;
495 elsif Token
= Tok_Digits
then
496 Attr_Name
:= Name_Digits
;
498 elsif Token
= Tok_Access
then
499 Attr_Name
:= Name_Access
;
501 elsif Token
= Tok_Mod
and then Ada_Version
>= Ada_95
then
502 Attr_Name
:= Name_Mod
;
504 elsif Apostrophe_Should_Be_Semicolon
then
505 Expr_Form
:= EF_Name
;
509 Error_Msg_AP
("attribute designator expected");
514 Style
.Check_Attribute_Name
(True);
518 -- We come here with an OK attribute scanned, and corresponding
519 -- Attribute identifier node stored in Ident_Node.
521 Prefix_Node
:= Name_Node
;
522 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
523 Scan
; -- past attribute designator
524 Set_Prefix
(Name_Node
, Prefix_Node
);
525 Set_Attribute_Name
(Name_Node
, Attr_Name
);
527 -- Scan attribute arguments/designator. We skip this if we know
528 -- that the attribute cannot have an argument (see documentation
529 -- of Is_Parameterless_Attribute for further details).
531 if Token
= Tok_Left_Paren
533 Is_Parameterless_Attribute
(Get_Attribute_Id
(Attr_Name
))
535 -- Attribute Update contains an array or record association
536 -- list which provides new values for various components or
537 -- elements. The list is parsed as an aggregate, and we get
538 -- better error handling by knowing that in the parser.
540 if Attr_Name
= Name_Update
then
541 Set_Expressions
(Name_Node
, New_List
);
542 Append
(P_Aggregate
, Expressions
(Name_Node
));
544 -- All other cases of parsing attribute arguments
547 Set_Expressions
(Name_Node
, New_List
);
548 Scan
; -- past left paren
552 Expr
: constant Node_Id
:= P_Expression_If_OK
;
556 -- Case of => for named notation
558 if Token
= Tok_Arrow
then
560 -- Named notation allowed only for the special
561 -- case of System'Restriction_Set (No_Dependence =>
562 -- unit_NAME), in which case construct a parameter
563 -- assocation node and append to the arguments.
565 if Attr_Name
= Name_Restriction_Set
566 and then Nkind
(Expr
) = N_Identifier
567 and then Chars
(Expr
) = Name_No_Dependence
571 Append_To
(Expressions
(Name_Node
),
572 Make_Parameter_Association
(Sloc
(Rnam
),
573 Selector_Name
=> Expr
,
574 Explicit_Actual_Parameter
=> Rnam
));
577 -- For all other cases named notation is illegal
581 ("named parameters not permitted "
583 Scan
; -- past junk arrow
586 -- Here for normal case (not => for named parameter)
589 -- Special handling for 'Image in Ada 2012, where
590 -- the attribute can be parameterless and its value
591 -- can be the prefix of a slice. Rewrite name as a
592 -- slice, Expr is its low bound.
594 if Token
= Tok_Dot_Dot
595 and then Attr_Name
= Name_Image
596 and then Ada_Version
>= Ada_2012
598 Set_Expressions
(Name_Node
, No_List
);
599 Prefix_Node
:= Name_Node
;
601 New_Node
(N_Slice
, Sloc
(Prefix_Node
));
602 Set_Prefix
(Name_Node
, Prefix_Node
);
603 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
604 Set_Low_Bound
(Range_Node
, Expr
);
606 Expr_Node
:= P_Expression
;
607 Check_Simple_Expression
(Expr_Node
);
608 Set_High_Bound
(Range_Node
, Expr_Node
);
609 Set_Discrete_Range
(Name_Node
, Range_Node
);
612 goto Scan_Name_Extension
;
615 Append
(Expr
, Expressions
(Name_Node
));
616 exit when not Comma_Present
;
626 goto Scan_Name_Extension
;
629 -- Here for left parenthesis extending name (left paren skipped)
631 <<Scan_Name_Extension_Left_Paren
>>
633 -- We now have to scan through a list of items, terminated by a
634 -- right parenthesis. The scan is handled by a finite state
635 -- machine. The possibilities are:
639 -- This is a slice. This case is handled in LP_State_Init
641 -- (expression, expression, ..)
643 -- This is interpreted as an indexed component, i.e. as a
644 -- case of a name which can be extended in the normal manner.
645 -- This case is handled by LP_State_Name or LP_State_Expr.
647 -- Note: if and case expressions (without an extra level of
648 -- parentheses) are permitted in this context).
650 -- (..., identifier => expression , ...)
652 -- If there is at least one occurrence of identifier => (but
653 -- none of the other cases apply), then we have a call.
655 -- Test for Id => case
657 if Token
= Tok_Identifier
then
658 Save_Scan_State
(Scan_State
); -- at Id
661 -- Test for => (allow := as an error substitute)
663 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
664 Restore_Scan_State
(Scan_State
); -- to Id
665 Arg_List
:= New_List
;
669 Restore_Scan_State
(Scan_State
); -- to Id
673 -- Here we have an expression after all
675 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
677 -- Check cases of discrete range for a slice
679 -- First possibility: Range_Attribute_Reference
681 if Expr_Form
= EF_Range_Attr
then
682 Range_Node
:= Expr_Node
;
684 -- Second possibility: Simple_expression .. Simple_expression
686 elsif Token
= Tok_Dot_Dot
then
687 Check_Simple_Expression
(Expr_Node
);
688 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
689 Set_Low_Bound
(Range_Node
, Expr_Node
);
691 Expr_Node
:= P_Expression
;
692 Check_Simple_Expression
(Expr_Node
);
693 Set_High_Bound
(Range_Node
, Expr_Node
);
695 -- Third possibility: Type_name range Range
697 elsif Token
= Tok_Range
then
698 if Expr_Form
/= EF_Simple_Name
then
699 Error_Msg_SC
("subtype mark must precede RANGE");
703 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
705 -- Otherwise we just have an expression. It is true that we might
706 -- have a subtype mark without a range constraint but this case
707 -- is syntactically indistinguishable from the expression case.
710 Arg_List
:= New_List
;
714 -- Fall through here with unmistakable Discrete range scanned,
715 -- which means that we definitely have the case of a slice. The
716 -- Discrete range is in Range_Node.
718 if Token
= Tok_Comma
then
719 Error_Msg_SC
("slice cannot have more than one dimension");
722 elsif Token
/= Tok_Right_Paren
then
723 if Token
= Tok_Arrow
then
725 -- This may be an aggregate that is missing a qualification
728 ("context of aggregate must be a qualified expression");
737 Scan
; -- past right paren
738 Prefix_Node
:= Name_Node
;
739 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
740 Set_Prefix
(Name_Node
, Prefix_Node
);
741 Set_Discrete_Range
(Name_Node
, Range_Node
);
743 -- An operator node is legal as a prefix to other names,
744 -- but not for a slice.
746 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
747 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
750 -- If we have a name extension, go scan it
752 if Token
in Token_Class_Namext
then
753 goto Scan_Name_Extension_OK
;
755 -- Otherwise return (a slice is a name, but is not a call)
758 Expr_Form
:= EF_Name
;
763 -- In LP_State_Expr, we have scanned one or more expressions, and
764 -- so we have a call or an indexed component which is a name. On
765 -- entry we have the expression just scanned in Expr_Node and
766 -- Arg_List contains the list of expressions encountered so far
769 Append
(Expr_Node
, Arg_List
);
771 if Token
= Tok_Arrow
then
773 ("expect identifier in parameter association", Sloc
(Expr_Node
));
776 elsif not Comma_Present
then
779 Prefix_Node
:= Name_Node
;
780 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
781 Set_Prefix
(Name_Node
, Prefix_Node
);
782 Set_Expressions
(Name_Node
, Arg_List
);
784 goto Scan_Name_Extension
;
787 -- Comma present (and scanned out), test for identifier => case
788 -- Test for identifier => case
790 if Token
= Tok_Identifier
then
791 Save_Scan_State
(Scan_State
); -- at Id
794 -- Test for => (allow := as error substitute)
796 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
797 Restore_Scan_State
(Scan_State
); -- to Id
800 -- Otherwise it's just an expression after all, so backup
803 Restore_Scan_State
(Scan_State
); -- to Id
807 -- Here we have an expression after all, so stay in this state
809 Expr_Node
:= P_Expression_If_OK
;
812 -- LP_State_Call corresponds to the situation in which at least one
813 -- instance of Id => Expression has been encountered, so we know that
814 -- we do not have a name, but rather a call. We enter it with the
815 -- scan pointer pointing to the next argument to scan, and Arg_List
816 -- containing the list of arguments scanned so far.
820 -- Test for case of Id => Expression (named parameter)
822 if Token
= Tok_Identifier
then
823 Save_Scan_State
(Scan_State
); -- at Id
824 Ident_Node
:= Token_Node
;
827 -- Deal with => (allow := as incorrect substitute)
829 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
830 Arg_Node
:= New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
831 Set_Selector_Name
(Arg_Node
, Ident_Node
);
833 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
834 Append
(Arg_Node
, Arg_List
);
836 -- If a comma follows, go back and scan next entry
838 if Comma_Present
then
841 -- Otherwise we have the end of a call
844 Prefix_Node
:= Name_Node
;
845 Name_Node
:= New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
846 Set_Name
(Name_Node
, Prefix_Node
);
847 Set_Parameter_Associations
(Name_Node
, Arg_List
);
850 if Token
in Token_Class_Namext
then
851 goto Scan_Name_Extension_OK
;
853 -- This is a case of a call which cannot be a name
856 Expr_Form
:= EF_Name
;
861 -- Not named parameter: Id started an expression after all
864 Restore_Scan_State
(Scan_State
); -- to Id
868 -- Here if entry did not start with Id => which means that it
869 -- is a positional parameter, which is not allowed, since we
870 -- have seen at least one named parameter already.
873 ("positional parameter association " &
874 "not allowed after named one");
876 Expr_Node
:= P_Expression_If_OK
;
878 -- Leaving the '>' in an association is not unusual, so suggest
881 if Nkind
(Expr_Node
) = N_Op_Eq
then
882 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
885 -- We go back to scanning out expressions, so that we do not get
886 -- multiple error messages when several positional parameters
887 -- follow a named parameter.
891 -- End of treatment for name extensions starting with left paren
893 -- End of loop through name extensions
897 -- This function parses a restricted form of Names which are either
898 -- designators, or designators preceded by a sequence of prefixes
899 -- that are direct names.
901 -- Error recovery: cannot raise Error_Resync
903 function P_Function_Name
return Node_Id
is
904 Designator_Node
: Node_Id
;
905 Prefix_Node
: Node_Id
;
906 Selector_Node
: Node_Id
;
907 Dot_Sloc
: Source_Ptr
:= No_Location
;
910 -- Prefix_Node is set to the gathered prefix so far, Empty means that
911 -- no prefix has been scanned. This allows us to build up the result
912 -- in the required right recursive manner.
914 Prefix_Node
:= Empty
;
916 -- Loop through prefixes
919 Designator_Node
:= Token_Node
;
921 if Token
not in Token_Class_Desig
then
922 return P_Identifier
; -- let P_Identifier issue the error message
924 else -- Token in Token_Class_Desig
925 Scan
; -- past designator
926 exit when Token
/= Tok_Dot
;
929 -- Here at a dot, with token just before it in Designator_Node
931 if No
(Prefix_Node
) then
932 Prefix_Node
:= Designator_Node
;
934 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
935 Set_Prefix
(Selector_Node
, Prefix_Node
);
936 Set_Selector_Name
(Selector_Node
, Designator_Node
);
937 Prefix_Node
:= Selector_Node
;
940 Dot_Sloc
:= Token_Ptr
;
944 -- Fall out of the loop having just scanned a designator
946 if No
(Prefix_Node
) then
947 return Designator_Node
;
949 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
950 Set_Prefix
(Selector_Node
, Prefix_Node
);
951 Set_Selector_Name
(Selector_Node
, Designator_Node
);
952 return Selector_Node
;
960 -- This function parses a restricted form of Names which are either
961 -- identifiers, or identifiers preceded by a sequence of prefixes
962 -- that are direct names.
964 -- Error recovery: cannot raise Error_Resync
966 function P_Qualified_Simple_Name
return Node_Id
is
967 Designator_Node
: Node_Id
;
968 Prefix_Node
: Node_Id
;
969 Selector_Node
: Node_Id
;
970 Dot_Sloc
: Source_Ptr
:= No_Location
;
973 -- Prefix node is set to the gathered prefix so far, Empty means that
974 -- no prefix has been scanned. This allows us to build up the result
975 -- in the required right recursive manner.
977 Prefix_Node
:= Empty
;
979 -- Loop through prefixes
982 Designator_Node
:= Token_Node
;
984 if Token
= Tok_Identifier
then
985 Scan
; -- past identifier
986 exit when Token
/= Tok_Dot
;
988 elsif Token
not in Token_Class_Desig
then
989 return P_Identifier
; -- let P_Identifier issue the error message
992 Scan
; -- past designator
994 if Token
/= Tok_Dot
then
995 Error_Msg_SP
("identifier expected");
1000 -- Here at a dot, with token just before it in Designator_Node
1002 if No
(Prefix_Node
) then
1003 Prefix_Node
:= Designator_Node
;
1005 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1006 Set_Prefix
(Selector_Node
, Prefix_Node
);
1007 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1008 Prefix_Node
:= Selector_Node
;
1011 Dot_Sloc
:= Token_Ptr
;
1015 -- Fall out of the loop having just scanned an identifier
1017 if No
(Prefix_Node
) then
1018 return Designator_Node
;
1020 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1021 Set_Prefix
(Selector_Node
, Prefix_Node
);
1022 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1023 return Selector_Node
;
1027 when Error_Resync
=>
1029 end P_Qualified_Simple_Name
;
1031 -- This procedure differs from P_Qualified_Simple_Name only in that it
1032 -- raises Error_Resync if any error is encountered. It only returns after
1033 -- scanning a valid qualified simple name.
1035 -- Error recovery: can raise Error_Resync
1037 function P_Qualified_Simple_Name_Resync
return Node_Id
is
1038 Designator_Node
: Node_Id
;
1039 Prefix_Node
: Node_Id
;
1040 Selector_Node
: Node_Id
;
1041 Dot_Sloc
: Source_Ptr
:= No_Location
;
1044 Prefix_Node
:= Empty
;
1046 -- Loop through prefixes
1049 Designator_Node
:= Token_Node
;
1051 if Token
= Tok_Identifier
then
1052 Scan
; -- past identifier
1053 exit when Token
/= Tok_Dot
;
1055 elsif Token
not in Token_Class_Desig
then
1056 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
1060 Scan
; -- past designator
1062 if Token
/= Tok_Dot
then
1063 Error_Msg_SP
("identifier expected");
1068 -- Here at a dot, with token just before it in Designator_Node
1070 if No
(Prefix_Node
) then
1071 Prefix_Node
:= Designator_Node
;
1073 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1074 Set_Prefix
(Selector_Node
, Prefix_Node
);
1075 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1076 Prefix_Node
:= Selector_Node
;
1079 Dot_Sloc
:= Token_Ptr
;
1080 Scan
; -- past period
1083 -- Fall out of the loop having just scanned an identifier
1085 if No
(Prefix_Node
) then
1086 return Designator_Node
;
1088 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1089 Set_Prefix
(Selector_Node
, Prefix_Node
);
1090 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1091 return Selector_Node
;
1093 end P_Qualified_Simple_Name_Resync
;
1095 ----------------------
1096 -- 4.1 Direct_Name --
1097 ----------------------
1099 -- Parsed by P_Name and other functions in section 4.1
1105 -- Parsed by P_Name (4.1)
1107 -------------------------------
1108 -- 4.1 Explicit Dereference --
1109 -------------------------------
1111 -- Parsed by P_Name (4.1)
1113 -------------------------------
1114 -- 4.1 Implicit_Dereference --
1115 -------------------------------
1117 -- Parsed by P_Name (4.1)
1119 ----------------------------
1120 -- 4.1 Indexed Component --
1121 ----------------------------
1123 -- Parsed by P_Name (4.1)
1129 -- Parsed by P_Name (4.1)
1131 -----------------------------
1132 -- 4.1 Selected_Component --
1133 -----------------------------
1135 -- Parsed by P_Name (4.1)
1137 ------------------------
1138 -- 4.1 Selector Name --
1139 ------------------------
1141 -- Parsed by P_Name (4.1)
1143 ------------------------------
1144 -- 4.1 Attribute Reference --
1145 ------------------------------
1147 -- Parsed by P_Name (4.1)
1149 -------------------------------
1150 -- 4.1 Attribute Designator --
1151 -------------------------------
1153 -- Parsed by P_Name (4.1)
1155 --------------------------------------
1156 -- 4.1.4 Range Attribute Reference --
1157 --------------------------------------
1159 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1161 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1163 -- In the grammar, a RANGE attribute is simply a name, but its use is
1164 -- highly restricted, so in the parser, we do not regard it as a name.
1165 -- Instead, P_Name returns without scanning the 'RANGE part of the
1166 -- attribute, and the caller uses the following function to construct
1167 -- a range attribute in places where it is appropriate.
1169 -- Note that RANGE here is treated essentially as an identifier,
1170 -- rather than a reserved word.
1172 -- The caller has parsed the prefix, i.e. a name, and Token points to
1173 -- the apostrophe. The token after the apostrophe is known to be RANGE
1174 -- at this point. The prefix node becomes the prefix of the attribute.
1176 -- Error_Recovery: Cannot raise Error_Resync
1178 function P_Range_Attribute_Reference
1179 (Prefix_Node
: Node_Id
)
1182 Attr_Node
: Node_Id
;
1185 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1186 Set_Prefix
(Attr_Node
, Prefix_Node
);
1187 Scan
; -- past apostrophe
1190 Style
.Check_Attribute_Name
(True);
1193 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1196 if Token
= Tok_Left_Paren
then
1197 Scan
; -- past left paren
1198 Set_Expressions
(Attr_Node
, New_List
(P_Expression_If_OK
));
1203 end P_Range_Attribute_Reference
;
1205 ---------------------------------------
1206 -- 4.1.4 Range Attribute Designator --
1207 ---------------------------------------
1209 -- Parsed by P_Range_Attribute_Reference (4.4)
1211 --------------------
1213 --------------------
1215 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1217 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1218 -- an aggregate is known to be required (code statement, extension
1219 -- aggregate), in which cases this routine performs the necessary check
1220 -- that we have an aggregate rather than a parenthesized expression
1222 -- Error recovery: can raise Error_Resync
1224 function P_Aggregate
return Node_Id
is
1225 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1226 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1229 if Nkind
(Aggr_Node
) /= N_Aggregate
1231 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1234 ("aggregate may not have single positional component", Aggr_Sloc
);
1241 ------------------------------------------------
1242 -- 4.3 Aggregate or Parenthesized Expression --
1243 ------------------------------------------------
1245 -- This procedure parses out either an aggregate or a parenthesized
1246 -- expression (these two constructs are closely related, since a
1247 -- parenthesized expression looks like an aggregate with a single
1248 -- positional component).
1251 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1253 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1255 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1256 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1259 -- RECORD_COMPONENT_ASSOCIATION ::=
1260 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1262 -- COMPONENT_CHOICE_LIST ::=
1263 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1266 -- EXTENSION_AGGREGATE ::=
1267 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1269 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1271 -- ARRAY_AGGREGATE ::=
1272 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1274 -- POSITIONAL_ARRAY_AGGREGATE ::=
1275 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1276 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1277 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1279 -- NAMED_ARRAY_AGGREGATE ::=
1280 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1282 -- PRIMARY ::= (EXPRESSION);
1284 -- Error recovery: can raise Error_Resync
1286 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1287 -- to Ada 2005 limited aggregates (AI-287)
1289 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1290 Aggregate_Node
: Node_Id
;
1291 Expr_List
: List_Id
;
1292 Assoc_List
: List_Id
;
1293 Expr_Node
: Node_Id
;
1294 Lparen_Sloc
: Source_Ptr
;
1295 Scan_State
: Saved_Scan_State
;
1297 procedure Box_Error
;
1298 -- Called if <> is encountered as positional aggregate element. Issues
1299 -- error message and sets Expr_Node to Error.
1301 function Is_Quantified_Expression
return Boolean;
1302 -- The presence of iterated component associations requires a one
1303 -- token lookahead to distinguish it from quantified expressions.
1309 procedure Box_Error
is
1311 if Ada_Version
< Ada_2005
then
1312 Error_Msg_SC
("box in aggregate is an Ada 2005 extension");
1315 -- Ada 2005 (AI-287): The box notation is allowed only with named
1316 -- notation because positional notation might be error prone. For
1317 -- example, in "(X, <>, Y, <>)", there is no type associated with
1318 -- the boxes, so you might not be leaving out the components you
1319 -- thought you were leaving out.
1321 Error_Msg_SC
("(Ada 2005) box only allowed with named notation");
1326 ------------------------------
1327 -- Is_Quantified_Expression --
1328 ------------------------------
1330 function Is_Quantified_Expression
return Boolean is
1332 Scan_State
: Saved_Scan_State
;
1335 Save_Scan_State
(Scan_State
);
1337 Maybe
:= Token
= Tok_All
or else Token
= Tok_Some
;
1338 Restore_Scan_State
(Scan_State
); -- to FOR
1340 end Is_Quantified_Expression
;
1342 -- Start of processing for P_Aggregate_Or_Paren_Expr
1345 Lparen_Sloc
:= Token_Ptr
;
1348 -- Note on parentheses count. For cases like an if expression, the
1349 -- parens here really count as real parentheses for the paren count,
1350 -- so we adjust the paren count accordingly after scanning the expr.
1354 if Token
= Tok_If
then
1355 Expr_Node
:= P_If_Expression
;
1357 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1362 elsif Token
= Tok_Case
then
1363 Expr_Node
:= P_Case_Expression
;
1365 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1368 -- Quantified expression
1370 elsif Token
= Tok_For
and then Is_Quantified_Expression
then
1371 Expr_Node
:= P_Quantified_Expression
;
1373 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1376 -- Note: the mechanism used here of rescanning the initial expression
1377 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1378 -- out the discrete choice list.
1380 -- Deal with expression and extension aggregates first
1382 elsif Token
/= Tok_Others
then
1383 Save_Scan_State
(Scan_State
); -- at start of expression
1385 -- Deal with (NULL RECORD)
1387 if Token
= Tok_Null
then
1390 if Token
= Tok_Record
then
1391 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1392 Set_Null_Record_Present
(Aggregate_Node
, True);
1393 Scan
; -- past RECORD
1395 return Aggregate_Node
;
1397 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1400 elsif Token
= Tok_For
then
1401 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1402 Expr_Node
:= P_Iterated_Component_Association
;
1406 -- Scan expression, handling box appearing as positional argument
1408 if Token
= Tok_Box
then
1411 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1414 -- Extension or Delta aggregate
1416 if Token
= Tok_With
then
1417 if Nkind
(Expr_Node
) = N_Attribute_Reference
1418 and then Attribute_Name
(Expr_Node
) = Name_Range
1420 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1424 if Ada_Version
= Ada_83
then
1425 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1429 if Token
= Tok_Delta
then
1431 Aggregate_Node
:= New_Node
(N_Delta_Aggregate
, Lparen_Sloc
);
1432 Set_Expression
(Aggregate_Node
, Expr_Node
);
1438 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1439 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1442 -- Deal with WITH NULL RECORD case
1444 if Token
= Tok_Null
then
1445 Save_Scan_State
(Scan_State
); -- at NULL
1448 if Token
= Tok_Record
then
1449 Scan
; -- past RECORD
1450 Set_Null_Record_Present
(Aggregate_Node
, True);
1452 return Aggregate_Node
;
1455 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1459 if Token
/= Tok_Others
then
1460 Save_Scan_State
(Scan_State
);
1461 Expr_Node
:= P_Expression
;
1468 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1469 if Nkind
(Expr_Node
) = N_Attribute_Reference
1470 and then Attribute_Name
(Expr_Node
) = Name_Range
1473 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
1474 Scan
; -- past right paren
1478 -- Bump paren count of expression
1480 if Expr_Node
/= Error
then
1481 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1484 T_Right_Paren
; -- past right paren (error message if none)
1490 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1496 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1500 -- Prepare to scan list of component associations
1502 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1503 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1505 -- This loop scans through component associations. On entry to the
1506 -- loop, an expression has been scanned at the start of the current
1507 -- association unless initial token was OTHERS, in which case
1508 -- Expr_Node is set to Empty.
1511 -- Deal with others association first. This is a named association
1513 if No
(Expr_Node
) then
1514 if No
(Assoc_List
) then
1515 Assoc_List
:= New_List
;
1518 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1520 -- Improper use of WITH
1522 elsif Token
= Tok_With
then
1523 Error_Msg_SC
("WITH must be preceded by single expression in " &
1524 "extension aggregate");
1527 -- Range attribute can only appear as part of a discrete choice list
1529 elsif Nkind
(Expr_Node
) = N_Attribute_Reference
1530 and then Attribute_Name
(Expr_Node
) = Name_Range
1531 and then Token
/= Tok_Arrow
1532 and then Token
/= Tok_Vertical_Bar
1534 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1537 -- Assume positional case if comma, right paren, or literal or
1538 -- identifier or OTHERS follows (the latter cases are missing
1539 -- comma cases). Also assume positional if a semicolon follows,
1540 -- which can happen if there are missing parens.
1542 elsif Nkind
(Expr_Node
) = N_Iterated_Component_Association
then
1543 if No
(Assoc_List
) then
1544 Assoc_List
:= New_List
(Expr_Node
);
1546 Append_To
(Assoc_List
, Expr_Node
);
1549 elsif Token
= Tok_Comma
1550 or else Token
= Tok_Right_Paren
1551 or else Token
= Tok_Others
1552 or else Token
in Token_Class_Lit_Or_Name
1553 or else Token
= Tok_Semicolon
1555 if Present
(Assoc_List
) then
1556 Error_Msg_BC
-- CODEFIX
1557 ("""='>"" expected (positional association cannot follow "
1558 & "named association)");
1561 if No
(Expr_List
) then
1562 Expr_List
:= New_List
;
1565 Append
(Expr_Node
, Expr_List
);
1567 -- Check for aggregate followed by left parent, maybe missing comma
1569 elsif Nkind
(Expr_Node
) = N_Aggregate
1570 and then Token
= Tok_Left_Paren
1574 if No
(Expr_List
) then
1575 Expr_List
:= New_List
;
1578 Append
(Expr_Node
, Expr_List
);
1580 -- Anything else is assumed to be a named association
1583 Restore_Scan_State
(Scan_State
); -- to start of expression
1585 if No
(Assoc_List
) then
1586 Assoc_List
:= New_List
;
1589 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1592 exit when not Comma_Present
;
1594 -- If we are at an expression terminator, something is seriously
1595 -- wrong, so let's get out now, before we start eating up stuff
1596 -- that doesn't belong to us.
1598 if Token
in Token_Class_Eterm
and then Token
/= Tok_For
then
1600 ("expecting expression or component association");
1604 -- Deal with misused box
1606 if Token
= Tok_Box
then
1609 -- Otherwise initiate for reentry to top of loop by scanning an
1610 -- initial expression, unless the first token is OTHERS or FOR,
1611 -- which indicates an iterated component association.
1613 elsif Token
= Tok_Others
then
1616 elsif Token
= Tok_For
then
1617 Expr_Node
:= P_Iterated_Component_Association
;
1620 Save_Scan_State
(Scan_State
); -- at start of expression
1621 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1626 -- All component associations (positional and named) have been scanned
1630 if Nkind
(Aggregate_Node
) /= N_Delta_Aggregate
then
1631 Set_Expressions
(Aggregate_Node
, Expr_List
);
1634 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1635 return Aggregate_Node
;
1636 end P_Aggregate_Or_Paren_Expr
;
1638 ------------------------------------------------
1639 -- 4.3 Record or Array Component Association --
1640 ------------------------------------------------
1642 -- RECORD_COMPONENT_ASSOCIATION ::=
1643 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1644 -- | COMPONENT_CHOICE_LIST => <>
1646 -- COMPONENT_CHOICE_LIST =>
1647 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1650 -- ARRAY_COMPONENT_ASSOCIATION ::=
1651 -- DISCRETE_CHOICE_LIST => EXPRESSION
1652 -- | DISCRETE_CHOICE_LIST => <>
1653 -- | ITERATED_COMPONENT_ASSOCIATION
1655 -- Note: this routine only handles the named cases, including others.
1656 -- Cases where the component choice list is not present have already
1657 -- been handled directly.
1659 -- Error recovery: can raise Error_Resync
1661 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1662 -- rules have been extended to give support to Ada 2005 limited
1663 -- aggregates (AI-287)
1665 function P_Record_Or_Array_Component_Association
return Node_Id
is
1666 Assoc_Node
: Node_Id
;
1669 -- A loop indicates an iterated_component_association
1671 if Token
= Tok_For
then
1672 return P_Iterated_Component_Association
;
1675 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1676 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1677 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1680 if Token
= Tok_Box
then
1682 -- Ada 2005(AI-287): The box notation is used to indicate the
1683 -- default initialization of aggregate components
1685 if Ada_Version
< Ada_2005
then
1687 ("component association with '<'> is an Ada 2005 extension");
1688 Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
1691 Set_Box_Present
(Assoc_Node
);
1694 Set_Expression
(Assoc_Node
, P_Expression
);
1698 end P_Record_Or_Array_Component_Association
;
1700 -----------------------------
1701 -- 4.3.1 Record Aggregate --
1702 -----------------------------
1704 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1705 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1707 ----------------------------------------------
1708 -- 4.3.1 Record Component Association List --
1709 ----------------------------------------------
1711 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1713 ----------------------------------
1714 -- 4.3.1 Component Choice List --
1715 ----------------------------------
1717 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1719 --------------------------------
1720 -- 4.3.1 Extension Aggregate --
1721 --------------------------------
1723 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1725 --------------------------
1726 -- 4.3.1 Ancestor Part --
1727 --------------------------
1729 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1731 ----------------------------
1732 -- 4.3.1 Array Aggregate --
1733 ----------------------------
1735 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1737 ---------------------------------------
1738 -- 4.3.1 Positional Array Aggregate --
1739 ---------------------------------------
1741 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1743 ----------------------------------
1744 -- 4.3.1 Named Array Aggregate --
1745 ----------------------------------
1747 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1749 ----------------------------------------
1750 -- 4.3.1 Array Component Association --
1751 ----------------------------------------
1753 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1755 ---------------------
1756 -- 4.4 Expression --
1757 ---------------------
1759 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1762 -- RELATION {LOGICAL_OPERATOR RELATION}
1764 -- CHOICE_EXPRESSION ::=
1765 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1767 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1769 -- On return, Expr_Form indicates the categorization of the expression
1770 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1771 -- an error message is given, and Error is returned).
1773 -- Error recovery: cannot raise Error_Resync
1775 function P_Expression
return Node_Id
is
1776 Logical_Op
: Node_Kind
;
1777 Prev_Logical_Op
: Node_Kind
;
1778 Op_Location
: Source_Ptr
;
1783 Node1
:= P_Relation
;
1785 if Token
in Token_Class_Logop
then
1786 Prev_Logical_Op
:= N_Empty
;
1789 Op_Location
:= Token_Ptr
;
1790 Logical_Op
:= P_Logical_Operator
;
1792 if Prev_Logical_Op
/= N_Empty
and then
1793 Logical_Op
/= Prev_Logical_Op
1796 ("mixed logical operators in expression", Op_Location
);
1797 Prev_Logical_Op
:= N_Empty
;
1799 Prev_Logical_Op
:= Logical_Op
;
1803 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1804 Set_Left_Opnd
(Node1
, Node2
);
1805 Set_Right_Opnd
(Node1
, P_Relation
);
1807 -- Check for case of errant comma or semicolon
1809 if Token
= Tok_Comma
or else Token
= Tok_Semicolon
then
1811 Com
: constant Boolean := Token
= Tok_Comma
;
1812 Scan_State
: Saved_Scan_State
;
1816 Save_Scan_State
(Scan_State
); -- at comma/semicolon
1817 Scan
; -- past comma/semicolon
1819 -- Check for AND THEN or OR ELSE after comma/semicolon. We
1820 -- do not deal with AND/OR because those cases get mixed up
1821 -- with the select alternatives case.
1823 if Token
= Tok_And
or else Token
= Tok_Or
then
1824 Logop
:= P_Logical_Operator
;
1825 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1827 if Nkind_In
(Logop
, N_And_Then
, N_Or_Else
) then
1828 Scan
; -- past comma/semicolon
1831 Error_Msg_SP
-- CODEFIX
1832 ("|extra "","" ignored");
1834 Error_Msg_SP
-- CODEFIX
1835 ("|extra "";"" ignored");
1839 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1843 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1848 exit when Token
not in Token_Class_Logop
;
1851 Expr_Form
:= EF_Non_Simple
;
1854 if Token
= Tok_Apostrophe
then
1855 Bad_Range_Attribute
(Token_Ptr
);
1862 -- This function is identical to the normal P_Expression, except that it
1863 -- also permits the appearance of a case, conditional, or quantified
1864 -- expression if the call immediately follows a left paren, and followed
1865 -- by a right parenthesis. These forms are allowed if these conditions
1866 -- are not met, but an error message will be issued.
1868 function P_Expression_If_OK
return Node_Id
is
1870 -- Case of conditional, case or quantified expression
1872 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1873 return P_Unparen_Cond_Case_Quant_Expression
;
1875 -- Normal case, not case/conditional/quantified expression
1878 return P_Expression
;
1880 end P_Expression_If_OK
;
1882 -- This function is identical to the normal P_Expression, except that it
1883 -- checks that the expression scan did not stop on a right paren. It is
1884 -- called in all contexts where a right parenthesis cannot legitimately
1885 -- follow an expression.
1887 -- Error recovery: can not raise Error_Resync
1889 function P_Expression_No_Right_Paren
return Node_Id
is
1890 Expr
: constant Node_Id
:= P_Expression
;
1892 Ignore
(Tok_Right_Paren
);
1894 end P_Expression_No_Right_Paren
;
1896 ----------------------------------------
1897 -- 4.4 Expression_Or_Range_Attribute --
1898 ----------------------------------------
1901 -- RELATION {and RELATION} | RELATION {and then RELATION}
1902 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1903 -- | RELATION {xor RELATION}
1905 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1907 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1909 -- On return, Expr_Form indicates the categorization of the expression
1910 -- and EF_Range_Attr is one of the possibilities.
1912 -- Error recovery: cannot raise Error_Resync
1914 -- In the grammar, a RANGE attribute is simply a name, but its use is
1915 -- highly restricted, so in the parser, we do not regard it as a name.
1916 -- Instead, P_Name returns without scanning the 'RANGE part of the
1917 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1918 -- attribute reference. In the normal case where a range attribute is
1919 -- not allowed, an error message is issued by P_Expression.
1921 function P_Expression_Or_Range_Attribute
return Node_Id
is
1922 Logical_Op
: Node_Kind
;
1923 Prev_Logical_Op
: Node_Kind
;
1924 Op_Location
: Source_Ptr
;
1927 Attr_Node
: Node_Id
;
1930 Node1
:= P_Relation
;
1932 if Token
= Tok_Apostrophe
then
1933 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
1934 Expr_Form
:= EF_Range_Attr
;
1937 elsif Token
in Token_Class_Logop
then
1938 Prev_Logical_Op
:= N_Empty
;
1941 Op_Location
:= Token_Ptr
;
1942 Logical_Op
:= P_Logical_Operator
;
1944 if Prev_Logical_Op
/= N_Empty
and then
1945 Logical_Op
/= Prev_Logical_Op
1948 ("mixed logical operators in expression", Op_Location
);
1949 Prev_Logical_Op
:= N_Empty
;
1951 Prev_Logical_Op
:= Logical_Op
;
1955 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1956 Set_Left_Opnd
(Node1
, Node2
);
1957 Set_Right_Opnd
(Node1
, P_Relation
);
1958 exit when Token
not in Token_Class_Logop
;
1961 Expr_Form
:= EF_Non_Simple
;
1964 if Token
= Tok_Apostrophe
then
1965 Bad_Range_Attribute
(Token_Ptr
);
1970 end P_Expression_Or_Range_Attribute
;
1972 -- Version that allows a non-parenthesized case, conditional, or quantified
1973 -- expression if the call immediately follows a left paren, and followed
1974 -- by a right parenthesis. These forms are allowed if these conditions
1975 -- are not met, but an error message will be issued.
1977 function P_Expression_Or_Range_Attribute_If_OK
return Node_Id
is
1979 -- Case of conditional, case or quantified expression
1981 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1982 return P_Unparen_Cond_Case_Quant_Expression
;
1984 -- Normal case, not one of the above expression types
1987 return P_Expression_Or_Range_Attribute
;
1989 end P_Expression_Or_Range_Attribute_If_OK
;
1995 -- This procedure scans both relations and choice relations
1997 -- CHOICE_RELATION ::=
1998 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
2001 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
2002 -- | RAISE_EXPRESSION
2004 -- MEMBERSHIP_CHOICE_LIST ::=
2005 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
2007 -- MEMBERSHIP_CHOICE ::=
2008 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
2010 -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
2012 -- On return, Expr_Form indicates the categorization of the expression
2014 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2015 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2017 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2018 -- expression, then tokens are scanned until either a non-expression token,
2019 -- a right paren (not matched by a left paren) or a comma, is encountered.
2021 function P_Relation
return Node_Id
is
2022 Node1
, Node2
: Node_Id
;
2026 -- First check for raise expression
2028 if Token
= Tok_Raise
then
2029 Expr_Form
:= EF_Non_Simple
;
2030 return P_Raise_Expression
;
2035 Node1
:= P_Simple_Expression
;
2037 if Token
not in Token_Class_Relop
then
2041 -- Here we have a relational operator following. If so then scan it
2042 -- out. Note that the assignment symbol := is treated as a relational
2043 -- operator to improve the error recovery when it is misused for =.
2044 -- P_Relational_Operator also parses the IN and NOT IN operations.
2047 Node2
:= New_Op_Node
(P_Relational_Operator
, Optok
);
2048 Set_Left_Opnd
(Node2
, Node1
);
2050 -- Case of IN or NOT IN
2052 if Prev_Token
= Tok_In
then
2053 P_Membership_Test
(Node2
);
2055 -- Case of relational operator (= /= < <= > >=)
2058 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
2061 Expr_Form
:= EF_Non_Simple
;
2063 if Token
in Token_Class_Relop
then
2064 Error_Msg_SC
("unexpected relational operator");
2071 -- If any error occurs, then scan to the next expression terminator symbol
2072 -- or comma or right paren at the outer (i.e. current) parentheses level.
2073 -- The flags are set to indicate a normal simple expression.
2076 when Error_Resync
=>
2078 Expr_Form
:= EF_Simple
;
2082 ----------------------------
2083 -- 4.4 Simple Expression --
2084 ----------------------------
2086 -- SIMPLE_EXPRESSION ::=
2087 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2089 -- On return, Expr_Form indicates the categorization of the expression
2091 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2092 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2094 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2095 -- expression, then tokens are scanned until either a non-expression token,
2096 -- a right paren (not matched by a left paren) or a comma, is encountered.
2098 -- Note: P_Simple_Expression is called only internally by higher level
2099 -- expression routines. In cases in the grammar where a simple expression
2100 -- is required, the approach is to scan an expression, and then post an
2101 -- appropriate error message if the expression obtained is not simple. This
2102 -- gives better error recovery and treatment.
2104 function P_Simple_Expression
return Node_Id
is
2105 Scan_State
: Saved_Scan_State
;
2108 Tokptr
: Source_Ptr
;
2110 function At_Start_Of_Attribute
return Boolean;
2111 -- Tests if we have quote followed by attribute name, if so, return True
2112 -- otherwise return False.
2114 ---------------------------
2115 -- At_Start_Of_Attribute --
2116 ---------------------------
2118 function At_Start_Of_Attribute
return Boolean is
2120 if Token
/= Tok_Apostrophe
then
2125 Scan_State
: Saved_Scan_State
;
2128 Save_Scan_State
(Scan_State
);
2131 if Token
= Tok_Identifier
2132 and then Is_Attribute_Name
(Chars
(Token_Node
))
2134 Restore_Scan_State
(Scan_State
);
2137 Restore_Scan_State
(Scan_State
);
2142 end At_Start_Of_Attribute
;
2144 -- Start of processing for P_Simple_Expression
2147 -- Check for cases starting with a name. There are two reasons for
2148 -- special casing. First speed things up by catching a common case
2149 -- without going through several routine layers. Second the caller must
2150 -- be informed via Expr_Form when the simple expression is a name.
2152 if Token
in Token_Class_Name
then
2155 -- Deal with apostrophe cases
2157 if Token
= Tok_Apostrophe
then
2158 Save_Scan_State
(Scan_State
); -- at apostrophe
2159 Scan
; -- past apostrophe
2161 -- If qualified expression, scan it out and fall through
2163 if Token
= Tok_Left_Paren
then
2164 Node1
:= P_Qualified_Expression
(Node1
);
2165 Expr_Form
:= EF_Simple
;
2167 -- If range attribute, then we return with Token pointing to the
2168 -- apostrophe. Note: avoid the normal error check on exit. We
2169 -- know that the expression really is complete in this case.
2171 else -- Token = Tok_Range then
2172 Restore_Scan_State
(Scan_State
); -- to apostrophe
2173 Expr_Form
:= EF_Simple_Name
;
2178 -- If an expression terminator follows, the previous processing
2179 -- completely scanned out the expression (a common case), and
2180 -- left Expr_Form set appropriately for returning to our caller.
2182 if Token
in Token_Class_Sterm
then
2185 -- If we do not have an expression terminator, then complete the
2186 -- scan of a simple expression. This code duplicates the code
2187 -- found in P_Term and P_Factor.
2190 if Token
= Tok_Double_Asterisk
then
2192 Style
.Check_Exponentiation_Operator
;
2195 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2197 Set_Left_Opnd
(Node2
, Node1
);
2198 Set_Right_Opnd
(Node2
, P_Primary
);
2204 exit when Token
not in Token_Class_Mulop
;
2205 Tokptr
:= Token_Ptr
;
2206 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2209 Style
.Check_Binary_Operator
;
2212 Scan
; -- past operator
2213 Set_Left_Opnd
(Node2
, Node1
);
2214 Set_Right_Opnd
(Node2
, P_Factor
);
2219 exit when Token
not in Token_Class_Binary_Addop
;
2220 Tokptr
:= Token_Ptr
;
2221 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2224 Style
.Check_Binary_Operator
;
2227 Scan
; -- past operator
2228 Set_Left_Opnd
(Node2
, Node1
);
2229 Set_Right_Opnd
(Node2
, P_Term
);
2233 Expr_Form
:= EF_Simple
;
2236 -- Cases where simple expression does not start with a name
2239 -- Scan initial sign and initial Term
2241 if Token
in Token_Class_Unary_Addop
then
2242 Tokptr
:= Token_Ptr
;
2243 Node1
:= New_Op_Node
(P_Unary_Adding_Operator
, Tokptr
);
2246 Style
.Check_Unary_Plus_Or_Minus
(Inside_Depends
);
2249 Scan
; -- past operator
2250 Set_Right_Opnd
(Node1
, P_Term
);
2255 -- In the following, we special-case a sequence of concatenations of
2256 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
2257 -- else mixed in. For such a sequence, we return a tree representing
2258 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
2259 -- the number of concatenations is large. If semantic analysis
2260 -- resolves the "&" to a predefined one, then this folding gives the
2261 -- right answer. Otherwise, semantic analysis will complain about a
2262 -- capacity-exceeded error. The purpose of this trick is to avoid
2263 -- creating a deeply nested tree, which would cause deep recursion
2264 -- during semantics, causing stack overflow. This way, we can handle
2265 -- enormous concatenations in the normal case of predefined "&". We
2266 -- first build up the normal tree, and then rewrite it if
2270 Num_Concats_Threshold
: constant Positive := 1000;
2271 -- Arbitrary threshold value to enable optimization
2273 First_Node
: constant Node_Id
:= Node1
;
2274 Is_Strlit_Concat
: Boolean;
2275 -- True iff we've parsed a sequence of concatenations of string
2276 -- literals, with nothing else mixed in.
2278 Num_Concats
: Natural;
2279 -- Number of "&" operators if Is_Strlit_Concat is True
2283 Nkind
(Node1
) = N_String_Literal
2284 and then Token
= Tok_Ampersand
;
2287 -- Scan out sequence of terms separated by binary adding operators
2290 exit when Token
not in Token_Class_Binary_Addop
;
2291 Tokptr
:= Token_Ptr
;
2292 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2294 if Style_Check
and then not Debug_Flag_Dot_QQ
then
2295 Style
.Check_Binary_Operator
;
2298 Scan
; -- past operator
2299 Set_Left_Opnd
(Node2
, Node1
);
2301 Set_Right_Opnd
(Node2
, Node1
);
2303 -- Check if we're still concatenating string literals
2307 and then Nkind
(Node2
) = N_Op_Concat
2308 and then Nkind
(Node1
) = N_String_Literal
;
2310 if Is_Strlit_Concat
then
2311 Num_Concats
:= Num_Concats
+ 1;
2317 -- If we have an enormous series of concatenations of string
2318 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2319 -- flag tells semantic analysis that if the "&" is not predefined,
2320 -- the folded value is wrong.
2323 and then Num_Concats
>= Num_Concats_Threshold
2326 Empty_String_Val
: String_Id
;
2329 Strlit_Concat_Val
: String_Id
;
2330 -- Contains the folded value (which will be correct if the
2331 -- "&" operators are the predefined ones).
2334 -- For walking up the tree
2337 -- Folded node to replace Node1
2339 Loc
: constant Source_Ptr
:= Sloc
(First_Node
);
2342 -- Walk up the tree starting at the leftmost string literal
2343 -- (First_Node), building up the Strlit_Concat_Val as we
2344 -- go. Note that we do not use recursion here -- the whole
2345 -- point is to avoid recursively walking that enormous tree.
2348 Store_String_Chars
(Strval
(First_Node
));
2350 Cur_Node
:= Parent
(First_Node
);
2351 while Present
(Cur_Node
) loop
2352 pragma Assert
(Nkind
(Cur_Node
) = N_Op_Concat
and then
2353 Nkind
(Right_Opnd
(Cur_Node
)) = N_String_Literal
);
2355 Store_String_Chars
(Strval
(Right_Opnd
(Cur_Node
)));
2356 Cur_Node
:= Parent
(Cur_Node
);
2359 Strlit_Concat_Val
:= End_String
;
2361 -- Create new folded node, and rewrite result with a concat-
2362 -- enation of an empty string literal and the folded node.
2365 Empty_String_Val
:= End_String
;
2367 Make_Op_Concat
(Loc
,
2368 Make_String_Literal
(Loc
, Empty_String_Val
),
2369 Make_String_Literal
(Loc
, Strlit_Concat_Val
,
2370 Is_Folded_In_Parser
=> True));
2371 Rewrite
(Node1
, New_Node
);
2376 -- All done, we clearly do not have name or numeric literal so this
2377 -- is a case of a simple expression which is some other possibility.
2379 Expr_Form
:= EF_Simple
;
2382 -- Come here at end of simple expression, where we do a couple of
2383 -- special checks to improve error recovery.
2385 -- Special test to improve error recovery. If the current token is a
2386 -- period, then someone is trying to do selection on something that is
2387 -- not a name, e.g. a qualified expression.
2389 if Token
= Tok_Dot
then
2390 Error_Msg_SC
("prefix for selection is not a name");
2392 -- If qualified expression, comment and continue, otherwise something
2393 -- is pretty nasty so do an Error_Resync call.
2395 if Ada_Version
< Ada_2012
2396 and then Nkind
(Node1
) = N_Qualified_Expression
2398 Error_Msg_SC
("\would be legal in Ada 2012 mode");
2404 -- Special test to improve error recovery: If the current token is
2405 -- not the first token on a line (as determined by checking the
2406 -- previous token position with the start of the current line),
2407 -- then we insist that we have an appropriate terminating token.
2408 -- Consider the following two examples:
2410 -- 1) if A nad B then ...
2415 -- In the first example, we would like to issue a binary operator
2416 -- expected message and resynchronize to the then. In the second
2417 -- example, we do not want to issue a binary operator message, so
2418 -- that instead we will get the missing semicolon message. This
2419 -- distinction is of course a heuristic which does not always work,
2420 -- but in practice it is quite effective.
2422 -- Note: the one case in which we do not go through this circuit is
2423 -- when we have scanned a range attribute and want to return with
2424 -- Token pointing to the apostrophe. The apostrophe is not normally
2425 -- an expression terminator, and is not in Token_Class_Sterm, but
2426 -- in this special case we know that the expression is complete.
2428 if not Token_Is_At_Start_Of_Line
2429 and then Token
not in Token_Class_Sterm
2431 -- Normally the right error message is indeed that we expected a
2432 -- binary operator, but in the case of being between a right and left
2433 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2435 if Prev_Token
= Tok_Right_Paren
and then Token
= Tok_Left_Paren
then
2438 -- And if we have a quote, we may have a bad attribute
2440 elsif At_Start_Of_Attribute
then
2441 Error_Msg_SC
("prefix of attribute must be a name");
2443 if Ada_Version
>= Ada_2012
then
2444 Error_Msg_SC
("\qualify expression to turn it into a name");
2447 -- Normal case for binary operator expected message
2450 Error_Msg_AP
("binary operator expected");
2459 -- If any error occurs, then scan to next expression terminator symbol
2460 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2461 -- level. Expr_Form is set to indicate a normal simple expression.
2464 when Error_Resync
=>
2466 Expr_Form
:= EF_Simple
;
2468 end P_Simple_Expression
;
2470 -----------------------------------------------
2471 -- 4.4 Simple Expression or Range Attribute --
2472 -----------------------------------------------
2474 -- SIMPLE_EXPRESSION ::=
2475 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2477 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2479 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2481 -- Error recovery: cannot raise Error_Resync
2483 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
2485 Attr_Node
: Node_Id
;
2488 -- We don't just want to roar ahead and call P_Simple_Expression
2489 -- here, since we want to handle the case of a parenthesized range
2490 -- attribute cleanly.
2492 if Token
= Tok_Left_Paren
then
2494 Lptr
: constant Source_Ptr
:= Token_Ptr
;
2495 Scan_State
: Saved_Scan_State
;
2498 Save_Scan_State
(Scan_State
);
2499 Scan
; -- past left paren
2500 Sexpr
:= P_Simple_Expression
;
2502 if Token
= Tok_Apostrophe
then
2503 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2504 Expr_Form
:= EF_Range_Attr
;
2506 if Token
= Tok_Right_Paren
then
2507 Scan
; -- scan past right paren if present
2510 Error_Msg
("parentheses not allowed for range attribute", Lptr
);
2515 Restore_Scan_State
(Scan_State
);
2519 -- Here after dealing with parenthesized range attribute
2521 Sexpr
:= P_Simple_Expression
;
2523 if Token
= Tok_Apostrophe
then
2524 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2525 Expr_Form
:= EF_Range_Attr
;
2531 end P_Simple_Expression_Or_Range_Attribute
;
2537 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2539 -- Error recovery: can raise Error_Resync
2541 function P_Term
return Node_Id
is
2542 Node1
, Node2
: Node_Id
;
2543 Tokptr
: Source_Ptr
;
2549 exit when Token
not in Token_Class_Mulop
;
2550 Tokptr
:= Token_Ptr
;
2551 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2553 if Style_Check
and then not Debug_Flag_Dot_QQ
then
2554 Style
.Check_Binary_Operator
;
2557 Scan
; -- past operator
2558 Set_Left_Opnd
(Node2
, Node1
);
2559 Set_Right_Opnd
(Node2
, P_Factor
);
2570 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2572 -- Error recovery: can raise Error_Resync
2574 function P_Factor
return Node_Id
is
2579 if Token
= Tok_Abs
then
2580 Node1
:= New_Op_Node
(N_Op_Abs
, Token_Ptr
);
2583 Style
.Check_Abs_Not
;
2587 Set_Right_Opnd
(Node1
, P_Primary
);
2590 elsif Token
= Tok_Not
then
2591 Node1
:= New_Op_Node
(N_Op_Not
, Token_Ptr
);
2594 Style
.Check_Abs_Not
;
2598 Set_Right_Opnd
(Node1
, P_Primary
);
2604 if Token
= Tok_Double_Asterisk
then
2605 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2607 Set_Left_Opnd
(Node2
, Node1
);
2608 Set_Right_Opnd
(Node2
, P_Primary
);
2622 -- NUMERIC_LITERAL | null
2623 -- | STRING_LITERAL | AGGREGATE
2624 -- | NAME | QUALIFIED_EXPRESSION
2625 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2627 -- Error recovery: can raise Error_Resync
2629 function P_Primary
return Node_Id
is
2630 Scan_State
: Saved_Scan_State
;
2633 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
2634 -- Remember if previous token is a left parenthesis. This is used to
2635 -- deal with checking whether IF/CASE/FOR expressions appearing as
2636 -- primaries require extra parenthesization.
2639 -- The loop runs more than once only if misplaced pragmas are found
2640 -- or if a misplaced unary minus is skipped.
2645 -- Name token can start a name, call or qualified expression, all
2646 -- of which are acceptable possibilities for primary. Note also
2647 -- that string literal is included in name (as operator symbol)
2648 -- and type conversion is included in name (as indexed component).
2650 when Tok_Char_Literal
2652 | Tok_Operator_Symbol
2656 -- All done unless apostrophe follows
2658 if Token
/= Tok_Apostrophe
then
2661 -- Apostrophe following means that we have either just parsed
2662 -- the subtype mark of a qualified expression, or the prefix
2663 -- or a range attribute.
2665 else -- Token = Tok_Apostrophe
2666 Save_Scan_State
(Scan_State
); -- at apostrophe
2667 Scan
; -- past apostrophe
2669 -- If range attribute, then this is always an error, since
2670 -- the only legitimate case (where the scanned expression is
2671 -- a qualified simple name) is handled at the level of the
2672 -- Simple_Expression processing. This case corresponds to a
2673 -- usage such as 3 + A'Range, which is always illegal.
2675 if Token
= Tok_Range
then
2676 Restore_Scan_State
(Scan_State
); -- to apostrophe
2677 Bad_Range_Attribute
(Token_Ptr
);
2680 -- If left paren, then we have a qualified expression.
2681 -- Note that P_Name guarantees that in this case, where
2682 -- Token = Tok_Apostrophe on return, the only two possible
2683 -- tokens following the apostrophe are left paren and
2684 -- RANGE, so we know we have a left paren here.
2686 else -- Token = Tok_Left_Paren
2687 return P_Qualified_Expression
(Node1
);
2692 -- Numeric or string literal
2694 when Tok_Integer_Literal
2696 | Tok_String_Literal
2698 Node1
:= Token_Node
;
2699 Scan
; -- past number
2702 -- Left paren, starts aggregate or parenthesized expression
2704 when Tok_Left_Paren
=>
2706 Expr
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
2709 if Nkind
(Expr
) = N_Attribute_Reference
2710 and then Attribute_Name
(Expr
) = Name_Range
2712 Bad_Range_Attribute
(Sloc
(Expr
));
2727 return New_Node
(N_Null
, Prev_Token_Ptr
);
2729 -- Pragma, not allowed here, so just skip past it
2732 P_Pragmas_Misplaced
;
2734 -- Deal with IF (possible unparenthesized if expression)
2738 -- If this looks like a real if, defined as an IF appearing at
2739 -- the start of a new line, then we consider we have a missing
2740 -- operand. If in Ada 2012 and the IF is not properly indented
2741 -- for a statement, we prefer to issue a message about an ill-
2742 -- parenthesized if expression.
2744 if Token_Is_At_Start_Of_Line
2746 (Ada_Version
>= Ada_2012
2747 and then Style_Check_Indentation
/= 0
2748 and then Start_Column
rem Style_Check_Indentation
/= 0)
2750 Error_Msg_AP
("missing operand");
2753 -- If this looks like an if expression, then treat it that way
2754 -- with an error message if not explicitly surrounded by
2757 elsif Ada_Version
>= Ada_2012
then
2758 Node1
:= P_If_Expression
;
2760 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2762 ("if expression must be parenthesized", Sloc
(Node1
));
2767 -- Otherwise treat as misused identifier
2770 return P_Identifier
;
2773 -- Deal with CASE (possible unparenthesized case expression)
2777 -- If this looks like a real case, defined as a CASE appearing
2778 -- the start of a new line, then we consider we have a missing
2779 -- operand. If in Ada 2012 and the CASE is not properly
2780 -- indented for a statement, we prefer to issue a message about
2781 -- an ill-parenthesized case expression.
2783 if Token_Is_At_Start_Of_Line
2785 (Ada_Version
>= Ada_2012
2786 and then Style_Check_Indentation
/= 0
2787 and then Start_Column
rem Style_Check_Indentation
/= 0)
2789 Error_Msg_AP
("missing operand");
2792 -- If this looks like a case expression, then treat it that way
2793 -- with an error message if not within parentheses.
2795 elsif Ada_Version
>= Ada_2012
then
2796 Node1
:= P_Case_Expression
;
2798 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2800 ("case expression must be parenthesized", Sloc
(Node1
));
2805 -- Otherwise treat as misused identifier
2808 return P_Identifier
;
2811 -- For [all | some] indicates a quantified expression
2814 if Token_Is_At_Start_Of_Line
then
2815 Error_Msg_AP
("misplaced loop");
2818 elsif Ada_Version
>= Ada_2012
then
2819 Save_Scan_State
(Scan_State
);
2822 if Token
= Tok_All
or else Token
= Tok_Some
then
2823 Restore_Scan_State
(Scan_State
); -- To FOR
2824 Node1
:= P_Quantified_Expression
;
2826 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2828 ("quantified expression must be parenthesized",
2832 Restore_Scan_State
(Scan_State
); -- To FOR
2833 Node1
:= P_Iterated_Component_Association
;
2838 -- Otherwise treat as misused identifier
2841 return P_Identifier
;
2844 -- Minus may well be an improper attempt at a unary minus. Give
2845 -- a message, skip the minus and keep going.
2848 Error_Msg_SC
("parentheses required for unary minus");
2851 when Tok_At_Sign
=> -- AI12-0125 : target_name
2852 if Ada_Version
< Ada_2020
then
2853 Error_Msg_SC
("target name is an Ada 2020 extension");
2854 Error_Msg_SC
("\compile with -gnatX");
2860 -- Anything else is illegal as the first token of a primary, but
2861 -- we test for some common errors, to improve error messages.
2864 if Is_Reserved_Identifier
then
2865 return P_Identifier
;
2867 elsif Prev_Token
= Tok_Comma
then
2868 Error_Msg_SP
-- CODEFIX
2869 ("|extra "","" ignored");
2873 Error_Msg_AP
("missing operand");
2880 -------------------------------
2881 -- 4.4 Quantified_Expression --
2882 -------------------------------
2884 -- QUANTIFIED_EXPRESSION ::=
2885 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2886 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2888 function P_Quantified_Expression
return Node_Id
is
2893 Error_Msg_Ada_2012_Feature
("quantified expression", Token_Ptr
);
2895 Node1
:= New_Node
(N_Quantified_Expression
, Prev_Token_Ptr
);
2897 if Token
= Tok_All
then
2898 Set_All_Present
(Node1
);
2899 elsif Token
/= Tok_Some
then
2900 Error_Msg_AP
("missing quantifier");
2904 Scan
; -- past ALL or SOME
2905 I_Spec
:= P_Loop_Parameter_Specification
;
2907 if Nkind
(I_Spec
) = N_Loop_Parameter_Specification
then
2908 Set_Loop_Parameter_Specification
(Node1
, I_Spec
);
2910 Set_Iterator_Specification
(Node1
, I_Spec
);
2913 if Token
= Tok_Arrow
then
2915 Set_Condition
(Node1
, P_Expression
);
2918 Error_Msg_AP
("missing arrow");
2921 end P_Quantified_Expression
;
2923 ---------------------------
2924 -- 4.5 Logical Operator --
2925 ---------------------------
2927 -- LOGICAL_OPERATOR ::= and | or | xor
2929 -- Note: AND THEN and OR ELSE are also treated as logical operators
2930 -- by the parser (even though they are not operators semantically)
2932 -- The value returned is the appropriate Node_Kind code for the operator
2933 -- On return, Token points to the token following the scanned operator.
2935 -- The caller has checked that the first token is a legitimate logical
2936 -- operator token (i.e. is either XOR, AND, OR).
2938 -- Error recovery: cannot raise Error_Resync
2940 function P_Logical_Operator
return Node_Kind
is
2942 if Token
= Tok_And
then
2944 Style
.Check_Binary_Operator
;
2949 if Token
= Tok_Then
then
2956 elsif Token
= Tok_Or
then
2958 Style
.Check_Binary_Operator
;
2963 if Token
= Tok_Else
then
2970 else -- Token = Tok_Xor
2972 Style
.Check_Binary_Operator
;
2978 end P_Logical_Operator
;
2980 ------------------------------
2981 -- 4.5 Relational Operator --
2982 ------------------------------
2984 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2986 -- The value returned is the appropriate Node_Kind code for the operator.
2987 -- On return, Token points to the operator token, NOT past it.
2989 -- The caller has checked that the first token is a legitimate relational
2990 -- operator token (i.e. is one of the operator tokens listed above).
2992 -- Error recovery: cannot raise Error_Resync
2994 function P_Relational_Operator
return Node_Kind
is
2995 Op_Kind
: Node_Kind
;
2996 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
2997 (Tok_Less
=> N_Op_Lt
,
2998 Tok_Equal
=> N_Op_Eq
,
2999 Tok_Greater
=> N_Op_Gt
,
3000 Tok_Not_Equal
=> N_Op_Ne
,
3001 Tok_Greater_Equal
=> N_Op_Ge
,
3002 Tok_Less_Equal
=> N_Op_Le
,
3004 Tok_Not
=> N_Not_In
,
3005 Tok_Box
=> N_Op_Ne
);
3008 if Token
= Tok_Box
then
3009 Error_Msg_SC
-- CODEFIX
3010 ("|""'<'>"" should be ""/=""");
3013 Op_Kind
:= Relop_Node
(Token
);
3016 Style
.Check_Binary_Operator
;
3019 Scan
; -- past operator token
3021 -- Deal with NOT IN, if previous token was NOT, we must have IN now
3023 if Prev_Token
= Tok_Not
then
3025 -- Style check, for NOT IN, we require one space between NOT and IN
3027 if Style_Check
and then Token
= Tok_In
then
3035 end P_Relational_Operator
;
3037 ---------------------------------
3038 -- 4.5 Binary Adding Operator --
3039 ---------------------------------
3041 -- BINARY_ADDING_OPERATOR ::= + | - | &
3043 -- The value returned is the appropriate Node_Kind code for the operator.
3044 -- On return, Token points to the operator token (NOT past it).
3046 -- The caller has checked that the first token is a legitimate adding
3047 -- operator token (i.e. is one of the operator tokens listed above).
3049 -- Error recovery: cannot raise Error_Resync
3051 function P_Binary_Adding_Operator
return Node_Kind
is
3052 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
3053 (Tok_Ampersand
=> N_Op_Concat
,
3054 Tok_Minus
=> N_Op_Subtract
,
3055 Tok_Plus
=> N_Op_Add
);
3057 return Addop_Node
(Token
);
3058 end P_Binary_Adding_Operator
;
3060 --------------------------------
3061 -- 4.5 Unary Adding Operator --
3062 --------------------------------
3064 -- UNARY_ADDING_OPERATOR ::= + | -
3066 -- The value returned is the appropriate Node_Kind code for the operator.
3067 -- On return, Token points to the operator token (NOT past it).
3069 -- The caller has checked that the first token is a legitimate adding
3070 -- operator token (i.e. is one of the operator tokens listed above).
3072 -- Error recovery: cannot raise Error_Resync
3074 function P_Unary_Adding_Operator
return Node_Kind
is
3075 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
3076 (Tok_Minus
=> N_Op_Minus
,
3077 Tok_Plus
=> N_Op_Plus
);
3079 return Addop_Node
(Token
);
3080 end P_Unary_Adding_Operator
;
3082 -------------------------------
3083 -- 4.5 Multiplying Operator --
3084 -------------------------------
3086 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
3088 -- The value returned is the appropriate Node_Kind code for the operator.
3089 -- On return, Token points to the operator token (NOT past it).
3091 -- The caller has checked that the first token is a legitimate multiplying
3092 -- operator token (i.e. is one of the operator tokens listed above).
3094 -- Error recovery: cannot raise Error_Resync
3096 function P_Multiplying_Operator
return Node_Kind
is
3097 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
3098 (Tok_Asterisk
=> N_Op_Multiply
,
3099 Tok_Mod
=> N_Op_Mod
,
3100 Tok_Rem
=> N_Op_Rem
,
3101 Tok_Slash
=> N_Op_Divide
);
3103 return Mulop_Node
(Token
);
3104 end P_Multiplying_Operator
;
3106 --------------------------------------
3107 -- 4.5 Highest Precedence Operator --
3108 --------------------------------------
3110 -- Parsed by P_Factor (4.4)
3112 -- Note: this rule is not in fact used by the grammar at any point
3114 --------------------------
3115 -- 4.6 Type Conversion --
3116 --------------------------
3118 -- Parsed by P_Primary as a Name (4.1)
3120 -------------------------------
3121 -- 4.7 Qualified Expression --
3122 -------------------------------
3124 -- QUALIFIED_EXPRESSION ::=
3125 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
3127 -- The caller has scanned the name which is the Subtype_Mark parameter
3128 -- and scanned past the single quote following the subtype mark. The
3129 -- caller has not checked that this name is in fact appropriate for
3130 -- a subtype mark name (i.e. it is a selected component or identifier).
3132 -- Error_Recovery: cannot raise Error_Resync
3134 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
3135 Qual_Node
: Node_Id
;
3137 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
3138 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
3139 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
3141 end P_Qualified_Expression
;
3143 --------------------
3145 --------------------
3148 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
3149 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
3151 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
3153 -- The caller has checked that the initial token is NEW
3155 -- Error recovery: can raise Error_Resync
3157 function P_Allocator
return Node_Id
is
3158 Alloc_Node
: Node_Id
;
3159 Type_Node
: Node_Id
;
3160 Null_Exclusion_Present
: Boolean;
3163 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
3166 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
3168 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
3170 if Token
= Tok_Left_Paren
then
3172 Set_Subpool_Handle_Name
(Alloc_Node
, P_Name
);
3175 Error_Msg_Ada_2012_Feature
3176 ("|subpool specification",
3177 Sloc
(Subpool_Handle_Name
(Alloc_Node
)));
3180 Null_Exclusion_Present
:= P_Null_Exclusion
;
3181 Set_Null_Exclusion_Present
(Alloc_Node
, Null_Exclusion_Present
);
3182 Type_Node
:= P_Subtype_Mark_Resync
;
3184 if Token
= Tok_Apostrophe
then
3185 Scan
; -- past apostrophe
3186 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
3190 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));
3192 -- AI05-0104: An explicit null exclusion is not allowed for an
3193 -- allocator without initialization. In previous versions of the
3194 -- language it just raises constraint error.
3196 if Ada_Version
>= Ada_2012
and then Null_Exclusion_Present
then
3198 ("an allocator with a subtype indication "
3199 & "cannot have a null exclusion", Alloc_Node
);
3206 -----------------------
3207 -- P_Case_Expression --
3208 -----------------------
3210 function P_Case_Expression
return Node_Id
is
3211 Loc
: constant Source_Ptr
:= Token_Ptr
;
3212 Case_Node
: Node_Id
;
3213 Save_State
: Saved_Scan_State
;
3216 Error_Msg_Ada_2012_Feature
("|case expression", Token_Ptr
);
3219 Make_Case_Expression
(Loc
,
3220 Expression
=> P_Expression_No_Right_Paren
,
3221 Alternatives
=> New_List
);
3224 -- We now have scanned out CASE expression IS, scan alternatives
3228 Append_To
(Alternatives
(Case_Node
), P_Case_Expression_Alternative
);
3230 -- Missing comma if WHEN (more alternatives present)
3232 if Token
= Tok_When
then
3235 -- A semicolon followed by "when" is probably meant to be a comma
3237 elsif Token
= Tok_Semicolon
then
3238 Save_Scan_State
(Save_State
);
3239 Scan
; -- past the semicolon
3241 if Token
/= Tok_When
then
3242 Restore_Scan_State
(Save_State
);
3246 Error_Msg_SP
-- CODEFIX
3247 ("|"";"" should be "",""");
3249 -- If comma/WHEN, skip comma and we have another alternative
3251 elsif Token
= Tok_Comma
then
3252 Save_Scan_State
(Save_State
);
3255 if Token
/= Tok_When
then
3256 Restore_Scan_State
(Save_State
);
3260 -- If no comma or WHEN, definitely done
3267 -- If we have an END CASE, diagnose as not needed
3269 if Token
= Tok_End
then
3270 Error_Msg_SC
("`END CASE` not allowed at end of case expression");
3273 if Token
= Tok_Case
then
3278 -- Return the Case_Expression node
3281 end P_Case_Expression
;
3283 -----------------------------------
3284 -- P_Case_Expression_Alternative --
3285 -----------------------------------
3287 -- CASE_STATEMENT_ALTERNATIVE ::=
3288 -- when DISCRETE_CHOICE_LIST =>
3291 -- The caller has checked that and scanned past the initial WHEN token
3292 -- Error recovery: can raise Error_Resync
3294 function P_Case_Expression_Alternative
return Node_Id
is
3295 Case_Alt_Node
: Node_Id
;
3297 Case_Alt_Node
:= New_Node
(N_Case_Expression_Alternative
, Token_Ptr
);
3298 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
3300 Set_Expression
(Case_Alt_Node
, P_Expression
);
3301 return Case_Alt_Node
;
3302 end P_Case_Expression_Alternative
;
3304 --------------------------------------
3305 -- P_Iterated_Component_Association --
3306 --------------------------------------
3308 -- ITERATED_COMPONENT_ASSOCIATION ::=
3309 -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
3311 function P_Iterated_Component_Association
return Node_Id
is
3312 Assoc_Node
: Node_Id
;
3314 -- Start of processing for P_Iterated_Component_Association
3319 New_Node
(N_Iterated_Component_Association
, Prev_Token_Ptr
);
3321 Set_Defining_Identifier
(Assoc_Node
, P_Defining_Identifier
);
3323 Set_Discrete_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
3325 Set_Expression
(Assoc_Node
, P_Expression
);
3327 if Ada_Version
< Ada_2020
then
3328 Error_Msg_SC
("iterated component is an Ada 2020 extension");
3329 Error_Msg_SC
("\compile with -gnatX");
3333 end P_Iterated_Component_Association
;
3335 ---------------------
3336 -- P_If_Expression --
3337 ---------------------
3339 -- IF_EXPRESSION ::=
3340 -- if CONDITION then DEPENDENT_EXPRESSION
3341 -- {elsif CONDITION then DEPENDENT_EXPRESSION}
3342 -- [else DEPENDENT_EXPRESSION]
3344 -- DEPENDENT_EXPRESSION ::= EXPRESSION
3346 function P_If_Expression
return Node_Id
is
3347 function P_If_Expression_Internal
3349 Cond
: Node_Id
) return Node_Id
;
3350 -- This is the internal recursive routine that does all the work, it is
3351 -- recursive since it is used to process ELSIF parts, which internally
3352 -- are N_If_Expression nodes with the Is_Elsif flag set. The calling
3353 -- sequence is like the outer function except that the caller passes
3354 -- the conditional expression (scanned using P_Expression), and the
3355 -- scan pointer points just past this expression. Loc points to the
3356 -- IF or ELSIF token.
3358 ------------------------------
3359 -- P_If_Expression_Internal --
3360 ------------------------------
3362 function P_If_Expression_Internal
3364 Cond
: Node_Id
) return Node_Id
3366 Exprs
: constant List_Id
:= New_List
;
3368 State
: Saved_Scan_State
;
3372 -- All cases except where we are at right paren
3374 if Token
/= Tok_Right_Paren
then
3376 Append_To
(Exprs
, P_Condition
(Cond
));
3377 Append_To
(Exprs
, P_Expression
);
3379 -- Case of right paren (missing THEN phrase). Note that we know this
3380 -- is the IF case, since the caller dealt with this possibility in
3384 Error_Msg_BC
("missing THEN phrase");
3385 Append_To
(Exprs
, P_Condition
(Cond
));
3388 -- We now have scanned out IF expr THEN expr
3390 -- Check for common error of semicolon before the ELSE
3392 if Token
= Tok_Semicolon
then
3393 Save_Scan_State
(State
);
3394 Scan
; -- past semicolon
3396 if Token
= Tok_Else
or else Token
= Tok_Elsif
then
3397 Error_Msg_SP
-- CODEFIX
3398 ("|extra "";"" ignored");
3401 Restore_Scan_State
(State
);
3405 -- Scan out ELSIF sequence if present
3407 if Token
= Tok_Elsif
then
3410 Expr
:= P_Expression
;
3412 -- If we are at a right paren, we assume the ELSIF should be ELSE
3414 if Token
= Tok_Right_Paren
then
3415 Error_Msg
("ELSIF should be ELSE", Eptr
);
3416 Append_To
(Exprs
, Expr
);
3418 -- Otherwise we have an OK ELSIF
3421 Expr
:= P_If_Expression_Internal
(Eptr
, Expr
);
3422 Set_Is_Elsif
(Expr
);
3423 Append_To
(Exprs
, Expr
);
3426 -- Scan out ELSE phrase if present
3428 elsif Token
= Tok_Else
then
3430 -- Scan out ELSE expression
3433 Append_To
(Exprs
, P_Expression
);
3435 -- Skip redundant ELSE parts
3437 while Token
= Tok_Else
loop
3438 Error_Msg_SC
("only one ELSE part is allowed");
3440 Discard_Junk_Node
(P_Expression
);
3443 -- Two expression case (implied True, filled in during semantics)
3449 -- If we have an END IF, diagnose as not needed
3451 if Token
= Tok_End
then
3452 Error_Msg_SC
("`END IF` not allowed at end of if expression");
3455 if Token
= Tok_If
then
3460 -- Return the If_Expression node
3462 return Make_If_Expression
(Loc
, Expressions
=> Exprs
);
3463 end P_If_Expression_Internal
;
3467 Loc
: constant Source_Ptr
:= Token_Ptr
;
3470 -- Start of processing for P_If_Expression
3473 Error_Msg_Ada_2012_Feature
("|if expression", Token_Ptr
);
3475 Inside_If_Expression
:= Inside_If_Expression
+ 1;
3476 If_Expr
:= P_If_Expression_Internal
(Loc
, P_Expression
);
3477 Inside_If_Expression
:= Inside_If_Expression
- 1;
3479 end P_If_Expression
;
3481 -----------------------
3482 -- P_Membership_Test --
3483 -----------------------
3485 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3486 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3488 procedure P_Membership_Test
(N
: Node_Id
) is
3489 Alt
: constant Node_Id
:=
3490 P_Range_Or_Subtype_Mark
3491 (Allow_Simple_Expression
=> (Ada_Version
>= Ada_2012
));
3496 if Token
= Tok_Vertical_Bar
then
3497 Error_Msg_Ada_2012_Feature
("set notation", Token_Ptr
);
3498 Set_Alternatives
(N
, New_List
(Alt
));
3499 Set_Right_Opnd
(N
, Empty
);
3501 -- Loop to accumulate alternatives
3503 while Token
= Tok_Vertical_Bar
loop
3504 Scan
; -- past vertical bar
3507 P_Range_Or_Subtype_Mark
(Allow_Simple_Expression
=> True));
3513 Set_Right_Opnd
(N
, Alt
);
3514 Set_Alternatives
(N
, No_List
);
3516 end P_Membership_Test
;
3518 ------------------------------------------
3519 -- P_Unparen_Cond_Case_Quant_Expression --
3520 ------------------------------------------
3522 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
is
3523 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
3526 Scan_State
: Saved_Scan_State
;
3531 if Token
= Tok_Case
then
3532 Result
:= P_Case_Expression
;
3534 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3535 Error_Msg_N
("case expression must be parenthesized!", Result
);
3540 elsif Token
= Tok_If
then
3541 Result
:= P_If_Expression
;
3543 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3544 Error_Msg_N
("if expression must be parenthesized!", Result
);
3547 -- Quantified expression or iterated component association
3549 elsif Token
= Tok_For
then
3551 Save_Scan_State
(Scan_State
);
3554 if Token
= Tok_All
or else Token
= Tok_Some
then
3555 Restore_Scan_State
(Scan_State
);
3556 Result
:= P_Quantified_Expression
;
3558 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3560 ("quantified expression must be parenthesized!", Result
);
3564 -- If no quantifier keyword, this is an iterated component in
3567 Restore_Scan_State
(Scan_State
);
3568 Result
:= P_Iterated_Component_Association
;
3571 -- No other possibility should exist (caller was supposed to check)
3574 raise Program_Error
;
3577 -- Return expression (possibly after having given message)
3580 end P_Unparen_Cond_Case_Quant_Expression
;