1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2012, 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_Stub_Type
=> True,
44 Attribute_Version
=> True,
45 Attribute_Type_Key
=> True,
47 -- This map contains True for parameterless attributes that return a
48 -- string or a type. For those attributes, a left parenthesis after
49 -- the attribute should not be analyzed as the beginning of a parameters
50 -- list because it may denote a slice operation (X'Img (1 .. 2)) or
51 -- a type conversion (X'Class (Y)).
53 -- Note that this map designates the minimum set of attributes where a
54 -- construct in parentheses that is not an argument can appear right
55 -- after the attribute. For attributes like 'Size, we do not put them
56 -- in the map. If someone writes X'Size (3), that's illegal in any case,
57 -- but we get a better error message by parsing the (3) as an illegal
58 -- argument to the attribute, rather than some meaningless junk that
59 -- follows the attribute.
61 -----------------------
62 -- Local Subprograms --
63 -----------------------
65 function P_Aggregate_Or_Paren_Expr
return Node_Id
;
66 function P_Allocator
return Node_Id
;
67 function P_Case_Expression_Alternative
return Node_Id
;
68 function P_Record_Or_Array_Component_Association
return Node_Id
;
69 function P_Factor
return Node_Id
;
70 function P_Primary
return Node_Id
;
71 function P_Relation
return Node_Id
;
72 function P_Term
return Node_Id
;
74 function P_Binary_Adding_Operator
return Node_Kind
;
75 function P_Logical_Operator
return Node_Kind
;
76 function P_Multiplying_Operator
return Node_Kind
;
77 function P_Relational_Operator
return Node_Kind
;
78 function P_Unary_Adding_Operator
return Node_Kind
;
80 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
);
81 -- Called to place complaint about bad range attribute at the given
82 -- source location. Terminates by raising Error_Resync.
84 procedure Check_Bad_Exp
;
85 -- Called after scanning a**b, posts error if ** detected
87 procedure P_Membership_Test
(N
: Node_Id
);
88 -- N is the node for a N_In or N_Not_In node whose right operand has not
89 -- yet been processed. It is called just after scanning out the IN keyword.
90 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
92 function P_Range_Attribute_Reference
(Prefix_Node
: Node_Id
) return Node_Id
;
93 -- Scan a range attribute reference. The caller has scanned out the
94 -- prefix. The current token is known to be an apostrophe and the
95 -- following token is known to be RANGE.
97 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
;
98 -- This function is called with Token pointing to IF, CASE, or FOR, in a
99 -- context that allows a case, conditional, or quantified expression if
100 -- it is surrounded by parentheses. If not surrounded by parentheses, the
101 -- expression is still returned, but an error message is issued.
103 -------------------------
104 -- Bad_Range_Attribute --
105 -------------------------
107 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
109 Error_Msg
("range attribute cannot be used in expression!", Loc
);
111 end Bad_Range_Attribute
;
117 procedure Check_Bad_Exp
is
119 if Token
= Tok_Double_Asterisk
then
120 Error_Msg_SC
("parenthesization required for '*'*");
122 Discard_Junk_Node
(P_Primary
);
127 --------------------------
128 -- 4.1 Name (also 6.4) --
129 --------------------------
132 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
133 -- | INDEXED_COMPONENT | SLICE
134 -- | SELECTED_COMPONENT | ATTRIBUTE
135 -- | TYPE_CONVERSION | FUNCTION_CALL
136 -- | CHARACTER_LITERAL
138 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
140 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
142 -- EXPLICIT_DEREFERENCE ::= NAME . all
144 -- IMPLICIT_DEREFERENCE ::= NAME
146 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
148 -- SLICE ::= PREFIX (DISCRETE_RANGE)
150 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
152 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
154 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
156 -- ATTRIBUTE_DESIGNATOR ::=
157 -- IDENTIFIER [(static_EXPRESSION)]
158 -- | access | delta | digits
162 -- | function_PREFIX ACTUAL_PARAMETER_PART
164 -- ACTUAL_PARAMETER_PART ::=
165 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
167 -- PARAMETER_ASSOCIATION ::=
168 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
170 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
172 -- Note: syntactically a procedure call looks just like a function call,
173 -- so this routine is in practice used to scan out procedure calls as well.
175 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
177 -- Error recovery: can raise Error_Resync
179 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
180 -- followed by either a left paren (qualified expression case), or by
181 -- range (range attribute case). All other uses of apostrophe (i.e. all
182 -- other attributes) are handled in this routine.
184 -- Error recovery: can raise Error_Resync
186 function P_Name
return Node_Id
is
187 Scan_State
: Saved_Scan_State
;
189 Prefix_Node
: Node_Id
;
190 Ident_Node
: Node_Id
;
192 Range_Node
: Node_Id
;
195 Arg_List
: List_Id
:= No_List
; -- kill junk warning
196 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
199 -- Case of not a name
201 if Token
not in Token_Class_Name
then
203 -- If it looks like start of expression, complain and scan expression
205 if Token
in Token_Class_Literal
206 or else Token
= Tok_Left_Paren
208 Error_Msg_SC
("name expected");
211 -- Otherwise some other junk, not much we can do
214 Error_Msg_AP
("name expected");
219 -- Loop through designators in qualified name
221 Name_Node
:= Token_Node
;
224 Scan
; -- past designator
225 exit when Token
/= Tok_Dot
;
226 Save_Scan_State
(Scan_State
); -- at dot
229 -- If we do not have another designator after the dot, then join
230 -- the normal circuit to handle a dot extension (may be .all or
231 -- character literal case). Otherwise loop back to scan the next
234 if Token
not in Token_Class_Desig
then
235 goto Scan_Name_Extension_Dot
;
237 Prefix_Node
:= Name_Node
;
238 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
239 Set_Prefix
(Name_Node
, Prefix_Node
);
240 Set_Selector_Name
(Name_Node
, Token_Node
);
244 -- We have now scanned out a qualified designator. If the last token is
245 -- an operator symbol, then we certainly do not have the Snam case, so
246 -- we can just use the normal name extension check circuit
248 if Prev_Token
= Tok_Operator_Symbol
then
249 goto Scan_Name_Extension
;
252 -- We have scanned out a qualified simple name, check for name extension
253 -- Note that we know there is no dot here at this stage, so the only
254 -- possible cases of name extension are apostrophe and left paren.
256 if Token
= Tok_Apostrophe
then
257 Save_Scan_State
(Scan_State
); -- at apostrophe
258 Scan
; -- past apostrophe
260 -- Qualified expression in Ada 2012 mode (treated as a name)
262 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
263 goto Scan_Name_Extension_Apostrophe
;
265 -- If left paren not in Ada 2012, then it is not part of the name,
266 -- since qualified expressions are not names in prior versions of
267 -- Ada, so return with Token backed up to point to the apostrophe.
268 -- The treatment for the range attribute is similar (we do not
269 -- consider x'range to be a name in this grammar).
271 elsif Token
= Tok_Left_Paren
or else Token
= Tok_Range
then
272 Restore_Scan_State
(Scan_State
); -- to apostrophe
273 Expr_Form
:= EF_Simple_Name
;
276 -- Otherwise we have the case of a name extended by an attribute
279 goto Scan_Name_Extension_Apostrophe
;
282 -- Check case of qualified simple name extended by a left parenthesis
284 elsif Token
= Tok_Left_Paren
then
285 Scan
; -- past left paren
286 goto Scan_Name_Extension_Left_Paren
;
288 -- Otherwise the qualified simple name is not extended, so return
291 Expr_Form
:= EF_Simple_Name
;
295 -- Loop scanning past name extensions. A label is used for control
296 -- transfer for this loop for ease of interfacing with the finite state
297 -- machine in the parenthesis scanning circuit, and also to allow for
298 -- passing in control to the appropriate point from the above code.
300 <<Scan_Name_Extension
>>
302 -- Character literal used as name cannot be extended. Also this
303 -- cannot be a call, since the name for a call must be a designator.
304 -- Return in these cases, or if there is no name extension
306 if Token
not in Token_Class_Namext
307 or else Prev_Token
= Tok_Char_Literal
309 Expr_Form
:= EF_Name
;
313 -- Merge here when we know there is a name extension
315 <<Scan_Name_Extension_OK
>>
317 if Token
= Tok_Left_Paren
then
318 Scan
; -- past left paren
319 goto Scan_Name_Extension_Left_Paren
;
321 elsif Token
= Tok_Apostrophe
then
322 Save_Scan_State
(Scan_State
); -- at apostrophe
323 Scan
; -- past apostrophe
324 goto Scan_Name_Extension_Apostrophe
;
326 else -- Token = Tok_Dot
327 Save_Scan_State
(Scan_State
); -- at dot
329 goto Scan_Name_Extension_Dot
;
332 -- Case of name extended by dot (selection), dot is already skipped
333 -- and the scan state at the point of the dot is saved in Scan_State.
335 <<Scan_Name_Extension_Dot
>>
337 -- Explicit dereference case
339 if Token
= Tok_All
then
340 Prefix_Node
:= Name_Node
;
341 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
342 Set_Prefix
(Name_Node
, Prefix_Node
);
344 goto Scan_Name_Extension
;
346 -- Selected component case
348 elsif Token
in Token_Class_Name
then
349 Prefix_Node
:= Name_Node
;
350 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
351 Set_Prefix
(Name_Node
, Prefix_Node
);
352 Set_Selector_Name
(Name_Node
, Token_Node
);
353 Scan
; -- past selector
354 goto Scan_Name_Extension
;
356 -- Reserved identifier as selector
358 elsif Is_Reserved_Identifier
then
359 Scan_Reserved_Identifier
(Force_Msg
=> False);
360 Prefix_Node
:= Name_Node
;
361 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
362 Set_Prefix
(Name_Node
, Prefix_Node
);
363 Set_Selector_Name
(Name_Node
, Token_Node
);
364 Scan
; -- past identifier used as selector
365 goto Scan_Name_Extension
;
367 -- If dot is at end of line and followed by nothing legal,
368 -- then assume end of name and quit (dot will be taken as
369 -- an erroneous form of some other punctuation by our caller).
371 elsif Token_Is_At_Start_Of_Line
then
372 Restore_Scan_State
(Scan_State
);
375 -- Here if nothing legal after the dot
378 Error_Msg_AP
("selector expected");
382 -- Here for an apostrophe as name extension. The scan position at the
383 -- apostrophe has already been saved, and the apostrophe scanned out.
385 <<Scan_Name_Extension_Apostrophe
>>
387 Scan_Apostrophe
: declare
388 function Apostrophe_Should_Be_Semicolon
return Boolean;
389 -- Checks for case where apostrophe should probably be
390 -- a semicolon, and if so, gives appropriate message,
391 -- resets the scan pointer to the apostrophe, changes
392 -- the current token to Tok_Semicolon, and returns True.
393 -- Otherwise returns False.
395 ------------------------------------
396 -- Apostrophe_Should_Be_Semicolon --
397 ------------------------------------
399 function Apostrophe_Should_Be_Semicolon
return Boolean is
401 if Token_Is_At_Start_Of_Line
then
402 Restore_Scan_State
(Scan_State
); -- to apostrophe
403 Error_Msg_SC
("|""''"" should be "";""");
404 Token
:= Tok_Semicolon
;
409 end Apostrophe_Should_Be_Semicolon
;
411 -- Start of processing for Scan_Apostrophe
414 -- Check for qualified expression case in Ada 2012 mode
416 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
417 Name_Node
:= P_Qualified_Expression
(Name_Node
);
418 goto Scan_Name_Extension
;
420 -- If range attribute after apostrophe, then return with Token
421 -- pointing to the apostrophe. Note that in this case the prefix
422 -- need not be a simple name (cases like A.all'range). Similarly
423 -- if there is a left paren after the apostrophe, then we also
424 -- return with Token pointing to the apostrophe (this is the
425 -- aggregate case, or some error case).
427 elsif Token
= Tok_Range
or else Token
= Tok_Left_Paren
then
428 Restore_Scan_State
(Scan_State
); -- to apostrophe
429 Expr_Form
:= EF_Name
;
432 -- Here for cases where attribute designator is an identifier
434 elsif Token
= Tok_Identifier
then
435 Attr_Name
:= Token_Name
;
437 if not Is_Attribute_Name
(Attr_Name
) then
438 if Apostrophe_Should_Be_Semicolon
then
439 Expr_Form
:= EF_Name
;
442 -- Here for a bad attribute name
445 Signal_Bad_Attribute
;
446 Scan
; -- past bad identifier
448 if Token
= Tok_Left_Paren
then
449 Scan
; -- past left paren
452 Discard_Junk_Node
(P_Expression_If_OK
);
453 exit when not Comma_Present
;
464 Style
.Check_Attribute_Name
(False);
467 -- Here for case of attribute designator is not an identifier
470 if Token
= Tok_Delta
then
471 Attr_Name
:= Name_Delta
;
473 elsif Token
= Tok_Digits
then
474 Attr_Name
:= Name_Digits
;
476 elsif Token
= Tok_Access
then
477 Attr_Name
:= Name_Access
;
479 elsif Token
= Tok_Mod
and then Ada_Version
>= Ada_95
then
480 Attr_Name
:= Name_Mod
;
482 elsif Apostrophe_Should_Be_Semicolon
then
483 Expr_Form
:= EF_Name
;
487 Error_Msg_AP
("attribute designator expected");
492 Style
.Check_Attribute_Name
(True);
496 -- We come here with an OK attribute scanned, and corresponding
497 -- Attribute identifier node stored in Ident_Node.
499 Prefix_Node
:= Name_Node
;
500 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
501 Scan
; -- past attribute designator
502 Set_Prefix
(Name_Node
, Prefix_Node
);
503 Set_Attribute_Name
(Name_Node
, Attr_Name
);
505 -- Scan attribute arguments/designator. We skip this if we know
506 -- that the attribute cannot have an argument.
508 if Token
= Tok_Left_Paren
510 Is_Parameterless_Attribute
(Get_Attribute_Id
(Attr_Name
))
512 Set_Expressions
(Name_Node
, New_List
);
514 -- Attribute Update contains an array or record association
515 -- list which provides new values for various components or
516 -- elements. The list is parsed as an aggregate.
518 if Attr_Name
= Name_Update
then
519 Append
(P_Aggregate
, Expressions
(Name_Node
));
522 Scan
; -- past left paren
526 Expr
: constant Node_Id
:= P_Expression_If_OK
;
529 if Token
= Tok_Arrow
then
531 ("named parameters not permitted for attributes");
532 Scan
; -- past junk arrow
535 Append
(Expr
, Expressions
(Name_Node
));
536 exit when not Comma_Present
;
545 goto Scan_Name_Extension
;
548 -- Here for left parenthesis extending name (left paren skipped)
550 <<Scan_Name_Extension_Left_Paren
>>
552 -- We now have to scan through a list of items, terminated by a
553 -- right parenthesis. The scan is handled by a finite state
554 -- machine. The possibilities are:
558 -- This is a slice. This case is handled in LP_State_Init
560 -- (expression, expression, ..)
562 -- This is interpreted as an indexed component, i.e. as a
563 -- case of a name which can be extended in the normal manner.
564 -- This case is handled by LP_State_Name or LP_State_Expr.
566 -- Note: if and case expressions (without an extra level of
567 -- parentheses) are permitted in this context).
569 -- (..., identifier => expression , ...)
571 -- If there is at least one occurrence of identifier => (but
572 -- none of the other cases apply), then we have a call.
574 -- Test for Id => case
576 if Token
= Tok_Identifier
then
577 Save_Scan_State
(Scan_State
); -- at Id
580 -- Test for => (allow := as an error substitute)
582 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
583 Restore_Scan_State
(Scan_State
); -- to Id
584 Arg_List
:= New_List
;
588 Restore_Scan_State
(Scan_State
); -- to Id
592 -- Here we have an expression after all
594 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
596 -- Check cases of discrete range for a slice
598 -- First possibility: Range_Attribute_Reference
600 if Expr_Form
= EF_Range_Attr
then
601 Range_Node
:= Expr_Node
;
603 -- Second possibility: Simple_expression .. Simple_expression
605 elsif Token
= Tok_Dot_Dot
then
606 Check_Simple_Expression
(Expr_Node
);
607 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
608 Set_Low_Bound
(Range_Node
, Expr_Node
);
610 Expr_Node
:= P_Expression
;
611 Check_Simple_Expression
(Expr_Node
);
612 Set_High_Bound
(Range_Node
, Expr_Node
);
614 -- Third possibility: Type_name range Range
616 elsif Token
= Tok_Range
then
617 if Expr_Form
/= EF_Simple_Name
then
618 Error_Msg_SC
("subtype mark must precede RANGE");
622 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
624 -- Otherwise we just have an expression. It is true that we might
625 -- have a subtype mark without a range constraint but this case
626 -- is syntactically indistinguishable from the expression case.
629 Arg_List
:= New_List
;
633 -- Fall through here with unmistakable Discrete range scanned,
634 -- which means that we definitely have the case of a slice. The
635 -- Discrete range is in Range_Node.
637 if Token
= Tok_Comma
then
638 Error_Msg_SC
("slice cannot have more than one dimension");
641 elsif Token
/= Tok_Right_Paren
then
642 if Token
= Tok_Arrow
then
644 -- This may be an aggregate that is missing a qualification
647 ("context of aggregate must be a qualified expression");
656 Scan
; -- past right paren
657 Prefix_Node
:= Name_Node
;
658 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
659 Set_Prefix
(Name_Node
, Prefix_Node
);
660 Set_Discrete_Range
(Name_Node
, Range_Node
);
662 -- An operator node is legal as a prefix to other names,
663 -- but not for a slice.
665 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
666 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
669 -- If we have a name extension, go scan it
671 if Token
in Token_Class_Namext
then
672 goto Scan_Name_Extension_OK
;
674 -- Otherwise return (a slice is a name, but is not a call)
677 Expr_Form
:= EF_Name
;
682 -- In LP_State_Expr, we have scanned one or more expressions, and
683 -- so we have a call or an indexed component which is a name. On
684 -- entry we have the expression just scanned in Expr_Node and
685 -- Arg_List contains the list of expressions encountered so far
688 Append
(Expr_Node
, Arg_List
);
690 if Token
= Tok_Arrow
then
692 ("expect identifier in parameter association",
696 elsif not Comma_Present
then
698 Prefix_Node
:= Name_Node
;
699 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
700 Set_Prefix
(Name_Node
, Prefix_Node
);
701 Set_Expressions
(Name_Node
, Arg_List
);
702 goto Scan_Name_Extension
;
705 -- Comma present (and scanned out), test for identifier => case
706 -- Test for identifier => case
708 if Token
= Tok_Identifier
then
709 Save_Scan_State
(Scan_State
); -- at Id
712 -- Test for => (allow := as error substitute)
714 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
715 Restore_Scan_State
(Scan_State
); -- to Id
718 -- Otherwise it's just an expression after all, so backup
721 Restore_Scan_State
(Scan_State
); -- to Id
725 -- Here we have an expression after all, so stay in this state
727 Expr_Node
:= P_Expression_If_OK
;
730 -- LP_State_Call corresponds to the situation in which at least
731 -- one instance of Id => Expression has been encountered, so we
732 -- know that we do not have a name, but rather a call. We enter
733 -- it with the scan pointer pointing to the next argument to scan,
734 -- and Arg_List containing the list of arguments scanned so far.
738 -- Test for case of Id => Expression (named parameter)
740 if Token
= Tok_Identifier
then
741 Save_Scan_State
(Scan_State
); -- at Id
742 Ident_Node
:= Token_Node
;
745 -- Deal with => (allow := as erroneous substitute)
747 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
748 Arg_Node
:= New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
749 Set_Selector_Name
(Arg_Node
, Ident_Node
);
751 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
752 Append
(Arg_Node
, Arg_List
);
754 -- If a comma follows, go back and scan next entry
756 if Comma_Present
then
759 -- Otherwise we have the end of a call
762 Prefix_Node
:= Name_Node
;
763 Name_Node
:= New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
764 Set_Name
(Name_Node
, Prefix_Node
);
765 Set_Parameter_Associations
(Name_Node
, Arg_List
);
768 if Token
in Token_Class_Namext
then
769 goto Scan_Name_Extension_OK
;
771 -- This is a case of a call which cannot be a name
774 Expr_Form
:= EF_Name
;
779 -- Not named parameter: Id started an expression after all
782 Restore_Scan_State
(Scan_State
); -- to Id
786 -- Here if entry did not start with Id => which means that it
787 -- is a positional parameter, which is not allowed, since we
788 -- have seen at least one named parameter already.
791 ("positional parameter association " &
792 "not allowed after named one");
794 Expr_Node
:= P_Expression_If_OK
;
796 -- Leaving the '>' in an association is not unusual, so suggest
799 if Nkind
(Expr_Node
) = N_Op_Eq
then
800 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
803 -- We go back to scanning out expressions, so that we do not get
804 -- multiple error messages when several positional parameters
805 -- follow a named parameter.
809 -- End of treatment for name extensions starting with left paren
811 -- End of loop through name extensions
815 -- This function parses a restricted form of Names which are either
816 -- designators, or designators preceded by a sequence of prefixes
817 -- that are direct names.
819 -- Error recovery: cannot raise Error_Resync
821 function P_Function_Name
return Node_Id
is
822 Designator_Node
: Node_Id
;
823 Prefix_Node
: Node_Id
;
824 Selector_Node
: Node_Id
;
825 Dot_Sloc
: Source_Ptr
:= No_Location
;
828 -- Prefix_Node is set to the gathered prefix so far, Empty means that
829 -- no prefix has been scanned. This allows us to build up the result
830 -- in the required right recursive manner.
832 Prefix_Node
:= Empty
;
834 -- Loop through prefixes
837 Designator_Node
:= Token_Node
;
839 if Token
not in Token_Class_Desig
then
840 return P_Identifier
; -- let P_Identifier issue the error message
842 else -- Token in Token_Class_Desig
843 Scan
; -- past designator
844 exit when Token
/= Tok_Dot
;
847 -- Here at a dot, with token just before it in Designator_Node
849 if No
(Prefix_Node
) then
850 Prefix_Node
:= Designator_Node
;
852 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
853 Set_Prefix
(Selector_Node
, Prefix_Node
);
854 Set_Selector_Name
(Selector_Node
, Designator_Node
);
855 Prefix_Node
:= Selector_Node
;
858 Dot_Sloc
:= Token_Ptr
;
862 -- Fall out of the loop having just scanned a designator
864 if No
(Prefix_Node
) then
865 return Designator_Node
;
867 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
868 Set_Prefix
(Selector_Node
, Prefix_Node
);
869 Set_Selector_Name
(Selector_Node
, Designator_Node
);
870 return Selector_Node
;
878 -- This function parses a restricted form of Names which are either
879 -- identifiers, or identifiers preceded by a sequence of prefixes
880 -- that are direct names.
882 -- Error recovery: cannot raise Error_Resync
884 function P_Qualified_Simple_Name
return Node_Id
is
885 Designator_Node
: Node_Id
;
886 Prefix_Node
: Node_Id
;
887 Selector_Node
: Node_Id
;
888 Dot_Sloc
: Source_Ptr
:= No_Location
;
891 -- Prefix node is set to the gathered prefix so far, Empty means that
892 -- no prefix has been scanned. This allows us to build up the result
893 -- in the required right recursive manner.
895 Prefix_Node
:= Empty
;
897 -- Loop through prefixes
900 Designator_Node
:= Token_Node
;
902 if Token
= Tok_Identifier
then
903 Scan
; -- past identifier
904 exit when Token
/= Tok_Dot
;
906 elsif Token
not in Token_Class_Desig
then
907 return P_Identifier
; -- let P_Identifier issue the error message
910 Scan
; -- past designator
912 if Token
/= Tok_Dot
then
913 Error_Msg_SP
("identifier expected");
918 -- Here at a dot, with token just before it in Designator_Node
920 if No
(Prefix_Node
) then
921 Prefix_Node
:= Designator_Node
;
923 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
924 Set_Prefix
(Selector_Node
, Prefix_Node
);
925 Set_Selector_Name
(Selector_Node
, Designator_Node
);
926 Prefix_Node
:= Selector_Node
;
929 Dot_Sloc
:= Token_Ptr
;
933 -- Fall out of the loop having just scanned an identifier
935 if No
(Prefix_Node
) then
936 return Designator_Node
;
938 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
939 Set_Prefix
(Selector_Node
, Prefix_Node
);
940 Set_Selector_Name
(Selector_Node
, Designator_Node
);
941 return Selector_Node
;
947 end P_Qualified_Simple_Name
;
949 -- This procedure differs from P_Qualified_Simple_Name only in that it
950 -- raises Error_Resync if any error is encountered. It only returns after
951 -- scanning a valid qualified simple name.
953 -- Error recovery: can raise Error_Resync
955 function P_Qualified_Simple_Name_Resync
return Node_Id
is
956 Designator_Node
: Node_Id
;
957 Prefix_Node
: Node_Id
;
958 Selector_Node
: Node_Id
;
959 Dot_Sloc
: Source_Ptr
:= No_Location
;
962 Prefix_Node
:= Empty
;
964 -- Loop through prefixes
967 Designator_Node
:= Token_Node
;
969 if Token
= Tok_Identifier
then
970 Scan
; -- past identifier
971 exit when Token
/= Tok_Dot
;
973 elsif Token
not in Token_Class_Desig
then
974 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
978 Scan
; -- past designator
980 if Token
/= Tok_Dot
then
981 Error_Msg_SP
("identifier expected");
986 -- Here at a dot, with token just before it in Designator_Node
988 if No
(Prefix_Node
) then
989 Prefix_Node
:= Designator_Node
;
991 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
992 Set_Prefix
(Selector_Node
, Prefix_Node
);
993 Set_Selector_Name
(Selector_Node
, Designator_Node
);
994 Prefix_Node
:= Selector_Node
;
997 Dot_Sloc
:= Token_Ptr
;
1001 -- Fall out of the loop having just scanned an identifier
1003 if No
(Prefix_Node
) then
1004 return Designator_Node
;
1006 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1007 Set_Prefix
(Selector_Node
, Prefix_Node
);
1008 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1009 return Selector_Node
;
1011 end P_Qualified_Simple_Name_Resync
;
1013 ----------------------
1014 -- 4.1 Direct_Name --
1015 ----------------------
1017 -- Parsed by P_Name and other functions in section 4.1
1023 -- Parsed by P_Name (4.1)
1025 -------------------------------
1026 -- 4.1 Explicit Dereference --
1027 -------------------------------
1029 -- Parsed by P_Name (4.1)
1031 -------------------------------
1032 -- 4.1 Implicit_Dereference --
1033 -------------------------------
1035 -- Parsed by P_Name (4.1)
1037 ----------------------------
1038 -- 4.1 Indexed Component --
1039 ----------------------------
1041 -- Parsed by P_Name (4.1)
1047 -- Parsed by P_Name (4.1)
1049 -----------------------------
1050 -- 4.1 Selected_Component --
1051 -----------------------------
1053 -- Parsed by P_Name (4.1)
1055 ------------------------
1056 -- 4.1 Selector Name --
1057 ------------------------
1059 -- Parsed by P_Name (4.1)
1061 ------------------------------
1062 -- 4.1 Attribute Reference --
1063 ------------------------------
1065 -- Parsed by P_Name (4.1)
1067 -------------------------------
1068 -- 4.1 Attribute Designator --
1069 -------------------------------
1071 -- Parsed by P_Name (4.1)
1073 --------------------------------------
1074 -- 4.1.4 Range Attribute Reference --
1075 --------------------------------------
1077 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1079 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1081 -- In the grammar, a RANGE attribute is simply a name, but its use is
1082 -- highly restricted, so in the parser, we do not regard it as a name.
1083 -- Instead, P_Name returns without scanning the 'RANGE part of the
1084 -- attribute, and the caller uses the following function to construct
1085 -- a range attribute in places where it is appropriate.
1087 -- Note that RANGE here is treated essentially as an identifier,
1088 -- rather than a reserved word.
1090 -- The caller has parsed the prefix, i.e. a name, and Token points to
1091 -- the apostrophe. The token after the apostrophe is known to be RANGE
1092 -- at this point. The prefix node becomes the prefix of the attribute.
1094 -- Error_Recovery: Cannot raise Error_Resync
1096 function P_Range_Attribute_Reference
1097 (Prefix_Node
: Node_Id
)
1100 Attr_Node
: Node_Id
;
1103 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1104 Set_Prefix
(Attr_Node
, Prefix_Node
);
1105 Scan
; -- past apostrophe
1108 Style
.Check_Attribute_Name
(True);
1111 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1114 if Token
= Tok_Left_Paren
then
1115 Scan
; -- past left paren
1116 Set_Expressions
(Attr_Node
, New_List
(P_Expression_If_OK
));
1121 end P_Range_Attribute_Reference
;
1123 ---------------------------------------
1124 -- 4.1.4 Range Attribute Designator --
1125 ---------------------------------------
1127 -- Parsed by P_Range_Attribute_Reference (4.4)
1129 --------------------
1131 --------------------
1133 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1135 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1136 -- an aggregate is known to be required (code statement, extension
1137 -- aggregate), in which cases this routine performs the necessary check
1138 -- that we have an aggregate rather than a parenthesized expression
1140 -- Error recovery: can raise Error_Resync
1142 function P_Aggregate
return Node_Id
is
1143 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1144 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1147 if Nkind
(Aggr_Node
) /= N_Aggregate
1149 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1152 ("aggregate may not have single positional component", Aggr_Sloc
);
1159 ------------------------------------------------
1160 -- 4.3 Aggregate or Parenthesized Expression --
1161 ------------------------------------------------
1163 -- This procedure parses out either an aggregate or a parenthesized
1164 -- expression (these two constructs are closely related, since a
1165 -- parenthesized expression looks like an aggregate with a single
1166 -- positional component).
1169 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1171 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1173 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1174 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1177 -- RECORD_COMPONENT_ASSOCIATION ::=
1178 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1180 -- COMPONENT_CHOICE_LIST ::=
1181 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1184 -- EXTENSION_AGGREGATE ::=
1185 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1187 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1189 -- ARRAY_AGGREGATE ::=
1190 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1192 -- POSITIONAL_ARRAY_AGGREGATE ::=
1193 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1194 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1195 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1197 -- NAMED_ARRAY_AGGREGATE ::=
1198 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1200 -- PRIMARY ::= (EXPRESSION);
1202 -- Error recovery: can raise Error_Resync
1204 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1205 -- to Ada 2005 limited aggregates (AI-287)
1207 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1208 Aggregate_Node
: Node_Id
;
1209 Expr_List
: List_Id
;
1210 Assoc_List
: List_Id
;
1211 Expr_Node
: Node_Id
;
1212 Lparen_Sloc
: Source_Ptr
;
1213 Scan_State
: Saved_Scan_State
;
1215 procedure Box_Error
;
1216 -- Called if <> is encountered as positional aggregate element. Issues
1217 -- error message and sets Expr_Node to Error.
1223 procedure Box_Error
is
1225 if Ada_Version
< Ada_2005
then
1226 Error_Msg_SC
("box in aggregate is an Ada 2005 extension");
1229 -- Ada 2005 (AI-287): The box notation is allowed only with named
1230 -- notation because positional notation might be error prone. For
1231 -- example, in "(X, <>, Y, <>)", there is no type associated with
1232 -- the boxes, so you might not be leaving out the components you
1233 -- thought you were leaving out.
1235 Error_Msg_SC
("(Ada 2005) box only allowed with named notation");
1240 -- Start of processing for P_Aggregate_Or_Paren_Expr
1243 Lparen_Sloc
:= Token_Ptr
;
1246 -- Note on parentheses count. For cases like an if expression, the
1247 -- parens here really count as real parentheses for the paren count,
1248 -- so we adjust the paren count accordingly after scanning the expr.
1252 if Token
= Tok_If
then
1253 Expr_Node
:= P_If_Expression
;
1255 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1260 elsif Token
= Tok_Case
then
1261 Expr_Node
:= P_Case_Expression
;
1263 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1266 -- Quantified expression
1268 elsif Token
= Tok_For
then
1269 Expr_Node
:= P_Quantified_Expression
;
1271 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1274 -- Note: the mechanism used here of rescanning the initial expression
1275 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1276 -- out the discrete choice list.
1278 -- Deal with expression and extension aggregates first
1280 elsif Token
/= Tok_Others
then
1281 Save_Scan_State
(Scan_State
); -- at start of expression
1283 -- Deal with (NULL RECORD)
1285 if Token
= Tok_Null
then
1288 if Token
= Tok_Record
then
1289 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1290 Set_Null_Record_Present
(Aggregate_Node
, True);
1291 Scan
; -- past RECORD
1293 return Aggregate_Node
;
1295 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1299 -- Scan expression, handling box appearing as positional argument
1301 if Token
= Tok_Box
then
1304 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1307 -- Extension aggregate
1309 if Token
= Tok_With
then
1310 if Nkind
(Expr_Node
) = N_Attribute_Reference
1311 and then Attribute_Name
(Expr_Node
) = Name_Range
1313 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1317 if Ada_Version
= Ada_83
then
1318 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1321 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1322 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1325 -- Deal with WITH NULL RECORD case
1327 if Token
= Tok_Null
then
1328 Save_Scan_State
(Scan_State
); -- at NULL
1331 if Token
= Tok_Record
then
1332 Scan
; -- past RECORD
1333 Set_Null_Record_Present
(Aggregate_Node
, True);
1335 return Aggregate_Node
;
1338 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1342 if Token
/= Tok_Others
then
1343 Save_Scan_State
(Scan_State
);
1344 Expr_Node
:= P_Expression
;
1351 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1352 if Nkind
(Expr_Node
) = N_Attribute_Reference
1353 and then Attribute_Name
(Expr_Node
) = Name_Range
1356 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
1357 Scan
; -- past right paren
1361 -- Bump paren count of expression
1363 if Expr_Node
/= Error
then
1364 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1367 T_Right_Paren
; -- past right paren (error message if none)
1373 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1379 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1383 -- Prepare to scan list of component associations
1385 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1386 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1388 -- This loop scans through component associations. On entry to the
1389 -- loop, an expression has been scanned at the start of the current
1390 -- association unless initial token was OTHERS, in which case
1391 -- Expr_Node is set to Empty.
1394 -- Deal with others association first. This is a named association
1396 if No
(Expr_Node
) then
1397 if No
(Assoc_List
) then
1398 Assoc_List
:= New_List
;
1401 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1403 -- Improper use of WITH
1405 elsif Token
= Tok_With
then
1406 Error_Msg_SC
("WITH must be preceded by single expression in " &
1407 "extension aggregate");
1410 -- Range attribute can only appear as part of a discrete choice list
1412 elsif Nkind
(Expr_Node
) = N_Attribute_Reference
1413 and then Attribute_Name
(Expr_Node
) = Name_Range
1414 and then Token
/= Tok_Arrow
1415 and then Token
/= Tok_Vertical_Bar
1417 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1420 -- Assume positional case if comma, right paren, or literal or
1421 -- identifier or OTHERS follows (the latter cases are missing
1422 -- comma cases). Also assume positional if a semicolon follows,
1423 -- which can happen if there are missing parens
1425 elsif Token
= Tok_Comma
1426 or else Token
= Tok_Right_Paren
1427 or else Token
= Tok_Others
1428 or else Token
in Token_Class_Lit_Or_Name
1429 or else Token
= Tok_Semicolon
1431 if Present
(Assoc_List
) then
1432 Error_Msg_BC
-- CODEFIX
1433 ("""='>"" expected (positional association cannot follow " &
1434 "named association)");
1437 if No
(Expr_List
) then
1438 Expr_List
:= New_List
;
1441 Append
(Expr_Node
, Expr_List
);
1443 -- Check for aggregate followed by left parent, maybe missing comma
1445 elsif Nkind
(Expr_Node
) = N_Aggregate
1446 and then Token
= Tok_Left_Paren
1450 if No
(Expr_List
) then
1451 Expr_List
:= New_List
;
1454 Append
(Expr_Node
, Expr_List
);
1456 -- Anything else is assumed to be a named association
1459 Restore_Scan_State
(Scan_State
); -- to start of expression
1461 if No
(Assoc_List
) then
1462 Assoc_List
:= New_List
;
1465 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1468 exit when not Comma_Present
;
1470 -- If we are at an expression terminator, something is seriously
1471 -- wrong, so let's get out now, before we start eating up stuff
1472 -- that doesn't belong to us!
1474 if Token
in Token_Class_Eterm
then
1476 ("expecting expression or component association");
1480 -- Deal with misused box
1482 if Token
= Tok_Box
then
1485 -- Otherwise initiate for reentry to top of loop by scanning an
1486 -- initial expression, unless the first token is OTHERS.
1488 elsif Token
= Tok_Others
then
1492 Save_Scan_State
(Scan_State
); -- at start of expression
1493 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1498 -- All component associations (positional and named) have been scanned
1501 Set_Expressions
(Aggregate_Node
, Expr_List
);
1502 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1503 return Aggregate_Node
;
1504 end P_Aggregate_Or_Paren_Expr
;
1506 ------------------------------------------------
1507 -- 4.3 Record or Array Component Association --
1508 ------------------------------------------------
1510 -- RECORD_COMPONENT_ASSOCIATION ::=
1511 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1512 -- | COMPONENT_CHOICE_LIST => <>
1514 -- COMPONENT_CHOICE_LIST =>
1515 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1518 -- ARRAY_COMPONENT_ASSOCIATION ::=
1519 -- DISCRETE_CHOICE_LIST => EXPRESSION
1520 -- | DISCRETE_CHOICE_LIST => <>
1522 -- Note: this routine only handles the named cases, including others.
1523 -- Cases where the component choice list is not present have already
1524 -- been handled directly.
1526 -- Error recovery: can raise Error_Resync
1528 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1529 -- rules have been extended to give support to Ada 2005 limited
1530 -- aggregates (AI-287)
1532 function P_Record_Or_Array_Component_Association
return Node_Id
is
1533 Assoc_Node
: Node_Id
;
1536 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1537 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1538 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1541 if Token
= Tok_Box
then
1543 -- Ada 2005(AI-287): The box notation is used to indicate the
1544 -- default initialization of aggregate components
1546 if Ada_Version
< Ada_2005
then
1548 ("component association with '<'> is an Ada 2005 extension");
1549 Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
1552 Set_Box_Present
(Assoc_Node
);
1555 Set_Expression
(Assoc_Node
, P_Expression
);
1559 end P_Record_Or_Array_Component_Association
;
1561 -----------------------------
1562 -- 4.3.1 Record Aggregate --
1563 -----------------------------
1565 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1566 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1568 ----------------------------------------------
1569 -- 4.3.1 Record Component Association List --
1570 ----------------------------------------------
1572 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1574 ----------------------------------
1575 -- 4.3.1 Component Choice List --
1576 ----------------------------------
1578 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1580 --------------------------------
1581 -- 4.3.1 Extension Aggregate --
1582 --------------------------------
1584 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1586 --------------------------
1587 -- 4.3.1 Ancestor Part --
1588 --------------------------
1590 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1592 ----------------------------
1593 -- 4.3.1 Array Aggregate --
1594 ----------------------------
1596 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1598 ---------------------------------------
1599 -- 4.3.1 Positional Array Aggregate --
1600 ---------------------------------------
1602 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1604 ----------------------------------
1605 -- 4.3.1 Named Array Aggregate --
1606 ----------------------------------
1608 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1610 ----------------------------------------
1611 -- 4.3.1 Array Component Association --
1612 ----------------------------------------
1614 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1616 ---------------------
1617 -- 4.4 Expression --
1618 ---------------------
1620 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1623 -- RELATION {LOGICAL_OPERATOR RELATION}
1625 -- CHOICE_EXPRESSION ::=
1626 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1628 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1630 -- On return, Expr_Form indicates the categorization of the expression
1631 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1632 -- an error message is given, and Error is returned).
1634 -- Error recovery: cannot raise Error_Resync
1636 function P_Expression
return Node_Id
is
1637 Logical_Op
: Node_Kind
;
1638 Prev_Logical_Op
: Node_Kind
;
1639 Op_Location
: Source_Ptr
;
1644 Node1
:= P_Relation
;
1646 if Token
in Token_Class_Logop
then
1647 Prev_Logical_Op
:= N_Empty
;
1650 Op_Location
:= Token_Ptr
;
1651 Logical_Op
:= P_Logical_Operator
;
1653 if Prev_Logical_Op
/= N_Empty
and then
1654 Logical_Op
/= Prev_Logical_Op
1657 ("mixed logical operators in expression", Op_Location
);
1658 Prev_Logical_Op
:= N_Empty
;
1660 Prev_Logical_Op
:= Logical_Op
;
1664 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1665 Set_Left_Opnd
(Node1
, Node2
);
1666 Set_Right_Opnd
(Node1
, P_Relation
);
1667 exit when Token
not in Token_Class_Logop
;
1670 Expr_Form
:= EF_Non_Simple
;
1673 if Token
= Tok_Apostrophe
then
1674 Bad_Range_Attribute
(Token_Ptr
);
1681 -- This function is identical to the normal P_Expression, except that it
1682 -- also permits the appearance of a case, conditional, or quantified
1683 -- expression if the call immediately follows a left paren, and followed
1684 -- by a right parenthesis. These forms are allowed if these conditions
1685 -- are not met, but an error message will be issued.
1687 function P_Expression_If_OK
return Node_Id
is
1689 -- Case of conditional, case or quantified expression
1691 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1692 return P_Unparen_Cond_Case_Quant_Expression
;
1694 -- Normal case, not case/conditional/quantified expression
1697 return P_Expression
;
1699 end P_Expression_If_OK
;
1701 -- This function is identical to the normal P_Expression, except that it
1702 -- checks that the expression scan did not stop on a right paren. It is
1703 -- called in all contexts where a right parenthesis cannot legitimately
1704 -- follow an expression.
1706 -- Error recovery: can not raise Error_Resync
1708 function P_Expression_No_Right_Paren
return Node_Id
is
1709 Expr
: constant Node_Id
:= P_Expression
;
1711 Ignore
(Tok_Right_Paren
);
1713 end P_Expression_No_Right_Paren
;
1715 ----------------------------------------
1716 -- 4.4 Expression_Or_Range_Attribute --
1717 ----------------------------------------
1720 -- RELATION {and RELATION} | RELATION {and then RELATION}
1721 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1722 -- | RELATION {xor RELATION}
1724 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1726 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1728 -- On return, Expr_Form indicates the categorization of the expression
1729 -- and EF_Range_Attr is one of the possibilities.
1731 -- Error recovery: cannot raise Error_Resync
1733 -- In the grammar, a RANGE attribute is simply a name, but its use is
1734 -- highly restricted, so in the parser, we do not regard it as a name.
1735 -- Instead, P_Name returns without scanning the 'RANGE part of the
1736 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1737 -- attribute reference. In the normal case where a range attribute is
1738 -- not allowed, an error message is issued by P_Expression.
1740 function P_Expression_Or_Range_Attribute
return Node_Id
is
1741 Logical_Op
: Node_Kind
;
1742 Prev_Logical_Op
: Node_Kind
;
1743 Op_Location
: Source_Ptr
;
1746 Attr_Node
: Node_Id
;
1749 Node1
:= P_Relation
;
1751 if Token
= Tok_Apostrophe
then
1752 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
1753 Expr_Form
:= EF_Range_Attr
;
1756 elsif Token
in Token_Class_Logop
then
1757 Prev_Logical_Op
:= N_Empty
;
1760 Op_Location
:= Token_Ptr
;
1761 Logical_Op
:= P_Logical_Operator
;
1763 if Prev_Logical_Op
/= N_Empty
and then
1764 Logical_Op
/= Prev_Logical_Op
1767 ("mixed logical operators in expression", Op_Location
);
1768 Prev_Logical_Op
:= N_Empty
;
1770 Prev_Logical_Op
:= Logical_Op
;
1774 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1775 Set_Left_Opnd
(Node1
, Node2
);
1776 Set_Right_Opnd
(Node1
, P_Relation
);
1777 exit when Token
not in Token_Class_Logop
;
1780 Expr_Form
:= EF_Non_Simple
;
1783 if Token
= Tok_Apostrophe
then
1784 Bad_Range_Attribute
(Token_Ptr
);
1789 end P_Expression_Or_Range_Attribute
;
1791 -- Version that allows a non-parenthesized case, conditional, or quantified
1792 -- expression if the call immediately follows a left paren, and followed
1793 -- by a right parenthesis. These forms are allowed if these conditions
1794 -- are not met, but an error message will be issued.
1796 function P_Expression_Or_Range_Attribute_If_OK
return Node_Id
is
1798 -- Case of conditional, case or quantified expression
1800 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1801 return P_Unparen_Cond_Case_Quant_Expression
;
1803 -- Normal case, not one of the above expression types
1806 return P_Expression_Or_Range_Attribute
;
1808 end P_Expression_Or_Range_Attribute_If_OK
;
1814 -- This procedure scans both relations and choice relations
1816 -- CHOICE_RELATION ::=
1817 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1820 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
1822 -- MEMBERSHIP_CHOICE_LIST ::=
1823 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
1825 -- MEMBERSHIP_CHOICE ::=
1826 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
1828 -- On return, Expr_Form indicates the categorization of the expression
1830 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1831 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1833 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1834 -- expression, then tokens are scanned until either a non-expression token,
1835 -- a right paren (not matched by a left paren) or a comma, is encountered.
1837 function P_Relation
return Node_Id
is
1838 Node1
, Node2
: Node_Id
;
1842 Node1
:= P_Simple_Expression
;
1844 if Token
not in Token_Class_Relop
then
1848 -- Here we have a relational operator following. If so then scan it
1849 -- out. Note that the assignment symbol := is treated as a relational
1850 -- operator to improve the error recovery when it is misused for =.
1851 -- P_Relational_Operator also parses the IN and NOT IN operations.
1854 Node2
:= New_Op_Node
(P_Relational_Operator
, Optok
);
1855 Set_Left_Opnd
(Node2
, Node1
);
1857 -- Case of IN or NOT IN
1859 if Prev_Token
= Tok_In
then
1860 P_Membership_Test
(Node2
);
1862 -- Case of relational operator (= /= < <= > >=)
1865 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
1868 Expr_Form
:= EF_Non_Simple
;
1870 if Token
in Token_Class_Relop
then
1871 Error_Msg_SC
("unexpected relational operator");
1878 -- If any error occurs, then scan to the next expression terminator symbol
1879 -- or comma or right paren at the outer (i.e. current) parentheses level.
1880 -- The flags are set to indicate a normal simple expression.
1883 when Error_Resync
=>
1885 Expr_Form
:= EF_Simple
;
1889 ----------------------------
1890 -- 4.4 Simple Expression --
1891 ----------------------------
1893 -- SIMPLE_EXPRESSION ::=
1894 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1896 -- On return, Expr_Form indicates the categorization of the expression
1898 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1899 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1901 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1902 -- expression, then tokens are scanned until either a non-expression token,
1903 -- a right paren (not matched by a left paren) or a comma, is encountered.
1905 -- Note: P_Simple_Expression is called only internally by higher level
1906 -- expression routines. In cases in the grammar where a simple expression
1907 -- is required, the approach is to scan an expression, and then post an
1908 -- appropriate error message if the expression obtained is not simple. This
1909 -- gives better error recovery and treatment.
1911 function P_Simple_Expression
return Node_Id
is
1912 Scan_State
: Saved_Scan_State
;
1915 Tokptr
: Source_Ptr
;
1918 -- Check for cases starting with a name. There are two reasons for
1919 -- special casing. First speed things up by catching a common case
1920 -- without going through several routine layers. Second the caller must
1921 -- be informed via Expr_Form when the simple expression is a name.
1923 if Token
in Token_Class_Name
then
1926 -- Deal with apostrophe cases
1928 if Token
= Tok_Apostrophe
then
1929 Save_Scan_State
(Scan_State
); -- at apostrophe
1930 Scan
; -- past apostrophe
1932 -- If qualified expression, scan it out and fall through
1934 if Token
= Tok_Left_Paren
then
1935 Node1
:= P_Qualified_Expression
(Node1
);
1936 Expr_Form
:= EF_Simple
;
1938 -- If range attribute, then we return with Token pointing to the
1939 -- apostrophe. Note: avoid the normal error check on exit. We
1940 -- know that the expression really is complete in this case!
1942 else -- Token = Tok_Range then
1943 Restore_Scan_State
(Scan_State
); -- to apostrophe
1944 Expr_Form
:= EF_Simple_Name
;
1949 -- If an expression terminator follows, the previous processing
1950 -- completely scanned out the expression (a common case), and
1951 -- left Expr_Form set appropriately for returning to our caller.
1953 if Token
in Token_Class_Sterm
then
1956 -- If we do not have an expression terminator, then complete the
1957 -- scan of a simple expression. This code duplicates the code
1958 -- found in P_Term and P_Factor.
1961 if Token
= Tok_Double_Asterisk
then
1963 Style
.Check_Exponentiation_Operator
;
1966 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
1968 Set_Left_Opnd
(Node2
, Node1
);
1969 Set_Right_Opnd
(Node2
, P_Primary
);
1975 exit when Token
not in Token_Class_Mulop
;
1976 Tokptr
:= Token_Ptr
;
1977 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
1980 Style
.Check_Binary_Operator
;
1983 Scan
; -- past operator
1984 Set_Left_Opnd
(Node2
, Node1
);
1985 Set_Right_Opnd
(Node2
, P_Factor
);
1990 exit when Token
not in Token_Class_Binary_Addop
;
1991 Tokptr
:= Token_Ptr
;
1992 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
1995 Style
.Check_Binary_Operator
;
1998 Scan
; -- past operator
1999 Set_Left_Opnd
(Node2
, Node1
);
2000 Set_Right_Opnd
(Node2
, P_Term
);
2004 Expr_Form
:= EF_Simple
;
2007 -- Cases where simple expression does not start with a name
2010 -- Scan initial sign and initial Term
2012 if Token
in Token_Class_Unary_Addop
then
2013 Tokptr
:= Token_Ptr
;
2014 Node1
:= New_Op_Node
(P_Unary_Adding_Operator
, Tokptr
);
2017 Style
.Check_Unary_Plus_Or_Minus
;
2020 Scan
; -- past operator
2021 Set_Right_Opnd
(Node1
, P_Term
);
2026 -- In the following, we special-case a sequence of concatenations of
2027 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
2028 -- else mixed in. For such a sequence, we return a tree representing
2029 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
2030 -- the number of concatenations is large. If semantic analysis
2031 -- resolves the "&" to a predefined one, then this folding gives the
2032 -- right answer. Otherwise, semantic analysis will complain about a
2033 -- capacity-exceeded error. The purpose of this trick is to avoid
2034 -- creating a deeply nested tree, which would cause deep recursion
2035 -- during semantics, causing stack overflow. This way, we can handle
2036 -- enormous concatenations in the normal case of predefined "&". We
2037 -- first build up the normal tree, and then rewrite it if
2041 Num_Concats_Threshold
: constant Positive := 1000;
2042 -- Arbitrary threshold value to enable optimization
2044 First_Node
: constant Node_Id
:= Node1
;
2045 Is_Strlit_Concat
: Boolean;
2046 -- True iff we've parsed a sequence of concatenations of string
2047 -- literals, with nothing else mixed in.
2049 Num_Concats
: Natural;
2050 -- Number of "&" operators if Is_Strlit_Concat is True
2054 Nkind
(Node1
) = N_String_Literal
2055 and then Token
= Tok_Ampersand
;
2058 -- Scan out sequence of terms separated by binary adding operators
2061 exit when Token
not in Token_Class_Binary_Addop
;
2062 Tokptr
:= Token_Ptr
;
2063 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2064 Scan
; -- past operator
2065 Set_Left_Opnd
(Node2
, Node1
);
2067 Set_Right_Opnd
(Node2
, Node1
);
2069 -- Check if we're still concatenating string literals
2073 and then Nkind
(Node2
) = N_Op_Concat
2074 and then Nkind
(Node1
) = N_String_Literal
;
2076 if Is_Strlit_Concat
then
2077 Num_Concats
:= Num_Concats
+ 1;
2083 -- If we have an enormous series of concatenations of string
2084 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2085 -- flag tells semantic analysis that if the "&" is not predefined,
2086 -- the folded value is wrong.
2089 and then Num_Concats
>= Num_Concats_Threshold
2092 Empty_String_Val
: String_Id
;
2095 Strlit_Concat_Val
: String_Id
;
2096 -- Contains the folded value (which will be correct if the
2097 -- "&" operators are the predefined ones).
2100 -- For walking up the tree
2103 -- Folded node to replace Node1
2105 Loc
: constant Source_Ptr
:= Sloc
(First_Node
);
2108 -- Walk up the tree starting at the leftmost string literal
2109 -- (First_Node), building up the Strlit_Concat_Val as we
2110 -- go. Note that we do not use recursion here -- the whole
2111 -- point is to avoid recursively walking that enormous tree.
2114 Store_String_Chars
(Strval
(First_Node
));
2116 Cur_Node
:= Parent
(First_Node
);
2117 while Present
(Cur_Node
) loop
2118 pragma Assert
(Nkind
(Cur_Node
) = N_Op_Concat
and then
2119 Nkind
(Right_Opnd
(Cur_Node
)) = N_String_Literal
);
2121 Store_String_Chars
(Strval
(Right_Opnd
(Cur_Node
)));
2122 Cur_Node
:= Parent
(Cur_Node
);
2125 Strlit_Concat_Val
:= End_String
;
2127 -- Create new folded node, and rewrite result with a concat-
2128 -- enation of an empty string literal and the folded node.
2131 Empty_String_Val
:= End_String
;
2133 Make_Op_Concat
(Loc
,
2134 Make_String_Literal
(Loc
, Empty_String_Val
),
2135 Make_String_Literal
(Loc
, Strlit_Concat_Val
,
2136 Is_Folded_In_Parser
=> True));
2137 Rewrite
(Node1
, New_Node
);
2142 -- All done, we clearly do not have name or numeric literal so this
2143 -- is a case of a simple expression which is some other possibility.
2145 Expr_Form
:= EF_Simple
;
2148 -- Come here at end of simple expression, where we do a couple of
2149 -- special checks to improve error recovery.
2151 -- Special test to improve error recovery. If the current token
2152 -- is a period, then someone is trying to do selection on something
2153 -- that is not a name, e.g. a qualified expression.
2155 if Token
= Tok_Dot
then
2156 Error_Msg_SC
("prefix for selection is not a name");
2158 -- If qualified expression, comment and continue, otherwise something
2159 -- is pretty nasty so do an Error_Resync call.
2161 if Ada_Version
< Ada_2012
2162 and then Nkind
(Node1
) = N_Qualified_Expression
2164 Error_Msg_SC
("\would be legal in Ada 2012 mode");
2170 -- Special test to improve error recovery: If the current token is
2171 -- not the first token on a line (as determined by checking the
2172 -- previous token position with the start of the current line),
2173 -- then we insist that we have an appropriate terminating token.
2174 -- Consider the following two examples:
2176 -- 1) if A nad B then ...
2181 -- In the first example, we would like to issue a binary operator
2182 -- expected message and resynchronize to the then. In the second
2183 -- example, we do not want to issue a binary operator message, so
2184 -- that instead we will get the missing semicolon message. This
2185 -- distinction is of course a heuristic which does not always work,
2186 -- but in practice it is quite effective.
2188 -- Note: the one case in which we do not go through this circuit is
2189 -- when we have scanned a range attribute and want to return with
2190 -- Token pointing to the apostrophe. The apostrophe is not normally
2191 -- an expression terminator, and is not in Token_Class_Sterm, but
2192 -- in this special case we know that the expression is complete.
2194 if not Token_Is_At_Start_Of_Line
2195 and then Token
not in Token_Class_Sterm
2197 -- Normally the right error message is indeed that we expected a
2198 -- binary operator, but in the case of being between a right and left
2199 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2201 if Prev_Token
= Tok_Right_Paren
and then Token
= Tok_Left_Paren
then
2204 Error_Msg_AP
("binary operator expected");
2213 -- If any error occurs, then scan to next expression terminator symbol
2214 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2215 -- level. Expr_Form is set to indicate a normal simple expression.
2218 when Error_Resync
=>
2220 Expr_Form
:= EF_Simple
;
2222 end P_Simple_Expression
;
2224 -----------------------------------------------
2225 -- 4.4 Simple Expression or Range Attribute --
2226 -----------------------------------------------
2228 -- SIMPLE_EXPRESSION ::=
2229 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2231 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2233 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2235 -- Error recovery: cannot raise Error_Resync
2237 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
2239 Attr_Node
: Node_Id
;
2242 -- We don't just want to roar ahead and call P_Simple_Expression
2243 -- here, since we want to handle the case of a parenthesized range
2244 -- attribute cleanly.
2246 if Token
= Tok_Left_Paren
then
2248 Lptr
: constant Source_Ptr
:= Token_Ptr
;
2249 Scan_State
: Saved_Scan_State
;
2252 Save_Scan_State
(Scan_State
);
2253 Scan
; -- past left paren
2254 Sexpr
:= P_Simple_Expression
;
2256 if Token
= Tok_Apostrophe
then
2257 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2258 Expr_Form
:= EF_Range_Attr
;
2260 if Token
= Tok_Right_Paren
then
2261 Scan
; -- scan past right paren if present
2264 Error_Msg
("parentheses not allowed for range attribute", Lptr
);
2269 Restore_Scan_State
(Scan_State
);
2273 -- Here after dealing with parenthesized range attribute
2275 Sexpr
:= P_Simple_Expression
;
2277 if Token
= Tok_Apostrophe
then
2278 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2279 Expr_Form
:= EF_Range_Attr
;
2285 end P_Simple_Expression_Or_Range_Attribute
;
2291 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2293 -- Error recovery: can raise Error_Resync
2295 function P_Term
return Node_Id
is
2296 Node1
, Node2
: Node_Id
;
2297 Tokptr
: Source_Ptr
;
2303 exit when Token
not in Token_Class_Mulop
;
2304 Tokptr
:= Token_Ptr
;
2305 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2306 Scan
; -- past operator
2307 Set_Left_Opnd
(Node2
, Node1
);
2308 Set_Right_Opnd
(Node2
, P_Factor
);
2319 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2321 -- Error recovery: can raise Error_Resync
2323 function P_Factor
return Node_Id
is
2328 if Token
= Tok_Abs
then
2329 Node1
:= New_Op_Node
(N_Op_Abs
, Token_Ptr
);
2332 Style
.Check_Abs_Not
;
2336 Set_Right_Opnd
(Node1
, P_Primary
);
2339 elsif Token
= Tok_Not
then
2340 Node1
:= New_Op_Node
(N_Op_Not
, Token_Ptr
);
2343 Style
.Check_Abs_Not
;
2347 Set_Right_Opnd
(Node1
, P_Primary
);
2353 if Token
= Tok_Double_Asterisk
then
2354 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2356 Set_Left_Opnd
(Node2
, Node1
);
2357 Set_Right_Opnd
(Node2
, P_Primary
);
2371 -- NUMERIC_LITERAL | null
2372 -- | STRING_LITERAL | AGGREGATE
2373 -- | NAME | QUALIFIED_EXPRESSION
2374 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2376 -- Error recovery: can raise Error_Resync
2378 function P_Primary
return Node_Id
is
2379 Scan_State
: Saved_Scan_State
;
2382 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
2383 -- Remember if previous token is a left parenthesis. This is used to
2384 -- deal with checking whether IF/CASE/FOR expressions appearing as
2385 -- primaries require extra parenthesization.
2388 -- The loop runs more than once only if misplaced pragmas are found
2389 -- or if a misplaced unary minus is skipped.
2394 -- Name token can start a name, call or qualified expression, all
2395 -- of which are acceptable possibilities for primary. Note also
2396 -- that string literal is included in name (as operator symbol)
2397 -- and type conversion is included in name (as indexed component).
2399 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier
=>
2402 -- All done unless apostrophe follows
2404 if Token
/= Tok_Apostrophe
then
2407 -- Apostrophe following means that we have either just parsed
2408 -- the subtype mark of a qualified expression, or the prefix
2409 -- or a range attribute.
2411 else -- Token = Tok_Apostrophe
2412 Save_Scan_State
(Scan_State
); -- at apostrophe
2413 Scan
; -- past apostrophe
2415 -- If range attribute, then this is always an error, since
2416 -- the only legitimate case (where the scanned expression is
2417 -- a qualified simple name) is handled at the level of the
2418 -- Simple_Expression processing. This case corresponds to a
2419 -- usage such as 3 + A'Range, which is always illegal.
2421 if Token
= Tok_Range
then
2422 Restore_Scan_State
(Scan_State
); -- to apostrophe
2423 Bad_Range_Attribute
(Token_Ptr
);
2426 -- If left paren, then we have a qualified expression.
2427 -- Note that P_Name guarantees that in this case, where
2428 -- Token = Tok_Apostrophe on return, the only two possible
2429 -- tokens following the apostrophe are left paren and
2430 -- RANGE, so we know we have a left paren here.
2432 else -- Token = Tok_Left_Paren
2433 return P_Qualified_Expression
(Node1
);
2438 -- Numeric or string literal
2440 when Tok_Integer_Literal |
2442 Tok_String_Literal
=>
2444 Node1
:= Token_Node
;
2445 Scan
; -- past number
2448 -- Left paren, starts aggregate or parenthesized expression
2450 when Tok_Left_Paren
=>
2452 Expr
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
2455 if Nkind
(Expr
) = N_Attribute_Reference
2456 and then Attribute_Name
(Expr
) = Name_Range
2458 Bad_Range_Attribute
(Sloc
(Expr
));
2473 return New_Node
(N_Null
, Prev_Token_Ptr
);
2475 -- Pragma, not allowed here, so just skip past it
2478 P_Pragmas_Misplaced
;
2480 -- Deal with IF (possible unparenthesized if expression)
2484 -- If this looks like a real if, defined as an IF appearing at
2485 -- the start of a new line, then we consider we have a missing
2486 -- operand. If in Ada 2012 and the IF is not properly indented
2487 -- for a statement, we prefer to issue a message about an ill-
2488 -- parenthesized if expression.
2490 if Token_Is_At_Start_Of_Line
2492 (Ada_Version
>= Ada_2012
2493 and then Style_Check_Indentation
/= 0
2494 and then Start_Column
rem Style_Check_Indentation
/= 0)
2496 Error_Msg_AP
("missing operand");
2499 -- If this looks like an if expression, then treat it that way
2500 -- with an error message if not explicitly surrounded by
2503 elsif Ada_Version
>= Ada_2012
then
2504 Node1
:= P_If_Expression
;
2506 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2508 ("if expression must be parenthesized", Sloc
(Node1
));
2513 -- Otherwise treat as misused identifier
2516 return P_Identifier
;
2519 -- Deal with CASE (possible unparenthesized case expression)
2523 -- If this looks like a real case, defined as a CASE appearing
2524 -- the start of a new line, then we consider we have a missing
2525 -- operand. If in Ada 2012 and the CASE is not properly
2526 -- indented for a statement, we prefer to issue a message about
2527 -- an ill-parenthesized case expression.
2529 if Token_Is_At_Start_Of_Line
2531 (Ada_Version
>= Ada_2012
2532 and then Style_Check_Indentation
/= 0
2533 and then Start_Column
rem Style_Check_Indentation
/= 0)
2535 Error_Msg_AP
("missing operand");
2538 -- If this looks like a case expression, then treat it that way
2539 -- with an error message if not within parentheses.
2541 elsif Ada_Version
>= Ada_2012
then
2542 Node1
:= P_Case_Expression
;
2544 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2546 ("case expression must be parenthesized", Sloc
(Node1
));
2551 -- Otherwise treat as misused identifier
2554 return P_Identifier
;
2557 -- For [all | some] indicates a quantified expression
2560 if Token_Is_At_Start_Of_Line
then
2561 Error_Msg_AP
("misplaced loop");
2564 elsif Ada_Version
>= Ada_2012
then
2565 Node1
:= P_Quantified_Expression
;
2567 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2569 ("quantified expression must be parenthesized",
2575 -- Otherwise treat as misused identifier
2578 return P_Identifier
;
2581 -- Minus may well be an improper attempt at a unary minus. Give
2582 -- a message, skip the minus and keep going!
2585 Error_Msg_SC
("parentheses required for unary minus");
2588 -- Anything else is illegal as the first token of a primary, but
2589 -- we test for some common errors, to improve error messages.
2592 if Is_Reserved_Identifier
then
2593 return P_Identifier
;
2595 elsif Prev_Token
= Tok_Comma
then
2596 Error_Msg_SP
-- CODEFIX
2597 ("|extra "","" ignored");
2601 Error_Msg_AP
("missing operand");
2609 -------------------------------
2610 -- 4.4 Quantified_Expression --
2611 -------------------------------
2613 -- QUANTIFIED_EXPRESSION ::=
2614 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2615 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2617 function P_Quantified_Expression
return Node_Id
is
2622 if Ada_Version
< Ada_2012
then
2623 Error_Msg_SC
("quantified expression is an Ada 2012 feature");
2624 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
2629 Node1
:= New_Node
(N_Quantified_Expression
, Prev_Token_Ptr
);
2631 if Token
= Tok_All
then
2632 Set_All_Present
(Node1
);
2634 elsif Token
/= Tok_Some
then
2635 Error_Msg_AP
("missing quantifier");
2640 I_Spec
:= P_Loop_Parameter_Specification
;
2642 if Nkind
(I_Spec
) = N_Loop_Parameter_Specification
then
2643 Set_Loop_Parameter_Specification
(Node1
, I_Spec
);
2645 Set_Iterator_Specification
(Node1
, I_Spec
);
2648 if Token
= Tok_Arrow
then
2650 Set_Condition
(Node1
, P_Expression
);
2653 Error_Msg_AP
("missing arrow");
2656 end P_Quantified_Expression
;
2658 ---------------------------
2659 -- 4.5 Logical Operator --
2660 ---------------------------
2662 -- LOGICAL_OPERATOR ::= and | or | xor
2664 -- Note: AND THEN and OR ELSE are also treated as logical operators
2665 -- by the parser (even though they are not operators semantically)
2667 -- The value returned is the appropriate Node_Kind code for the operator
2668 -- On return, Token points to the token following the scanned operator.
2670 -- The caller has checked that the first token is a legitimate logical
2671 -- operator token (i.e. is either XOR, AND, OR).
2673 -- Error recovery: cannot raise Error_Resync
2675 function P_Logical_Operator
return Node_Kind
is
2677 if Token
= Tok_And
then
2679 Style
.Check_Binary_Operator
;
2684 if Token
= Tok_Then
then
2691 elsif Token
= Tok_Or
then
2693 Style
.Check_Binary_Operator
;
2698 if Token
= Tok_Else
then
2705 else -- Token = Tok_Xor
2707 Style
.Check_Binary_Operator
;
2713 end P_Logical_Operator
;
2715 ------------------------------
2716 -- 4.5 Relational Operator --
2717 ------------------------------
2719 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2721 -- The value returned is the appropriate Node_Kind code for the operator.
2722 -- On return, Token points to the operator token, NOT past it.
2724 -- The caller has checked that the first token is a legitimate relational
2725 -- operator token (i.e. is one of the operator tokens listed above).
2727 -- Error recovery: cannot raise Error_Resync
2729 function P_Relational_Operator
return Node_Kind
is
2730 Op_Kind
: Node_Kind
;
2731 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
2732 (Tok_Less
=> N_Op_Lt
,
2733 Tok_Equal
=> N_Op_Eq
,
2734 Tok_Greater
=> N_Op_Gt
,
2735 Tok_Not_Equal
=> N_Op_Ne
,
2736 Tok_Greater_Equal
=> N_Op_Ge
,
2737 Tok_Less_Equal
=> N_Op_Le
,
2739 Tok_Not
=> N_Not_In
,
2740 Tok_Box
=> N_Op_Ne
);
2743 if Token
= Tok_Box
then
2744 Error_Msg_SC
-- CODEFIX
2745 ("|""'<'>"" should be ""/=""");
2748 Op_Kind
:= Relop_Node
(Token
);
2751 Style
.Check_Binary_Operator
;
2754 Scan
; -- past operator token
2756 -- Deal with NOT IN, if previous token was NOT, we must have IN now
2758 if Prev_Token
= Tok_Not
then
2760 -- Style check, for NOT IN, we require one space between NOT and IN
2762 if Style_Check
and then Token
= Tok_In
then
2770 end P_Relational_Operator
;
2772 ---------------------------------
2773 -- 4.5 Binary Adding Operator --
2774 ---------------------------------
2776 -- BINARY_ADDING_OPERATOR ::= + | - | &
2778 -- The value returned is the appropriate Node_Kind code for the operator.
2779 -- On return, Token points to the operator token (NOT past it).
2781 -- The caller has checked that the first token is a legitimate adding
2782 -- operator token (i.e. is one of the operator tokens listed above).
2784 -- Error recovery: cannot raise Error_Resync
2786 function P_Binary_Adding_Operator
return Node_Kind
is
2787 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
2788 (Tok_Ampersand
=> N_Op_Concat
,
2789 Tok_Minus
=> N_Op_Subtract
,
2790 Tok_Plus
=> N_Op_Add
);
2792 return Addop_Node
(Token
);
2793 end P_Binary_Adding_Operator
;
2795 --------------------------------
2796 -- 4.5 Unary Adding Operator --
2797 --------------------------------
2799 -- UNARY_ADDING_OPERATOR ::= + | -
2801 -- The value returned is the appropriate Node_Kind code for the operator.
2802 -- On return, Token points to the operator token (NOT past it).
2804 -- The caller has checked that the first token is a legitimate adding
2805 -- operator token (i.e. is one of the operator tokens listed above).
2807 -- Error recovery: cannot raise Error_Resync
2809 function P_Unary_Adding_Operator
return Node_Kind
is
2810 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
2811 (Tok_Minus
=> N_Op_Minus
,
2812 Tok_Plus
=> N_Op_Plus
);
2814 return Addop_Node
(Token
);
2815 end P_Unary_Adding_Operator
;
2817 -------------------------------
2818 -- 4.5 Multiplying Operator --
2819 -------------------------------
2821 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2823 -- The value returned is the appropriate Node_Kind code for the operator.
2824 -- On return, Token points to the operator token (NOT past it).
2826 -- The caller has checked that the first token is a legitimate multiplying
2827 -- operator token (i.e. is one of the operator tokens listed above).
2829 -- Error recovery: cannot raise Error_Resync
2831 function P_Multiplying_Operator
return Node_Kind
is
2832 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
2833 (Tok_Asterisk
=> N_Op_Multiply
,
2834 Tok_Mod
=> N_Op_Mod
,
2835 Tok_Rem
=> N_Op_Rem
,
2836 Tok_Slash
=> N_Op_Divide
);
2838 return Mulop_Node
(Token
);
2839 end P_Multiplying_Operator
;
2841 --------------------------------------
2842 -- 4.5 Highest Precedence Operator --
2843 --------------------------------------
2845 -- Parsed by P_Factor (4.4)
2847 -- Note: this rule is not in fact used by the grammar at any point!
2849 --------------------------
2850 -- 4.6 Type Conversion --
2851 --------------------------
2853 -- Parsed by P_Primary as a Name (4.1)
2855 -------------------------------
2856 -- 4.7 Qualified Expression --
2857 -------------------------------
2859 -- QUALIFIED_EXPRESSION ::=
2860 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2862 -- The caller has scanned the name which is the Subtype_Mark parameter
2863 -- and scanned past the single quote following the subtype mark. The
2864 -- caller has not checked that this name is in fact appropriate for
2865 -- a subtype mark name (i.e. it is a selected component or identifier).
2867 -- Error_Recovery: cannot raise Error_Resync
2869 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
2870 Qual_Node
: Node_Id
;
2872 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
2873 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
2874 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
2876 end P_Qualified_Expression
;
2878 --------------------
2880 --------------------
2883 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
2884 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
2886 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
2888 -- The caller has checked that the initial token is NEW
2890 -- Error recovery: can raise Error_Resync
2892 function P_Allocator
return Node_Id
is
2893 Alloc_Node
: Node_Id
;
2894 Type_Node
: Node_Id
;
2895 Null_Exclusion_Present
: Boolean;
2898 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
2901 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
2903 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2905 if Token
= Tok_Left_Paren
then
2907 Set_Subpool_Handle_Name
(Alloc_Node
, P_Name
);
2910 if Ada_Version
< Ada_2012
then
2912 ("|subpool specification is an Ada 2012 feature",
2913 Subpool_Handle_Name
(Alloc_Node
));
2915 ("\|unit must be compiled with -gnat2012 switch",
2916 Subpool_Handle_Name
(Alloc_Node
));
2920 Null_Exclusion_Present
:= P_Null_Exclusion
;
2921 Set_Null_Exclusion_Present
(Alloc_Node
, Null_Exclusion_Present
);
2922 Type_Node
:= P_Subtype_Mark_Resync
;
2924 if Token
= Tok_Apostrophe
then
2925 Scan
; -- past apostrophe
2926 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
2930 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));
2932 -- AI05-0104: An explicit null exclusion is not allowed for an
2933 -- allocator without initialization. In previous versions of the
2934 -- language it just raises constraint error.
2936 if Ada_Version
>= Ada_2012
and then Null_Exclusion_Present
then
2938 ("an allocator with a subtype indication "
2939 & "cannot have a null exclusion", Alloc_Node
);
2946 -----------------------
2947 -- P_Case_Expression --
2948 -----------------------
2950 function P_Case_Expression
return Node_Id
is
2951 Loc
: constant Source_Ptr
:= Token_Ptr
;
2952 Case_Node
: Node_Id
;
2953 Save_State
: Saved_Scan_State
;
2956 if Ada_Version
< Ada_2012
then
2957 Error_Msg_SC
("|case expression is an Ada 2012 feature");
2958 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
2963 Make_Case_Expression
(Loc
,
2964 Expression
=> P_Expression_No_Right_Paren
,
2965 Alternatives
=> New_List
);
2968 -- We now have scanned out CASE expression IS, scan alternatives
2972 Append_To
(Alternatives
(Case_Node
), P_Case_Expression_Alternative
);
2974 -- Missing comma if WHEN (more alternatives present)
2976 if Token
= Tok_When
then
2979 -- If comma/WHEN, skip comma and we have another alternative
2981 elsif Token
= Tok_Comma
then
2982 Save_Scan_State
(Save_State
);
2985 if Token
/= Tok_When
then
2986 Restore_Scan_State
(Save_State
);
2990 -- If no comma or WHEN, definitely done
2997 -- If we have an END CASE, diagnose as not needed
2999 if Token
= Tok_End
then
3000 Error_Msg_SC
("`END CASE` not allowed at end of case expression");
3003 if Token
= Tok_Case
then
3008 -- Return the Case_Expression node
3011 end P_Case_Expression
;
3013 -----------------------------------
3014 -- P_Case_Expression_Alternative --
3015 -----------------------------------
3017 -- CASE_STATEMENT_ALTERNATIVE ::=
3018 -- when DISCRETE_CHOICE_LIST =>
3021 -- The caller has checked that and scanned past the initial WHEN token
3022 -- Error recovery: can raise Error_Resync
3024 function P_Case_Expression_Alternative
return Node_Id
is
3025 Case_Alt_Node
: Node_Id
;
3027 Case_Alt_Node
:= New_Node
(N_Case_Expression_Alternative
, Token_Ptr
);
3028 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
3030 Set_Expression
(Case_Alt_Node
, P_Expression
);
3031 return Case_Alt_Node
;
3032 end P_Case_Expression_Alternative
;
3034 ---------------------
3035 -- P_If_Expression --
3036 ---------------------
3038 function P_If_Expression
return Node_Id
is
3039 Exprs
: constant List_Id
:= New_List
;
3040 Loc
: constant Source_Ptr
:= Token_Ptr
;
3042 State
: Saved_Scan_State
;
3045 Inside_If_Expression
:= Inside_If_Expression
+ 1;
3047 if Token
= Tok_If
and then Ada_Version
< Ada_2012
then
3048 Error_Msg_SC
("|if expression is an Ada 2012 feature");
3049 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
3052 Scan
; -- past IF or ELSIF
3053 Append_To
(Exprs
, P_Condition
);
3055 Append_To
(Exprs
, P_Expression
);
3057 -- We now have scanned out IF expr THEN expr
3059 -- Check for common error of semicolon before the ELSE
3061 if Token
= Tok_Semicolon
then
3062 Save_Scan_State
(State
);
3063 Scan
; -- past semicolon
3065 if Token
= Tok_Else
or else Token
= Tok_Elsif
then
3066 Error_Msg_SP
-- CODEFIX
3067 ("|extra "";"" ignored");
3070 Restore_Scan_State
(State
);
3074 -- Scan out ELSIF sequence if present
3076 if Token
= Tok_Elsif
then
3077 Expr
:= P_If_Expression
;
3078 Set_Is_Elsif
(Expr
);
3079 Append_To
(Exprs
, Expr
);
3081 -- Scan out ELSE phrase if present
3083 elsif Token
= Tok_Else
then
3085 -- Scan out ELSE expression
3088 Append_To
(Exprs
, P_Expression
);
3090 -- Two expression case (implied True, filled in during semantics)
3096 -- If we have an END IF, diagnose as not needed
3098 if Token
= Tok_End
then
3099 Error_Msg_SC
("`END IF` not allowed at end of if expression");
3102 if Token
= Tok_If
then
3107 Inside_If_Expression
:= Inside_If_Expression
- 1;
3109 -- Return the If_Expression node
3112 Make_If_Expression
(Loc
,
3113 Expressions
=> Exprs
);
3114 end P_If_Expression
;
3116 -----------------------
3117 -- P_Membership_Test --
3118 -----------------------
3120 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3121 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3123 procedure P_Membership_Test
(N
: Node_Id
) is
3124 Alt
: constant Node_Id
:=
3125 P_Range_Or_Subtype_Mark
3126 (Allow_Simple_Expression
=> (Ada_Version
>= Ada_2012
));
3131 if Token
= Tok_Vertical_Bar
then
3132 if Ada_Version
< Ada_2012
then
3133 Error_Msg_SC
("set notation is an Ada 2012 feature");
3134 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
3137 Set_Alternatives
(N
, New_List
(Alt
));
3138 Set_Right_Opnd
(N
, Empty
);
3140 -- Loop to accumulate alternatives
3142 while Token
= Tok_Vertical_Bar
loop
3143 Scan
; -- past vertical bar
3146 P_Range_Or_Subtype_Mark
(Allow_Simple_Expression
=> True));
3152 Set_Right_Opnd
(N
, Alt
);
3153 Set_Alternatives
(N
, No_List
);
3155 end P_Membership_Test
;
3157 ------------------------------------------
3158 -- P_Unparen_Cond_Case_Quant_Expression --
3159 ------------------------------------------
3161 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
is
3162 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
3168 if Token
= Tok_Case
then
3169 Result
:= P_Case_Expression
;
3171 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3172 Error_Msg_N
("case expression must be parenthesized!", Result
);
3177 elsif Token
= Tok_If
then
3178 Result
:= P_If_Expression
;
3180 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3181 Error_Msg_N
("if expression must be parenthesized!", Result
);
3184 -- Quantified expression
3186 elsif Token
= Tok_For
then
3187 Result
:= P_Quantified_Expression
;
3189 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3191 ("quantified expression must be parenthesized!", Result
);
3194 -- No other possibility should exist (caller was supposed to check)
3197 raise Program_Error
;
3200 -- Return expression (possibly after having given message)
3203 end P_Unparen_Cond_Case_Quant_Expression
;