1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, 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_Body_Version
=> True,
39 Attribute_External_Tag
=> True,
40 Attribute_Img
=> True,
41 Attribute_Version
=> True,
42 Attribute_Base
=> True,
43 Attribute_Class
=> True,
44 Attribute_Stub_Type
=> 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 P_Membership_Test
(N
: Node_Id
);
85 -- N is the node for a N_In or N_Not_In node whose right operand has not
86 -- yet been processed. It is called just after scanning out the IN keyword.
87 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
89 function P_Range_Attribute_Reference
(Prefix_Node
: Node_Id
) return Node_Id
;
90 -- Scan a range attribute reference. The caller has scanned out the
91 -- prefix. The current token is known to be an apostrophe and the
92 -- following token is known to be RANGE.
94 -------------------------
95 -- Bad_Range_Attribute --
96 -------------------------
98 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
100 Error_Msg
("range attribute cannot be used in expression!", Loc
);
102 end Bad_Range_Attribute
;
104 --------------------------
105 -- 4.1 Name (also 6.4) --
106 --------------------------
109 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
110 -- | INDEXED_COMPONENT | SLICE
111 -- | SELECTED_COMPONENT | ATTRIBUTE
112 -- | TYPE_CONVERSION | FUNCTION_CALL
113 -- | CHARACTER_LITERAL
115 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
117 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
119 -- EXPLICIT_DEREFERENCE ::= NAME . all
121 -- IMPLICIT_DEREFERENCE ::= NAME
123 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
125 -- SLICE ::= PREFIX (DISCRETE_RANGE)
127 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
129 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
131 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
133 -- ATTRIBUTE_DESIGNATOR ::=
134 -- IDENTIFIER [(static_EXPRESSION)]
135 -- | access | delta | digits
139 -- | function_PREFIX ACTUAL_PARAMETER_PART
141 -- ACTUAL_PARAMETER_PART ::=
142 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
144 -- PARAMETER_ASSOCIATION ::=
145 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
147 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
149 -- Note: syntactically a procedure call looks just like a function call,
150 -- so this routine is in practice used to scan out procedure calls as well.
152 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
154 -- Error recovery: can raise Error_Resync
156 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
157 -- followed by either a left paren (qualified expression case), or by
158 -- range (range attribute case). All other uses of apostrophe (i.e. all
159 -- other attributes) are handled in this routine.
161 -- Error recovery: can raise Error_Resync
163 function P_Name
return Node_Id
is
164 Scan_State
: Saved_Scan_State
;
166 Prefix_Node
: Node_Id
;
167 Ident_Node
: Node_Id
;
169 Range_Node
: Node_Id
;
172 Arg_List
: List_Id
:= No_List
; -- kill junk warning
173 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
176 -- Case of not a name
178 if Token
not in Token_Class_Name
then
180 -- If it looks like start of expression, complain and scan expression
182 if Token
in Token_Class_Literal
183 or else Token
= Tok_Left_Paren
185 Error_Msg_SC
("name expected");
188 -- Otherwise some other junk, not much we can do
191 Error_Msg_AP
("name expected");
196 -- Loop through designators in qualified name
198 Name_Node
:= Token_Node
;
201 Scan
; -- past designator
202 exit when Token
/= Tok_Dot
;
203 Save_Scan_State
(Scan_State
); -- at dot
206 -- If we do not have another designator after the dot, then join
207 -- the normal circuit to handle a dot extension (may be .all or
208 -- character literal case). Otherwise loop back to scan the next
211 if Token
not in Token_Class_Desig
then
212 goto Scan_Name_Extension_Dot
;
214 Prefix_Node
:= Name_Node
;
215 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
216 Set_Prefix
(Name_Node
, Prefix_Node
);
217 Set_Selector_Name
(Name_Node
, Token_Node
);
221 -- We have now scanned out a qualified designator. If the last token is
222 -- an operator symbol, then we certainly do not have the Snam case, so
223 -- we can just use the normal name extension check circuit
225 if Prev_Token
= Tok_Operator_Symbol
then
226 goto Scan_Name_Extension
;
229 -- We have scanned out a qualified simple name, check for name extension
230 -- Note that we know there is no dot here at this stage, so the only
231 -- possible cases of name extension are apostrophe and left paren.
233 if Token
= Tok_Apostrophe
then
234 Save_Scan_State
(Scan_State
); -- at apostrophe
235 Scan
; -- past apostrophe
237 -- Qualified expression in Ada 2012 mode (treated as a name)
239 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
240 goto Scan_Name_Extension_Apostrophe
;
242 -- If left paren not in Ada 2012, then it is not part of the name,
243 -- since qualified expressions are not names in prior versions of
244 -- Ada, so return with Token backed up to point to the apostrophe.
245 -- The treatment for the range attribute is similar (we do not
246 -- consider x'range to be a name in this grammar).
248 elsif Token
= Tok_Left_Paren
or else Token
= Tok_Range
then
249 Restore_Scan_State
(Scan_State
); -- to apostrophe
250 Expr_Form
:= EF_Simple_Name
;
253 -- Otherwise we have the case of a name extended by an attribute
256 goto Scan_Name_Extension_Apostrophe
;
259 -- Check case of qualified simple name extended by a left parenthesis
261 elsif Token
= Tok_Left_Paren
then
262 Scan
; -- past left paren
263 goto Scan_Name_Extension_Left_Paren
;
265 -- Otherwise the qualified simple name is not extended, so return
268 Expr_Form
:= EF_Simple_Name
;
272 -- Loop scanning past name extensions. A label is used for control
273 -- transfer for this loop for ease of interfacing with the finite state
274 -- machine in the parenthesis scanning circuit, and also to allow for
275 -- passing in control to the appropriate point from the above code.
277 <<Scan_Name_Extension
>>
279 -- Character literal used as name cannot be extended. Also this
280 -- cannot be a call, since the name for a call must be a designator.
281 -- Return in these cases, or if there is no name extension
283 if Token
not in Token_Class_Namext
284 or else Prev_Token
= Tok_Char_Literal
286 Expr_Form
:= EF_Name
;
290 -- Merge here when we know there is a name extension
292 <<Scan_Name_Extension_OK
>>
294 if Token
= Tok_Left_Paren
then
295 Scan
; -- past left paren
296 goto Scan_Name_Extension_Left_Paren
;
298 elsif Token
= Tok_Apostrophe
then
299 Save_Scan_State
(Scan_State
); -- at apostrophe
300 Scan
; -- past apostrophe
301 goto Scan_Name_Extension_Apostrophe
;
303 else -- Token = Tok_Dot
304 Save_Scan_State
(Scan_State
); -- at dot
306 goto Scan_Name_Extension_Dot
;
309 -- Case of name extended by dot (selection), dot is already skipped
310 -- and the scan state at the point of the dot is saved in Scan_State.
312 <<Scan_Name_Extension_Dot
>>
314 -- Explicit dereference case
316 if Token
= Tok_All
then
317 Prefix_Node
:= Name_Node
;
318 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
319 Set_Prefix
(Name_Node
, Prefix_Node
);
321 goto Scan_Name_Extension
;
323 -- Selected component case
325 elsif Token
in Token_Class_Name
then
326 Prefix_Node
:= Name_Node
;
327 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
328 Set_Prefix
(Name_Node
, Prefix_Node
);
329 Set_Selector_Name
(Name_Node
, Token_Node
);
330 Scan
; -- past selector
331 goto Scan_Name_Extension
;
333 -- Reserved identifier as selector
335 elsif Is_Reserved_Identifier
then
336 Scan_Reserved_Identifier
(Force_Msg
=> False);
337 Prefix_Node
:= Name_Node
;
338 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
339 Set_Prefix
(Name_Node
, Prefix_Node
);
340 Set_Selector_Name
(Name_Node
, Token_Node
);
341 Scan
; -- past identifier used as selector
342 goto Scan_Name_Extension
;
344 -- If dot is at end of line and followed by nothing legal,
345 -- then assume end of name and quit (dot will be taken as
346 -- an erroneous form of some other punctuation by our caller).
348 elsif Token_Is_At_Start_Of_Line
then
349 Restore_Scan_State
(Scan_State
);
352 -- Here if nothing legal after the dot
355 Error_Msg_AP
("selector expected");
359 -- Here for an apostrophe as name extension. The scan position at the
360 -- apostrophe has already been saved, and the apostrophe scanned out.
362 <<Scan_Name_Extension_Apostrophe
>>
364 Scan_Apostrophe
: declare
365 function Apostrophe_Should_Be_Semicolon
return Boolean;
366 -- Checks for case where apostrophe should probably be
367 -- a semicolon, and if so, gives appropriate message,
368 -- resets the scan pointer to the apostrophe, changes
369 -- the current token to Tok_Semicolon, and returns True.
370 -- Otherwise returns False.
372 ------------------------------------
373 -- Apostrophe_Should_Be_Semicolon --
374 ------------------------------------
376 function Apostrophe_Should_Be_Semicolon
return Boolean is
378 if Token_Is_At_Start_Of_Line
then
379 Restore_Scan_State
(Scan_State
); -- to apostrophe
380 Error_Msg_SC
("|""''"" should be "";""");
381 Token
:= Tok_Semicolon
;
386 end Apostrophe_Should_Be_Semicolon
;
388 -- Start of processing for Scan_Apostrophe
391 -- Check for qualified expression case in Ada 2012 mode
393 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
394 Name_Node
:= P_Qualified_Expression
(Name_Node
);
395 goto Scan_Name_Extension
;
397 -- If range attribute after apostrophe, then return with Token
398 -- pointing to the apostrophe. Note that in this case the prefix
399 -- need not be a simple name (cases like A.all'range). Similarly
400 -- if there is a left paren after the apostrophe, then we also
401 -- return with Token pointing to the apostrophe (this is the
402 -- aggregate case, or some error case).
404 elsif Token
= Tok_Range
or else Token
= Tok_Left_Paren
then
405 Restore_Scan_State
(Scan_State
); -- to apostrophe
406 Expr_Form
:= EF_Name
;
409 -- Here for cases where attribute designator is an identifier
411 elsif Token
= Tok_Identifier
then
412 Attr_Name
:= Token_Name
;
414 if not Is_Attribute_Name
(Attr_Name
) then
415 if Apostrophe_Should_Be_Semicolon
then
416 Expr_Form
:= EF_Name
;
419 -- Here for a bad attribute name
422 Signal_Bad_Attribute
;
423 Scan
; -- past bad identifier
425 if Token
= Tok_Left_Paren
then
426 Scan
; -- past left paren
429 Discard_Junk_Node
(P_Expression_If_OK
);
430 exit when not Comma_Present
;
441 Style
.Check_Attribute_Name
(False);
444 -- Here for case of attribute designator is not an identifier
447 if Token
= Tok_Delta
then
448 Attr_Name
:= Name_Delta
;
450 elsif Token
= Tok_Digits
then
451 Attr_Name
:= Name_Digits
;
453 elsif Token
= Tok_Access
then
454 Attr_Name
:= Name_Access
;
456 elsif Token
= Tok_Mod
and then Ada_Version
>= Ada_95
then
457 Attr_Name
:= Name_Mod
;
459 elsif Apostrophe_Should_Be_Semicolon
then
460 Expr_Form
:= EF_Name
;
464 Error_Msg_AP
("attribute designator expected");
469 Style
.Check_Attribute_Name
(True);
473 -- We come here with an OK attribute scanned, and the
474 -- corresponding Attribute identifier node stored in Ident_Node.
476 Prefix_Node
:= Name_Node
;
477 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
478 Scan
; -- past attribute designator
479 Set_Prefix
(Name_Node
, Prefix_Node
);
480 Set_Attribute_Name
(Name_Node
, Attr_Name
);
482 -- Scan attribute arguments/designator. We skip this if we know
483 -- that the attribute cannot have an argument.
485 if Token
= Tok_Left_Paren
487 Is_Parameterless_Attribute
(Get_Attribute_Id
(Attr_Name
))
489 Set_Expressions
(Name_Node
, New_List
);
490 Scan
; -- past left paren
494 Expr
: constant Node_Id
:= P_Expression_If_OK
;
497 if Token
= Tok_Arrow
then
499 ("named parameters not permitted for attributes");
500 Scan
; -- past junk arrow
503 Append
(Expr
, Expressions
(Name_Node
));
504 exit when not Comma_Present
;
512 goto Scan_Name_Extension
;
515 -- Here for left parenthesis extending name (left paren skipped)
517 <<Scan_Name_Extension_Left_Paren
>>
519 -- We now have to scan through a list of items, terminated by a
520 -- right parenthesis. The scan is handled by a finite state
521 -- machine. The possibilities are:
525 -- This is a slice. This case is handled in LP_State_Init
527 -- (expression, expression, ..)
529 -- This is interpreted as an indexed component, i.e. as a
530 -- case of a name which can be extended in the normal manner.
531 -- This case is handled by LP_State_Name or LP_State_Expr.
533 -- Note: conditional expressions (without an extra level of
534 -- parentheses) are permitted in this context).
536 -- (..., identifier => expression , ...)
538 -- If there is at least one occurrence of identifier => (but
539 -- none of the other cases apply), then we have a call.
541 -- Test for Id => case
543 if Token
= Tok_Identifier
then
544 Save_Scan_State
(Scan_State
); -- at Id
547 -- Test for => (allow := as an error substitute)
549 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
550 Restore_Scan_State
(Scan_State
); -- to Id
551 Arg_List
:= New_List
;
555 Restore_Scan_State
(Scan_State
); -- to Id
559 -- Here we have an expression after all
561 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
563 -- Check cases of discrete range for a slice
565 -- First possibility: Range_Attribute_Reference
567 if Expr_Form
= EF_Range_Attr
then
568 Range_Node
:= Expr_Node
;
570 -- Second possibility: Simple_expression .. Simple_expression
572 elsif Token
= Tok_Dot_Dot
then
573 Check_Simple_Expression
(Expr_Node
);
574 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
575 Set_Low_Bound
(Range_Node
, Expr_Node
);
577 Expr_Node
:= P_Expression
;
578 Check_Simple_Expression
(Expr_Node
);
579 Set_High_Bound
(Range_Node
, Expr_Node
);
581 -- Third possibility: Type_name range Range
583 elsif Token
= Tok_Range
then
584 if Expr_Form
/= EF_Simple_Name
then
585 Error_Msg_SC
("subtype mark must precede RANGE");
589 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
591 -- Otherwise we just have an expression. It is true that we might
592 -- have a subtype mark without a range constraint but this case
593 -- is syntactically indistinguishable from the expression case.
596 Arg_List
:= New_List
;
600 -- Fall through here with unmistakable Discrete range scanned,
601 -- which means that we definitely have the case of a slice. The
602 -- Discrete range is in Range_Node.
604 if Token
= Tok_Comma
then
605 Error_Msg_SC
("slice cannot have more than one dimension");
608 elsif Token
/= Tok_Right_Paren
then
613 Scan
; -- past right paren
614 Prefix_Node
:= Name_Node
;
615 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
616 Set_Prefix
(Name_Node
, Prefix_Node
);
617 Set_Discrete_Range
(Name_Node
, Range_Node
);
619 -- An operator node is legal as a prefix to other names,
620 -- but not for a slice.
622 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
623 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
626 -- If we have a name extension, go scan it
628 if Token
in Token_Class_Namext
then
629 goto Scan_Name_Extension_OK
;
631 -- Otherwise return (a slice is a name, but is not a call)
634 Expr_Form
:= EF_Name
;
639 -- In LP_State_Expr, we have scanned one or more expressions, and
640 -- so we have a call or an indexed component which is a name. On
641 -- entry we have the expression just scanned in Expr_Node and
642 -- Arg_List contains the list of expressions encountered so far
645 Append
(Expr_Node
, Arg_List
);
647 if Token
= Tok_Arrow
then
649 ("expect identifier in parameter association",
653 elsif not Comma_Present
then
655 Prefix_Node
:= Name_Node
;
656 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
657 Set_Prefix
(Name_Node
, Prefix_Node
);
658 Set_Expressions
(Name_Node
, Arg_List
);
659 goto Scan_Name_Extension
;
662 -- Comma present (and scanned out), test for identifier => case
663 -- Test for identifier => case
665 if Token
= Tok_Identifier
then
666 Save_Scan_State
(Scan_State
); -- at Id
669 -- Test for => (allow := as error substitute)
671 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
672 Restore_Scan_State
(Scan_State
); -- to Id
675 -- Otherwise it's just an expression after all, so backup
678 Restore_Scan_State
(Scan_State
); -- to Id
682 -- Here we have an expression after all, so stay in this state
684 Expr_Node
:= P_Expression_If_OK
;
687 -- LP_State_Call corresponds to the situation in which at least
688 -- one instance of Id => Expression has been encountered, so we
689 -- know that we do not have a name, but rather a call. We enter
690 -- it with the scan pointer pointing to the next argument to scan,
691 -- and Arg_List containing the list of arguments scanned so far.
695 -- Test for case of Id => Expression (named parameter)
697 if Token
= Tok_Identifier
then
698 Save_Scan_State
(Scan_State
); -- at Id
699 Ident_Node
:= Token_Node
;
702 -- Deal with => (allow := as erroneous substitute)
704 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
705 Arg_Node
:= New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
706 Set_Selector_Name
(Arg_Node
, Ident_Node
);
708 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
709 Append
(Arg_Node
, Arg_List
);
711 -- If a comma follows, go back and scan next entry
713 if Comma_Present
then
716 -- Otherwise we have the end of a call
719 Prefix_Node
:= Name_Node
;
720 Name_Node
:= New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
721 Set_Name
(Name_Node
, Prefix_Node
);
722 Set_Parameter_Associations
(Name_Node
, Arg_List
);
725 if Token
in Token_Class_Namext
then
726 goto Scan_Name_Extension_OK
;
728 -- This is a case of a call which cannot be a name
731 Expr_Form
:= EF_Name
;
736 -- Not named parameter: Id started an expression after all
739 Restore_Scan_State
(Scan_State
); -- to Id
743 -- Here if entry did not start with Id => which means that it
744 -- is a positional parameter, which is not allowed, since we
745 -- have seen at least one named parameter already.
748 ("positional parameter association " &
749 "not allowed after named one");
751 Expr_Node
:= P_Expression_If_OK
;
753 -- Leaving the '>' in an association is not unusual, so suggest
756 if Nkind
(Expr_Node
) = N_Op_Eq
then
757 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
760 -- We go back to scanning out expressions, so that we do not get
761 -- multiple error messages when several positional parameters
762 -- follow a named parameter.
766 -- End of treatment for name extensions starting with left paren
768 -- End of loop through name extensions
772 -- This function parses a restricted form of Names which are either
773 -- designators, or designators preceded by a sequence of prefixes
774 -- that are direct names.
776 -- Error recovery: cannot raise Error_Resync
778 function P_Function_Name
return Node_Id
is
779 Designator_Node
: Node_Id
;
780 Prefix_Node
: Node_Id
;
781 Selector_Node
: Node_Id
;
782 Dot_Sloc
: Source_Ptr
:= No_Location
;
785 -- Prefix_Node is set to the gathered prefix so far, Empty means that
786 -- no prefix has been scanned. This allows us to build up the result
787 -- in the required right recursive manner.
789 Prefix_Node
:= Empty
;
791 -- Loop through prefixes
794 Designator_Node
:= Token_Node
;
796 if Token
not in Token_Class_Desig
then
797 return P_Identifier
; -- let P_Identifier issue the error message
799 else -- Token in Token_Class_Desig
800 Scan
; -- past designator
801 exit when Token
/= Tok_Dot
;
804 -- Here at a dot, with token just before it in Designator_Node
806 if No
(Prefix_Node
) then
807 Prefix_Node
:= Designator_Node
;
809 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
810 Set_Prefix
(Selector_Node
, Prefix_Node
);
811 Set_Selector_Name
(Selector_Node
, Designator_Node
);
812 Prefix_Node
:= Selector_Node
;
815 Dot_Sloc
:= Token_Ptr
;
819 -- Fall out of the loop having just scanned a designator
821 if No
(Prefix_Node
) then
822 return Designator_Node
;
824 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
825 Set_Prefix
(Selector_Node
, Prefix_Node
);
826 Set_Selector_Name
(Selector_Node
, Designator_Node
);
827 return Selector_Node
;
835 -- This function parses a restricted form of Names which are either
836 -- identifiers, or identifiers preceded by a sequence of prefixes
837 -- that are direct names.
839 -- Error recovery: cannot raise Error_Resync
841 function P_Qualified_Simple_Name
return Node_Id
is
842 Designator_Node
: Node_Id
;
843 Prefix_Node
: Node_Id
;
844 Selector_Node
: Node_Id
;
845 Dot_Sloc
: Source_Ptr
:= No_Location
;
848 -- Prefix node is set to the gathered prefix so far, Empty means that
849 -- no prefix has been scanned. This allows us to build up the result
850 -- in the required right recursive manner.
852 Prefix_Node
:= Empty
;
854 -- Loop through prefixes
857 Designator_Node
:= Token_Node
;
859 if Token
= Tok_Identifier
then
860 Scan
; -- past identifier
861 exit when Token
/= Tok_Dot
;
863 elsif Token
not in Token_Class_Desig
then
864 return P_Identifier
; -- let P_Identifier issue the error message
867 Scan
; -- past designator
869 if Token
/= Tok_Dot
then
870 Error_Msg_SP
("identifier expected");
875 -- Here at a dot, with token just before it in Designator_Node
877 if No
(Prefix_Node
) then
878 Prefix_Node
:= Designator_Node
;
880 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
881 Set_Prefix
(Selector_Node
, Prefix_Node
);
882 Set_Selector_Name
(Selector_Node
, Designator_Node
);
883 Prefix_Node
:= Selector_Node
;
886 Dot_Sloc
:= Token_Ptr
;
890 -- Fall out of the loop having just scanned an identifier
892 if No
(Prefix_Node
) then
893 return Designator_Node
;
895 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
896 Set_Prefix
(Selector_Node
, Prefix_Node
);
897 Set_Selector_Name
(Selector_Node
, Designator_Node
);
898 return Selector_Node
;
904 end P_Qualified_Simple_Name
;
906 -- This procedure differs from P_Qualified_Simple_Name only in that it
907 -- raises Error_Resync if any error is encountered. It only returns after
908 -- scanning a valid qualified simple name.
910 -- Error recovery: can raise Error_Resync
912 function P_Qualified_Simple_Name_Resync
return Node_Id
is
913 Designator_Node
: Node_Id
;
914 Prefix_Node
: Node_Id
;
915 Selector_Node
: Node_Id
;
916 Dot_Sloc
: Source_Ptr
:= No_Location
;
919 Prefix_Node
:= Empty
;
921 -- Loop through prefixes
924 Designator_Node
:= Token_Node
;
926 if Token
= Tok_Identifier
then
927 Scan
; -- past identifier
928 exit when Token
/= Tok_Dot
;
930 elsif Token
not in Token_Class_Desig
then
931 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
935 Scan
; -- past designator
937 if Token
/= Tok_Dot
then
938 Error_Msg_SP
("identifier expected");
943 -- Here at a dot, with token just before it in Designator_Node
945 if No
(Prefix_Node
) then
946 Prefix_Node
:= Designator_Node
;
948 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
949 Set_Prefix
(Selector_Node
, Prefix_Node
);
950 Set_Selector_Name
(Selector_Node
, Designator_Node
);
951 Prefix_Node
:= Selector_Node
;
954 Dot_Sloc
:= Token_Ptr
;
958 -- Fall out of the loop having just scanned an identifier
960 if No
(Prefix_Node
) then
961 return Designator_Node
;
963 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
964 Set_Prefix
(Selector_Node
, Prefix_Node
);
965 Set_Selector_Name
(Selector_Node
, Designator_Node
);
966 return Selector_Node
;
968 end P_Qualified_Simple_Name_Resync
;
970 ----------------------
971 -- 4.1 Direct_Name --
972 ----------------------
974 -- Parsed by P_Name and other functions in section 4.1
980 -- Parsed by P_Name (4.1)
982 -------------------------------
983 -- 4.1 Explicit Dereference --
984 -------------------------------
986 -- Parsed by P_Name (4.1)
988 -------------------------------
989 -- 4.1 Implicit_Dereference --
990 -------------------------------
992 -- Parsed by P_Name (4.1)
994 ----------------------------
995 -- 4.1 Indexed Component --
996 ----------------------------
998 -- Parsed by P_Name (4.1)
1004 -- Parsed by P_Name (4.1)
1006 -----------------------------
1007 -- 4.1 Selected_Component --
1008 -----------------------------
1010 -- Parsed by P_Name (4.1)
1012 ------------------------
1013 -- 4.1 Selector Name --
1014 ------------------------
1016 -- Parsed by P_Name (4.1)
1018 ------------------------------
1019 -- 4.1 Attribute Reference --
1020 ------------------------------
1022 -- Parsed by P_Name (4.1)
1024 -------------------------------
1025 -- 4.1 Attribute Designator --
1026 -------------------------------
1028 -- Parsed by P_Name (4.1)
1030 --------------------------------------
1031 -- 4.1.4 Range Attribute Reference --
1032 --------------------------------------
1034 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1036 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1038 -- In the grammar, a RANGE attribute is simply a name, but its use is
1039 -- highly restricted, so in the parser, we do not regard it as a name.
1040 -- Instead, P_Name returns without scanning the 'RANGE part of the
1041 -- attribute, and the caller uses the following function to construct
1042 -- a range attribute in places where it is appropriate.
1044 -- Note that RANGE here is treated essentially as an identifier,
1045 -- rather than a reserved word.
1047 -- The caller has parsed the prefix, i.e. a name, and Token points to
1048 -- the apostrophe. The token after the apostrophe is known to be RANGE
1049 -- at this point. The prefix node becomes the prefix of the attribute.
1051 -- Error_Recovery: Cannot raise Error_Resync
1053 function P_Range_Attribute_Reference
1054 (Prefix_Node
: Node_Id
)
1057 Attr_Node
: Node_Id
;
1060 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1061 Set_Prefix
(Attr_Node
, Prefix_Node
);
1062 Scan
; -- past apostrophe
1065 Style
.Check_Attribute_Name
(True);
1068 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1071 if Token
= Tok_Left_Paren
then
1072 Scan
; -- past left paren
1073 Set_Expressions
(Attr_Node
, New_List
(P_Expression_If_OK
));
1078 end P_Range_Attribute_Reference
;
1080 ---------------------------------------
1081 -- 4.1.4 Range Attribute Designator --
1082 ---------------------------------------
1084 -- Parsed by P_Range_Attribute_Reference (4.4)
1086 --------------------
1088 --------------------
1090 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1092 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1093 -- an aggregate is known to be required (code statement, extension
1094 -- aggregate), in which cases this routine performs the necessary check
1095 -- that we have an aggregate rather than a parenthesized expression
1097 -- Error recovery: can raise Error_Resync
1099 function P_Aggregate
return Node_Id
is
1100 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1101 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1104 if Nkind
(Aggr_Node
) /= N_Aggregate
1106 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1109 ("aggregate may not have single positional component", Aggr_Sloc
);
1116 ------------------------------------------------
1117 -- 4.3 Aggregate or Parenthesized Expression --
1118 ------------------------------------------------
1120 -- This procedure parses out either an aggregate or a parenthesized
1121 -- expression (these two constructs are closely related, since a
1122 -- parenthesized expression looks like an aggregate with a single
1123 -- positional component).
1126 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1128 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1130 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1131 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1134 -- RECORD_COMPONENT_ASSOCIATION ::=
1135 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1137 -- COMPONENT_CHOICE_LIST ::=
1138 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1141 -- EXTENSION_AGGREGATE ::=
1142 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1144 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1146 -- ARRAY_AGGREGATE ::=
1147 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1149 -- POSITIONAL_ARRAY_AGGREGATE ::=
1150 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1151 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1152 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1154 -- NAMED_ARRAY_AGGREGATE ::=
1155 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1157 -- PRIMARY ::= (EXPRESSION);
1159 -- Error recovery: can raise Error_Resync
1161 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1162 -- to Ada 2005 limited aggregates (AI-287)
1164 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1165 Aggregate_Node
: Node_Id
;
1166 Expr_List
: List_Id
;
1167 Assoc_List
: List_Id
;
1168 Expr_Node
: Node_Id
;
1169 Lparen_Sloc
: Source_Ptr
;
1170 Scan_State
: Saved_Scan_State
;
1172 procedure Box_Error
;
1173 -- Called if <> is encountered as positional aggregate element. Issues
1174 -- error message and sets Expr_Node to Error.
1180 procedure Box_Error
is
1182 if Ada_Version
< Ada_2005
then
1183 Error_Msg_SC
("box in aggregate is an Ada 2005 extension");
1186 -- Ada 2005 (AI-287): The box notation is allowed only with named
1187 -- notation because positional notation might be error prone. For
1188 -- example, in "(X, <>, Y, <>)", there is no type associated with
1189 -- the boxes, so you might not be leaving out the components you
1190 -- thought you were leaving out.
1192 Error_Msg_SC
("(Ada 2005) box only allowed with named notation");
1197 -- Start of processsing for P_Aggregate_Or_Paren_Expr
1200 Lparen_Sloc
:= Token_Ptr
;
1203 -- Conditional expression case
1205 if Token
= Tok_If
then
1206 Expr_Node
:= P_Conditional_Expression
;
1210 -- Case expression case
1212 elsif Token
= Tok_Case
then
1213 Expr_Node
:= P_Case_Expression
;
1217 -- Quantified expression case
1219 elsif Token
= Tok_For
then
1220 Expr_Node
:= P_Quantified_Expression
;
1224 -- Note: the mechanism used here of rescanning the initial expression
1225 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1226 -- out the discrete choice list.
1228 -- Deal with expression and extension aggregate cases first
1230 elsif Token
/= Tok_Others
then
1231 Save_Scan_State
(Scan_State
); -- at start of expression
1233 -- Deal with (NULL RECORD) case
1235 if Token
= Tok_Null
then
1238 if Token
= Tok_Record
then
1239 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1240 Set_Null_Record_Present
(Aggregate_Node
, True);
1241 Scan
; -- past RECORD
1243 return Aggregate_Node
;
1245 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1249 -- Scan expression, handling box appearing as positional argument
1251 if Token
= Tok_Box
then
1254 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1257 -- Extension aggregate case
1259 if Token
= Tok_With
then
1260 if Nkind
(Expr_Node
) = N_Attribute_Reference
1261 and then Attribute_Name
(Expr_Node
) = Name_Range
1263 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1267 if Ada_Version
= Ada_83
then
1268 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1271 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1272 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1275 -- Deal with WITH NULL RECORD case
1277 if Token
= Tok_Null
then
1278 Save_Scan_State
(Scan_State
); -- at NULL
1281 if Token
= Tok_Record
then
1282 Scan
; -- past RECORD
1283 Set_Null_Record_Present
(Aggregate_Node
, True);
1285 return Aggregate_Node
;
1288 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1292 if Token
/= Tok_Others
then
1293 Save_Scan_State
(Scan_State
);
1294 Expr_Node
:= P_Expression
;
1301 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1302 if Nkind
(Expr_Node
) = N_Attribute_Reference
1303 and then Attribute_Name
(Expr_Node
) = Name_Range
1306 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
1307 Scan
; -- past right paren
1311 -- Bump paren count of expression
1313 if Expr_Node
/= Error
then
1314 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1317 T_Right_Paren
; -- past right paren (error message if none)
1320 -- Normal aggregate case
1323 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1329 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1333 -- Prepare to scan list of component associations
1335 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1336 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1338 -- This loop scans through component associations. On entry to the
1339 -- loop, an expression has been scanned at the start of the current
1340 -- association unless initial token was OTHERS, in which case
1341 -- Expr_Node is set to Empty.
1344 -- Deal with others association first. This is a named association
1346 if No
(Expr_Node
) then
1347 if No
(Assoc_List
) then
1348 Assoc_List
:= New_List
;
1351 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1353 -- Improper use of WITH
1355 elsif Token
= Tok_With
then
1356 Error_Msg_SC
("WITH must be preceded by single expression in " &
1357 "extension aggregate");
1360 -- Range attribute can only appear as part of a discrete choice list
1362 elsif Nkind
(Expr_Node
) = N_Attribute_Reference
1363 and then Attribute_Name
(Expr_Node
) = Name_Range
1364 and then Token
/= Tok_Arrow
1365 and then Token
/= Tok_Vertical_Bar
1367 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1370 -- Assume positional case if comma, right paren, or literal or
1371 -- identifier or OTHERS follows (the latter cases are missing
1372 -- comma cases). Also assume positional if a semicolon follows,
1373 -- which can happen if there are missing parens
1375 elsif Token
= Tok_Comma
1376 or else Token
= Tok_Right_Paren
1377 or else Token
= Tok_Others
1378 or else Token
in Token_Class_Lit_Or_Name
1379 or else Token
= Tok_Semicolon
1381 if Present
(Assoc_List
) then
1382 Error_Msg_BC
-- CODEFIX
1383 ("""='>"" expected (positional association cannot follow " &
1384 "named association)");
1387 if No
(Expr_List
) then
1388 Expr_List
:= New_List
;
1391 Append
(Expr_Node
, Expr_List
);
1393 -- Check for aggregate followed by left parent, maybe missing comma
1395 elsif Nkind
(Expr_Node
) = N_Aggregate
1396 and then Token
= Tok_Left_Paren
1400 if No
(Expr_List
) then
1401 Expr_List
:= New_List
;
1404 Append
(Expr_Node
, Expr_List
);
1406 -- Anything else is assumed to be a named association
1409 Restore_Scan_State
(Scan_State
); -- to start of expression
1411 if No
(Assoc_List
) then
1412 Assoc_List
:= New_List
;
1415 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1418 exit when not Comma_Present
;
1420 -- If we are at an expression terminator, something is seriously
1421 -- wrong, so let's get out now, before we start eating up stuff
1422 -- that doesn't belong to us!
1424 if Token
in Token_Class_Eterm
then
1426 -- If Some becomes a keyword, the following is needed to make it
1427 -- acceptable in older versions of Ada.
1430 and then Ada_Version
< Ada_2012
1432 Scan_Reserved_Identifier
(False);
1435 ("expecting expression or component association");
1440 -- Deal with misused box
1442 if Token
= Tok_Box
then
1445 -- Otherwise initiate for reentry to top of loop by scanning an
1446 -- initial expression, unless the first token is OTHERS.
1448 elsif Token
= Tok_Others
then
1452 Save_Scan_State
(Scan_State
); -- at start of expression
1453 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1458 -- All component associations (positional and named) have been scanned
1461 Set_Expressions
(Aggregate_Node
, Expr_List
);
1462 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1463 return Aggregate_Node
;
1464 end P_Aggregate_Or_Paren_Expr
;
1466 ------------------------------------------------
1467 -- 4.3 Record or Array Component Association --
1468 ------------------------------------------------
1470 -- RECORD_COMPONENT_ASSOCIATION ::=
1471 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1472 -- | COMPONENT_CHOICE_LIST => <>
1474 -- COMPONENT_CHOICE_LIST =>
1475 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1478 -- ARRAY_COMPONENT_ASSOCIATION ::=
1479 -- DISCRETE_CHOICE_LIST => EXPRESSION
1480 -- | DISCRETE_CHOICE_LIST => <>
1482 -- Note: this routine only handles the named cases, including others.
1483 -- Cases where the component choice list is not present have already
1484 -- been handled directly.
1486 -- Error recovery: can raise Error_Resync
1488 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1489 -- rules have been extended to give support to Ada 2005 limited
1490 -- aggregates (AI-287)
1492 function P_Record_Or_Array_Component_Association
return Node_Id
is
1493 Assoc_Node
: Node_Id
;
1496 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1497 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1498 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1501 if Token
= Tok_Box
then
1503 -- Ada 2005(AI-287): The box notation is used to indicate the
1504 -- default initialization of aggregate components
1506 if Ada_Version
< Ada_2005
then
1508 ("component association with '<'> is an Ada 2005 extension");
1509 Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
1512 Set_Box_Present
(Assoc_Node
);
1515 Set_Expression
(Assoc_Node
, P_Expression
);
1519 end P_Record_Or_Array_Component_Association
;
1521 -----------------------------
1522 -- 4.3.1 Record Aggregate --
1523 -----------------------------
1525 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1526 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1528 ----------------------------------------------
1529 -- 4.3.1 Record Component Association List --
1530 ----------------------------------------------
1532 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1534 ----------------------------------
1535 -- 4.3.1 Component Choice List --
1536 ----------------------------------
1538 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1540 --------------------------------
1541 -- 4.3.1 Extension Aggregate --
1542 --------------------------------
1544 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1546 --------------------------
1547 -- 4.3.1 Ancestor Part --
1548 --------------------------
1550 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1552 ----------------------------
1553 -- 4.3.1 Array Aggregate --
1554 ----------------------------
1556 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1558 ---------------------------------------
1559 -- 4.3.1 Positional Array Aggregate --
1560 ---------------------------------------
1562 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1564 ----------------------------------
1565 -- 4.3.1 Named Array Aggregate --
1566 ----------------------------------
1568 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1570 ----------------------------------------
1571 -- 4.3.1 Array Component Association --
1572 ----------------------------------------
1574 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1576 ---------------------
1577 -- 4.4 Expression --
1578 ---------------------
1580 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1583 -- RELATION {LOGICAL_OPERATOR RELATION}
1585 -- CHOICE_EXPRESSION ::=
1586 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1588 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1590 -- On return, Expr_Form indicates the categorization of the expression
1591 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1592 -- an error message is given, and Error is returned).
1594 -- Error recovery: cannot raise Error_Resync
1596 function P_Expression
return Node_Id
is
1597 Logical_Op
: Node_Kind
;
1598 Prev_Logical_Op
: Node_Kind
;
1599 Op_Location
: Source_Ptr
;
1604 Node1
:= P_Relation
;
1606 if Token
in Token_Class_Logop
then
1607 Prev_Logical_Op
:= N_Empty
;
1610 Op_Location
:= Token_Ptr
;
1611 Logical_Op
:= P_Logical_Operator
;
1613 if Prev_Logical_Op
/= N_Empty
and then
1614 Logical_Op
/= Prev_Logical_Op
1617 ("mixed logical operators in expression", Op_Location
);
1618 Prev_Logical_Op
:= N_Empty
;
1620 Prev_Logical_Op
:= Logical_Op
;
1624 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1625 Set_Left_Opnd
(Node1
, Node2
);
1626 Set_Right_Opnd
(Node1
, P_Relation
);
1627 exit when Token
not in Token_Class_Logop
;
1630 Expr_Form
:= EF_Non_Simple
;
1633 if Token
= Tok_Apostrophe
then
1634 Bad_Range_Attribute
(Token_Ptr
);
1641 -- This function is identical to the normal P_Expression, except that it
1642 -- also permits the appearance of a case, conditional, or quantified
1643 -- expression without the usual surrounding parentheses.
1645 function P_Expression_If_OK
return Node_Id
is
1647 if Token
= Tok_Case
then
1648 return P_Case_Expression
;
1650 elsif Token
= Tok_If
then
1651 return P_Conditional_Expression
;
1653 elsif Token
= Tok_For
then
1654 return P_Quantified_Expression
;
1657 return P_Expression
;
1659 end P_Expression_If_OK
;
1661 -- This function is identical to the normal P_Expression, except that it
1662 -- checks that the expression scan did not stop on a right paren. It is
1663 -- called in all contexts where a right parenthesis cannot legitimately
1664 -- follow an expression.
1666 -- Error recovery: can not raise Error_Resync
1668 function P_Expression_No_Right_Paren
return Node_Id
is
1669 Expr
: constant Node_Id
:= P_Expression
;
1671 Ignore
(Tok_Right_Paren
);
1673 end P_Expression_No_Right_Paren
;
1675 ----------------------------------------
1676 -- 4.4 Expression_Or_Range_Attribute --
1677 ----------------------------------------
1680 -- RELATION {and RELATION} | RELATION {and then RELATION}
1681 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1682 -- | RELATION {xor RELATION}
1684 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1686 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1688 -- On return, Expr_Form indicates the categorization of the expression
1689 -- and EF_Range_Attr is one of the possibilities.
1691 -- Error recovery: cannot raise Error_Resync
1693 -- In the grammar, a RANGE attribute is simply a name, but its use is
1694 -- highly restricted, so in the parser, we do not regard it as a name.
1695 -- Instead, P_Name returns without scanning the 'RANGE part of the
1696 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1697 -- attribute reference. In the normal case where a range attribute is
1698 -- not allowed, an error message is issued by P_Expression.
1700 function P_Expression_Or_Range_Attribute
return Node_Id
is
1701 Logical_Op
: Node_Kind
;
1702 Prev_Logical_Op
: Node_Kind
;
1703 Op_Location
: Source_Ptr
;
1706 Attr_Node
: Node_Id
;
1709 Node1
:= P_Relation
;
1711 if Token
= Tok_Apostrophe
then
1712 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
1713 Expr_Form
:= EF_Range_Attr
;
1716 elsif Token
in Token_Class_Logop
then
1717 Prev_Logical_Op
:= N_Empty
;
1720 Op_Location
:= Token_Ptr
;
1721 Logical_Op
:= P_Logical_Operator
;
1723 if Prev_Logical_Op
/= N_Empty
and then
1724 Logical_Op
/= Prev_Logical_Op
1727 ("mixed logical operators in expression", Op_Location
);
1728 Prev_Logical_Op
:= N_Empty
;
1730 Prev_Logical_Op
:= Logical_Op
;
1734 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1735 Set_Left_Opnd
(Node1
, Node2
);
1736 Set_Right_Opnd
(Node1
, P_Relation
);
1737 exit when Token
not in Token_Class_Logop
;
1740 Expr_Form
:= EF_Non_Simple
;
1743 if Token
= Tok_Apostrophe
then
1744 Bad_Range_Attribute
(Token_Ptr
);
1749 end P_Expression_Or_Range_Attribute
;
1751 -- Version that allows a non-parenthesized case, conditional, or quantified
1754 function P_Expression_Or_Range_Attribute_If_OK
return Node_Id
is
1756 if Token
= Tok_Case
then
1757 return P_Case_Expression
;
1759 elsif Token
= Tok_If
then
1760 return P_Conditional_Expression
;
1762 elsif Token
= Tok_For
then
1763 return P_Quantified_Expression
;
1766 return P_Expression_Or_Range_Attribute
;
1768 end P_Expression_Or_Range_Attribute_If_OK
;
1774 -- This procedure scans both relations and choice relations
1776 -- CHOICE_RELATION ::=
1777 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1780 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
1782 -- MEMBERSHIP_CHOICE_LIST ::=
1783 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
1785 -- MEMBERSHIP_CHOICE ::=
1786 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
1788 -- On return, Expr_Form indicates the categorization of the expression
1790 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1791 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1793 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1794 -- expression, then tokens are scanned until either a non-expression token,
1795 -- a right paren (not matched by a left paren) or a comma, is encountered.
1797 function P_Relation
return Node_Id
is
1798 Node1
, Node2
: Node_Id
;
1802 Node1
:= P_Simple_Expression
;
1804 if Token
not in Token_Class_Relop
then
1808 -- Here we have a relational operator following. If so then scan it
1809 -- out. Note that the assignment symbol := is treated as a relational
1810 -- operator to improve the error recovery when it is misused for =.
1811 -- P_Relational_Operator also parses the IN and NOT IN operations.
1814 Node2
:= New_Op_Node
(P_Relational_Operator
, Optok
);
1815 Set_Left_Opnd
(Node2
, Node1
);
1817 -- Case of IN or NOT IN
1819 if Prev_Token
= Tok_In
then
1820 P_Membership_Test
(Node2
);
1822 -- Case of relational operator (= /= < <= > >=)
1825 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
1828 Expr_Form
:= EF_Non_Simple
;
1830 if Token
in Token_Class_Relop
then
1831 Error_Msg_SC
("unexpected relational operator");
1838 -- If any error occurs, then scan to the next expression terminator symbol
1839 -- or comma or right paren at the outer (i.e. current) parentheses level.
1840 -- The flags are set to indicate a normal simple expression.
1843 when Error_Resync
=>
1845 Expr_Form
:= EF_Simple
;
1849 ----------------------------
1850 -- 4.4 Simple Expression --
1851 ----------------------------
1853 -- SIMPLE_EXPRESSION ::=
1854 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1856 -- On return, Expr_Form indicates the categorization of the expression
1858 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1859 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1861 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1862 -- expression, then tokens are scanned until either a non-expression token,
1863 -- a right paren (not matched by a left paren) or a comma, is encountered.
1865 -- Note: P_Simple_Expression is called only internally by higher level
1866 -- expression routines. In cases in the grammar where a simple expression
1867 -- is required, the approach is to scan an expression, and then post an
1868 -- appropriate error message if the expression obtained is not simple. This
1869 -- gives better error recovery and treatment.
1871 function P_Simple_Expression
return Node_Id
is
1872 Scan_State
: Saved_Scan_State
;
1875 Tokptr
: Source_Ptr
;
1878 -- Check for cases starting with a name. There are two reasons for
1879 -- special casing. First speed things up by catching a common case
1880 -- without going through several routine layers. Second the caller must
1881 -- be informed via Expr_Form when the simple expression is a name.
1883 if Token
in Token_Class_Name
then
1886 -- Deal with apostrophe cases
1888 if Token
= Tok_Apostrophe
then
1889 Save_Scan_State
(Scan_State
); -- at apostrophe
1890 Scan
; -- past apostrophe
1892 -- If qualified expression, scan it out and fall through
1894 if Token
= Tok_Left_Paren
then
1895 Node1
:= P_Qualified_Expression
(Node1
);
1896 Expr_Form
:= EF_Simple
;
1898 -- If range attribute, then we return with Token pointing to the
1899 -- apostrophe. Note: avoid the normal error check on exit. We
1900 -- know that the expression really is complete in this case!
1902 else -- Token = Tok_Range then
1903 Restore_Scan_State
(Scan_State
); -- to apostrophe
1904 Expr_Form
:= EF_Simple_Name
;
1909 -- If an expression terminator follows, the previous processing
1910 -- completely scanned out the expression (a common case), and
1911 -- left Expr_Form set appropriately for returning to our caller.
1913 if Token
in Token_Class_Sterm
then
1916 -- If we do not have an expression terminator, then complete the
1917 -- scan of a simple expression. This code duplicates the code
1918 -- found in P_Term and P_Factor.
1921 if Token
= Tok_Double_Asterisk
then
1923 Style
.Check_Exponentiation_Operator
;
1926 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
1928 Set_Left_Opnd
(Node2
, Node1
);
1929 Set_Right_Opnd
(Node2
, P_Primary
);
1934 exit when Token
not in Token_Class_Mulop
;
1935 Tokptr
:= Token_Ptr
;
1936 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
1939 Style
.Check_Binary_Operator
;
1942 Scan
; -- past operator
1943 Set_Left_Opnd
(Node2
, Node1
);
1944 Set_Right_Opnd
(Node2
, P_Factor
);
1949 exit when Token
not in Token_Class_Binary_Addop
;
1950 Tokptr
:= Token_Ptr
;
1951 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
1954 Style
.Check_Binary_Operator
;
1957 Scan
; -- past operator
1958 Set_Left_Opnd
(Node2
, Node1
);
1959 Set_Right_Opnd
(Node2
, P_Term
);
1963 Expr_Form
:= EF_Simple
;
1966 -- Cases where simple expression does not start with a name
1969 -- Scan initial sign and initial Term
1971 if Token
in Token_Class_Unary_Addop
then
1972 Tokptr
:= Token_Ptr
;
1973 Node1
:= New_Op_Node
(P_Unary_Adding_Operator
, Tokptr
);
1976 Style
.Check_Unary_Plus_Or_Minus
;
1979 Scan
; -- past operator
1980 Set_Right_Opnd
(Node1
, P_Term
);
1985 -- In the following, we special-case a sequence of concatenations of
1986 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
1987 -- else mixed in. For such a sequence, we return a tree representing
1988 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
1989 -- the number of concatenations is large. If semantic analysis
1990 -- resolves the "&" to a predefined one, then this folding gives the
1991 -- right answer. Otherwise, semantic analysis will complain about a
1992 -- capacity-exceeded error. The purpose of this trick is to avoid
1993 -- creating a deeply nested tree, which would cause deep recursion
1994 -- during semantics, causing stack overflow. This way, we can handle
1995 -- enormous concatenations in the normal case of predefined "&". We
1996 -- first build up the normal tree, and then rewrite it if
2000 Num_Concats_Threshold
: constant Positive := 1000;
2001 -- Arbitrary threshold value to enable optimization
2003 First_Node
: constant Node_Id
:= Node1
;
2004 Is_Strlit_Concat
: Boolean;
2005 -- True iff we've parsed a sequence of concatenations of string
2006 -- literals, with nothing else mixed in.
2008 Num_Concats
: Natural;
2009 -- Number of "&" operators if Is_Strlit_Concat is True
2013 Nkind
(Node1
) = N_String_Literal
2014 and then Token
= Tok_Ampersand
;
2017 -- Scan out sequence of terms separated by binary adding operators
2020 exit when Token
not in Token_Class_Binary_Addop
;
2021 Tokptr
:= Token_Ptr
;
2022 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2023 Scan
; -- past operator
2024 Set_Left_Opnd
(Node2
, Node1
);
2026 Set_Right_Opnd
(Node2
, Node1
);
2028 -- Check if we're still concatenating string literals
2032 and then Nkind
(Node2
) = N_Op_Concat
2033 and then Nkind
(Node1
) = N_String_Literal
;
2035 if Is_Strlit_Concat
then
2036 Num_Concats
:= Num_Concats
+ 1;
2042 -- If we have an enormous series of concatenations of string
2043 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2044 -- flag tells semantic analysis that if the "&" is not predefined,
2045 -- the folded value is wrong.
2048 and then Num_Concats
>= Num_Concats_Threshold
2051 Empty_String_Val
: String_Id
;
2054 Strlit_Concat_Val
: String_Id
;
2055 -- Contains the folded value (which will be correct if the
2056 -- "&" operators are the predefined ones).
2059 -- For walking up the tree
2062 -- Folded node to replace Node1
2064 Loc
: constant Source_Ptr
:= Sloc
(First_Node
);
2067 -- Walk up the tree starting at the leftmost string literal
2068 -- (First_Node), building up the Strlit_Concat_Val as we
2069 -- go. Note that we do not use recursion here -- the whole
2070 -- point is to avoid recursively walking that enormous tree.
2073 Store_String_Chars
(Strval
(First_Node
));
2075 Cur_Node
:= Parent
(First_Node
);
2076 while Present
(Cur_Node
) loop
2077 pragma Assert
(Nkind
(Cur_Node
) = N_Op_Concat
and then
2078 Nkind
(Right_Opnd
(Cur_Node
)) = N_String_Literal
);
2080 Store_String_Chars
(Strval
(Right_Opnd
(Cur_Node
)));
2081 Cur_Node
:= Parent
(Cur_Node
);
2084 Strlit_Concat_Val
:= End_String
;
2086 -- Create new folded node, and rewrite result with a concat-
2087 -- enation of an empty string literal and the folded node.
2090 Empty_String_Val
:= End_String
;
2092 Make_Op_Concat
(Loc
,
2093 Make_String_Literal
(Loc
, Empty_String_Val
),
2094 Make_String_Literal
(Loc
, Strlit_Concat_Val
,
2095 Is_Folded_In_Parser
=> True));
2096 Rewrite
(Node1
, New_Node
);
2101 -- All done, we clearly do not have name or numeric literal so this
2102 -- is a case of a simple expression which is some other possibility.
2104 Expr_Form
:= EF_Simple
;
2107 -- Come here at end of simple expression, where we do a couple of
2108 -- special checks to improve error recovery.
2110 -- Special test to improve error recovery. If the current token
2111 -- is a period, then someone is trying to do selection on something
2112 -- that is not a name, e.g. a qualified expression.
2114 if Token
= Tok_Dot
then
2115 Error_Msg_SC
("prefix for selection is not a name");
2117 -- If qualified expression, comment and continue, otherwise something
2118 -- is pretty nasty so do an Error_Resync call.
2120 if Ada_Version
< Ada_2012
2121 and then Nkind
(Node1
) = N_Qualified_Expression
2123 Error_Msg_SC
("\would be legal in Ada 2012 mode");
2129 -- Special test to improve error recovery: If the current token is
2130 -- not the first token on a line (as determined by checking the
2131 -- previous token position with the start of the current line),
2132 -- then we insist that we have an appropriate terminating token.
2133 -- Consider the following two examples:
2135 -- 1) if A nad B then ...
2140 -- In the first example, we would like to issue a binary operator
2141 -- expected message and resynchronize to the then. In the second
2142 -- example, we do not want to issue a binary operator message, so
2143 -- that instead we will get the missing semicolon message. This
2144 -- distinction is of course a heuristic which does not always work,
2145 -- but in practice it is quite effective.
2147 -- Note: the one case in which we do not go through this circuit is
2148 -- when we have scanned a range attribute and want to return with
2149 -- Token pointing to the apostrophe. The apostrophe is not normally
2150 -- an expression terminator, and is not in Token_Class_Sterm, but
2151 -- in this special case we know that the expression is complete.
2153 if not Token_Is_At_Start_Of_Line
2154 and then Token
not in Token_Class_Sterm
2156 -- Normally the right error message is indeed that we expected a
2157 -- binary operator, but in the case of being between a right and left
2158 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2160 if Prev_Token
= Tok_Right_Paren
and then Token
= Tok_Left_Paren
then
2163 Error_Msg_AP
("binary operator expected");
2172 -- If any error occurs, then scan to next expression terminator symbol
2173 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2174 -- level. Expr_Form is set to indicate a normal simple expression.
2177 when Error_Resync
=>
2179 Expr_Form
:= EF_Simple
;
2181 end P_Simple_Expression
;
2183 -----------------------------------------------
2184 -- 4.4 Simple Expression or Range Attribute --
2185 -----------------------------------------------
2187 -- SIMPLE_EXPRESSION ::=
2188 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2190 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2192 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2194 -- Error recovery: cannot raise Error_Resync
2196 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
2198 Attr_Node
: Node_Id
;
2201 -- We don't just want to roar ahead and call P_Simple_Expression
2202 -- here, since we want to handle the case of a parenthesized range
2203 -- attribute cleanly.
2205 if Token
= Tok_Left_Paren
then
2207 Lptr
: constant Source_Ptr
:= Token_Ptr
;
2208 Scan_State
: Saved_Scan_State
;
2211 Save_Scan_State
(Scan_State
);
2212 Scan
; -- past left paren
2213 Sexpr
:= P_Simple_Expression
;
2215 if Token
= Tok_Apostrophe
then
2216 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2217 Expr_Form
:= EF_Range_Attr
;
2219 if Token
= Tok_Right_Paren
then
2220 Scan
; -- scan past right paren if present
2223 Error_Msg
("parentheses not allowed for range attribute", Lptr
);
2228 Restore_Scan_State
(Scan_State
);
2232 -- Here after dealing with parenthesized range attribute
2234 Sexpr
:= P_Simple_Expression
;
2236 if Token
= Tok_Apostrophe
then
2237 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2238 Expr_Form
:= EF_Range_Attr
;
2244 end P_Simple_Expression_Or_Range_Attribute
;
2250 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2252 -- Error recovery: can raise Error_Resync
2254 function P_Term
return Node_Id
is
2255 Node1
, Node2
: Node_Id
;
2256 Tokptr
: Source_Ptr
;
2262 exit when Token
not in Token_Class_Mulop
;
2263 Tokptr
:= Token_Ptr
;
2264 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2265 Scan
; -- past operator
2266 Set_Left_Opnd
(Node2
, Node1
);
2267 Set_Right_Opnd
(Node2
, P_Factor
);
2278 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2280 -- Error recovery: can raise Error_Resync
2282 function P_Factor
return Node_Id
is
2287 if Token
= Tok_Abs
then
2288 Node1
:= New_Op_Node
(N_Op_Abs
, Token_Ptr
);
2291 Style
.Check_Abs_Not
;
2295 Set_Right_Opnd
(Node1
, P_Primary
);
2298 elsif Token
= Tok_Not
then
2299 Node1
:= New_Op_Node
(N_Op_Not
, Token_Ptr
);
2302 Style
.Check_Abs_Not
;
2306 Set_Right_Opnd
(Node1
, P_Primary
);
2312 if Token
= Tok_Double_Asterisk
then
2313 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2315 Set_Left_Opnd
(Node2
, Node1
);
2316 Set_Right_Opnd
(Node2
, P_Primary
);
2329 -- NUMERIC_LITERAL | null
2330 -- | STRING_LITERAL | AGGREGATE
2331 -- | NAME | QUALIFIED_EXPRESSION
2332 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2334 -- Error recovery: can raise Error_Resync
2336 function P_Primary
return Node_Id
is
2337 Scan_State
: Saved_Scan_State
;
2341 -- The loop runs more than once only if misplaced pragmas are found
2346 -- Name token can start a name, call or qualified expression, all
2347 -- of which are acceptable possibilities for primary. Note also
2348 -- that string literal is included in name (as operator symbol)
2349 -- and type conversion is included in name (as indexed component).
2351 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier
=>
2354 -- All done unless apostrophe follows
2356 if Token
/= Tok_Apostrophe
then
2359 -- Apostrophe following means that we have either just parsed
2360 -- the subtype mark of a qualified expression, or the prefix
2361 -- or a range attribute.
2363 else -- Token = Tok_Apostrophe
2364 Save_Scan_State
(Scan_State
); -- at apostrophe
2365 Scan
; -- past apostrophe
2367 -- If range attribute, then this is always an error, since
2368 -- the only legitimate case (where the scanned expression is
2369 -- a qualified simple name) is handled at the level of the
2370 -- Simple_Expression processing. This case corresponds to a
2371 -- usage such as 3 + A'Range, which is always illegal.
2373 if Token
= Tok_Range
then
2374 Restore_Scan_State
(Scan_State
); -- to apostrophe
2375 Bad_Range_Attribute
(Token_Ptr
);
2378 -- If left paren, then we have a qualified expression.
2379 -- Note that P_Name guarantees that in this case, where
2380 -- Token = Tok_Apostrophe on return, the only two possible
2381 -- tokens following the apostrophe are left paren and
2382 -- RANGE, so we know we have a left paren here.
2384 else -- Token = Tok_Left_Paren
2385 return P_Qualified_Expression
(Node1
);
2390 -- Numeric or string literal
2392 when Tok_Integer_Literal |
2394 Tok_String_Literal
=>
2396 Node1
:= Token_Node
;
2397 Scan
; -- past number
2400 -- Left paren, starts aggregate or parenthesized expression
2402 when Tok_Left_Paren
=>
2404 Expr
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
2407 if Nkind
(Expr
) = N_Attribute_Reference
2408 and then Attribute_Name
(Expr
) = Name_Range
2410 Bad_Range_Attribute
(Sloc
(Expr
));
2425 return New_Node
(N_Null
, Prev_Token_Ptr
);
2427 -- Pragma, not allowed here, so just skip past it
2430 P_Pragmas_Misplaced
;
2432 -- Deal with IF (possible unparenthesized conditional expression)
2436 -- If this looks like a real if, defined as an IF appearing at
2437 -- the start of a new line, then we consider we have a missing
2440 if Token_Is_At_Start_Of_Line
then
2441 Error_Msg_AP
("missing operand");
2444 -- If this looks like a conditional expression, then treat it
2445 -- that way with an error message.
2447 elsif Ada_Version
>= Ada_2012
then
2449 ("conditional expression must be parenthesized");
2450 return P_Conditional_Expression
;
2452 -- Otherwise treat as misused identifier
2455 return P_Identifier
;
2458 -- Deal with CASE (possible unparenthesized case expression)
2462 -- If this looks like a real case, defined as a CASE appearing
2463 -- the start of a new line, then we consider we have a missing
2466 if Token_Is_At_Start_Of_Line
then
2467 Error_Msg_AP
("missing operand");
2470 -- If this looks like a case expression, then treat it that way
2471 -- with an error message.
2473 elsif Ada_Version
>= Ada_2012
then
2474 Error_Msg_SC
("case expression must be parenthesized");
2475 return P_Case_Expression
;
2477 -- Otherwise treat as misused identifier
2480 return P_Identifier
;
2483 -- For [all | some] indicates a quantified expression
2487 if Token_Is_At_Start_Of_Line
then
2488 Error_Msg_AP
("misplaced loop");
2491 elsif Ada_Version
>= Ada_2012
then
2492 Error_Msg_SC
("quantified expression must be parenthesized");
2493 return P_Quantified_Expression
;
2497 -- Otherwise treat as misused identifier
2499 return P_Identifier
;
2502 -- Anything else is illegal as the first token of a primary, but
2503 -- we test for a reserved identifier so that it is treated nicely
2506 if Is_Reserved_Identifier
then
2507 return P_Identifier
;
2509 elsif Prev_Token
= Tok_Comma
then
2510 Error_Msg_SP
-- CODEFIX
2511 ("|extra "","" ignored");
2515 Error_Msg_AP
("missing operand");
2523 -------------------------------
2524 -- 4.4 Quantified_Expression --
2525 -------------------------------
2527 -- QUANTIFIED_EXPRESSION ::=
2528 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2529 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2531 function P_Quantified_Expression
return Node_Id
is
2538 Node1
:= New_Node
(N_Quantified_Expression
, Prev_Token_Ptr
);
2540 if Token
= Tok_All
then
2541 Set_All_Present
(Node1
);
2543 -- We treat Some as a non-reserved keyword, so it appears to the scanner
2544 -- as an identifier. If Some is made into a reserved word, the check
2545 -- below is against Tok_Some.
2547 elsif Token
/= Tok_Identifier
2548 or else Chars
(Token_Node
) /= Name_Some
2550 Error_Msg_AP
("missing quantifier");
2555 I_Spec
:= P_Loop_Parameter_Specification
;
2557 if Nkind
(I_Spec
) = N_Loop_Parameter_Specification
then
2558 Set_Loop_Parameter_Specification
(Node1
, I_Spec
);
2560 Set_Iterator_Specification
(Node1
, I_Spec
);
2563 if Token
= Tok_Arrow
then
2565 Set_Condition
(Node1
, P_Expression
);
2568 Error_Msg_AP
("missing arrow");
2571 end P_Quantified_Expression
;
2573 ---------------------------
2574 -- 4.5 Logical Operator --
2575 ---------------------------
2577 -- LOGICAL_OPERATOR ::= and | or | xor
2579 -- Note: AND THEN and OR ELSE are also treated as logical operators
2580 -- by the parser (even though they are not operators semantically)
2582 -- The value returned is the appropriate Node_Kind code for the operator
2583 -- On return, Token points to the token following the scanned operator.
2585 -- The caller has checked that the first token is a legitimate logical
2586 -- operator token (i.e. is either XOR, AND, OR).
2588 -- Error recovery: cannot raise Error_Resync
2590 function P_Logical_Operator
return Node_Kind
is
2592 if Token
= Tok_And
then
2594 Style
.Check_Binary_Operator
;
2599 if Token
= Tok_Then
then
2606 elsif Token
= Tok_Or
then
2608 Style
.Check_Binary_Operator
;
2613 if Token
= Tok_Else
then
2620 else -- Token = Tok_Xor
2622 Style
.Check_Binary_Operator
;
2628 end P_Logical_Operator
;
2630 ------------------------------
2631 -- 4.5 Relational Operator --
2632 ------------------------------
2634 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2636 -- The value returned is the appropriate Node_Kind code for the operator.
2637 -- On return, Token points to the operator token, NOT past it.
2639 -- The caller has checked that the first token is a legitimate relational
2640 -- operator token (i.e. is one of the operator tokens listed above).
2642 -- Error recovery: cannot raise Error_Resync
2644 function P_Relational_Operator
return Node_Kind
is
2645 Op_Kind
: Node_Kind
;
2646 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
2647 (Tok_Less
=> N_Op_Lt
,
2648 Tok_Equal
=> N_Op_Eq
,
2649 Tok_Greater
=> N_Op_Gt
,
2650 Tok_Not_Equal
=> N_Op_Ne
,
2651 Tok_Greater_Equal
=> N_Op_Ge
,
2652 Tok_Less_Equal
=> N_Op_Le
,
2654 Tok_Not
=> N_Not_In
,
2655 Tok_Box
=> N_Op_Ne
);
2658 if Token
= Tok_Box
then
2659 Error_Msg_SC
-- CODEFIX
2660 ("|""'<'>"" should be ""/=""");
2663 Op_Kind
:= Relop_Node
(Token
);
2666 Style
.Check_Binary_Operator
;
2669 Scan
; -- past operator token
2671 if Prev_Token
= Tok_Not
then
2676 end P_Relational_Operator
;
2678 ---------------------------------
2679 -- 4.5 Binary Adding Operator --
2680 ---------------------------------
2682 -- BINARY_ADDING_OPERATOR ::= + | - | &
2684 -- The value returned is the appropriate Node_Kind code for the operator.
2685 -- On return, Token points to the operator token (NOT past it).
2687 -- The caller has checked that the first token is a legitimate adding
2688 -- operator token (i.e. is one of the operator tokens listed above).
2690 -- Error recovery: cannot raise Error_Resync
2692 function P_Binary_Adding_Operator
return Node_Kind
is
2693 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
2694 (Tok_Ampersand
=> N_Op_Concat
,
2695 Tok_Minus
=> N_Op_Subtract
,
2696 Tok_Plus
=> N_Op_Add
);
2698 return Addop_Node
(Token
);
2699 end P_Binary_Adding_Operator
;
2701 --------------------------------
2702 -- 4.5 Unary Adding Operator --
2703 --------------------------------
2705 -- UNARY_ADDING_OPERATOR ::= + | -
2707 -- The value returned is the appropriate Node_Kind code for the operator.
2708 -- On return, Token points to the operator token (NOT past it).
2710 -- The caller has checked that the first token is a legitimate adding
2711 -- operator token (i.e. is one of the operator tokens listed above).
2713 -- Error recovery: cannot raise Error_Resync
2715 function P_Unary_Adding_Operator
return Node_Kind
is
2716 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
2717 (Tok_Minus
=> N_Op_Minus
,
2718 Tok_Plus
=> N_Op_Plus
);
2720 return Addop_Node
(Token
);
2721 end P_Unary_Adding_Operator
;
2723 -------------------------------
2724 -- 4.5 Multiplying Operator --
2725 -------------------------------
2727 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2729 -- The value returned is the appropriate Node_Kind code for the operator.
2730 -- On return, Token points to the operator token (NOT past it).
2732 -- The caller has checked that the first token is a legitimate multiplying
2733 -- operator token (i.e. is one of the operator tokens listed above).
2735 -- Error recovery: cannot raise Error_Resync
2737 function P_Multiplying_Operator
return Node_Kind
is
2738 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
2739 (Tok_Asterisk
=> N_Op_Multiply
,
2740 Tok_Mod
=> N_Op_Mod
,
2741 Tok_Rem
=> N_Op_Rem
,
2742 Tok_Slash
=> N_Op_Divide
);
2744 return Mulop_Node
(Token
);
2745 end P_Multiplying_Operator
;
2747 --------------------------------------
2748 -- 4.5 Highest Precedence Operator --
2749 --------------------------------------
2751 -- Parsed by P_Factor (4.4)
2753 -- Note: this rule is not in fact used by the grammar at any point!
2755 --------------------------
2756 -- 4.6 Type Conversion --
2757 --------------------------
2759 -- Parsed by P_Primary as a Name (4.1)
2761 -------------------------------
2762 -- 4.7 Qualified Expression --
2763 -------------------------------
2765 -- QUALIFIED_EXPRESSION ::=
2766 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2768 -- The caller has scanned the name which is the Subtype_Mark parameter
2769 -- and scanned past the single quote following the subtype mark. The
2770 -- caller has not checked that this name is in fact appropriate for
2771 -- a subtype mark name (i.e. it is a selected component or identifier).
2773 -- Error_Recovery: cannot raise Error_Resync
2775 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
2776 Qual_Node
: Node_Id
;
2778 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
2779 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
2780 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
2782 end P_Qualified_Expression
;
2784 --------------------
2786 --------------------
2789 -- new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2791 -- The caller has checked that the initial token is NEW
2793 -- Error recovery: can raise Error_Resync
2795 function P_Allocator
return Node_Id
is
2796 Alloc_Node
: Node_Id
;
2797 Type_Node
: Node_Id
;
2798 Null_Exclusion_Present
: Boolean;
2801 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
2804 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2806 Null_Exclusion_Present
:= P_Null_Exclusion
;
2807 Set_Null_Exclusion_Present
(Alloc_Node
, Null_Exclusion_Present
);
2808 Type_Node
:= P_Subtype_Mark_Resync
;
2810 if Token
= Tok_Apostrophe
then
2811 Scan
; -- past apostrophe
2812 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
2816 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));
2822 -----------------------
2823 -- P_Case_Expression --
2824 -----------------------
2826 function P_Case_Expression
return Node_Id
is
2827 Loc
: constant Source_Ptr
:= Token_Ptr
;
2828 Case_Node
: Node_Id
;
2829 Save_State
: Saved_Scan_State
;
2832 if Ada_Version
< Ada_2012
then
2833 Error_Msg_SC
("|case expression is an Ada 2012 feature");
2834 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
2839 Make_Case_Expression
(Loc
,
2840 Expression
=> P_Expression_No_Right_Paren
,
2841 Alternatives
=> New_List
);
2844 -- We now have scanned out CASE expression IS, scan alternatives
2848 Append_To
(Alternatives
(Case_Node
), P_Case_Expression_Alternative
);
2850 -- Missing comma if WHEN (more alternatives present)
2852 if Token
= Tok_When
then
2855 -- If comma/WHEN, skip comma and we have another alternative
2857 elsif Token
= Tok_Comma
then
2858 Save_Scan_State
(Save_State
);
2861 if Token
/= Tok_When
then
2862 Restore_Scan_State
(Save_State
);
2866 -- If no comma or WHEN, definitely done
2873 -- If we have an END CASE, diagnose as not needed
2875 if Token
= Tok_End
then
2876 Error_Msg_SC
("`END CASE` not allowed at end of case expression");
2879 if Token
= Tok_Case
then
2884 -- Return the Case_Expression node
2887 end P_Case_Expression
;
2889 -----------------------------------
2890 -- P_Case_Expression_Alternative --
2891 -----------------------------------
2893 -- CASE_STATEMENT_ALTERNATIVE ::=
2894 -- when DISCRETE_CHOICE_LIST =>
2897 -- The caller has checked that and scanned past the initial WHEN token
2898 -- Error recovery: can raise Error_Resync
2900 function P_Case_Expression_Alternative
return Node_Id
is
2901 Case_Alt_Node
: Node_Id
;
2903 Case_Alt_Node
:= New_Node
(N_Case_Expression_Alternative
, Token_Ptr
);
2904 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
2906 Set_Expression
(Case_Alt_Node
, P_Expression
);
2907 return Case_Alt_Node
;
2908 end P_Case_Expression_Alternative
;
2910 ------------------------------
2911 -- P_Conditional_Expression --
2912 ------------------------------
2914 function P_Conditional_Expression
return Node_Id
is
2915 Exprs
: constant List_Id
:= New_List
;
2916 Loc
: constant Source_Ptr
:= Token_Ptr
;
2918 State
: Saved_Scan_State
;
2921 Inside_Conditional_Expression
:= Inside_Conditional_Expression
+ 1;
2923 if Token
= Tok_If
and then Ada_Version
< Ada_2012
then
2924 Error_Msg_SC
("|conditional expression is an Ada 2012 feature");
2925 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
2928 Scan
; -- past IF or ELSIF
2929 Append_To
(Exprs
, P_Condition
);
2931 Append_To
(Exprs
, P_Expression
);
2933 -- We now have scanned out IF expr THEN expr
2935 -- Check for common error of semicolon before the ELSE
2937 if Token
= Tok_Semicolon
then
2938 Save_Scan_State
(State
);
2939 Scan
; -- past semicolon
2941 if Token
= Tok_Else
or else Token
= Tok_Elsif
then
2942 Error_Msg_SP
-- CODEFIX
2943 ("|extra "";"" ignored");
2946 Restore_Scan_State
(State
);
2950 -- Scan out ELSIF sequence if present
2952 if Token
= Tok_Elsif
then
2953 Expr
:= P_Conditional_Expression
;
2954 Set_Is_Elsif
(Expr
);
2955 Append_To
(Exprs
, Expr
);
2957 -- Scan out ELSE phrase if present
2959 elsif Token
= Tok_Else
then
2961 -- Scan out ELSE expression
2964 Append_To
(Exprs
, P_Expression
);
2966 -- Two expression case (implied True, filled in during semantics)
2972 -- If we have an END IF, diagnose as not needed
2974 if Token
= Tok_End
then
2976 ("`END IF` not allowed at end of conditional expression");
2979 if Token
= Tok_If
then
2984 Inside_Conditional_Expression
:= Inside_Conditional_Expression
- 1;
2986 -- Return the Conditional_Expression node
2989 Make_Conditional_Expression
(Loc
,
2990 Expressions
=> Exprs
);
2991 end P_Conditional_Expression
;
2993 -----------------------
2994 -- P_Membership_Test --
2995 -----------------------
2997 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
2998 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3000 procedure P_Membership_Test
(N
: Node_Id
) is
3001 Alt
: constant Node_Id
:=
3002 P_Range_Or_Subtype_Mark
3003 (Allow_Simple_Expression
=> (Ada_Version
>= Ada_2012
));
3008 if Token
= Tok_Vertical_Bar
then
3009 if Ada_Version
< Ada_2012
then
3010 Error_Msg_SC
("set notation is an Ada 2012 feature");
3011 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
3014 Set_Alternatives
(N
, New_List
(Alt
));
3015 Set_Right_Opnd
(N
, Empty
);
3017 -- Loop to accumulate alternatives
3019 while Token
= Tok_Vertical_Bar
loop
3020 Scan
; -- past vertical bar
3023 P_Range_Or_Subtype_Mark
(Allow_Simple_Expression
=> True));
3029 Set_Right_Opnd
(N
, Alt
);
3030 Set_Alternatives
(N
, No_List
);
3032 end P_Membership_Test
;