1 -----------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2016, 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
51 -- string or a type. For those attributes, a left parenthesis after
52 -- the attribute should not be analyzed as the beginning of a parameters
53 -- list because it may denote a slice operation (X'Img (1 .. 2)) or
54 -- a type conversion (X'Class (Y)). The Ada2012 attribute 'Old is in
57 -- Note: Loop_Entry is in this list because, although it can take an
58 -- optional argument (the loop name), we can't distinguish that at parse
59 -- time from the case where no loop name is given and a legitimate index
60 -- expression is present. So we parse the argument as an indexed component
61 -- and the semantic analysis sorts out this syntactic ambiguity based on
62 -- the type and form of the expression.
64 -- Note that this map designates the minimum set of attributes where a
65 -- construct in parentheses that is not an argument can appear right
66 -- after the attribute. For attributes like 'Size, we do not put them
67 -- in the map. If someone writes X'Size (3), that's illegal in any case,
68 -- but we get a better error message by parsing the (3) as an illegal
69 -- argument to the attribute, rather than some meaningless junk that
70 -- follows the attribute.
72 -----------------------
73 -- Local Subprograms --
74 -----------------------
76 function P_Aggregate_Or_Paren_Expr
return Node_Id
;
77 function P_Allocator
return Node_Id
;
78 function P_Case_Expression_Alternative
return Node_Id
;
79 function P_Iterated_Component_Association
return Node_Id
;
80 function P_Record_Or_Array_Component_Association
return Node_Id
;
81 function P_Factor
return Node_Id
;
82 function P_Primary
return Node_Id
;
83 function P_Relation
return Node_Id
;
84 function P_Term
return Node_Id
;
86 function P_Binary_Adding_Operator
return Node_Kind
;
87 function P_Logical_Operator
return Node_Kind
;
88 function P_Multiplying_Operator
return Node_Kind
;
89 function P_Relational_Operator
return Node_Kind
;
90 function P_Unary_Adding_Operator
return Node_Kind
;
92 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
);
93 -- Called to place complaint about bad range attribute at the given
94 -- source location. Terminates by raising Error_Resync.
96 procedure Check_Bad_Exp
;
97 -- Called after scanning a**b, posts error if ** detected
99 procedure P_Membership_Test
(N
: Node_Id
);
100 -- N is the node for a N_In or N_Not_In node whose right operand has not
101 -- yet been processed. It is called just after scanning out the IN keyword.
102 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
104 function P_Range_Attribute_Reference
(Prefix_Node
: Node_Id
) return Node_Id
;
105 -- Scan a range attribute reference. The caller has scanned out the
106 -- prefix. The current token is known to be an apostrophe and the
107 -- following token is known to be RANGE.
109 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
;
110 -- This function is called with Token pointing to IF, CASE, or FOR, in a
111 -- context that allows a case, conditional, or quantified expression if
112 -- it is surrounded by parentheses. If not surrounded by parentheses, the
113 -- expression is still returned, but an error message is issued.
115 -------------------------
116 -- Bad_Range_Attribute --
117 -------------------------
119 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
121 Error_Msg
("range attribute cannot be used in expression!", Loc
);
123 end Bad_Range_Attribute
;
129 procedure Check_Bad_Exp
is
131 if Token
= Tok_Double_Asterisk
then
132 Error_Msg_SC
("parenthesization required for '*'*");
134 Discard_Junk_Node
(P_Primary
);
139 --------------------------
140 -- 4.1 Name (also 6.4) --
141 --------------------------
144 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
145 -- | INDEXED_COMPONENT | SLICE
146 -- | SELECTED_COMPONENT | ATTRIBUTE
147 -- | TYPE_CONVERSION | FUNCTION_CALL
148 -- | CHARACTER_LITERAL | TARGET_NAME
150 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
152 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
154 -- EXPLICIT_DEREFERENCE ::= NAME . all
156 -- IMPLICIT_DEREFERENCE ::= NAME
158 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
160 -- SLICE ::= PREFIX (DISCRETE_RANGE)
162 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
164 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
166 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
168 -- ATTRIBUTE_DESIGNATOR ::=
169 -- IDENTIFIER [(static_EXPRESSION)]
170 -- | access | delta | digits
174 -- | function_PREFIX ACTUAL_PARAMETER_PART
176 -- ACTUAL_PARAMETER_PART ::=
177 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
179 -- PARAMETER_ASSOCIATION ::=
180 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
182 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
184 -- TARGET_NAME ::= @ (AI12-0125-3: abbreviation for LHS)
186 -- Note: syntactically a procedure call looks just like a function call,
187 -- so this routine is in practice used to scan out procedure calls as well.
189 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
191 -- Error recovery: can raise Error_Resync
193 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
194 -- followed by either a left paren (qualified expression case), or by
195 -- range (range attribute case). All other uses of apostrophe (i.e. all
196 -- other attributes) are handled in this routine.
198 -- Error recovery: can raise Error_Resync
200 function P_Name
return Node_Id
is
201 Scan_State
: Saved_Scan_State
;
203 Prefix_Node
: Node_Id
;
204 Ident_Node
: Node_Id
;
206 Range_Node
: Node_Id
;
209 Arg_List
: List_Id
:= No_List
; -- kill junk warning
210 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
213 -- Case of not a name
215 if Token
not in Token_Class_Name
then
217 -- If it looks like start of expression, complain and scan expression
219 if Token
in Token_Class_Literal
220 or else Token
= Tok_Left_Paren
222 Error_Msg_SC
("name expected");
225 -- Otherwise some other junk, not much we can do
228 Error_Msg_AP
("name expected");
233 -- Loop through designators in qualified name
234 -- AI12-0125 : target_name
236 if Token
= Tok_At_Sign
then
237 Scan_Reserved_Identifier
(Force_Msg
=> False);
240 Name_Node
:= Token_Node
;
243 Scan
; -- past designator
244 exit when Token
/= Tok_Dot
;
245 Save_Scan_State
(Scan_State
); -- at dot
248 -- If we do not have another designator after the dot, then join
249 -- the normal circuit to handle a dot extension (may be .all or
250 -- character literal case). Otherwise loop back to scan the next
253 if Token
not in Token_Class_Desig
then
254 goto Scan_Name_Extension_Dot
;
256 Prefix_Node
:= Name_Node
;
257 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
258 Set_Prefix
(Name_Node
, Prefix_Node
);
259 Set_Selector_Name
(Name_Node
, Token_Node
);
263 -- We have now scanned out a qualified designator. If the last token is
264 -- an operator symbol, then we certainly do not have the Snam case, so
265 -- we can just use the normal name extension check circuit
267 if Prev_Token
= Tok_Operator_Symbol
then
268 goto Scan_Name_Extension
;
271 -- We have scanned out a qualified simple name, check for name extension
272 -- Note that we know there is no dot here at this stage, so the only
273 -- possible cases of name extension are apostrophe and left paren.
275 if Token
= Tok_Apostrophe
then
276 Save_Scan_State
(Scan_State
); -- at apostrophe
277 Scan
; -- past apostrophe
279 -- Qualified expression in Ada 2012 mode (treated as a name)
281 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
282 goto Scan_Name_Extension_Apostrophe
;
284 -- If left paren not in Ada 2012, then it is not part of the name,
285 -- since qualified expressions are not names in prior versions of
286 -- Ada, so return with Token backed up to point to the apostrophe.
287 -- The treatment for the range attribute is similar (we do not
288 -- consider x'range to be a name in this grammar).
290 elsif Token
= Tok_Left_Paren
or else Token
= Tok_Range
then
291 Restore_Scan_State
(Scan_State
); -- to apostrophe
292 Expr_Form
:= EF_Simple_Name
;
295 -- Otherwise we have the case of a name extended by an attribute
298 goto Scan_Name_Extension_Apostrophe
;
301 -- Check case of qualified simple name extended by a left parenthesis
303 elsif Token
= Tok_Left_Paren
then
304 Scan
; -- past left paren
305 goto Scan_Name_Extension_Left_Paren
;
307 -- Otherwise the qualified simple name is not extended, so return
310 Expr_Form
:= EF_Simple_Name
;
314 -- Loop scanning past name extensions. A label is used for control
315 -- transfer for this loop for ease of interfacing with the finite state
316 -- machine in the parenthesis scanning circuit, and also to allow for
317 -- passing in control to the appropriate point from the above code.
319 <<Scan_Name_Extension
>>
321 -- Character literal used as name cannot be extended. Also this
322 -- cannot be a call, since the name for a call must be a designator.
323 -- Return in these cases, or if there is no name extension
325 if Token
not in Token_Class_Namext
326 or else Prev_Token
= Tok_Char_Literal
328 Expr_Form
:= EF_Name
;
332 -- Merge here when we know there is a name extension
334 <<Scan_Name_Extension_OK
>>
336 if Token
= Tok_Left_Paren
then
337 Scan
; -- past left paren
338 goto Scan_Name_Extension_Left_Paren
;
340 elsif Token
= Tok_Apostrophe
then
341 Save_Scan_State
(Scan_State
); -- at apostrophe
342 Scan
; -- past apostrophe
343 goto Scan_Name_Extension_Apostrophe
;
345 else -- Token = Tok_Dot
346 Save_Scan_State
(Scan_State
); -- at dot
348 goto Scan_Name_Extension_Dot
;
351 -- Case of name extended by dot (selection), dot is already skipped
352 -- and the scan state at the point of the dot is saved in Scan_State.
354 <<Scan_Name_Extension_Dot
>>
356 -- Explicit dereference case
358 if Token
= Tok_All
then
359 Prefix_Node
:= Name_Node
;
360 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
361 Set_Prefix
(Name_Node
, Prefix_Node
);
363 goto Scan_Name_Extension
;
365 -- Selected component case
367 elsif Token
in Token_Class_Name
then
368 Prefix_Node
:= Name_Node
;
369 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
370 Set_Prefix
(Name_Node
, Prefix_Node
);
371 Set_Selector_Name
(Name_Node
, Token_Node
);
372 Scan
; -- past selector
373 goto Scan_Name_Extension
;
375 -- Reserved identifier as selector
377 elsif Is_Reserved_Identifier
then
378 Scan_Reserved_Identifier
(Force_Msg
=> False);
379 Prefix_Node
:= Name_Node
;
380 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
381 Set_Prefix
(Name_Node
, Prefix_Node
);
382 Set_Selector_Name
(Name_Node
, Token_Node
);
383 Scan
; -- past identifier used as selector
384 goto Scan_Name_Extension
;
386 -- If dot is at end of line and followed by nothing legal,
387 -- then assume end of name and quit (dot will be taken as
388 -- an incorrect form of some other punctuation by our caller).
390 elsif Token_Is_At_Start_Of_Line
then
391 Restore_Scan_State
(Scan_State
);
394 -- Here if nothing legal after the dot
397 Error_Msg_AP
("selector expected");
401 -- Here for an apostrophe as name extension. The scan position at the
402 -- apostrophe has already been saved, and the apostrophe scanned out.
404 <<Scan_Name_Extension_Apostrophe
>>
406 Scan_Apostrophe
: declare
407 function Apostrophe_Should_Be_Semicolon
return Boolean;
408 -- Checks for case where apostrophe should probably be
409 -- a semicolon, and if so, gives appropriate message,
410 -- resets the scan pointer to the apostrophe, changes
411 -- the current token to Tok_Semicolon, and returns True.
412 -- Otherwise returns False.
414 ------------------------------------
415 -- Apostrophe_Should_Be_Semicolon --
416 ------------------------------------
418 function Apostrophe_Should_Be_Semicolon
return Boolean is
420 if Token_Is_At_Start_Of_Line
then
421 Restore_Scan_State
(Scan_State
); -- to apostrophe
422 Error_Msg_SC
("|""''"" should be "";""");
423 Token
:= Tok_Semicolon
;
428 end Apostrophe_Should_Be_Semicolon
;
430 -- Start of processing for Scan_Apostrophe
433 -- Check for qualified expression case in Ada 2012 mode
435 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
436 Name_Node
:= P_Qualified_Expression
(Name_Node
);
437 goto Scan_Name_Extension
;
439 -- If range attribute after apostrophe, then return with Token
440 -- pointing to the apostrophe. Note that in this case the prefix
441 -- need not be a simple name (cases like A.all'range). Similarly
442 -- if there is a left paren after the apostrophe, then we also
443 -- return with Token pointing to the apostrophe (this is the
444 -- aggregate case, or some error case).
446 elsif Token
= Tok_Range
or else Token
= Tok_Left_Paren
then
447 Restore_Scan_State
(Scan_State
); -- to apostrophe
448 Expr_Form
:= EF_Name
;
451 -- Here for cases where attribute designator is an identifier
453 elsif Token
= Tok_Identifier
then
454 Attr_Name
:= Token_Name
;
456 if not Is_Attribute_Name
(Attr_Name
) then
457 if Apostrophe_Should_Be_Semicolon
then
458 Expr_Form
:= EF_Name
;
461 -- Here for a bad attribute name
464 Signal_Bad_Attribute
;
465 Scan
; -- past bad identifier
467 if Token
= Tok_Left_Paren
then
468 Scan
; -- past left paren
471 Discard_Junk_Node
(P_Expression_If_OK
);
472 exit when not Comma_Present
;
483 Style
.Check_Attribute_Name
(False);
486 -- Here for case of attribute designator is not an identifier
489 if Token
= Tok_Delta
then
490 Attr_Name
:= Name_Delta
;
492 elsif Token
= Tok_Digits
then
493 Attr_Name
:= Name_Digits
;
495 elsif Token
= Tok_Access
then
496 Attr_Name
:= Name_Access
;
498 elsif Token
= Tok_Mod
and then Ada_Version
>= Ada_95
then
499 Attr_Name
:= Name_Mod
;
501 elsif Apostrophe_Should_Be_Semicolon
then
502 Expr_Form
:= EF_Name
;
506 Error_Msg_AP
("attribute designator expected");
511 Style
.Check_Attribute_Name
(True);
515 -- We come here with an OK attribute scanned, and corresponding
516 -- Attribute identifier node stored in Ident_Node.
518 Prefix_Node
:= Name_Node
;
519 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
520 Scan
; -- past attribute designator
521 Set_Prefix
(Name_Node
, Prefix_Node
);
522 Set_Attribute_Name
(Name_Node
, Attr_Name
);
524 -- Scan attribute arguments/designator. We skip this if we know
525 -- that the attribute cannot have an argument (see documentation
526 -- of Is_Parameterless_Attribute for further details).
528 if Token
= Tok_Left_Paren
530 Is_Parameterless_Attribute
(Get_Attribute_Id
(Attr_Name
))
532 -- Attribute Update contains an array or record association
533 -- list which provides new values for various components or
534 -- elements. The list is parsed as an aggregate, and we get
535 -- better error handling by knowing that in the parser.
537 if Attr_Name
= Name_Update
then
538 Set_Expressions
(Name_Node
, New_List
);
539 Append
(P_Aggregate
, Expressions
(Name_Node
));
541 -- All other cases of parsing attribute arguments
544 Set_Expressions
(Name_Node
, New_List
);
545 Scan
; -- past left paren
549 Expr
: constant Node_Id
:= P_Expression_If_OK
;
553 -- Case of => for named notation
555 if Token
= Tok_Arrow
then
557 -- Named notation allowed only for the special
558 -- case of System'Restriction_Set (No_Dependence =>
559 -- unit_NAME), in which case construct a parameter
560 -- assocation node and append to the arguments.
562 if Attr_Name
= Name_Restriction_Set
563 and then Nkind
(Expr
) = N_Identifier
564 and then Chars
(Expr
) = Name_No_Dependence
568 Append_To
(Expressions
(Name_Node
),
569 Make_Parameter_Association
(Sloc
(Rnam
),
570 Selector_Name
=> Expr
,
571 Explicit_Actual_Parameter
=> Rnam
));
574 -- For all other cases named notation is illegal
578 ("named parameters not permitted "
580 Scan
; -- past junk arrow
583 -- Here for normal case (not => for named parameter)
586 Append
(Expr
, Expressions
(Name_Node
));
587 exit when not Comma_Present
;
596 goto Scan_Name_Extension
;
599 -- Here for left parenthesis extending name (left paren skipped)
601 <<Scan_Name_Extension_Left_Paren
>>
603 -- We now have to scan through a list of items, terminated by a
604 -- right parenthesis. The scan is handled by a finite state
605 -- machine. The possibilities are:
609 -- This is a slice. This case is handled in LP_State_Init
611 -- (expression, expression, ..)
613 -- This is interpreted as an indexed component, i.e. as a
614 -- case of a name which can be extended in the normal manner.
615 -- This case is handled by LP_State_Name or LP_State_Expr.
617 -- Note: if and case expressions (without an extra level of
618 -- parentheses) are permitted in this context).
620 -- (..., identifier => expression , ...)
622 -- If there is at least one occurrence of identifier => (but
623 -- none of the other cases apply), then we have a call.
625 -- Test for Id => case
627 if Token
= Tok_Identifier
then
628 Save_Scan_State
(Scan_State
); -- at Id
631 -- Test for => (allow := as an error substitute)
633 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
634 Restore_Scan_State
(Scan_State
); -- to Id
635 Arg_List
:= New_List
;
639 Restore_Scan_State
(Scan_State
); -- to Id
643 -- Here we have an expression after all
645 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
647 -- Check cases of discrete range for a slice
649 -- First possibility: Range_Attribute_Reference
651 if Expr_Form
= EF_Range_Attr
then
652 Range_Node
:= Expr_Node
;
654 -- Second possibility: Simple_expression .. Simple_expression
656 elsif Token
= Tok_Dot_Dot
then
657 Check_Simple_Expression
(Expr_Node
);
658 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
659 Set_Low_Bound
(Range_Node
, Expr_Node
);
661 Expr_Node
:= P_Expression
;
662 Check_Simple_Expression
(Expr_Node
);
663 Set_High_Bound
(Range_Node
, Expr_Node
);
665 -- Third possibility: Type_name range Range
667 elsif Token
= Tok_Range
then
668 if Expr_Form
/= EF_Simple_Name
then
669 Error_Msg_SC
("subtype mark must precede RANGE");
673 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
675 -- Otherwise we just have an expression. It is true that we might
676 -- have a subtype mark without a range constraint but this case
677 -- is syntactically indistinguishable from the expression case.
680 Arg_List
:= New_List
;
684 -- Fall through here with unmistakable Discrete range scanned,
685 -- which means that we definitely have the case of a slice. The
686 -- Discrete range is in Range_Node.
688 if Token
= Tok_Comma
then
689 Error_Msg_SC
("slice cannot have more than one dimension");
692 elsif Token
/= Tok_Right_Paren
then
693 if Token
= Tok_Arrow
then
695 -- This may be an aggregate that is missing a qualification
698 ("context of aggregate must be a qualified expression");
707 Scan
; -- past right paren
708 Prefix_Node
:= Name_Node
;
709 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
710 Set_Prefix
(Name_Node
, Prefix_Node
);
711 Set_Discrete_Range
(Name_Node
, Range_Node
);
713 -- An operator node is legal as a prefix to other names,
714 -- but not for a slice.
716 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
717 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
720 -- If we have a name extension, go scan it
722 if Token
in Token_Class_Namext
then
723 goto Scan_Name_Extension_OK
;
725 -- Otherwise return (a slice is a name, but is not a call)
728 Expr_Form
:= EF_Name
;
733 -- In LP_State_Expr, we have scanned one or more expressions, and
734 -- so we have a call or an indexed component which is a name. On
735 -- entry we have the expression just scanned in Expr_Node and
736 -- Arg_List contains the list of expressions encountered so far
739 Append
(Expr_Node
, Arg_List
);
741 if Token
= Tok_Arrow
then
743 ("expect identifier in parameter association", Sloc
(Expr_Node
));
746 elsif not Comma_Present
then
749 Prefix_Node
:= Name_Node
;
750 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
751 Set_Prefix
(Name_Node
, Prefix_Node
);
752 Set_Expressions
(Name_Node
, Arg_List
);
754 goto Scan_Name_Extension
;
757 -- Comma present (and scanned out), test for identifier => case
758 -- Test for identifier => case
760 if Token
= Tok_Identifier
then
761 Save_Scan_State
(Scan_State
); -- at Id
764 -- Test for => (allow := as error substitute)
766 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
767 Restore_Scan_State
(Scan_State
); -- to Id
770 -- Otherwise it's just an expression after all, so backup
773 Restore_Scan_State
(Scan_State
); -- to Id
777 -- Here we have an expression after all, so stay in this state
779 Expr_Node
:= P_Expression_If_OK
;
782 -- LP_State_Call corresponds to the situation in which at least one
783 -- instance of Id => Expression has been encountered, so we know that
784 -- we do not have a name, but rather a call. We enter it with the
785 -- scan pointer pointing to the next argument to scan, and Arg_List
786 -- containing the list of arguments scanned so far.
790 -- Test for case of Id => Expression (named parameter)
792 if Token
= Tok_Identifier
then
793 Save_Scan_State
(Scan_State
); -- at Id
794 Ident_Node
:= Token_Node
;
797 -- Deal with => (allow := as incorrect substitute)
799 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
800 Arg_Node
:= New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
801 Set_Selector_Name
(Arg_Node
, Ident_Node
);
803 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
804 Append
(Arg_Node
, Arg_List
);
806 -- If a comma follows, go back and scan next entry
808 if Comma_Present
then
811 -- Otherwise we have the end of a call
814 Prefix_Node
:= Name_Node
;
815 Name_Node
:= New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
816 Set_Name
(Name_Node
, Prefix_Node
);
817 Set_Parameter_Associations
(Name_Node
, Arg_List
);
820 if Token
in Token_Class_Namext
then
821 goto Scan_Name_Extension_OK
;
823 -- This is a case of a call which cannot be a name
826 Expr_Form
:= EF_Name
;
831 -- Not named parameter: Id started an expression after all
834 Restore_Scan_State
(Scan_State
); -- to Id
838 -- Here if entry did not start with Id => which means that it
839 -- is a positional parameter, which is not allowed, since we
840 -- have seen at least one named parameter already.
843 ("positional parameter association " &
844 "not allowed after named one");
846 Expr_Node
:= P_Expression_If_OK
;
848 -- Leaving the '>' in an association is not unusual, so suggest
851 if Nkind
(Expr_Node
) = N_Op_Eq
then
852 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
855 -- We go back to scanning out expressions, so that we do not get
856 -- multiple error messages when several positional parameters
857 -- follow a named parameter.
861 -- End of treatment for name extensions starting with left paren
863 -- End of loop through name extensions
867 -- This function parses a restricted form of Names which are either
868 -- designators, or designators preceded by a sequence of prefixes
869 -- that are direct names.
871 -- Error recovery: cannot raise Error_Resync
873 function P_Function_Name
return Node_Id
is
874 Designator_Node
: Node_Id
;
875 Prefix_Node
: Node_Id
;
876 Selector_Node
: Node_Id
;
877 Dot_Sloc
: Source_Ptr
:= No_Location
;
880 -- Prefix_Node is set to the gathered prefix so far, Empty means that
881 -- no prefix has been scanned. This allows us to build up the result
882 -- in the required right recursive manner.
884 Prefix_Node
:= Empty
;
886 -- Loop through prefixes
889 Designator_Node
:= Token_Node
;
891 if Token
not in Token_Class_Desig
then
892 return P_Identifier
; -- let P_Identifier issue the error message
894 else -- Token in Token_Class_Desig
895 Scan
; -- past designator
896 exit when Token
/= Tok_Dot
;
899 -- Here at a dot, with token just before it in Designator_Node
901 if No
(Prefix_Node
) then
902 Prefix_Node
:= Designator_Node
;
904 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
905 Set_Prefix
(Selector_Node
, Prefix_Node
);
906 Set_Selector_Name
(Selector_Node
, Designator_Node
);
907 Prefix_Node
:= Selector_Node
;
910 Dot_Sloc
:= Token_Ptr
;
914 -- Fall out of the loop having just scanned a designator
916 if No
(Prefix_Node
) then
917 return Designator_Node
;
919 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
920 Set_Prefix
(Selector_Node
, Prefix_Node
);
921 Set_Selector_Name
(Selector_Node
, Designator_Node
);
922 return Selector_Node
;
930 -- This function parses a restricted form of Names which are either
931 -- identifiers, or identifiers preceded by a sequence of prefixes
932 -- that are direct names.
934 -- Error recovery: cannot raise Error_Resync
936 function P_Qualified_Simple_Name
return Node_Id
is
937 Designator_Node
: Node_Id
;
938 Prefix_Node
: Node_Id
;
939 Selector_Node
: Node_Id
;
940 Dot_Sloc
: Source_Ptr
:= No_Location
;
943 -- Prefix node is set to the gathered prefix so far, Empty means that
944 -- no prefix has been scanned. This allows us to build up the result
945 -- in the required right recursive manner.
947 Prefix_Node
:= Empty
;
949 -- Loop through prefixes
952 Designator_Node
:= Token_Node
;
954 if Token
= Tok_Identifier
then
955 Scan
; -- past identifier
956 exit when Token
/= Tok_Dot
;
958 elsif Token
not in Token_Class_Desig
then
959 return P_Identifier
; -- let P_Identifier issue the error message
962 Scan
; -- past designator
964 if Token
/= Tok_Dot
then
965 Error_Msg_SP
("identifier expected");
970 -- Here at a dot, with token just before it in Designator_Node
972 if No
(Prefix_Node
) then
973 Prefix_Node
:= Designator_Node
;
975 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
976 Set_Prefix
(Selector_Node
, Prefix_Node
);
977 Set_Selector_Name
(Selector_Node
, Designator_Node
);
978 Prefix_Node
:= Selector_Node
;
981 Dot_Sloc
:= Token_Ptr
;
985 -- Fall out of the loop having just scanned an identifier
987 if No
(Prefix_Node
) then
988 return Designator_Node
;
990 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
991 Set_Prefix
(Selector_Node
, Prefix_Node
);
992 Set_Selector_Name
(Selector_Node
, Designator_Node
);
993 return Selector_Node
;
999 end P_Qualified_Simple_Name
;
1001 -- This procedure differs from P_Qualified_Simple_Name only in that it
1002 -- raises Error_Resync if any error is encountered. It only returns after
1003 -- scanning a valid qualified simple name.
1005 -- Error recovery: can raise Error_Resync
1007 function P_Qualified_Simple_Name_Resync
return Node_Id
is
1008 Designator_Node
: Node_Id
;
1009 Prefix_Node
: Node_Id
;
1010 Selector_Node
: Node_Id
;
1011 Dot_Sloc
: Source_Ptr
:= No_Location
;
1014 Prefix_Node
:= Empty
;
1016 -- Loop through prefixes
1019 Designator_Node
:= Token_Node
;
1021 if Token
= Tok_Identifier
then
1022 Scan
; -- past identifier
1023 exit when Token
/= Tok_Dot
;
1025 elsif Token
not in Token_Class_Desig
then
1026 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
1030 Scan
; -- past designator
1032 if Token
/= Tok_Dot
then
1033 Error_Msg_SP
("identifier expected");
1038 -- Here at a dot, with token just before it in Designator_Node
1040 if No
(Prefix_Node
) then
1041 Prefix_Node
:= Designator_Node
;
1043 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1044 Set_Prefix
(Selector_Node
, Prefix_Node
);
1045 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1046 Prefix_Node
:= Selector_Node
;
1049 Dot_Sloc
:= Token_Ptr
;
1050 Scan
; -- past period
1053 -- Fall out of the loop having just scanned an identifier
1055 if No
(Prefix_Node
) then
1056 return Designator_Node
;
1058 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1059 Set_Prefix
(Selector_Node
, Prefix_Node
);
1060 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1061 return Selector_Node
;
1063 end P_Qualified_Simple_Name_Resync
;
1065 ----------------------
1066 -- 4.1 Direct_Name --
1067 ----------------------
1069 -- Parsed by P_Name and other functions in section 4.1
1075 -- Parsed by P_Name (4.1)
1077 -------------------------------
1078 -- 4.1 Explicit Dereference --
1079 -------------------------------
1081 -- Parsed by P_Name (4.1)
1083 -------------------------------
1084 -- 4.1 Implicit_Dereference --
1085 -------------------------------
1087 -- Parsed by P_Name (4.1)
1089 ----------------------------
1090 -- 4.1 Indexed Component --
1091 ----------------------------
1093 -- Parsed by P_Name (4.1)
1099 -- Parsed by P_Name (4.1)
1101 -----------------------------
1102 -- 4.1 Selected_Component --
1103 -----------------------------
1105 -- Parsed by P_Name (4.1)
1107 ------------------------
1108 -- 4.1 Selector Name --
1109 ------------------------
1111 -- Parsed by P_Name (4.1)
1113 ------------------------------
1114 -- 4.1 Attribute Reference --
1115 ------------------------------
1117 -- Parsed by P_Name (4.1)
1119 -------------------------------
1120 -- 4.1 Attribute Designator --
1121 -------------------------------
1123 -- Parsed by P_Name (4.1)
1125 --------------------------------------
1126 -- 4.1.4 Range Attribute Reference --
1127 --------------------------------------
1129 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1131 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1133 -- In the grammar, a RANGE attribute is simply a name, but its use is
1134 -- highly restricted, so in the parser, we do not regard it as a name.
1135 -- Instead, P_Name returns without scanning the 'RANGE part of the
1136 -- attribute, and the caller uses the following function to construct
1137 -- a range attribute in places where it is appropriate.
1139 -- Note that RANGE here is treated essentially as an identifier,
1140 -- rather than a reserved word.
1142 -- The caller has parsed the prefix, i.e. a name, and Token points to
1143 -- the apostrophe. The token after the apostrophe is known to be RANGE
1144 -- at this point. The prefix node becomes the prefix of the attribute.
1146 -- Error_Recovery: Cannot raise Error_Resync
1148 function P_Range_Attribute_Reference
1149 (Prefix_Node
: Node_Id
)
1152 Attr_Node
: Node_Id
;
1155 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1156 Set_Prefix
(Attr_Node
, Prefix_Node
);
1157 Scan
; -- past apostrophe
1160 Style
.Check_Attribute_Name
(True);
1163 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1166 if Token
= Tok_Left_Paren
then
1167 Scan
; -- past left paren
1168 Set_Expressions
(Attr_Node
, New_List
(P_Expression_If_OK
));
1173 end P_Range_Attribute_Reference
;
1175 ---------------------------------------
1176 -- 4.1.4 Range Attribute Designator --
1177 ---------------------------------------
1179 -- Parsed by P_Range_Attribute_Reference (4.4)
1181 --------------------
1183 --------------------
1185 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1187 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1188 -- an aggregate is known to be required (code statement, extension
1189 -- aggregate), in which cases this routine performs the necessary check
1190 -- that we have an aggregate rather than a parenthesized expression
1192 -- Error recovery: can raise Error_Resync
1194 function P_Aggregate
return Node_Id
is
1195 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1196 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1199 if Nkind
(Aggr_Node
) /= N_Aggregate
1201 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1204 ("aggregate may not have single positional component", Aggr_Sloc
);
1211 ------------------------------------------------
1212 -- 4.3 Aggregate or Parenthesized Expression --
1213 ------------------------------------------------
1215 -- This procedure parses out either an aggregate or a parenthesized
1216 -- expression (these two constructs are closely related, since a
1217 -- parenthesized expression looks like an aggregate with a single
1218 -- positional component).
1221 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1223 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1225 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1226 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1229 -- RECORD_COMPONENT_ASSOCIATION ::=
1230 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1232 -- COMPONENT_CHOICE_LIST ::=
1233 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1236 -- EXTENSION_AGGREGATE ::=
1237 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1239 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1241 -- ARRAY_AGGREGATE ::=
1242 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1244 -- POSITIONAL_ARRAY_AGGREGATE ::=
1245 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1246 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1247 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1249 -- NAMED_ARRAY_AGGREGATE ::=
1250 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1252 -- PRIMARY ::= (EXPRESSION);
1254 -- Error recovery: can raise Error_Resync
1256 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1257 -- to Ada 2005 limited aggregates (AI-287)
1259 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1260 Aggregate_Node
: Node_Id
;
1261 Expr_List
: List_Id
;
1262 Assoc_List
: List_Id
;
1263 Expr_Node
: Node_Id
;
1264 Lparen_Sloc
: Source_Ptr
;
1265 Scan_State
: Saved_Scan_State
;
1267 procedure Box_Error
;
1268 -- Called if <> is encountered as positional aggregate element. Issues
1269 -- error message and sets Expr_Node to Error.
1271 function Is_Quantified_Expression
return Boolean;
1272 -- The presence of iterated component associations requires a one
1273 -- token lookahead to distinguish it from quantified expressions.
1279 procedure Box_Error
is
1281 if Ada_Version
< Ada_2005
then
1282 Error_Msg_SC
("box in aggregate is an Ada 2005 extension");
1285 -- Ada 2005 (AI-287): The box notation is allowed only with named
1286 -- notation because positional notation might be error prone. For
1287 -- example, in "(X, <>, Y, <>)", there is no type associated with
1288 -- the boxes, so you might not be leaving out the components you
1289 -- thought you were leaving out.
1291 Error_Msg_SC
("(Ada 2005) box only allowed with named notation");
1296 ------------------------------
1297 -- Is_Quantified_Expression --
1298 ------------------------------
1300 function Is_Quantified_Expression
return Boolean is
1302 Scan_State
: Saved_Scan_State
;
1305 Save_Scan_State
(Scan_State
);
1307 Maybe
:= Token
= Tok_All
or else Token
= Tok_Some
;
1308 Restore_Scan_State
(Scan_State
); -- to FOR
1310 end Is_Quantified_Expression
;
1312 -- Start of processing for P_Aggregate_Or_Paren_Expr
1315 Lparen_Sloc
:= Token_Ptr
;
1318 -- Note on parentheses count. For cases like an if expression, the
1319 -- parens here really count as real parentheses for the paren count,
1320 -- so we adjust the paren count accordingly after scanning the expr.
1324 if Token
= Tok_If
then
1325 Expr_Node
:= P_If_Expression
;
1327 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1332 elsif Token
= Tok_Case
then
1333 Expr_Node
:= P_Case_Expression
;
1335 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1338 -- Quantified expression
1340 elsif Token
= Tok_For
and then Is_Quantified_Expression
then
1341 Expr_Node
:= P_Quantified_Expression
;
1343 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1346 -- Note: the mechanism used here of rescanning the initial expression
1347 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1348 -- out the discrete choice list.
1350 -- Deal with expression and extension aggregates first
1352 elsif Token
/= Tok_Others
then
1353 Save_Scan_State
(Scan_State
); -- at start of expression
1355 -- Deal with (NULL RECORD)
1357 if Token
= Tok_Null
then
1360 if Token
= Tok_Record
then
1361 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1362 Set_Null_Record_Present
(Aggregate_Node
, True);
1363 Scan
; -- past RECORD
1365 return Aggregate_Node
;
1367 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1370 elsif Token
= Tok_For
then
1371 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1372 Expr_Node
:= P_Iterated_Component_Association
;
1376 -- Scan expression, handling box appearing as positional argument
1378 if Token
= Tok_Box
then
1381 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1384 -- Extension or Delta aggregate
1386 if Token
= Tok_With
then
1387 if Nkind
(Expr_Node
) = N_Attribute_Reference
1388 and then Attribute_Name
(Expr_Node
) = Name_Range
1390 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1394 if Ada_Version
= Ada_83
then
1395 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1399 if Token
= Tok_Delta
then
1401 Aggregate_Node
:= New_Node
(N_Delta_Aggregate
, Lparen_Sloc
);
1402 Set_Expression
(Aggregate_Node
, Expr_Node
);
1407 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1408 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1411 -- Deal with WITH NULL RECORD case
1413 if Token
= Tok_Null
then
1414 Save_Scan_State
(Scan_State
); -- at NULL
1417 if Token
= Tok_Record
then
1418 Scan
; -- past RECORD
1419 Set_Null_Record_Present
(Aggregate_Node
, True);
1421 return Aggregate_Node
;
1424 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1428 if Token
/= Tok_Others
then
1429 Save_Scan_State
(Scan_State
);
1430 Expr_Node
:= P_Expression
;
1437 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1438 if Nkind
(Expr_Node
) = N_Attribute_Reference
1439 and then Attribute_Name
(Expr_Node
) = Name_Range
1442 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
1443 Scan
; -- past right paren
1447 -- Bump paren count of expression
1449 if Expr_Node
/= Error
then
1450 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1453 T_Right_Paren
; -- past right paren (error message if none)
1459 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1465 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1469 -- Prepare to scan list of component associations
1471 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1472 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1474 -- This loop scans through component associations. On entry to the
1475 -- loop, an expression has been scanned at the start of the current
1476 -- association unless initial token was OTHERS, in which case
1477 -- Expr_Node is set to Empty.
1480 -- Deal with others association first. This is a named association
1482 if No
(Expr_Node
) then
1483 if No
(Assoc_List
) then
1484 Assoc_List
:= New_List
;
1487 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1489 -- Improper use of WITH
1491 elsif Token
= Tok_With
then
1492 Error_Msg_SC
("WITH must be preceded by single expression in " &
1493 "extension aggregate");
1496 -- Range attribute can only appear as part of a discrete choice list
1498 elsif Nkind
(Expr_Node
) = N_Attribute_Reference
1499 and then Attribute_Name
(Expr_Node
) = Name_Range
1500 and then Token
/= Tok_Arrow
1501 and then Token
/= Tok_Vertical_Bar
1503 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1506 -- Assume positional case if comma, right paren, or literal or
1507 -- identifier or OTHERS follows (the latter cases are missing
1508 -- comma cases). Also assume positional if a semicolon follows,
1509 -- which can happen if there are missing parens.
1511 elsif Nkind
(Expr_Node
) = N_Iterated_Component_Association
then
1512 if No
(Assoc_List
) then
1513 Assoc_List
:= New_List
(Expr_Node
);
1515 Append_To
(Assoc_List
, Expr_Node
);
1518 elsif Token
= Tok_Comma
1519 or else Token
= Tok_Right_Paren
1520 or else Token
= Tok_Others
1521 or else Token
in Token_Class_Lit_Or_Name
1522 or else Token
= Tok_Semicolon
1524 if Present
(Assoc_List
) then
1525 Error_Msg_BC
-- CODEFIX
1526 ("""='>"" expected (positional association cannot follow "
1527 & "named association)");
1530 if No
(Expr_List
) then
1531 Expr_List
:= New_List
;
1534 Append
(Expr_Node
, Expr_List
);
1536 -- Check for aggregate followed by left parent, maybe missing comma
1538 elsif Nkind
(Expr_Node
) = N_Aggregate
1539 and then Token
= Tok_Left_Paren
1543 if No
(Expr_List
) then
1544 Expr_List
:= New_List
;
1547 Append
(Expr_Node
, Expr_List
);
1549 -- Anything else is assumed to be a named association
1552 Restore_Scan_State
(Scan_State
); -- to start of expression
1554 if No
(Assoc_List
) then
1555 Assoc_List
:= New_List
;
1558 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1561 exit when not Comma_Present
;
1563 -- If we are at an expression terminator, something is seriously
1564 -- wrong, so let's get out now, before we start eating up stuff
1565 -- that doesn't belong to us.
1567 if Token
in Token_Class_Eterm
and then Token
/= Tok_For
then
1569 ("expecting expression or component association");
1573 -- Deal with misused box
1575 if Token
= Tok_Box
then
1578 -- Otherwise initiate for reentry to top of loop by scanning an
1579 -- initial expression, unless the first token is OTHERS or FOR,
1580 -- which indicates an iterated component association.
1582 elsif Token
= Tok_Others
then
1585 elsif Token
= Tok_For
then
1586 Expr_Node
:= P_Iterated_Component_Association
;
1589 Save_Scan_State
(Scan_State
); -- at start of expression
1590 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1595 -- All component associations (positional and named) have been scanned
1599 if Nkind
(Aggregate_Node
) /= N_Delta_Aggregate
then
1600 Set_Expressions
(Aggregate_Node
, Expr_List
);
1603 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1604 return Aggregate_Node
;
1605 end P_Aggregate_Or_Paren_Expr
;
1607 ------------------------------------------------
1608 -- 4.3 Record or Array Component Association --
1609 ------------------------------------------------
1611 -- RECORD_COMPONENT_ASSOCIATION ::=
1612 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1613 -- | COMPONENT_CHOICE_LIST => <>
1615 -- COMPONENT_CHOICE_LIST =>
1616 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1619 -- ARRAY_COMPONENT_ASSOCIATION ::=
1620 -- DISCRETE_CHOICE_LIST => EXPRESSION
1621 -- | DISCRETE_CHOICE_LIST => <>
1622 -- | ITERATED_COMPONENT_ASSOCIATION
1624 -- Note: this routine only handles the named cases, including others.
1625 -- Cases where the component choice list is not present have already
1626 -- been handled directly.
1628 -- Error recovery: can raise Error_Resync
1630 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1631 -- rules have been extended to give support to Ada 2005 limited
1632 -- aggregates (AI-287)
1634 function P_Record_Or_Array_Component_Association
return Node_Id
is
1635 Assoc_Node
: Node_Id
;
1638 if Token
= Tok_For
then
1639 return P_Iterated_Component_Association
;
1642 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1643 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1644 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1647 if Token
= Tok_Box
then
1649 -- Ada 2005(AI-287): The box notation is used to indicate the
1650 -- default initialization of aggregate components
1652 if Ada_Version
< Ada_2005
then
1654 ("component association with '<'> is an Ada 2005 extension");
1655 Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
1658 Set_Box_Present
(Assoc_Node
);
1661 Set_Expression
(Assoc_Node
, P_Expression
);
1665 end P_Record_Or_Array_Component_Association
;
1667 -----------------------------
1668 -- 4.3.1 Record Aggregate --
1669 -----------------------------
1671 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1672 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1674 ----------------------------------------------
1675 -- 4.3.1 Record Component Association List --
1676 ----------------------------------------------
1678 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1680 ----------------------------------
1681 -- 4.3.1 Component Choice List --
1682 ----------------------------------
1684 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1686 --------------------------------
1687 -- 4.3.1 Extension Aggregate --
1688 --------------------------------
1690 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1692 --------------------------
1693 -- 4.3.1 Ancestor Part --
1694 --------------------------
1696 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1698 ----------------------------
1699 -- 4.3.1 Array Aggregate --
1700 ----------------------------
1702 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1704 ---------------------------------------
1705 -- 4.3.1 Positional Array Aggregate --
1706 ---------------------------------------
1708 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1710 ----------------------------------
1711 -- 4.3.1 Named Array Aggregate --
1712 ----------------------------------
1714 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1716 ----------------------------------------
1717 -- 4.3.1 Array Component Association --
1718 ----------------------------------------
1720 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1722 ---------------------
1723 -- 4.4 Expression --
1724 ---------------------
1726 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1729 -- RELATION {LOGICAL_OPERATOR RELATION}
1731 -- CHOICE_EXPRESSION ::=
1732 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1734 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1736 -- On return, Expr_Form indicates the categorization of the expression
1737 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1738 -- an error message is given, and Error is returned).
1740 -- Error recovery: cannot raise Error_Resync
1742 function P_Expression
return Node_Id
is
1743 Logical_Op
: Node_Kind
;
1744 Prev_Logical_Op
: Node_Kind
;
1745 Op_Location
: Source_Ptr
;
1750 Node1
:= P_Relation
;
1752 if Token
in Token_Class_Logop
then
1753 Prev_Logical_Op
:= N_Empty
;
1756 Op_Location
:= Token_Ptr
;
1757 Logical_Op
:= P_Logical_Operator
;
1759 if Prev_Logical_Op
/= N_Empty
and then
1760 Logical_Op
/= Prev_Logical_Op
1763 ("mixed logical operators in expression", Op_Location
);
1764 Prev_Logical_Op
:= N_Empty
;
1766 Prev_Logical_Op
:= Logical_Op
;
1770 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1771 Set_Left_Opnd
(Node1
, Node2
);
1772 Set_Right_Opnd
(Node1
, P_Relation
);
1774 -- Check for case of errant comma or semicolon
1776 if Token
= Tok_Comma
or else Token
= Tok_Semicolon
then
1778 Com
: constant Boolean := Token
= Tok_Comma
;
1779 Scan_State
: Saved_Scan_State
;
1783 Save_Scan_State
(Scan_State
); -- at comma/semicolon
1784 Scan
; -- past comma/semicolon
1786 -- Check for AND THEN or OR ELSE after comma/semicolon. We
1787 -- do not deal with AND/OR because those cases get mixed up
1788 -- with the select alternatives case.
1790 if Token
= Tok_And
or else Token
= Tok_Or
then
1791 Logop
:= P_Logical_Operator
;
1792 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1794 if Nkind_In
(Logop
, N_And_Then
, N_Or_Else
) then
1795 Scan
; -- past comma/semicolon
1798 Error_Msg_SP
-- CODEFIX
1799 ("|extra "","" ignored");
1801 Error_Msg_SP
-- CODEFIX
1802 ("|extra "";"" ignored");
1806 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1810 Restore_Scan_State
(Scan_State
); -- to comma/semicolon
1815 exit when Token
not in Token_Class_Logop
;
1818 Expr_Form
:= EF_Non_Simple
;
1821 if Token
= Tok_Apostrophe
then
1822 Bad_Range_Attribute
(Token_Ptr
);
1829 -- This function is identical to the normal P_Expression, except that it
1830 -- also permits the appearance of a case, conditional, or quantified
1831 -- expression if the call immediately follows a left paren, and followed
1832 -- by a right parenthesis. These forms are allowed if these conditions
1833 -- are not met, but an error message will be issued.
1835 function P_Expression_If_OK
return Node_Id
is
1837 -- Case of conditional, case or quantified expression
1839 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1840 return P_Unparen_Cond_Case_Quant_Expression
;
1842 -- Normal case, not case/conditional/quantified expression
1845 return P_Expression
;
1847 end P_Expression_If_OK
;
1849 -- This function is identical to the normal P_Expression, except that it
1850 -- checks that the expression scan did not stop on a right paren. It is
1851 -- called in all contexts where a right parenthesis cannot legitimately
1852 -- follow an expression.
1854 -- Error recovery: can not raise Error_Resync
1856 function P_Expression_No_Right_Paren
return Node_Id
is
1857 Expr
: constant Node_Id
:= P_Expression
;
1859 Ignore
(Tok_Right_Paren
);
1861 end P_Expression_No_Right_Paren
;
1863 ----------------------------------------
1864 -- 4.4 Expression_Or_Range_Attribute --
1865 ----------------------------------------
1868 -- RELATION {and RELATION} | RELATION {and then RELATION}
1869 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1870 -- | RELATION {xor RELATION}
1872 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1874 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1876 -- On return, Expr_Form indicates the categorization of the expression
1877 -- and EF_Range_Attr is one of the possibilities.
1879 -- Error recovery: cannot raise Error_Resync
1881 -- In the grammar, a RANGE attribute is simply a name, but its use is
1882 -- highly restricted, so in the parser, we do not regard it as a name.
1883 -- Instead, P_Name returns without scanning the 'RANGE part of the
1884 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1885 -- attribute reference. In the normal case where a range attribute is
1886 -- not allowed, an error message is issued by P_Expression.
1888 function P_Expression_Or_Range_Attribute
return Node_Id
is
1889 Logical_Op
: Node_Kind
;
1890 Prev_Logical_Op
: Node_Kind
;
1891 Op_Location
: Source_Ptr
;
1894 Attr_Node
: Node_Id
;
1897 Node1
:= P_Relation
;
1899 if Token
= Tok_Apostrophe
then
1900 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
1901 Expr_Form
:= EF_Range_Attr
;
1904 elsif Token
in Token_Class_Logop
then
1905 Prev_Logical_Op
:= N_Empty
;
1908 Op_Location
:= Token_Ptr
;
1909 Logical_Op
:= P_Logical_Operator
;
1911 if Prev_Logical_Op
/= N_Empty
and then
1912 Logical_Op
/= Prev_Logical_Op
1915 ("mixed logical operators in expression", Op_Location
);
1916 Prev_Logical_Op
:= N_Empty
;
1918 Prev_Logical_Op
:= Logical_Op
;
1922 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1923 Set_Left_Opnd
(Node1
, Node2
);
1924 Set_Right_Opnd
(Node1
, P_Relation
);
1925 exit when Token
not in Token_Class_Logop
;
1928 Expr_Form
:= EF_Non_Simple
;
1931 if Token
= Tok_Apostrophe
then
1932 Bad_Range_Attribute
(Token_Ptr
);
1937 end P_Expression_Or_Range_Attribute
;
1939 -- Version that allows a non-parenthesized case, conditional, or quantified
1940 -- expression if the call immediately follows a left paren, and followed
1941 -- by a right parenthesis. These forms are allowed if these conditions
1942 -- are not met, but an error message will be issued.
1944 function P_Expression_Or_Range_Attribute_If_OK
return Node_Id
is
1946 -- Case of conditional, case or quantified expression
1948 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1949 return P_Unparen_Cond_Case_Quant_Expression
;
1951 -- Normal case, not one of the above expression types
1954 return P_Expression_Or_Range_Attribute
;
1956 end P_Expression_Or_Range_Attribute_If_OK
;
1962 -- This procedure scans both relations and choice relations
1964 -- CHOICE_RELATION ::=
1965 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1968 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
1969 -- | RAISE_EXPRESSION
1971 -- MEMBERSHIP_CHOICE_LIST ::=
1972 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
1974 -- MEMBERSHIP_CHOICE ::=
1975 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
1977 -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
1979 -- On return, Expr_Form indicates the categorization of the expression
1981 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1982 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1984 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1985 -- expression, then tokens are scanned until either a non-expression token,
1986 -- a right paren (not matched by a left paren) or a comma, is encountered.
1988 function P_Relation
return Node_Id
is
1989 Node1
, Node2
: Node_Id
;
1993 -- First check for raise expression
1995 if Token
= Tok_Raise
then
1996 Expr_Form
:= EF_Non_Simple
;
1997 return P_Raise_Expression
;
2002 Node1
:= P_Simple_Expression
;
2004 if Token
not in Token_Class_Relop
then
2008 -- Here we have a relational operator following. If so then scan it
2009 -- out. Note that the assignment symbol := is treated as a relational
2010 -- operator to improve the error recovery when it is misused for =.
2011 -- P_Relational_Operator also parses the IN and NOT IN operations.
2014 Node2
:= New_Op_Node
(P_Relational_Operator
, Optok
);
2015 Set_Left_Opnd
(Node2
, Node1
);
2017 -- Case of IN or NOT IN
2019 if Prev_Token
= Tok_In
then
2020 P_Membership_Test
(Node2
);
2022 -- Case of relational operator (= /= < <= > >=)
2025 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
2028 Expr_Form
:= EF_Non_Simple
;
2030 if Token
in Token_Class_Relop
then
2031 Error_Msg_SC
("unexpected relational operator");
2038 -- If any error occurs, then scan to the next expression terminator symbol
2039 -- or comma or right paren at the outer (i.e. current) parentheses level.
2040 -- The flags are set to indicate a normal simple expression.
2043 when Error_Resync
=>
2045 Expr_Form
:= EF_Simple
;
2049 ----------------------------
2050 -- 4.4 Simple Expression --
2051 ----------------------------
2053 -- SIMPLE_EXPRESSION ::=
2054 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2056 -- On return, Expr_Form indicates the categorization of the expression
2058 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
2059 -- EF_Simple_Name and the following token is RANGE (range attribute case).
2061 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
2062 -- expression, then tokens are scanned until either a non-expression token,
2063 -- a right paren (not matched by a left paren) or a comma, is encountered.
2065 -- Note: P_Simple_Expression is called only internally by higher level
2066 -- expression routines. In cases in the grammar where a simple expression
2067 -- is required, the approach is to scan an expression, and then post an
2068 -- appropriate error message if the expression obtained is not simple. This
2069 -- gives better error recovery and treatment.
2071 function P_Simple_Expression
return Node_Id
is
2072 Scan_State
: Saved_Scan_State
;
2075 Tokptr
: Source_Ptr
;
2077 function At_Start_Of_Attribute
return Boolean;
2078 -- Tests if we have quote followed by attribute name, if so, return True
2079 -- otherwise return False.
2081 ---------------------------
2082 -- At_Start_Of_Attribute --
2083 ---------------------------
2085 function At_Start_Of_Attribute
return Boolean is
2087 if Token
/= Tok_Apostrophe
then
2092 Scan_State
: Saved_Scan_State
;
2095 Save_Scan_State
(Scan_State
);
2098 if Token
= Tok_Identifier
2099 and then Is_Attribute_Name
(Chars
(Token_Node
))
2101 Restore_Scan_State
(Scan_State
);
2104 Restore_Scan_State
(Scan_State
);
2109 end At_Start_Of_Attribute
;
2111 -- Start of processing for P_Simple_Expression
2114 -- Check for cases starting with a name. There are two reasons for
2115 -- special casing. First speed things up by catching a common case
2116 -- without going through several routine layers. Second the caller must
2117 -- be informed via Expr_Form when the simple expression is a name.
2119 if Token
in Token_Class_Name
then
2122 -- Deal with apostrophe cases
2124 if Token
= Tok_Apostrophe
then
2125 Save_Scan_State
(Scan_State
); -- at apostrophe
2126 Scan
; -- past apostrophe
2128 -- If qualified expression, scan it out and fall through
2130 if Token
= Tok_Left_Paren
then
2131 Node1
:= P_Qualified_Expression
(Node1
);
2132 Expr_Form
:= EF_Simple
;
2134 -- If range attribute, then we return with Token pointing to the
2135 -- apostrophe. Note: avoid the normal error check on exit. We
2136 -- know that the expression really is complete in this case.
2138 else -- Token = Tok_Range then
2139 Restore_Scan_State
(Scan_State
); -- to apostrophe
2140 Expr_Form
:= EF_Simple_Name
;
2145 -- If an expression terminator follows, the previous processing
2146 -- completely scanned out the expression (a common case), and
2147 -- left Expr_Form set appropriately for returning to our caller.
2149 if Token
in Token_Class_Sterm
then
2152 -- If we do not have an expression terminator, then complete the
2153 -- scan of a simple expression. This code duplicates the code
2154 -- found in P_Term and P_Factor.
2157 if Token
= Tok_Double_Asterisk
then
2159 Style
.Check_Exponentiation_Operator
;
2162 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2164 Set_Left_Opnd
(Node2
, Node1
);
2165 Set_Right_Opnd
(Node2
, P_Primary
);
2171 exit when Token
not in Token_Class_Mulop
;
2172 Tokptr
:= Token_Ptr
;
2173 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2176 Style
.Check_Binary_Operator
;
2179 Scan
; -- past operator
2180 Set_Left_Opnd
(Node2
, Node1
);
2181 Set_Right_Opnd
(Node2
, P_Factor
);
2186 exit when Token
not in Token_Class_Binary_Addop
;
2187 Tokptr
:= Token_Ptr
;
2188 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2191 Style
.Check_Binary_Operator
;
2194 Scan
; -- past operator
2195 Set_Left_Opnd
(Node2
, Node1
);
2196 Set_Right_Opnd
(Node2
, P_Term
);
2200 Expr_Form
:= EF_Simple
;
2203 -- Cases where simple expression does not start with a name
2206 -- Scan initial sign and initial Term
2208 if Token
in Token_Class_Unary_Addop
then
2209 Tokptr
:= Token_Ptr
;
2210 Node1
:= New_Op_Node
(P_Unary_Adding_Operator
, Tokptr
);
2213 Style
.Check_Unary_Plus_Or_Minus
(Inside_Depends
);
2216 Scan
; -- past operator
2217 Set_Right_Opnd
(Node1
, P_Term
);
2222 -- In the following, we special-case a sequence of concatenations of
2223 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
2224 -- else mixed in. For such a sequence, we return a tree representing
2225 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
2226 -- the number of concatenations is large. If semantic analysis
2227 -- resolves the "&" to a predefined one, then this folding gives the
2228 -- right answer. Otherwise, semantic analysis will complain about a
2229 -- capacity-exceeded error. The purpose of this trick is to avoid
2230 -- creating a deeply nested tree, which would cause deep recursion
2231 -- during semantics, causing stack overflow. This way, we can handle
2232 -- enormous concatenations in the normal case of predefined "&". We
2233 -- first build up the normal tree, and then rewrite it if
2237 Num_Concats_Threshold
: constant Positive := 1000;
2238 -- Arbitrary threshold value to enable optimization
2240 First_Node
: constant Node_Id
:= Node1
;
2241 Is_Strlit_Concat
: Boolean;
2242 -- True iff we've parsed a sequence of concatenations of string
2243 -- literals, with nothing else mixed in.
2245 Num_Concats
: Natural;
2246 -- Number of "&" operators if Is_Strlit_Concat is True
2250 Nkind
(Node1
) = N_String_Literal
2251 and then Token
= Tok_Ampersand
;
2254 -- Scan out sequence of terms separated by binary adding operators
2257 exit when Token
not in Token_Class_Binary_Addop
;
2258 Tokptr
:= Token_Ptr
;
2259 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2261 if Style_Check
and then not Debug_Flag_Dot_QQ
then
2262 Style
.Check_Binary_Operator
;
2265 Scan
; -- past operator
2266 Set_Left_Opnd
(Node2
, Node1
);
2268 Set_Right_Opnd
(Node2
, Node1
);
2270 -- Check if we're still concatenating string literals
2274 and then Nkind
(Node2
) = N_Op_Concat
2275 and then Nkind
(Node1
) = N_String_Literal
;
2277 if Is_Strlit_Concat
then
2278 Num_Concats
:= Num_Concats
+ 1;
2284 -- If we have an enormous series of concatenations of string
2285 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2286 -- flag tells semantic analysis that if the "&" is not predefined,
2287 -- the folded value is wrong.
2290 and then Num_Concats
>= Num_Concats_Threshold
2293 Empty_String_Val
: String_Id
;
2296 Strlit_Concat_Val
: String_Id
;
2297 -- Contains the folded value (which will be correct if the
2298 -- "&" operators are the predefined ones).
2301 -- For walking up the tree
2304 -- Folded node to replace Node1
2306 Loc
: constant Source_Ptr
:= Sloc
(First_Node
);
2309 -- Walk up the tree starting at the leftmost string literal
2310 -- (First_Node), building up the Strlit_Concat_Val as we
2311 -- go. Note that we do not use recursion here -- the whole
2312 -- point is to avoid recursively walking that enormous tree.
2315 Store_String_Chars
(Strval
(First_Node
));
2317 Cur_Node
:= Parent
(First_Node
);
2318 while Present
(Cur_Node
) loop
2319 pragma Assert
(Nkind
(Cur_Node
) = N_Op_Concat
and then
2320 Nkind
(Right_Opnd
(Cur_Node
)) = N_String_Literal
);
2322 Store_String_Chars
(Strval
(Right_Opnd
(Cur_Node
)));
2323 Cur_Node
:= Parent
(Cur_Node
);
2326 Strlit_Concat_Val
:= End_String
;
2328 -- Create new folded node, and rewrite result with a concat-
2329 -- enation of an empty string literal and the folded node.
2332 Empty_String_Val
:= End_String
;
2334 Make_Op_Concat
(Loc
,
2335 Make_String_Literal
(Loc
, Empty_String_Val
),
2336 Make_String_Literal
(Loc
, Strlit_Concat_Val
,
2337 Is_Folded_In_Parser
=> True));
2338 Rewrite
(Node1
, New_Node
);
2343 -- All done, we clearly do not have name or numeric literal so this
2344 -- is a case of a simple expression which is some other possibility.
2346 Expr_Form
:= EF_Simple
;
2349 -- Come here at end of simple expression, where we do a couple of
2350 -- special checks to improve error recovery.
2352 -- Special test to improve error recovery. If the current token is a
2353 -- period, then someone is trying to do selection on something that is
2354 -- not a name, e.g. a qualified expression.
2356 if Token
= Tok_Dot
then
2357 Error_Msg_SC
("prefix for selection is not a name");
2359 -- If qualified expression, comment and continue, otherwise something
2360 -- is pretty nasty so do an Error_Resync call.
2362 if Ada_Version
< Ada_2012
2363 and then Nkind
(Node1
) = N_Qualified_Expression
2365 Error_Msg_SC
("\would be legal in Ada 2012 mode");
2371 -- Special test to improve error recovery: If the current token is
2372 -- not the first token on a line (as determined by checking the
2373 -- previous token position with the start of the current line),
2374 -- then we insist that we have an appropriate terminating token.
2375 -- Consider the following two examples:
2377 -- 1) if A nad B then ...
2382 -- In the first example, we would like to issue a binary operator
2383 -- expected message and resynchronize to the then. In the second
2384 -- example, we do not want to issue a binary operator message, so
2385 -- that instead we will get the missing semicolon message. This
2386 -- distinction is of course a heuristic which does not always work,
2387 -- but in practice it is quite effective.
2389 -- Note: the one case in which we do not go through this circuit is
2390 -- when we have scanned a range attribute and want to return with
2391 -- Token pointing to the apostrophe. The apostrophe is not normally
2392 -- an expression terminator, and is not in Token_Class_Sterm, but
2393 -- in this special case we know that the expression is complete.
2395 if not Token_Is_At_Start_Of_Line
2396 and then Token
not in Token_Class_Sterm
2398 -- Normally the right error message is indeed that we expected a
2399 -- binary operator, but in the case of being between a right and left
2400 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2402 if Prev_Token
= Tok_Right_Paren
and then Token
= Tok_Left_Paren
then
2405 -- And if we have a quote, we may have a bad attribute
2407 elsif At_Start_Of_Attribute
then
2408 Error_Msg_SC
("prefix of attribute must be a name");
2410 if Ada_Version
>= Ada_2012
then
2411 Error_Msg_SC
("\qualify expression to turn it into a name");
2414 -- Normal case for binary operator expected message
2417 Error_Msg_AP
("binary operator expected");
2426 -- If any error occurs, then scan to next expression terminator symbol
2427 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2428 -- level. Expr_Form is set to indicate a normal simple expression.
2431 when Error_Resync
=>
2433 Expr_Form
:= EF_Simple
;
2435 end P_Simple_Expression
;
2437 -----------------------------------------------
2438 -- 4.4 Simple Expression or Range Attribute --
2439 -----------------------------------------------
2441 -- SIMPLE_EXPRESSION ::=
2442 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2444 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2446 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2448 -- Error recovery: cannot raise Error_Resync
2450 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
2452 Attr_Node
: Node_Id
;
2455 -- We don't just want to roar ahead and call P_Simple_Expression
2456 -- here, since we want to handle the case of a parenthesized range
2457 -- attribute cleanly.
2459 if Token
= Tok_Left_Paren
then
2461 Lptr
: constant Source_Ptr
:= Token_Ptr
;
2462 Scan_State
: Saved_Scan_State
;
2465 Save_Scan_State
(Scan_State
);
2466 Scan
; -- past left paren
2467 Sexpr
:= P_Simple_Expression
;
2469 if Token
= Tok_Apostrophe
then
2470 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2471 Expr_Form
:= EF_Range_Attr
;
2473 if Token
= Tok_Right_Paren
then
2474 Scan
; -- scan past right paren if present
2477 Error_Msg
("parentheses not allowed for range attribute", Lptr
);
2482 Restore_Scan_State
(Scan_State
);
2486 -- Here after dealing with parenthesized range attribute
2488 Sexpr
:= P_Simple_Expression
;
2490 if Token
= Tok_Apostrophe
then
2491 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2492 Expr_Form
:= EF_Range_Attr
;
2498 end P_Simple_Expression_Or_Range_Attribute
;
2504 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2506 -- Error recovery: can raise Error_Resync
2508 function P_Term
return Node_Id
is
2509 Node1
, Node2
: Node_Id
;
2510 Tokptr
: Source_Ptr
;
2516 exit when Token
not in Token_Class_Mulop
;
2517 Tokptr
:= Token_Ptr
;
2518 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2520 if Style_Check
and then not Debug_Flag_Dot_QQ
then
2521 Style
.Check_Binary_Operator
;
2524 Scan
; -- past operator
2525 Set_Left_Opnd
(Node2
, Node1
);
2526 Set_Right_Opnd
(Node2
, P_Factor
);
2537 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2539 -- Error recovery: can raise Error_Resync
2541 function P_Factor
return Node_Id
is
2546 if Token
= Tok_Abs
then
2547 Node1
:= New_Op_Node
(N_Op_Abs
, Token_Ptr
);
2550 Style
.Check_Abs_Not
;
2554 Set_Right_Opnd
(Node1
, P_Primary
);
2557 elsif Token
= Tok_Not
then
2558 Node1
:= New_Op_Node
(N_Op_Not
, Token_Ptr
);
2561 Style
.Check_Abs_Not
;
2565 Set_Right_Opnd
(Node1
, P_Primary
);
2571 if Token
= Tok_Double_Asterisk
then
2572 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2574 Set_Left_Opnd
(Node2
, Node1
);
2575 Set_Right_Opnd
(Node2
, P_Primary
);
2589 -- NUMERIC_LITERAL | null
2590 -- | STRING_LITERAL | AGGREGATE
2591 -- | NAME | QUALIFIED_EXPRESSION
2592 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2594 -- Error recovery: can raise Error_Resync
2596 function P_Primary
return Node_Id
is
2597 Scan_State
: Saved_Scan_State
;
2600 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
2601 -- Remember if previous token is a left parenthesis. This is used to
2602 -- deal with checking whether IF/CASE/FOR expressions appearing as
2603 -- primaries require extra parenthesization.
2606 -- The loop runs more than once only if misplaced pragmas are found
2607 -- or if a misplaced unary minus is skipped.
2612 -- Name token can start a name, call or qualified expression, all
2613 -- of which are acceptable possibilities for primary. Note also
2614 -- that string literal is included in name (as operator symbol)
2615 -- and type conversion is included in name (as indexed component).
2617 when Tok_Char_Literal
2619 | Tok_Operator_Symbol
2623 -- All done unless apostrophe follows
2625 if Token
/= Tok_Apostrophe
then
2628 -- Apostrophe following means that we have either just parsed
2629 -- the subtype mark of a qualified expression, or the prefix
2630 -- or a range attribute.
2632 else -- Token = Tok_Apostrophe
2633 Save_Scan_State
(Scan_State
); -- at apostrophe
2634 Scan
; -- past apostrophe
2636 -- If range attribute, then this is always an error, since
2637 -- the only legitimate case (where the scanned expression is
2638 -- a qualified simple name) is handled at the level of the
2639 -- Simple_Expression processing. This case corresponds to a
2640 -- usage such as 3 + A'Range, which is always illegal.
2642 if Token
= Tok_Range
then
2643 Restore_Scan_State
(Scan_State
); -- to apostrophe
2644 Bad_Range_Attribute
(Token_Ptr
);
2647 -- If left paren, then we have a qualified expression.
2648 -- Note that P_Name guarantees that in this case, where
2649 -- Token = Tok_Apostrophe on return, the only two possible
2650 -- tokens following the apostrophe are left paren and
2651 -- RANGE, so we know we have a left paren here.
2653 else -- Token = Tok_Left_Paren
2654 return P_Qualified_Expression
(Node1
);
2659 -- Numeric or string literal
2661 when Tok_Integer_Literal
2663 | Tok_String_Literal
2665 Node1
:= Token_Node
;
2666 Scan
; -- past number
2669 -- Left paren, starts aggregate or parenthesized expression
2671 when Tok_Left_Paren
=>
2673 Expr
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
2676 if Nkind
(Expr
) = N_Attribute_Reference
2677 and then Attribute_Name
(Expr
) = Name_Range
2679 Bad_Range_Attribute
(Sloc
(Expr
));
2694 return New_Node
(N_Null
, Prev_Token_Ptr
);
2696 -- Pragma, not allowed here, so just skip past it
2699 P_Pragmas_Misplaced
;
2701 -- Deal with IF (possible unparenthesized if expression)
2705 -- If this looks like a real if, defined as an IF appearing at
2706 -- the start of a new line, then we consider we have a missing
2707 -- operand. If in Ada 2012 and the IF is not properly indented
2708 -- for a statement, we prefer to issue a message about an ill-
2709 -- parenthesized if expression.
2711 if Token_Is_At_Start_Of_Line
2713 (Ada_Version
>= Ada_2012
2714 and then Style_Check_Indentation
/= 0
2715 and then Start_Column
rem Style_Check_Indentation
/= 0)
2717 Error_Msg_AP
("missing operand");
2720 -- If this looks like an if expression, then treat it that way
2721 -- with an error message if not explicitly surrounded by
2724 elsif Ada_Version
>= Ada_2012
then
2725 Node1
:= P_If_Expression
;
2727 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2729 ("if expression must be parenthesized", Sloc
(Node1
));
2734 -- Otherwise treat as misused identifier
2737 return P_Identifier
;
2740 -- Deal with CASE (possible unparenthesized case expression)
2744 -- If this looks like a real case, defined as a CASE appearing
2745 -- the start of a new line, then we consider we have a missing
2746 -- operand. If in Ada 2012 and the CASE is not properly
2747 -- indented for a statement, we prefer to issue a message about
2748 -- an ill-parenthesized case expression.
2750 if Token_Is_At_Start_Of_Line
2752 (Ada_Version
>= Ada_2012
2753 and then Style_Check_Indentation
/= 0
2754 and then Start_Column
rem Style_Check_Indentation
/= 0)
2756 Error_Msg_AP
("missing operand");
2759 -- If this looks like a case expression, then treat it that way
2760 -- with an error message if not within parentheses.
2762 elsif Ada_Version
>= Ada_2012
then
2763 Node1
:= P_Case_Expression
;
2765 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2767 ("case expression must be parenthesized", Sloc
(Node1
));
2772 -- Otherwise treat as misused identifier
2775 return P_Identifier
;
2778 -- For [all | some] indicates a quantified expression
2781 if Token_Is_At_Start_Of_Line
then
2782 Error_Msg_AP
("misplaced loop");
2785 elsif Ada_Version
>= Ada_2012
then
2786 Save_Scan_State
(Scan_State
);
2789 if Token
= Tok_All
or else Token
= Tok_Some
then
2790 Restore_Scan_State
(Scan_State
); -- To FOR
2791 Node1
:= P_Quantified_Expression
;
2793 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2795 ("quantified expression must be parenthesized",
2799 Restore_Scan_State
(Scan_State
); -- To FOR
2800 Node1
:= P_Iterated_Component_Association
;
2805 -- Otherwise treat as misused identifier
2808 return P_Identifier
;
2811 -- Minus may well be an improper attempt at a unary minus. Give
2812 -- a message, skip the minus and keep going.
2815 Error_Msg_SC
("parentheses required for unary minus");
2818 when Tok_At_Sign
=> -- AI12-0125 : target_name
2819 if Ada_Version
< Ada_2020
then
2820 Error_Msg_SC
("target name is an Ada 2020 extension");
2821 Error_Msg_SC
("\compile with -gnatX");
2827 -- Anything else is illegal as the first token of a primary, but
2828 -- we test for some common errors, to improve error messages.
2831 if Is_Reserved_Identifier
then
2832 return P_Identifier
;
2834 elsif Prev_Token
= Tok_Comma
then
2835 Error_Msg_SP
-- CODEFIX
2836 ("|extra "","" ignored");
2840 Error_Msg_AP
("missing operand");
2847 -------------------------------
2848 -- 4.4 Quantified_Expression --
2849 -------------------------------
2851 -- QUANTIFIED_EXPRESSION ::=
2852 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2853 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2855 function P_Quantified_Expression
return Node_Id
is
2860 Error_Msg_Ada_2012_Feature
("quantified expression", Token_Ptr
);
2862 Node1
:= New_Node
(N_Quantified_Expression
, Prev_Token_Ptr
);
2864 if Token
= Tok_All
then
2865 Set_All_Present
(Node1
);
2866 elsif Token
/= Tok_Some
then
2867 Error_Msg_AP
("missing quantifier");
2871 Scan
; -- past ALL or SOME
2872 I_Spec
:= P_Loop_Parameter_Specification
;
2874 if Nkind
(I_Spec
) = N_Loop_Parameter_Specification
then
2875 Set_Loop_Parameter_Specification
(Node1
, I_Spec
);
2877 Set_Iterator_Specification
(Node1
, I_Spec
);
2880 if Token
= Tok_Arrow
then
2882 Set_Condition
(Node1
, P_Expression
);
2885 Error_Msg_AP
("missing arrow");
2888 end P_Quantified_Expression
;
2890 ---------------------------
2891 -- 4.5 Logical Operator --
2892 ---------------------------
2894 -- LOGICAL_OPERATOR ::= and | or | xor
2896 -- Note: AND THEN and OR ELSE are also treated as logical operators
2897 -- by the parser (even though they are not operators semantically)
2899 -- The value returned is the appropriate Node_Kind code for the operator
2900 -- On return, Token points to the token following the scanned operator.
2902 -- The caller has checked that the first token is a legitimate logical
2903 -- operator token (i.e. is either XOR, AND, OR).
2905 -- Error recovery: cannot raise Error_Resync
2907 function P_Logical_Operator
return Node_Kind
is
2909 if Token
= Tok_And
then
2911 Style
.Check_Binary_Operator
;
2916 if Token
= Tok_Then
then
2923 elsif Token
= Tok_Or
then
2925 Style
.Check_Binary_Operator
;
2930 if Token
= Tok_Else
then
2937 else -- Token = Tok_Xor
2939 Style
.Check_Binary_Operator
;
2945 end P_Logical_Operator
;
2947 ------------------------------
2948 -- 4.5 Relational Operator --
2949 ------------------------------
2951 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2953 -- The value returned is the appropriate Node_Kind code for the operator.
2954 -- On return, Token points to the operator token, NOT past it.
2956 -- The caller has checked that the first token is a legitimate relational
2957 -- operator token (i.e. is one of the operator tokens listed above).
2959 -- Error recovery: cannot raise Error_Resync
2961 function P_Relational_Operator
return Node_Kind
is
2962 Op_Kind
: Node_Kind
;
2963 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
2964 (Tok_Less
=> N_Op_Lt
,
2965 Tok_Equal
=> N_Op_Eq
,
2966 Tok_Greater
=> N_Op_Gt
,
2967 Tok_Not_Equal
=> N_Op_Ne
,
2968 Tok_Greater_Equal
=> N_Op_Ge
,
2969 Tok_Less_Equal
=> N_Op_Le
,
2971 Tok_Not
=> N_Not_In
,
2972 Tok_Box
=> N_Op_Ne
);
2975 if Token
= Tok_Box
then
2976 Error_Msg_SC
-- CODEFIX
2977 ("|""'<'>"" should be ""/=""");
2980 Op_Kind
:= Relop_Node
(Token
);
2983 Style
.Check_Binary_Operator
;
2986 Scan
; -- past operator token
2988 -- Deal with NOT IN, if previous token was NOT, we must have IN now
2990 if Prev_Token
= Tok_Not
then
2992 -- Style check, for NOT IN, we require one space between NOT and IN
2994 if Style_Check
and then Token
= Tok_In
then
3002 end P_Relational_Operator
;
3004 ---------------------------------
3005 -- 4.5 Binary Adding Operator --
3006 ---------------------------------
3008 -- BINARY_ADDING_OPERATOR ::= + | - | &
3010 -- The value returned is the appropriate Node_Kind code for the operator.
3011 -- On return, Token points to the operator token (NOT past it).
3013 -- The caller has checked that the first token is a legitimate adding
3014 -- operator token (i.e. is one of the operator tokens listed above).
3016 -- Error recovery: cannot raise Error_Resync
3018 function P_Binary_Adding_Operator
return Node_Kind
is
3019 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
3020 (Tok_Ampersand
=> N_Op_Concat
,
3021 Tok_Minus
=> N_Op_Subtract
,
3022 Tok_Plus
=> N_Op_Add
);
3024 return Addop_Node
(Token
);
3025 end P_Binary_Adding_Operator
;
3027 --------------------------------
3028 -- 4.5 Unary Adding Operator --
3029 --------------------------------
3031 -- UNARY_ADDING_OPERATOR ::= + | -
3033 -- The value returned is the appropriate Node_Kind code for the operator.
3034 -- On return, Token points to the operator token (NOT past it).
3036 -- The caller has checked that the first token is a legitimate adding
3037 -- operator token (i.e. is one of the operator tokens listed above).
3039 -- Error recovery: cannot raise Error_Resync
3041 function P_Unary_Adding_Operator
return Node_Kind
is
3042 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
3043 (Tok_Minus
=> N_Op_Minus
,
3044 Tok_Plus
=> N_Op_Plus
);
3046 return Addop_Node
(Token
);
3047 end P_Unary_Adding_Operator
;
3049 -------------------------------
3050 -- 4.5 Multiplying Operator --
3051 -------------------------------
3053 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
3055 -- The value returned is the appropriate Node_Kind code for the operator.
3056 -- On return, Token points to the operator token (NOT past it).
3058 -- The caller has checked that the first token is a legitimate multiplying
3059 -- operator token (i.e. is one of the operator tokens listed above).
3061 -- Error recovery: cannot raise Error_Resync
3063 function P_Multiplying_Operator
return Node_Kind
is
3064 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
3065 (Tok_Asterisk
=> N_Op_Multiply
,
3066 Tok_Mod
=> N_Op_Mod
,
3067 Tok_Rem
=> N_Op_Rem
,
3068 Tok_Slash
=> N_Op_Divide
);
3070 return Mulop_Node
(Token
);
3071 end P_Multiplying_Operator
;
3073 --------------------------------------
3074 -- 4.5 Highest Precedence Operator --
3075 --------------------------------------
3077 -- Parsed by P_Factor (4.4)
3079 -- Note: this rule is not in fact used by the grammar at any point
3081 --------------------------
3082 -- 4.6 Type Conversion --
3083 --------------------------
3085 -- Parsed by P_Primary as a Name (4.1)
3087 -------------------------------
3088 -- 4.7 Qualified Expression --
3089 -------------------------------
3091 -- QUALIFIED_EXPRESSION ::=
3092 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
3094 -- The caller has scanned the name which is the Subtype_Mark parameter
3095 -- and scanned past the single quote following the subtype mark. The
3096 -- caller has not checked that this name is in fact appropriate for
3097 -- a subtype mark name (i.e. it is a selected component or identifier).
3099 -- Error_Recovery: cannot raise Error_Resync
3101 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
3102 Qual_Node
: Node_Id
;
3104 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
3105 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
3106 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
3108 end P_Qualified_Expression
;
3110 --------------------
3112 --------------------
3115 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
3116 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
3118 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
3120 -- The caller has checked that the initial token is NEW
3122 -- Error recovery: can raise Error_Resync
3124 function P_Allocator
return Node_Id
is
3125 Alloc_Node
: Node_Id
;
3126 Type_Node
: Node_Id
;
3127 Null_Exclusion_Present
: Boolean;
3130 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
3133 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
3135 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
3137 if Token
= Tok_Left_Paren
then
3139 Set_Subpool_Handle_Name
(Alloc_Node
, P_Name
);
3142 Error_Msg_Ada_2012_Feature
3143 ("|subpool specification",
3144 Sloc
(Subpool_Handle_Name
(Alloc_Node
)));
3147 Null_Exclusion_Present
:= P_Null_Exclusion
;
3148 Set_Null_Exclusion_Present
(Alloc_Node
, Null_Exclusion_Present
);
3149 Type_Node
:= P_Subtype_Mark_Resync
;
3151 if Token
= Tok_Apostrophe
then
3152 Scan
; -- past apostrophe
3153 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
3157 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));
3159 -- AI05-0104: An explicit null exclusion is not allowed for an
3160 -- allocator without initialization. In previous versions of the
3161 -- language it just raises constraint error.
3163 if Ada_Version
>= Ada_2012
and then Null_Exclusion_Present
then
3165 ("an allocator with a subtype indication "
3166 & "cannot have a null exclusion", Alloc_Node
);
3173 -----------------------
3174 -- P_Case_Expression --
3175 -----------------------
3177 function P_Case_Expression
return Node_Id
is
3178 Loc
: constant Source_Ptr
:= Token_Ptr
;
3179 Case_Node
: Node_Id
;
3180 Save_State
: Saved_Scan_State
;
3183 Error_Msg_Ada_2012_Feature
("|case expression", Token_Ptr
);
3186 Make_Case_Expression
(Loc
,
3187 Expression
=> P_Expression_No_Right_Paren
,
3188 Alternatives
=> New_List
);
3191 -- We now have scanned out CASE expression IS, scan alternatives
3195 Append_To
(Alternatives
(Case_Node
), P_Case_Expression_Alternative
);
3197 -- Missing comma if WHEN (more alternatives present)
3199 if Token
= Tok_When
then
3202 -- If comma/WHEN, skip comma and we have another alternative
3204 elsif Token
= Tok_Comma
then
3205 Save_Scan_State
(Save_State
);
3208 if Token
/= Tok_When
then
3209 Restore_Scan_State
(Save_State
);
3213 -- If no comma or WHEN, definitely done
3220 -- If we have an END CASE, diagnose as not needed
3222 if Token
= Tok_End
then
3223 Error_Msg_SC
("`END CASE` not allowed at end of case expression");
3226 if Token
= Tok_Case
then
3231 -- Return the Case_Expression node
3234 end P_Case_Expression
;
3236 -----------------------------------
3237 -- P_Case_Expression_Alternative --
3238 -----------------------------------
3240 -- CASE_STATEMENT_ALTERNATIVE ::=
3241 -- when DISCRETE_CHOICE_LIST =>
3244 -- The caller has checked that and scanned past the initial WHEN token
3245 -- Error recovery: can raise Error_Resync
3247 function P_Case_Expression_Alternative
return Node_Id
is
3248 Case_Alt_Node
: Node_Id
;
3250 Case_Alt_Node
:= New_Node
(N_Case_Expression_Alternative
, Token_Ptr
);
3251 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
3253 Set_Expression
(Case_Alt_Node
, P_Expression
);
3254 return Case_Alt_Node
;
3255 end P_Case_Expression_Alternative
;
3257 --------------------------------------
3258 -- P_Iterated_Component_Association --
3259 --------------------------------------
3261 -- ITERATED_COMPONENT_ASSOCIATION ::=
3262 -- for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
3264 function P_Iterated_Component_Association
return Node_Id
is
3265 Assoc_Node
: Node_Id
;
3270 New_Node
(N_Iterated_Component_Association
, Prev_Token_Ptr
);
3271 Set_Defining_Identifier
(Assoc_Node
, P_Defining_Identifier
);
3273 Set_Discrete_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
3275 Set_Expression
(Assoc_Node
, P_Expression
);
3277 end P_Iterated_Component_Association
;
3279 ---------------------
3280 -- P_If_Expression --
3281 ---------------------
3283 -- IF_EXPRESSION ::=
3284 -- if CONDITION then DEPENDENT_EXPRESSION
3285 -- {elsif CONDITION then DEPENDENT_EXPRESSION}
3286 -- [else DEPENDENT_EXPRESSION]
3288 -- DEPENDENT_EXPRESSION ::= EXPRESSION
3290 function P_If_Expression
return Node_Id
is
3291 function P_If_Expression_Internal
3293 Cond
: Node_Id
) return Node_Id
;
3294 -- This is the internal recursive routine that does all the work, it is
3295 -- recursive since it is used to process ELSIF parts, which internally
3296 -- are N_If_Expression nodes with the Is_Elsif flag set. The calling
3297 -- sequence is like the outer function except that the caller passes
3298 -- the conditional expression (scanned using P_Expression), and the
3299 -- scan pointer points just past this expression. Loc points to the
3300 -- IF or ELSIF token.
3302 ------------------------------
3303 -- P_If_Expression_Internal --
3304 ------------------------------
3306 function P_If_Expression_Internal
3308 Cond
: Node_Id
) return Node_Id
3310 Exprs
: constant List_Id
:= New_List
;
3312 State
: Saved_Scan_State
;
3316 -- All cases except where we are at right paren
3318 if Token
/= Tok_Right_Paren
then
3320 Append_To
(Exprs
, P_Condition
(Cond
));
3321 Append_To
(Exprs
, P_Expression
);
3323 -- Case of right paren (missing THEN phrase). Note that we know this
3324 -- is the IF case, since the caller dealt with this possibility in
3328 Error_Msg_BC
("missing THEN phrase");
3329 Append_To
(Exprs
, P_Condition
(Cond
));
3332 -- We now have scanned out IF expr THEN expr
3334 -- Check for common error of semicolon before the ELSE
3336 if Token
= Tok_Semicolon
then
3337 Save_Scan_State
(State
);
3338 Scan
; -- past semicolon
3340 if Token
= Tok_Else
or else Token
= Tok_Elsif
then
3341 Error_Msg_SP
-- CODEFIX
3342 ("|extra "";"" ignored");
3345 Restore_Scan_State
(State
);
3349 -- Scan out ELSIF sequence if present
3351 if Token
= Tok_Elsif
then
3354 Expr
:= P_Expression
;
3356 -- If we are at a right paren, we assume the ELSIF should be ELSE
3358 if Token
= Tok_Right_Paren
then
3359 Error_Msg
("ELSIF should be ELSE", Eptr
);
3360 Append_To
(Exprs
, Expr
);
3362 -- Otherwise we have an OK ELSIF
3365 Expr
:= P_If_Expression_Internal
(Eptr
, Expr
);
3366 Set_Is_Elsif
(Expr
);
3367 Append_To
(Exprs
, Expr
);
3370 -- Scan out ELSE phrase if present
3372 elsif Token
= Tok_Else
then
3374 -- Scan out ELSE expression
3377 Append_To
(Exprs
, P_Expression
);
3379 -- Skip redundant ELSE parts
3381 while Token
= Tok_Else
loop
3382 Error_Msg_SC
("only one ELSE part is allowed");
3384 Discard_Junk_Node
(P_Expression
);
3387 -- Two expression case (implied True, filled in during semantics)
3393 -- If we have an END IF, diagnose as not needed
3395 if Token
= Tok_End
then
3396 Error_Msg_SC
("`END IF` not allowed at end of if expression");
3399 if Token
= Tok_If
then
3404 -- Return the If_Expression node
3406 return Make_If_Expression
(Loc
, Expressions
=> Exprs
);
3407 end P_If_Expression_Internal
;
3411 Loc
: constant Source_Ptr
:= Token_Ptr
;
3414 -- Start of processing for P_If_Expression
3417 Error_Msg_Ada_2012_Feature
("|if expression", Token_Ptr
);
3419 Inside_If_Expression
:= Inside_If_Expression
+ 1;
3420 If_Expr
:= P_If_Expression_Internal
(Loc
, P_Expression
);
3421 Inside_If_Expression
:= Inside_If_Expression
- 1;
3423 end P_If_Expression
;
3425 -----------------------
3426 -- P_Membership_Test --
3427 -----------------------
3429 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3430 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3432 procedure P_Membership_Test
(N
: Node_Id
) is
3433 Alt
: constant Node_Id
:=
3434 P_Range_Or_Subtype_Mark
3435 (Allow_Simple_Expression
=> (Ada_Version
>= Ada_2012
));
3440 if Token
= Tok_Vertical_Bar
then
3441 Error_Msg_Ada_2012_Feature
("set notation", Token_Ptr
);
3442 Set_Alternatives
(N
, New_List
(Alt
));
3443 Set_Right_Opnd
(N
, Empty
);
3445 -- Loop to accumulate alternatives
3447 while Token
= Tok_Vertical_Bar
loop
3448 Scan
; -- past vertical bar
3451 P_Range_Or_Subtype_Mark
(Allow_Simple_Expression
=> True));
3457 Set_Right_Opnd
(N
, Alt
);
3458 Set_Alternatives
(N
, No_List
);
3460 end P_Membership_Test
;
3462 ------------------------------------------
3463 -- P_Unparen_Cond_Case_Quant_Expression --
3464 ------------------------------------------
3466 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
is
3467 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
3470 Scan_State
: Saved_Scan_State
;
3475 if Token
= Tok_Case
then
3476 Result
:= P_Case_Expression
;
3478 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3479 Error_Msg_N
("case expression must be parenthesized!", Result
);
3484 elsif Token
= Tok_If
then
3485 Result
:= P_If_Expression
;
3487 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3488 Error_Msg_N
("if expression must be parenthesized!", Result
);
3491 -- Quantified expression or iterated component association
3493 elsif Token
= Tok_For
then
3495 Save_Scan_State
(Scan_State
);
3498 if Token
= Tok_All
or else Token
= Tok_Some
then
3499 Restore_Scan_State
(Scan_State
);
3500 Result
:= P_Quantified_Expression
;
3502 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3504 ("quantified expression must be parenthesized!", Result
);
3508 -- If no quantifier keyword, this is an iterated component in
3511 Restore_Scan_State
(Scan_State
);
3512 Result
:= P_Iterated_Component_Association
;
3515 -- No other possibility should exist (caller was supposed to check)
3518 raise Program_Error
;
3521 -- Return expression (possibly after having given message)
3524 end P_Unparen_Cond_Case_Quant_Expression
;