1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 pragma Style_Checks
(All_Checks
);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
30 with Stringt
; use Stringt
;
35 -- Attributes that cannot have arguments
37 Is_Parameterless_Attribute
: constant Attribute_Class_Array
:=
38 (Attribute_Base
=> True,
39 Attribute_Body_Version
=> True,
40 Attribute_Class
=> True,
41 Attribute_External_Tag
=> True,
42 Attribute_Img
=> True,
43 Attribute_Stub_Type
=> True,
44 Attribute_Version
=> True,
45 Attribute_Type_Key
=> True,
47 -- This map contains True for parameterless attributes that return a
48 -- string or a type. For those attributes, a left parenthesis after
49 -- the attribute should not be analyzed as the beginning of a parameters
50 -- list because it may denote a slice operation (X'Img (1 .. 2)) or
51 -- a type conversion (X'Class (Y)).
53 -- Note that this map designates the minimum set of attributes where a
54 -- construct in parentheses that is not an argument can appear right
55 -- after the attribute. For attributes like 'Size, we do not put them
56 -- in the map. If someone writes X'Size (3), that's illegal in any case,
57 -- but we get a better error message by parsing the (3) as an illegal
58 -- argument to the attribute, rather than some meaningless junk that
59 -- follows the attribute.
61 -----------------------
62 -- Local Subprograms --
63 -----------------------
65 function P_Aggregate_Or_Paren_Expr
return Node_Id
;
66 function P_Allocator
return Node_Id
;
67 function P_Case_Expression_Alternative
return Node_Id
;
68 function P_Record_Or_Array_Component_Association
return Node_Id
;
69 function P_Factor
return Node_Id
;
70 function P_Primary
return Node_Id
;
71 function P_Relation
return Node_Id
;
72 function P_Term
return Node_Id
;
74 function P_Binary_Adding_Operator
return Node_Kind
;
75 function P_Logical_Operator
return Node_Kind
;
76 function P_Multiplying_Operator
return Node_Kind
;
77 function P_Relational_Operator
return Node_Kind
;
78 function P_Unary_Adding_Operator
return Node_Kind
;
80 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
);
81 -- Called to place complaint about bad range attribute at the given
82 -- source location. Terminates by raising Error_Resync.
84 procedure 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 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
;
95 -- This function is called with Token pointing to IF, CASE, or FOR, in a
96 -- context that allows a case, conditional, or quantified expression if
97 -- it is surrounded by parentheses. If not surrounded by parentheses, the
98 -- expression is still returned, but an error message is issued.
100 -------------------------
101 -- Bad_Range_Attribute --
102 -------------------------
104 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
106 Error_Msg
("range attribute cannot be used in expression!", Loc
);
108 end Bad_Range_Attribute
;
110 --------------------------
111 -- 4.1 Name (also 6.4) --
112 --------------------------
115 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
116 -- | INDEXED_COMPONENT | SLICE
117 -- | SELECTED_COMPONENT | ATTRIBUTE
118 -- | TYPE_CONVERSION | FUNCTION_CALL
119 -- | CHARACTER_LITERAL
121 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
123 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
125 -- EXPLICIT_DEREFERENCE ::= NAME . all
127 -- IMPLICIT_DEREFERENCE ::= NAME
129 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
131 -- SLICE ::= PREFIX (DISCRETE_RANGE)
133 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
135 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
137 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
139 -- ATTRIBUTE_DESIGNATOR ::=
140 -- IDENTIFIER [(static_EXPRESSION)]
141 -- | access | delta | digits
145 -- | function_PREFIX ACTUAL_PARAMETER_PART
147 -- ACTUAL_PARAMETER_PART ::=
148 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
150 -- PARAMETER_ASSOCIATION ::=
151 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
153 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
155 -- Note: syntactically a procedure call looks just like a function call,
156 -- so this routine is in practice used to scan out procedure calls as well.
158 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
160 -- Error recovery: can raise Error_Resync
162 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
163 -- followed by either a left paren (qualified expression case), or by
164 -- range (range attribute case). All other uses of apostrophe (i.e. all
165 -- other attributes) are handled in this routine.
167 -- Error recovery: can raise Error_Resync
169 function P_Name
return Node_Id
is
170 Scan_State
: Saved_Scan_State
;
172 Prefix_Node
: Node_Id
;
173 Ident_Node
: Node_Id
;
175 Range_Node
: Node_Id
;
178 Arg_List
: List_Id
:= No_List
; -- kill junk warning
179 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
182 -- Case of not a name
184 if Token
not in Token_Class_Name
then
186 -- If it looks like start of expression, complain and scan expression
188 if Token
in Token_Class_Literal
189 or else Token
= Tok_Left_Paren
191 Error_Msg_SC
("name expected");
194 -- Otherwise some other junk, not much we can do
197 Error_Msg_AP
("name expected");
202 -- Loop through designators in qualified name
204 Name_Node
:= Token_Node
;
207 Scan
; -- past designator
208 exit when Token
/= Tok_Dot
;
209 Save_Scan_State
(Scan_State
); -- at dot
212 -- If we do not have another designator after the dot, then join
213 -- the normal circuit to handle a dot extension (may be .all or
214 -- character literal case). Otherwise loop back to scan the next
217 if Token
not in Token_Class_Desig
then
218 goto Scan_Name_Extension_Dot
;
220 Prefix_Node
:= Name_Node
;
221 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
222 Set_Prefix
(Name_Node
, Prefix_Node
);
223 Set_Selector_Name
(Name_Node
, Token_Node
);
227 -- We have now scanned out a qualified designator. If the last token is
228 -- an operator symbol, then we certainly do not have the Snam case, so
229 -- we can just use the normal name extension check circuit
231 if Prev_Token
= Tok_Operator_Symbol
then
232 goto Scan_Name_Extension
;
235 -- We have scanned out a qualified simple name, check for name extension
236 -- Note that we know there is no dot here at this stage, so the only
237 -- possible cases of name extension are apostrophe and left paren.
239 if Token
= Tok_Apostrophe
then
240 Save_Scan_State
(Scan_State
); -- at apostrophe
241 Scan
; -- past apostrophe
243 -- Qualified expression in Ada 2012 mode (treated as a name)
245 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
246 goto Scan_Name_Extension_Apostrophe
;
248 -- If left paren not in Ada 2012, then it is not part of the name,
249 -- since qualified expressions are not names in prior versions of
250 -- Ada, so return with Token backed up to point to the apostrophe.
251 -- The treatment for the range attribute is similar (we do not
252 -- consider x'range to be a name in this grammar).
254 elsif Token
= Tok_Left_Paren
or else Token
= Tok_Range
then
255 Restore_Scan_State
(Scan_State
); -- to apostrophe
256 Expr_Form
:= EF_Simple_Name
;
259 -- Otherwise we have the case of a name extended by an attribute
262 goto Scan_Name_Extension_Apostrophe
;
265 -- Check case of qualified simple name extended by a left parenthesis
267 elsif Token
= Tok_Left_Paren
then
268 Scan
; -- past left paren
269 goto Scan_Name_Extension_Left_Paren
;
271 -- Otherwise the qualified simple name is not extended, so return
274 Expr_Form
:= EF_Simple_Name
;
278 -- Loop scanning past name extensions. A label is used for control
279 -- transfer for this loop for ease of interfacing with the finite state
280 -- machine in the parenthesis scanning circuit, and also to allow for
281 -- passing in control to the appropriate point from the above code.
283 <<Scan_Name_Extension
>>
285 -- Character literal used as name cannot be extended. Also this
286 -- cannot be a call, since the name for a call must be a designator.
287 -- Return in these cases, or if there is no name extension
289 if Token
not in Token_Class_Namext
290 or else Prev_Token
= Tok_Char_Literal
292 Expr_Form
:= EF_Name
;
296 -- Merge here when we know there is a name extension
298 <<Scan_Name_Extension_OK
>>
300 if Token
= Tok_Left_Paren
then
301 Scan
; -- past left paren
302 goto Scan_Name_Extension_Left_Paren
;
304 elsif Token
= Tok_Apostrophe
then
305 Save_Scan_State
(Scan_State
); -- at apostrophe
306 Scan
; -- past apostrophe
307 goto Scan_Name_Extension_Apostrophe
;
309 else -- Token = Tok_Dot
310 Save_Scan_State
(Scan_State
); -- at dot
312 goto Scan_Name_Extension_Dot
;
315 -- Case of name extended by dot (selection), dot is already skipped
316 -- and the scan state at the point of the dot is saved in Scan_State.
318 <<Scan_Name_Extension_Dot
>>
320 -- Explicit dereference case
322 if Token
= Tok_All
then
323 Prefix_Node
:= Name_Node
;
324 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
325 Set_Prefix
(Name_Node
, Prefix_Node
);
327 goto Scan_Name_Extension
;
329 -- Selected component case
331 elsif Token
in Token_Class_Name
then
332 Prefix_Node
:= Name_Node
;
333 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
334 Set_Prefix
(Name_Node
, Prefix_Node
);
335 Set_Selector_Name
(Name_Node
, Token_Node
);
336 Scan
; -- past selector
337 goto Scan_Name_Extension
;
339 -- Reserved identifier as selector
341 elsif Is_Reserved_Identifier
then
342 Scan_Reserved_Identifier
(Force_Msg
=> False);
343 Prefix_Node
:= Name_Node
;
344 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
345 Set_Prefix
(Name_Node
, Prefix_Node
);
346 Set_Selector_Name
(Name_Node
, Token_Node
);
347 Scan
; -- past identifier used as selector
348 goto Scan_Name_Extension
;
350 -- If dot is at end of line and followed by nothing legal,
351 -- then assume end of name and quit (dot will be taken as
352 -- an erroneous form of some other punctuation by our caller).
354 elsif Token_Is_At_Start_Of_Line
then
355 Restore_Scan_State
(Scan_State
);
358 -- Here if nothing legal after the dot
361 Error_Msg_AP
("selector expected");
365 -- Here for an apostrophe as name extension. The scan position at the
366 -- apostrophe has already been saved, and the apostrophe scanned out.
368 <<Scan_Name_Extension_Apostrophe
>>
370 Scan_Apostrophe
: declare
371 function Apostrophe_Should_Be_Semicolon
return Boolean;
372 -- Checks for case where apostrophe should probably be
373 -- a semicolon, and if so, gives appropriate message,
374 -- resets the scan pointer to the apostrophe, changes
375 -- the current token to Tok_Semicolon, and returns True.
376 -- Otherwise returns False.
378 ------------------------------------
379 -- Apostrophe_Should_Be_Semicolon --
380 ------------------------------------
382 function Apostrophe_Should_Be_Semicolon
return Boolean is
384 if Token_Is_At_Start_Of_Line
then
385 Restore_Scan_State
(Scan_State
); -- to apostrophe
386 Error_Msg_SC
("|""''"" should be "";""");
387 Token
:= Tok_Semicolon
;
392 end Apostrophe_Should_Be_Semicolon
;
394 -- Start of processing for Scan_Apostrophe
397 -- Check for qualified expression case in Ada 2012 mode
399 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
400 Name_Node
:= P_Qualified_Expression
(Name_Node
);
401 goto Scan_Name_Extension
;
403 -- If range attribute after apostrophe, then return with Token
404 -- pointing to the apostrophe. Note that in this case the prefix
405 -- need not be a simple name (cases like A.all'range). Similarly
406 -- if there is a left paren after the apostrophe, then we also
407 -- return with Token pointing to the apostrophe (this is the
408 -- aggregate case, or some error case).
410 elsif Token
= Tok_Range
or else Token
= Tok_Left_Paren
then
411 Restore_Scan_State
(Scan_State
); -- to apostrophe
412 Expr_Form
:= EF_Name
;
415 -- Here for cases where attribute designator is an identifier
417 elsif Token
= Tok_Identifier
then
418 Attr_Name
:= Token_Name
;
420 if not Is_Attribute_Name
(Attr_Name
) then
421 if Apostrophe_Should_Be_Semicolon
then
422 Expr_Form
:= EF_Name
;
425 -- Here for a bad attribute name
428 Signal_Bad_Attribute
;
429 Scan
; -- past bad identifier
431 if Token
= Tok_Left_Paren
then
432 Scan
; -- past left paren
435 Discard_Junk_Node
(P_Expression_If_OK
);
436 exit when not Comma_Present
;
447 Style
.Check_Attribute_Name
(False);
450 -- Here for case of attribute designator is not an identifier
453 if Token
= Tok_Delta
then
454 Attr_Name
:= Name_Delta
;
456 elsif Token
= Tok_Digits
then
457 Attr_Name
:= Name_Digits
;
459 elsif Token
= Tok_Access
then
460 Attr_Name
:= Name_Access
;
462 elsif Token
= Tok_Mod
and then Ada_Version
>= Ada_95
then
463 Attr_Name
:= Name_Mod
;
465 elsif Apostrophe_Should_Be_Semicolon
then
466 Expr_Form
:= EF_Name
;
470 Error_Msg_AP
("attribute designator expected");
475 Style
.Check_Attribute_Name
(True);
479 -- We come here with an OK attribute scanned, and corresponding
480 -- Attribute identifier node stored in Ident_Node.
482 Prefix_Node
:= Name_Node
;
483 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
484 Scan
; -- past attribute designator
485 Set_Prefix
(Name_Node
, Prefix_Node
);
486 Set_Attribute_Name
(Name_Node
, Attr_Name
);
488 -- Scan attribute arguments/designator. We skip this if we know
489 -- that the attribute cannot have an argument.
491 if Token
= Tok_Left_Paren
493 Is_Parameterless_Attribute
(Get_Attribute_Id
(Attr_Name
))
495 Set_Expressions
(Name_Node
, New_List
);
496 Scan
; -- past left paren
500 Expr
: constant Node_Id
:= P_Expression_If_OK
;
503 if Token
= Tok_Arrow
then
505 ("named parameters not permitted for attributes");
506 Scan
; -- past junk arrow
509 Append
(Expr
, Expressions
(Name_Node
));
510 exit when not Comma_Present
;
518 goto Scan_Name_Extension
;
521 -- Here for left parenthesis extending name (left paren skipped)
523 <<Scan_Name_Extension_Left_Paren
>>
525 -- We now have to scan through a list of items, terminated by a
526 -- right parenthesis. The scan is handled by a finite state
527 -- machine. The possibilities are:
531 -- This is a slice. This case is handled in LP_State_Init
533 -- (expression, expression, ..)
535 -- This is interpreted as an indexed component, i.e. as a
536 -- case of a name which can be extended in the normal manner.
537 -- This case is handled by LP_State_Name or LP_State_Expr.
539 -- Note: conditional expressions (without an extra level of
540 -- parentheses) are permitted in this context).
542 -- (..., identifier => expression , ...)
544 -- If there is at least one occurrence of identifier => (but
545 -- none of the other cases apply), then we have a call.
547 -- Test for Id => case
549 if Token
= Tok_Identifier
then
550 Save_Scan_State
(Scan_State
); -- at Id
553 -- Test for => (allow := as an error substitute)
555 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
556 Restore_Scan_State
(Scan_State
); -- to Id
557 Arg_List
:= New_List
;
561 Restore_Scan_State
(Scan_State
); -- to Id
565 -- Here we have an expression after all
567 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
569 -- Check cases of discrete range for a slice
571 -- First possibility: Range_Attribute_Reference
573 if Expr_Form
= EF_Range_Attr
then
574 Range_Node
:= Expr_Node
;
576 -- Second possibility: Simple_expression .. Simple_expression
578 elsif Token
= Tok_Dot_Dot
then
579 Check_Simple_Expression
(Expr_Node
);
580 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
581 Set_Low_Bound
(Range_Node
, Expr_Node
);
583 Expr_Node
:= P_Expression
;
584 Check_Simple_Expression
(Expr_Node
);
585 Set_High_Bound
(Range_Node
, Expr_Node
);
587 -- Third possibility: Type_name range Range
589 elsif Token
= Tok_Range
then
590 if Expr_Form
/= EF_Simple_Name
then
591 Error_Msg_SC
("subtype mark must precede RANGE");
595 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
597 -- Otherwise we just have an expression. It is true that we might
598 -- have a subtype mark without a range constraint but this case
599 -- is syntactically indistinguishable from the expression case.
602 Arg_List
:= New_List
;
606 -- Fall through here with unmistakable Discrete range scanned,
607 -- which means that we definitely have the case of a slice. The
608 -- Discrete range is in Range_Node.
610 if Token
= Tok_Comma
then
611 Error_Msg_SC
("slice cannot have more than one dimension");
614 elsif Token
/= Tok_Right_Paren
then
615 if Token
= Tok_Arrow
then
617 -- This may be an aggregate that is missing a qualification
620 ("context of aggregate must be a qualified expression");
629 Scan
; -- past right paren
630 Prefix_Node
:= Name_Node
;
631 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
632 Set_Prefix
(Name_Node
, Prefix_Node
);
633 Set_Discrete_Range
(Name_Node
, Range_Node
);
635 -- An operator node is legal as a prefix to other names,
636 -- but not for a slice.
638 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
639 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
642 -- If we have a name extension, go scan it
644 if Token
in Token_Class_Namext
then
645 goto Scan_Name_Extension_OK
;
647 -- Otherwise return (a slice is a name, but is not a call)
650 Expr_Form
:= EF_Name
;
655 -- In LP_State_Expr, we have scanned one or more expressions, and
656 -- so we have a call or an indexed component which is a name. On
657 -- entry we have the expression just scanned in Expr_Node and
658 -- Arg_List contains the list of expressions encountered so far
661 Append
(Expr_Node
, Arg_List
);
663 if Token
= Tok_Arrow
then
665 ("expect identifier in parameter association",
669 elsif not Comma_Present
then
671 Prefix_Node
:= Name_Node
;
672 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
673 Set_Prefix
(Name_Node
, Prefix_Node
);
674 Set_Expressions
(Name_Node
, Arg_List
);
675 goto Scan_Name_Extension
;
678 -- Comma present (and scanned out), test for identifier => case
679 -- Test for identifier => case
681 if Token
= Tok_Identifier
then
682 Save_Scan_State
(Scan_State
); -- at Id
685 -- Test for => (allow := as error substitute)
687 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
688 Restore_Scan_State
(Scan_State
); -- to Id
691 -- Otherwise it's just an expression after all, so backup
694 Restore_Scan_State
(Scan_State
); -- to Id
698 -- Here we have an expression after all, so stay in this state
700 Expr_Node
:= P_Expression_If_OK
;
703 -- LP_State_Call corresponds to the situation in which at least
704 -- one instance of Id => Expression has been encountered, so we
705 -- know that we do not have a name, but rather a call. We enter
706 -- it with the scan pointer pointing to the next argument to scan,
707 -- and Arg_List containing the list of arguments scanned so far.
711 -- Test for case of Id => Expression (named parameter)
713 if Token
= Tok_Identifier
then
714 Save_Scan_State
(Scan_State
); -- at Id
715 Ident_Node
:= Token_Node
;
718 -- Deal with => (allow := as erroneous substitute)
720 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
721 Arg_Node
:= New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
722 Set_Selector_Name
(Arg_Node
, Ident_Node
);
724 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
725 Append
(Arg_Node
, Arg_List
);
727 -- If a comma follows, go back and scan next entry
729 if Comma_Present
then
732 -- Otherwise we have the end of a call
735 Prefix_Node
:= Name_Node
;
736 Name_Node
:= New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
737 Set_Name
(Name_Node
, Prefix_Node
);
738 Set_Parameter_Associations
(Name_Node
, Arg_List
);
741 if Token
in Token_Class_Namext
then
742 goto Scan_Name_Extension_OK
;
744 -- This is a case of a call which cannot be a name
747 Expr_Form
:= EF_Name
;
752 -- Not named parameter: Id started an expression after all
755 Restore_Scan_State
(Scan_State
); -- to Id
759 -- Here if entry did not start with Id => which means that it
760 -- is a positional parameter, which is not allowed, since we
761 -- have seen at least one named parameter already.
764 ("positional parameter association " &
765 "not allowed after named one");
767 Expr_Node
:= P_Expression_If_OK
;
769 -- Leaving the '>' in an association is not unusual, so suggest
772 if Nkind
(Expr_Node
) = N_Op_Eq
then
773 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
776 -- We go back to scanning out expressions, so that we do not get
777 -- multiple error messages when several positional parameters
778 -- follow a named parameter.
782 -- End of treatment for name extensions starting with left paren
784 -- End of loop through name extensions
788 -- This function parses a restricted form of Names which are either
789 -- designators, or designators preceded by a sequence of prefixes
790 -- that are direct names.
792 -- Error recovery: cannot raise Error_Resync
794 function P_Function_Name
return Node_Id
is
795 Designator_Node
: Node_Id
;
796 Prefix_Node
: Node_Id
;
797 Selector_Node
: Node_Id
;
798 Dot_Sloc
: Source_Ptr
:= No_Location
;
801 -- Prefix_Node is set to the gathered prefix so far, Empty means that
802 -- no prefix has been scanned. This allows us to build up the result
803 -- in the required right recursive manner.
805 Prefix_Node
:= Empty
;
807 -- Loop through prefixes
810 Designator_Node
:= Token_Node
;
812 if Token
not in Token_Class_Desig
then
813 return P_Identifier
; -- let P_Identifier issue the error message
815 else -- Token in Token_Class_Desig
816 Scan
; -- past designator
817 exit when Token
/= Tok_Dot
;
820 -- Here at a dot, with token just before it in Designator_Node
822 if No
(Prefix_Node
) then
823 Prefix_Node
:= Designator_Node
;
825 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
826 Set_Prefix
(Selector_Node
, Prefix_Node
);
827 Set_Selector_Name
(Selector_Node
, Designator_Node
);
828 Prefix_Node
:= Selector_Node
;
831 Dot_Sloc
:= Token_Ptr
;
835 -- Fall out of the loop having just scanned a designator
837 if No
(Prefix_Node
) then
838 return Designator_Node
;
840 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
841 Set_Prefix
(Selector_Node
, Prefix_Node
);
842 Set_Selector_Name
(Selector_Node
, Designator_Node
);
843 return Selector_Node
;
851 -- This function parses a restricted form of Names which are either
852 -- identifiers, or identifiers preceded by a sequence of prefixes
853 -- that are direct names.
855 -- Error recovery: cannot raise Error_Resync
857 function P_Qualified_Simple_Name
return Node_Id
is
858 Designator_Node
: Node_Id
;
859 Prefix_Node
: Node_Id
;
860 Selector_Node
: Node_Id
;
861 Dot_Sloc
: Source_Ptr
:= No_Location
;
864 -- Prefix node is set to the gathered prefix so far, Empty means that
865 -- no prefix has been scanned. This allows us to build up the result
866 -- in the required right recursive manner.
868 Prefix_Node
:= Empty
;
870 -- Loop through prefixes
873 Designator_Node
:= Token_Node
;
875 if Token
= Tok_Identifier
then
876 Scan
; -- past identifier
877 exit when Token
/= Tok_Dot
;
879 elsif Token
not in Token_Class_Desig
then
880 return P_Identifier
; -- let P_Identifier issue the error message
883 Scan
; -- past designator
885 if Token
/= Tok_Dot
then
886 Error_Msg_SP
("identifier expected");
891 -- Here at a dot, with token just before it in Designator_Node
893 if No
(Prefix_Node
) then
894 Prefix_Node
:= Designator_Node
;
896 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
897 Set_Prefix
(Selector_Node
, Prefix_Node
);
898 Set_Selector_Name
(Selector_Node
, Designator_Node
);
899 Prefix_Node
:= Selector_Node
;
902 Dot_Sloc
:= Token_Ptr
;
906 -- Fall out of the loop having just scanned an identifier
908 if No
(Prefix_Node
) then
909 return Designator_Node
;
911 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
912 Set_Prefix
(Selector_Node
, Prefix_Node
);
913 Set_Selector_Name
(Selector_Node
, Designator_Node
);
914 return Selector_Node
;
920 end P_Qualified_Simple_Name
;
922 -- This procedure differs from P_Qualified_Simple_Name only in that it
923 -- raises Error_Resync if any error is encountered. It only returns after
924 -- scanning a valid qualified simple name.
926 -- Error recovery: can raise Error_Resync
928 function P_Qualified_Simple_Name_Resync
return Node_Id
is
929 Designator_Node
: Node_Id
;
930 Prefix_Node
: Node_Id
;
931 Selector_Node
: Node_Id
;
932 Dot_Sloc
: Source_Ptr
:= No_Location
;
935 Prefix_Node
:= Empty
;
937 -- Loop through prefixes
940 Designator_Node
:= Token_Node
;
942 if Token
= Tok_Identifier
then
943 Scan
; -- past identifier
944 exit when Token
/= Tok_Dot
;
946 elsif Token
not in Token_Class_Desig
then
947 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
951 Scan
; -- past designator
953 if Token
/= Tok_Dot
then
954 Error_Msg_SP
("identifier expected");
959 -- Here at a dot, with token just before it in Designator_Node
961 if No
(Prefix_Node
) then
962 Prefix_Node
:= Designator_Node
;
964 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
965 Set_Prefix
(Selector_Node
, Prefix_Node
);
966 Set_Selector_Name
(Selector_Node
, Designator_Node
);
967 Prefix_Node
:= Selector_Node
;
970 Dot_Sloc
:= Token_Ptr
;
974 -- Fall out of the loop having just scanned an identifier
976 if No
(Prefix_Node
) then
977 return Designator_Node
;
979 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
980 Set_Prefix
(Selector_Node
, Prefix_Node
);
981 Set_Selector_Name
(Selector_Node
, Designator_Node
);
982 return Selector_Node
;
984 end P_Qualified_Simple_Name_Resync
;
986 ----------------------
987 -- 4.1 Direct_Name --
988 ----------------------
990 -- Parsed by P_Name and other functions in section 4.1
996 -- Parsed by P_Name (4.1)
998 -------------------------------
999 -- 4.1 Explicit Dereference --
1000 -------------------------------
1002 -- Parsed by P_Name (4.1)
1004 -------------------------------
1005 -- 4.1 Implicit_Dereference --
1006 -------------------------------
1008 -- Parsed by P_Name (4.1)
1010 ----------------------------
1011 -- 4.1 Indexed Component --
1012 ----------------------------
1014 -- Parsed by P_Name (4.1)
1020 -- Parsed by P_Name (4.1)
1022 -----------------------------
1023 -- 4.1 Selected_Component --
1024 -----------------------------
1026 -- Parsed by P_Name (4.1)
1028 ------------------------
1029 -- 4.1 Selector Name --
1030 ------------------------
1032 -- Parsed by P_Name (4.1)
1034 ------------------------------
1035 -- 4.1 Attribute Reference --
1036 ------------------------------
1038 -- Parsed by P_Name (4.1)
1040 -------------------------------
1041 -- 4.1 Attribute Designator --
1042 -------------------------------
1044 -- Parsed by P_Name (4.1)
1046 --------------------------------------
1047 -- 4.1.4 Range Attribute Reference --
1048 --------------------------------------
1050 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1052 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1054 -- In the grammar, a RANGE attribute is simply a name, but its use is
1055 -- highly restricted, so in the parser, we do not regard it as a name.
1056 -- Instead, P_Name returns without scanning the 'RANGE part of the
1057 -- attribute, and the caller uses the following function to construct
1058 -- a range attribute in places where it is appropriate.
1060 -- Note that RANGE here is treated essentially as an identifier,
1061 -- rather than a reserved word.
1063 -- The caller has parsed the prefix, i.e. a name, and Token points to
1064 -- the apostrophe. The token after the apostrophe is known to be RANGE
1065 -- at this point. The prefix node becomes the prefix of the attribute.
1067 -- Error_Recovery: Cannot raise Error_Resync
1069 function P_Range_Attribute_Reference
1070 (Prefix_Node
: Node_Id
)
1073 Attr_Node
: Node_Id
;
1076 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1077 Set_Prefix
(Attr_Node
, Prefix_Node
);
1078 Scan
; -- past apostrophe
1081 Style
.Check_Attribute_Name
(True);
1084 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1087 if Token
= Tok_Left_Paren
then
1088 Scan
; -- past left paren
1089 Set_Expressions
(Attr_Node
, New_List
(P_Expression_If_OK
));
1094 end P_Range_Attribute_Reference
;
1096 ---------------------------------------
1097 -- 4.1.4 Range Attribute Designator --
1098 ---------------------------------------
1100 -- Parsed by P_Range_Attribute_Reference (4.4)
1102 --------------------
1104 --------------------
1106 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1108 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1109 -- an aggregate is known to be required (code statement, extension
1110 -- aggregate), in which cases this routine performs the necessary check
1111 -- that we have an aggregate rather than a parenthesized expression
1113 -- Error recovery: can raise Error_Resync
1115 function P_Aggregate
return Node_Id
is
1116 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1117 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1120 if Nkind
(Aggr_Node
) /= N_Aggregate
1122 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1125 ("aggregate may not have single positional component", Aggr_Sloc
);
1132 ------------------------------------------------
1133 -- 4.3 Aggregate or Parenthesized Expression --
1134 ------------------------------------------------
1136 -- This procedure parses out either an aggregate or a parenthesized
1137 -- expression (these two constructs are closely related, since a
1138 -- parenthesized expression looks like an aggregate with a single
1139 -- positional component).
1142 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1144 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1146 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1147 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1150 -- RECORD_COMPONENT_ASSOCIATION ::=
1151 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1153 -- COMPONENT_CHOICE_LIST ::=
1154 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1157 -- EXTENSION_AGGREGATE ::=
1158 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1160 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1162 -- ARRAY_AGGREGATE ::=
1163 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1165 -- POSITIONAL_ARRAY_AGGREGATE ::=
1166 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1167 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1168 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1170 -- NAMED_ARRAY_AGGREGATE ::=
1171 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1173 -- PRIMARY ::= (EXPRESSION);
1175 -- Error recovery: can raise Error_Resync
1177 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1178 -- to Ada 2005 limited aggregates (AI-287)
1180 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1181 Aggregate_Node
: Node_Id
;
1182 Expr_List
: List_Id
;
1183 Assoc_List
: List_Id
;
1184 Expr_Node
: Node_Id
;
1185 Lparen_Sloc
: Source_Ptr
;
1186 Scan_State
: Saved_Scan_State
;
1188 procedure Box_Error
;
1189 -- Called if <> is encountered as positional aggregate element. Issues
1190 -- error message and sets Expr_Node to Error.
1196 procedure Box_Error
is
1198 if Ada_Version
< Ada_2005
then
1199 Error_Msg_SC
("box in aggregate is an Ada 2005 extension");
1202 -- Ada 2005 (AI-287): The box notation is allowed only with named
1203 -- notation because positional notation might be error prone. For
1204 -- example, in "(X, <>, Y, <>)", there is no type associated with
1205 -- the boxes, so you might not be leaving out the components you
1206 -- thought you were leaving out.
1208 Error_Msg_SC
("(Ada 2005) box only allowed with named notation");
1213 -- Start of processing for P_Aggregate_Or_Paren_Expr
1216 Lparen_Sloc
:= Token_Ptr
;
1219 -- Conditional expression case
1221 if Token
= Tok_If
then
1222 Expr_Node
:= P_Conditional_Expression
;
1226 -- Case expression case
1228 elsif Token
= Tok_Case
then
1229 Expr_Node
:= P_Case_Expression
;
1233 -- Quantified expression case
1235 elsif Token
= Tok_For
then
1236 Expr_Node
:= P_Quantified_Expression
;
1240 -- Note: the mechanism used here of rescanning the initial expression
1241 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1242 -- out the discrete choice list.
1244 -- Deal with expression and extension aggregate cases first
1246 elsif Token
/= Tok_Others
then
1247 Save_Scan_State
(Scan_State
); -- at start of expression
1249 -- Deal with (NULL RECORD) case
1251 if Token
= Tok_Null
then
1254 if Token
= Tok_Record
then
1255 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1256 Set_Null_Record_Present
(Aggregate_Node
, True);
1257 Scan
; -- past RECORD
1259 return Aggregate_Node
;
1261 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1265 -- Scan expression, handling box appearing as positional argument
1267 if Token
= Tok_Box
then
1270 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1273 -- Extension aggregate case
1275 if Token
= Tok_With
then
1276 if Nkind
(Expr_Node
) = N_Attribute_Reference
1277 and then Attribute_Name
(Expr_Node
) = Name_Range
1279 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1283 if Ada_Version
= Ada_83
then
1284 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1287 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1288 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1291 -- Deal with WITH NULL RECORD case
1293 if Token
= Tok_Null
then
1294 Save_Scan_State
(Scan_State
); -- at NULL
1297 if Token
= Tok_Record
then
1298 Scan
; -- past RECORD
1299 Set_Null_Record_Present
(Aggregate_Node
, True);
1301 return Aggregate_Node
;
1304 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1308 if Token
/= Tok_Others
then
1309 Save_Scan_State
(Scan_State
);
1310 Expr_Node
:= P_Expression
;
1317 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1318 if Nkind
(Expr_Node
) = N_Attribute_Reference
1319 and then Attribute_Name
(Expr_Node
) = Name_Range
1322 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
1323 Scan
; -- past right paren
1327 -- Bump paren count of expression
1329 if Expr_Node
/= Error
then
1330 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1333 T_Right_Paren
; -- past right paren (error message if none)
1336 -- Normal aggregate case
1339 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1345 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1349 -- Prepare to scan list of component associations
1351 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1352 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1354 -- This loop scans through component associations. On entry to the
1355 -- loop, an expression has been scanned at the start of the current
1356 -- association unless initial token was OTHERS, in which case
1357 -- Expr_Node is set to Empty.
1360 -- Deal with others association first. This is a named association
1362 if No
(Expr_Node
) then
1363 if No
(Assoc_List
) then
1364 Assoc_List
:= New_List
;
1367 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1369 -- Improper use of WITH
1371 elsif Token
= Tok_With
then
1372 Error_Msg_SC
("WITH must be preceded by single expression in " &
1373 "extension aggregate");
1376 -- Range attribute can only appear as part of a discrete choice list
1378 elsif Nkind
(Expr_Node
) = N_Attribute_Reference
1379 and then Attribute_Name
(Expr_Node
) = Name_Range
1380 and then Token
/= Tok_Arrow
1381 and then Token
/= Tok_Vertical_Bar
1383 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1386 -- Assume positional case if comma, right paren, or literal or
1387 -- identifier or OTHERS follows (the latter cases are missing
1388 -- comma cases). Also assume positional if a semicolon follows,
1389 -- which can happen if there are missing parens
1391 elsif Token
= Tok_Comma
1392 or else Token
= Tok_Right_Paren
1393 or else Token
= Tok_Others
1394 or else Token
in Token_Class_Lit_Or_Name
1395 or else Token
= Tok_Semicolon
1397 if Present
(Assoc_List
) then
1398 Error_Msg_BC
-- CODEFIX
1399 ("""='>"" expected (positional association cannot follow " &
1400 "named association)");
1403 if No
(Expr_List
) then
1404 Expr_List
:= New_List
;
1407 Append
(Expr_Node
, Expr_List
);
1409 -- Check for aggregate followed by left parent, maybe missing comma
1411 elsif Nkind
(Expr_Node
) = N_Aggregate
1412 and then Token
= Tok_Left_Paren
1416 if No
(Expr_List
) then
1417 Expr_List
:= New_List
;
1420 Append
(Expr_Node
, Expr_List
);
1422 -- Anything else is assumed to be a named association
1425 Restore_Scan_State
(Scan_State
); -- to start of expression
1427 if No
(Assoc_List
) then
1428 Assoc_List
:= New_List
;
1431 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1434 exit when not Comma_Present
;
1436 -- If we are at an expression terminator, something is seriously
1437 -- wrong, so let's get out now, before we start eating up stuff
1438 -- that doesn't belong to us!
1440 if Token
in Token_Class_Eterm
then
1442 ("expecting expression or component association");
1446 -- Deal with misused box
1448 if Token
= Tok_Box
then
1451 -- Otherwise initiate for reentry to top of loop by scanning an
1452 -- initial expression, unless the first token is OTHERS.
1454 elsif Token
= Tok_Others
then
1458 Save_Scan_State
(Scan_State
); -- at start of expression
1459 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1464 -- All component associations (positional and named) have been scanned
1467 Set_Expressions
(Aggregate_Node
, Expr_List
);
1468 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1469 return Aggregate_Node
;
1470 end P_Aggregate_Or_Paren_Expr
;
1472 ------------------------------------------------
1473 -- 4.3 Record or Array Component Association --
1474 ------------------------------------------------
1476 -- RECORD_COMPONENT_ASSOCIATION ::=
1477 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1478 -- | COMPONENT_CHOICE_LIST => <>
1480 -- COMPONENT_CHOICE_LIST =>
1481 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1484 -- ARRAY_COMPONENT_ASSOCIATION ::=
1485 -- DISCRETE_CHOICE_LIST => EXPRESSION
1486 -- | DISCRETE_CHOICE_LIST => <>
1488 -- Note: this routine only handles the named cases, including others.
1489 -- Cases where the component choice list is not present have already
1490 -- been handled directly.
1492 -- Error recovery: can raise Error_Resync
1494 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1495 -- rules have been extended to give support to Ada 2005 limited
1496 -- aggregates (AI-287)
1498 function P_Record_Or_Array_Component_Association
return Node_Id
is
1499 Assoc_Node
: Node_Id
;
1502 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1503 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1504 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1507 if Token
= Tok_Box
then
1509 -- Ada 2005(AI-287): The box notation is used to indicate the
1510 -- default initialization of aggregate components
1512 if Ada_Version
< Ada_2005
then
1514 ("component association with '<'> is an Ada 2005 extension");
1515 Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
1518 Set_Box_Present
(Assoc_Node
);
1521 Set_Expression
(Assoc_Node
, P_Expression
);
1525 end P_Record_Or_Array_Component_Association
;
1527 -----------------------------
1528 -- 4.3.1 Record Aggregate --
1529 -----------------------------
1531 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1532 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1534 ----------------------------------------------
1535 -- 4.3.1 Record Component Association List --
1536 ----------------------------------------------
1538 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1540 ----------------------------------
1541 -- 4.3.1 Component Choice List --
1542 ----------------------------------
1544 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1546 --------------------------------
1547 -- 4.3.1 Extension Aggregate --
1548 --------------------------------
1550 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1552 --------------------------
1553 -- 4.3.1 Ancestor Part --
1554 --------------------------
1556 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1558 ----------------------------
1559 -- 4.3.1 Array Aggregate --
1560 ----------------------------
1562 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1564 ---------------------------------------
1565 -- 4.3.1 Positional Array Aggregate --
1566 ---------------------------------------
1568 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1570 ----------------------------------
1571 -- 4.3.1 Named Array Aggregate --
1572 ----------------------------------
1574 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1576 ----------------------------------------
1577 -- 4.3.1 Array Component Association --
1578 ----------------------------------------
1580 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1582 ---------------------
1583 -- 4.4 Expression --
1584 ---------------------
1586 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1589 -- RELATION {LOGICAL_OPERATOR RELATION}
1591 -- CHOICE_EXPRESSION ::=
1592 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1594 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1596 -- On return, Expr_Form indicates the categorization of the expression
1597 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1598 -- an error message is given, and Error is returned).
1600 -- Error recovery: cannot raise Error_Resync
1602 function P_Expression
return Node_Id
is
1603 Logical_Op
: Node_Kind
;
1604 Prev_Logical_Op
: Node_Kind
;
1605 Op_Location
: Source_Ptr
;
1610 Node1
:= P_Relation
;
1612 if Token
in Token_Class_Logop
then
1613 Prev_Logical_Op
:= N_Empty
;
1616 Op_Location
:= Token_Ptr
;
1617 Logical_Op
:= P_Logical_Operator
;
1619 if Prev_Logical_Op
/= N_Empty
and then
1620 Logical_Op
/= Prev_Logical_Op
1623 ("mixed logical operators in expression", Op_Location
);
1624 Prev_Logical_Op
:= N_Empty
;
1626 Prev_Logical_Op
:= Logical_Op
;
1630 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1631 Set_Left_Opnd
(Node1
, Node2
);
1632 Set_Right_Opnd
(Node1
, P_Relation
);
1633 exit when Token
not in Token_Class_Logop
;
1636 Expr_Form
:= EF_Non_Simple
;
1639 if Token
= Tok_Apostrophe
then
1640 Bad_Range_Attribute
(Token_Ptr
);
1647 -- This function is identical to the normal P_Expression, except that it
1648 -- also permits the appearance of a case, conditional, or quantified
1649 -- expression if the call immediately follows a left paren, and followed
1650 -- by a right parenthesis. These forms are allowed if these conditions
1651 -- are not met, but an error message will be issued.
1653 function P_Expression_If_OK
return Node_Id
is
1655 -- Case of conditional, case or quantified expression
1657 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1658 return P_Unparen_Cond_Case_Quant_Expression
;
1660 -- Normal case, not case/conditional/quantified expression
1663 return P_Expression
;
1665 end P_Expression_If_OK
;
1667 -- This function is identical to the normal P_Expression, except that it
1668 -- checks that the expression scan did not stop on a right paren. It is
1669 -- called in all contexts where a right parenthesis cannot legitimately
1670 -- follow an expression.
1672 -- Error recovery: can not raise Error_Resync
1674 function P_Expression_No_Right_Paren
return Node_Id
is
1675 Expr
: constant Node_Id
:= P_Expression
;
1677 Ignore
(Tok_Right_Paren
);
1679 end P_Expression_No_Right_Paren
;
1681 ----------------------------------------
1682 -- 4.4 Expression_Or_Range_Attribute --
1683 ----------------------------------------
1686 -- RELATION {and RELATION} | RELATION {and then RELATION}
1687 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1688 -- | RELATION {xor RELATION}
1690 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1692 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1694 -- On return, Expr_Form indicates the categorization of the expression
1695 -- and EF_Range_Attr is one of the possibilities.
1697 -- Error recovery: cannot raise Error_Resync
1699 -- In the grammar, a RANGE attribute is simply a name, but its use is
1700 -- highly restricted, so in the parser, we do not regard it as a name.
1701 -- Instead, P_Name returns without scanning the 'RANGE part of the
1702 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1703 -- attribute reference. In the normal case where a range attribute is
1704 -- not allowed, an error message is issued by P_Expression.
1706 function P_Expression_Or_Range_Attribute
return Node_Id
is
1707 Logical_Op
: Node_Kind
;
1708 Prev_Logical_Op
: Node_Kind
;
1709 Op_Location
: Source_Ptr
;
1712 Attr_Node
: Node_Id
;
1715 Node1
:= P_Relation
;
1717 if Token
= Tok_Apostrophe
then
1718 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
1719 Expr_Form
:= EF_Range_Attr
;
1722 elsif Token
in Token_Class_Logop
then
1723 Prev_Logical_Op
:= N_Empty
;
1726 Op_Location
:= Token_Ptr
;
1727 Logical_Op
:= P_Logical_Operator
;
1729 if Prev_Logical_Op
/= N_Empty
and then
1730 Logical_Op
/= Prev_Logical_Op
1733 ("mixed logical operators in expression", Op_Location
);
1734 Prev_Logical_Op
:= N_Empty
;
1736 Prev_Logical_Op
:= Logical_Op
;
1740 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1741 Set_Left_Opnd
(Node1
, Node2
);
1742 Set_Right_Opnd
(Node1
, P_Relation
);
1743 exit when Token
not in Token_Class_Logop
;
1746 Expr_Form
:= EF_Non_Simple
;
1749 if Token
= Tok_Apostrophe
then
1750 Bad_Range_Attribute
(Token_Ptr
);
1755 end P_Expression_Or_Range_Attribute
;
1757 -- Version that allows a non-parenthesized case, conditional, or quantified
1758 -- expression if the call immediately follows a left paren, and followed
1759 -- by a right parenthesis. These forms are allowed if these conditions
1760 -- are not met, but an error message will be issued.
1762 function P_Expression_Or_Range_Attribute_If_OK
return Node_Id
is
1764 -- Case of conditional, case or quantified expression
1766 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1767 return P_Unparen_Cond_Case_Quant_Expression
;
1769 -- Normal case, not one of the above expression types
1772 return P_Expression_Or_Range_Attribute
;
1774 end P_Expression_Or_Range_Attribute_If_OK
;
1780 -- This procedure scans both relations and choice relations
1782 -- CHOICE_RELATION ::=
1783 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1786 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
1788 -- MEMBERSHIP_CHOICE_LIST ::=
1789 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
1791 -- MEMBERSHIP_CHOICE ::=
1792 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
1794 -- On return, Expr_Form indicates the categorization of the expression
1796 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1797 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1799 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1800 -- expression, then tokens are scanned until either a non-expression token,
1801 -- a right paren (not matched by a left paren) or a comma, is encountered.
1803 function P_Relation
return Node_Id
is
1804 Node1
, Node2
: Node_Id
;
1808 Node1
:= P_Simple_Expression
;
1810 if Token
not in Token_Class_Relop
then
1814 -- Here we have a relational operator following. If so then scan it
1815 -- out. Note that the assignment symbol := is treated as a relational
1816 -- operator to improve the error recovery when it is misused for =.
1817 -- P_Relational_Operator also parses the IN and NOT IN operations.
1820 Node2
:= New_Op_Node
(P_Relational_Operator
, Optok
);
1821 Set_Left_Opnd
(Node2
, Node1
);
1823 -- Case of IN or NOT IN
1825 if Prev_Token
= Tok_In
then
1826 P_Membership_Test
(Node2
);
1828 -- Case of relational operator (= /= < <= > >=)
1831 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
1834 Expr_Form
:= EF_Non_Simple
;
1836 if Token
in Token_Class_Relop
then
1837 Error_Msg_SC
("unexpected relational operator");
1844 -- If any error occurs, then scan to the next expression terminator symbol
1845 -- or comma or right paren at the outer (i.e. current) parentheses level.
1846 -- The flags are set to indicate a normal simple expression.
1849 when Error_Resync
=>
1851 Expr_Form
:= EF_Simple
;
1855 ----------------------------
1856 -- 4.4 Simple Expression --
1857 ----------------------------
1859 -- SIMPLE_EXPRESSION ::=
1860 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1862 -- On return, Expr_Form indicates the categorization of the expression
1864 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1865 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1867 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1868 -- expression, then tokens are scanned until either a non-expression token,
1869 -- a right paren (not matched by a left paren) or a comma, is encountered.
1871 -- Note: P_Simple_Expression is called only internally by higher level
1872 -- expression routines. In cases in the grammar where a simple expression
1873 -- is required, the approach is to scan an expression, and then post an
1874 -- appropriate error message if the expression obtained is not simple. This
1875 -- gives better error recovery and treatment.
1877 function P_Simple_Expression
return Node_Id
is
1878 Scan_State
: Saved_Scan_State
;
1881 Tokptr
: Source_Ptr
;
1884 -- Check for cases starting with a name. There are two reasons for
1885 -- special casing. First speed things up by catching a common case
1886 -- without going through several routine layers. Second the caller must
1887 -- be informed via Expr_Form when the simple expression is a name.
1889 if Token
in Token_Class_Name
then
1892 -- Deal with apostrophe cases
1894 if Token
= Tok_Apostrophe
then
1895 Save_Scan_State
(Scan_State
); -- at apostrophe
1896 Scan
; -- past apostrophe
1898 -- If qualified expression, scan it out and fall through
1900 if Token
= Tok_Left_Paren
then
1901 Node1
:= P_Qualified_Expression
(Node1
);
1902 Expr_Form
:= EF_Simple
;
1904 -- If range attribute, then we return with Token pointing to the
1905 -- apostrophe. Note: avoid the normal error check on exit. We
1906 -- know that the expression really is complete in this case!
1908 else -- Token = Tok_Range then
1909 Restore_Scan_State
(Scan_State
); -- to apostrophe
1910 Expr_Form
:= EF_Simple_Name
;
1915 -- If an expression terminator follows, the previous processing
1916 -- completely scanned out the expression (a common case), and
1917 -- left Expr_Form set appropriately for returning to our caller.
1919 if Token
in Token_Class_Sterm
then
1922 -- If we do not have an expression terminator, then complete the
1923 -- scan of a simple expression. This code duplicates the code
1924 -- found in P_Term and P_Factor.
1927 if Token
= Tok_Double_Asterisk
then
1929 Style
.Check_Exponentiation_Operator
;
1932 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
1934 Set_Left_Opnd
(Node2
, Node1
);
1935 Set_Right_Opnd
(Node2
, P_Primary
);
1940 exit when Token
not in Token_Class_Mulop
;
1941 Tokptr
:= Token_Ptr
;
1942 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
1945 Style
.Check_Binary_Operator
;
1948 Scan
; -- past operator
1949 Set_Left_Opnd
(Node2
, Node1
);
1950 Set_Right_Opnd
(Node2
, P_Factor
);
1955 exit when Token
not in Token_Class_Binary_Addop
;
1956 Tokptr
:= Token_Ptr
;
1957 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
1960 Style
.Check_Binary_Operator
;
1963 Scan
; -- past operator
1964 Set_Left_Opnd
(Node2
, Node1
);
1965 Set_Right_Opnd
(Node2
, P_Term
);
1969 Expr_Form
:= EF_Simple
;
1972 -- Cases where simple expression does not start with a name
1975 -- Scan initial sign and initial Term
1977 if Token
in Token_Class_Unary_Addop
then
1978 Tokptr
:= Token_Ptr
;
1979 Node1
:= New_Op_Node
(P_Unary_Adding_Operator
, Tokptr
);
1982 Style
.Check_Unary_Plus_Or_Minus
;
1985 Scan
; -- past operator
1986 Set_Right_Opnd
(Node1
, P_Term
);
1991 -- In the following, we special-case a sequence of concatenations of
1992 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
1993 -- else mixed in. For such a sequence, we return a tree representing
1994 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
1995 -- the number of concatenations is large. If semantic analysis
1996 -- resolves the "&" to a predefined one, then this folding gives the
1997 -- right answer. Otherwise, semantic analysis will complain about a
1998 -- capacity-exceeded error. The purpose of this trick is to avoid
1999 -- creating a deeply nested tree, which would cause deep recursion
2000 -- during semantics, causing stack overflow. This way, we can handle
2001 -- enormous concatenations in the normal case of predefined "&". We
2002 -- first build up the normal tree, and then rewrite it if
2006 Num_Concats_Threshold
: constant Positive := 1000;
2007 -- Arbitrary threshold value to enable optimization
2009 First_Node
: constant Node_Id
:= Node1
;
2010 Is_Strlit_Concat
: Boolean;
2011 -- True iff we've parsed a sequence of concatenations of string
2012 -- literals, with nothing else mixed in.
2014 Num_Concats
: Natural;
2015 -- Number of "&" operators if Is_Strlit_Concat is True
2019 Nkind
(Node1
) = N_String_Literal
2020 and then Token
= Tok_Ampersand
;
2023 -- Scan out sequence of terms separated by binary adding operators
2026 exit when Token
not in Token_Class_Binary_Addop
;
2027 Tokptr
:= Token_Ptr
;
2028 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2029 Scan
; -- past operator
2030 Set_Left_Opnd
(Node2
, Node1
);
2032 Set_Right_Opnd
(Node2
, Node1
);
2034 -- Check if we're still concatenating string literals
2038 and then Nkind
(Node2
) = N_Op_Concat
2039 and then Nkind
(Node1
) = N_String_Literal
;
2041 if Is_Strlit_Concat
then
2042 Num_Concats
:= Num_Concats
+ 1;
2048 -- If we have an enormous series of concatenations of string
2049 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2050 -- flag tells semantic analysis that if the "&" is not predefined,
2051 -- the folded value is wrong.
2054 and then Num_Concats
>= Num_Concats_Threshold
2057 Empty_String_Val
: String_Id
;
2060 Strlit_Concat_Val
: String_Id
;
2061 -- Contains the folded value (which will be correct if the
2062 -- "&" operators are the predefined ones).
2065 -- For walking up the tree
2068 -- Folded node to replace Node1
2070 Loc
: constant Source_Ptr
:= Sloc
(First_Node
);
2073 -- Walk up the tree starting at the leftmost string literal
2074 -- (First_Node), building up the Strlit_Concat_Val as we
2075 -- go. Note that we do not use recursion here -- the whole
2076 -- point is to avoid recursively walking that enormous tree.
2079 Store_String_Chars
(Strval
(First_Node
));
2081 Cur_Node
:= Parent
(First_Node
);
2082 while Present
(Cur_Node
) loop
2083 pragma Assert
(Nkind
(Cur_Node
) = N_Op_Concat
and then
2084 Nkind
(Right_Opnd
(Cur_Node
)) = N_String_Literal
);
2086 Store_String_Chars
(Strval
(Right_Opnd
(Cur_Node
)));
2087 Cur_Node
:= Parent
(Cur_Node
);
2090 Strlit_Concat_Val
:= End_String
;
2092 -- Create new folded node, and rewrite result with a concat-
2093 -- enation of an empty string literal and the folded node.
2096 Empty_String_Val
:= End_String
;
2098 Make_Op_Concat
(Loc
,
2099 Make_String_Literal
(Loc
, Empty_String_Val
),
2100 Make_String_Literal
(Loc
, Strlit_Concat_Val
,
2101 Is_Folded_In_Parser
=> True));
2102 Rewrite
(Node1
, New_Node
);
2107 -- All done, we clearly do not have name or numeric literal so this
2108 -- is a case of a simple expression which is some other possibility.
2110 Expr_Form
:= EF_Simple
;
2113 -- Come here at end of simple expression, where we do a couple of
2114 -- special checks to improve error recovery.
2116 -- Special test to improve error recovery. If the current token
2117 -- is a period, then someone is trying to do selection on something
2118 -- that is not a name, e.g. a qualified expression.
2120 if Token
= Tok_Dot
then
2121 Error_Msg_SC
("prefix for selection is not a name");
2123 -- If qualified expression, comment and continue, otherwise something
2124 -- is pretty nasty so do an Error_Resync call.
2126 if Ada_Version
< Ada_2012
2127 and then Nkind
(Node1
) = N_Qualified_Expression
2129 Error_Msg_SC
("\would be legal in Ada 2012 mode");
2135 -- Special test to improve error recovery: If the current token is
2136 -- not the first token on a line (as determined by checking the
2137 -- previous token position with the start of the current line),
2138 -- then we insist that we have an appropriate terminating token.
2139 -- Consider the following two examples:
2141 -- 1) if A nad B then ...
2146 -- In the first example, we would like to issue a binary operator
2147 -- expected message and resynchronize to the then. In the second
2148 -- example, we do not want to issue a binary operator message, so
2149 -- that instead we will get the missing semicolon message. This
2150 -- distinction is of course a heuristic which does not always work,
2151 -- but in practice it is quite effective.
2153 -- Note: the one case in which we do not go through this circuit is
2154 -- when we have scanned a range attribute and want to return with
2155 -- Token pointing to the apostrophe. The apostrophe is not normally
2156 -- an expression terminator, and is not in Token_Class_Sterm, but
2157 -- in this special case we know that the expression is complete.
2159 if not Token_Is_At_Start_Of_Line
2160 and then Token
not in Token_Class_Sterm
2162 -- Normally the right error message is indeed that we expected a
2163 -- binary operator, but in the case of being between a right and left
2164 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2166 if Prev_Token
= Tok_Right_Paren
and then Token
= Tok_Left_Paren
then
2169 Error_Msg_AP
("binary operator expected");
2178 -- If any error occurs, then scan to next expression terminator symbol
2179 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2180 -- level. Expr_Form is set to indicate a normal simple expression.
2183 when Error_Resync
=>
2185 Expr_Form
:= EF_Simple
;
2187 end P_Simple_Expression
;
2189 -----------------------------------------------
2190 -- 4.4 Simple Expression or Range Attribute --
2191 -----------------------------------------------
2193 -- SIMPLE_EXPRESSION ::=
2194 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2196 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2198 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2200 -- Error recovery: cannot raise Error_Resync
2202 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
2204 Attr_Node
: Node_Id
;
2207 -- We don't just want to roar ahead and call P_Simple_Expression
2208 -- here, since we want to handle the case of a parenthesized range
2209 -- attribute cleanly.
2211 if Token
= Tok_Left_Paren
then
2213 Lptr
: constant Source_Ptr
:= Token_Ptr
;
2214 Scan_State
: Saved_Scan_State
;
2217 Save_Scan_State
(Scan_State
);
2218 Scan
; -- past left paren
2219 Sexpr
:= P_Simple_Expression
;
2221 if Token
= Tok_Apostrophe
then
2222 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2223 Expr_Form
:= EF_Range_Attr
;
2225 if Token
= Tok_Right_Paren
then
2226 Scan
; -- scan past right paren if present
2229 Error_Msg
("parentheses not allowed for range attribute", Lptr
);
2234 Restore_Scan_State
(Scan_State
);
2238 -- Here after dealing with parenthesized range attribute
2240 Sexpr
:= P_Simple_Expression
;
2242 if Token
= Tok_Apostrophe
then
2243 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2244 Expr_Form
:= EF_Range_Attr
;
2250 end P_Simple_Expression_Or_Range_Attribute
;
2256 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2258 -- Error recovery: can raise Error_Resync
2260 function P_Term
return Node_Id
is
2261 Node1
, Node2
: Node_Id
;
2262 Tokptr
: Source_Ptr
;
2268 exit when Token
not in Token_Class_Mulop
;
2269 Tokptr
:= Token_Ptr
;
2270 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2271 Scan
; -- past operator
2272 Set_Left_Opnd
(Node2
, Node1
);
2273 Set_Right_Opnd
(Node2
, P_Factor
);
2284 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2286 -- Error recovery: can raise Error_Resync
2288 function P_Factor
return Node_Id
is
2293 if Token
= Tok_Abs
then
2294 Node1
:= New_Op_Node
(N_Op_Abs
, Token_Ptr
);
2297 Style
.Check_Abs_Not
;
2301 Set_Right_Opnd
(Node1
, P_Primary
);
2304 elsif Token
= Tok_Not
then
2305 Node1
:= New_Op_Node
(N_Op_Not
, Token_Ptr
);
2308 Style
.Check_Abs_Not
;
2312 Set_Right_Opnd
(Node1
, P_Primary
);
2318 if Token
= Tok_Double_Asterisk
then
2319 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2321 Set_Left_Opnd
(Node2
, Node1
);
2322 Set_Right_Opnd
(Node2
, P_Primary
);
2335 -- NUMERIC_LITERAL | null
2336 -- | STRING_LITERAL | AGGREGATE
2337 -- | NAME | QUALIFIED_EXPRESSION
2338 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2340 -- Error recovery: can raise Error_Resync
2342 function P_Primary
return Node_Id
is
2343 Scan_State
: Saved_Scan_State
;
2347 -- The loop runs more than once only if misplaced pragmas are found
2352 -- Name token can start a name, call or qualified expression, all
2353 -- of which are acceptable possibilities for primary. Note also
2354 -- that string literal is included in name (as operator symbol)
2355 -- and type conversion is included in name (as indexed component).
2357 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier
=>
2360 -- All done unless apostrophe follows
2362 if Token
/= Tok_Apostrophe
then
2365 -- Apostrophe following means that we have either just parsed
2366 -- the subtype mark of a qualified expression, or the prefix
2367 -- or a range attribute.
2369 else -- Token = Tok_Apostrophe
2370 Save_Scan_State
(Scan_State
); -- at apostrophe
2371 Scan
; -- past apostrophe
2373 -- If range attribute, then this is always an error, since
2374 -- the only legitimate case (where the scanned expression is
2375 -- a qualified simple name) is handled at the level of the
2376 -- Simple_Expression processing. This case corresponds to a
2377 -- usage such as 3 + A'Range, which is always illegal.
2379 if Token
= Tok_Range
then
2380 Restore_Scan_State
(Scan_State
); -- to apostrophe
2381 Bad_Range_Attribute
(Token_Ptr
);
2384 -- If left paren, then we have a qualified expression.
2385 -- Note that P_Name guarantees that in this case, where
2386 -- Token = Tok_Apostrophe on return, the only two possible
2387 -- tokens following the apostrophe are left paren and
2388 -- RANGE, so we know we have a left paren here.
2390 else -- Token = Tok_Left_Paren
2391 return P_Qualified_Expression
(Node1
);
2396 -- Numeric or string literal
2398 when Tok_Integer_Literal |
2400 Tok_String_Literal
=>
2402 Node1
:= Token_Node
;
2403 Scan
; -- past number
2406 -- Left paren, starts aggregate or parenthesized expression
2408 when Tok_Left_Paren
=>
2410 Expr
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
2413 if Nkind
(Expr
) = N_Attribute_Reference
2414 and then Attribute_Name
(Expr
) = Name_Range
2416 Bad_Range_Attribute
(Sloc
(Expr
));
2431 return New_Node
(N_Null
, Prev_Token_Ptr
);
2433 -- Pragma, not allowed here, so just skip past it
2436 P_Pragmas_Misplaced
;
2438 -- Deal with IF (possible unparenthesized conditional expression)
2442 -- If this looks like a real if, defined as an IF appearing at
2443 -- the start of a new line, then we consider we have a missing
2444 -- operand. If in Ada 2012 and the IF is not properly indented
2445 -- for a statement, we prefer to issue a message about an ill-
2446 -- parenthesized conditional expression.
2448 if Token_Is_At_Start_Of_Line
2450 (Ada_Version
>= Ada_2012
2451 and then Style_Check_Indentation
/= 0
2452 and then Start_Column
rem Style_Check_Indentation
/= 0)
2454 Error_Msg_AP
("missing operand");
2457 -- If this looks like a conditional expression, then treat it
2458 -- that way with an error message.
2460 elsif Ada_Version
>= Ada_2012
then
2462 ("conditional expression must be parenthesized");
2463 return P_Conditional_Expression
;
2465 -- Otherwise treat as misused identifier
2468 return P_Identifier
;
2471 -- Deal with CASE (possible unparenthesized case expression)
2475 -- If this looks like a real case, defined as a CASE appearing
2476 -- the start of a new line, then we consider we have a missing
2477 -- operand. If in Ada 2012 and the CASE is not properly
2478 -- indented for a statement, we prefer to issue a message about
2479 -- an ill-parenthesized case expression.
2481 if Token_Is_At_Start_Of_Line
2483 (Ada_Version
>= Ada_2012
2484 and then Style_Check_Indentation
/= 0
2485 and then Start_Column
rem Style_Check_Indentation
/= 0)
2487 Error_Msg_AP
("missing operand");
2490 -- If this looks like a case expression, then treat it that way
2491 -- with an error message.
2493 elsif Ada_Version
>= Ada_2012
then
2494 Error_Msg_SC
("case expression must be parenthesized");
2495 return P_Case_Expression
;
2497 -- Otherwise treat as misused identifier
2500 return P_Identifier
;
2503 -- For [all | some] indicates a quantified expression
2507 if Token_Is_At_Start_Of_Line
then
2508 Error_Msg_AP
("misplaced loop");
2511 elsif Ada_Version
>= Ada_2012
then
2512 Error_Msg_SC
("quantified expression must be parenthesized");
2513 return P_Quantified_Expression
;
2517 -- Otherwise treat as misused identifier
2519 return P_Identifier
;
2522 -- Anything else is illegal as the first token of a primary, but
2523 -- we test for a reserved identifier so that it is treated nicely
2526 if Is_Reserved_Identifier
then
2527 return P_Identifier
;
2529 elsif Prev_Token
= Tok_Comma
then
2530 Error_Msg_SP
-- CODEFIX
2531 ("|extra "","" ignored");
2535 Error_Msg_AP
("missing operand");
2543 -------------------------------
2544 -- 4.4 Quantified_Expression --
2545 -------------------------------
2547 -- QUANTIFIED_EXPRESSION ::=
2548 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2549 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2551 function P_Quantified_Expression
return Node_Id
is
2558 Node1
:= New_Node
(N_Quantified_Expression
, Prev_Token_Ptr
);
2560 if Token
= Tok_All
then
2561 Set_All_Present
(Node1
);
2563 elsif Token
/= Tok_Some
then
2564 Error_Msg_AP
("missing quantifier");
2569 I_Spec
:= P_Loop_Parameter_Specification
;
2571 if Nkind
(I_Spec
) = N_Loop_Parameter_Specification
then
2572 Set_Loop_Parameter_Specification
(Node1
, I_Spec
);
2574 Set_Iterator_Specification
(Node1
, I_Spec
);
2577 if Token
= Tok_Arrow
then
2579 Set_Condition
(Node1
, P_Expression
);
2582 Error_Msg_AP
("missing arrow");
2585 end P_Quantified_Expression
;
2587 ---------------------------
2588 -- 4.5 Logical Operator --
2589 ---------------------------
2591 -- LOGICAL_OPERATOR ::= and | or | xor
2593 -- Note: AND THEN and OR ELSE are also treated as logical operators
2594 -- by the parser (even though they are not operators semantically)
2596 -- The value returned is the appropriate Node_Kind code for the operator
2597 -- On return, Token points to the token following the scanned operator.
2599 -- The caller has checked that the first token is a legitimate logical
2600 -- operator token (i.e. is either XOR, AND, OR).
2602 -- Error recovery: cannot raise Error_Resync
2604 function P_Logical_Operator
return Node_Kind
is
2606 if Token
= Tok_And
then
2608 Style
.Check_Binary_Operator
;
2613 if Token
= Tok_Then
then
2620 elsif Token
= Tok_Or
then
2622 Style
.Check_Binary_Operator
;
2627 if Token
= Tok_Else
then
2634 else -- Token = Tok_Xor
2636 Style
.Check_Binary_Operator
;
2642 end P_Logical_Operator
;
2644 ------------------------------
2645 -- 4.5 Relational Operator --
2646 ------------------------------
2648 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2650 -- The value returned is the appropriate Node_Kind code for the operator.
2651 -- On return, Token points to the operator token, NOT past it.
2653 -- The caller has checked that the first token is a legitimate relational
2654 -- operator token (i.e. is one of the operator tokens listed above).
2656 -- Error recovery: cannot raise Error_Resync
2658 function P_Relational_Operator
return Node_Kind
is
2659 Op_Kind
: Node_Kind
;
2660 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
2661 (Tok_Less
=> N_Op_Lt
,
2662 Tok_Equal
=> N_Op_Eq
,
2663 Tok_Greater
=> N_Op_Gt
,
2664 Tok_Not_Equal
=> N_Op_Ne
,
2665 Tok_Greater_Equal
=> N_Op_Ge
,
2666 Tok_Less_Equal
=> N_Op_Le
,
2668 Tok_Not
=> N_Not_In
,
2669 Tok_Box
=> N_Op_Ne
);
2672 if Token
= Tok_Box
then
2673 Error_Msg_SC
-- CODEFIX
2674 ("|""'<'>"" should be ""/=""");
2677 Op_Kind
:= Relop_Node
(Token
);
2680 Style
.Check_Binary_Operator
;
2683 Scan
; -- past operator token
2685 if Prev_Token
= Tok_Not
then
2690 end P_Relational_Operator
;
2692 ---------------------------------
2693 -- 4.5 Binary Adding Operator --
2694 ---------------------------------
2696 -- BINARY_ADDING_OPERATOR ::= + | - | &
2698 -- The value returned is the appropriate Node_Kind code for the operator.
2699 -- On return, Token points to the operator token (NOT past it).
2701 -- The caller has checked that the first token is a legitimate adding
2702 -- operator token (i.e. is one of the operator tokens listed above).
2704 -- Error recovery: cannot raise Error_Resync
2706 function P_Binary_Adding_Operator
return Node_Kind
is
2707 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
2708 (Tok_Ampersand
=> N_Op_Concat
,
2709 Tok_Minus
=> N_Op_Subtract
,
2710 Tok_Plus
=> N_Op_Add
);
2712 return Addop_Node
(Token
);
2713 end P_Binary_Adding_Operator
;
2715 --------------------------------
2716 -- 4.5 Unary Adding Operator --
2717 --------------------------------
2719 -- UNARY_ADDING_OPERATOR ::= + | -
2721 -- The value returned is the appropriate Node_Kind code for the operator.
2722 -- On return, Token points to the operator token (NOT past it).
2724 -- The caller has checked that the first token is a legitimate adding
2725 -- operator token (i.e. is one of the operator tokens listed above).
2727 -- Error recovery: cannot raise Error_Resync
2729 function P_Unary_Adding_Operator
return Node_Kind
is
2730 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
2731 (Tok_Minus
=> N_Op_Minus
,
2732 Tok_Plus
=> N_Op_Plus
);
2734 return Addop_Node
(Token
);
2735 end P_Unary_Adding_Operator
;
2737 -------------------------------
2738 -- 4.5 Multiplying Operator --
2739 -------------------------------
2741 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2743 -- The value returned is the appropriate Node_Kind code for the operator.
2744 -- On return, Token points to the operator token (NOT past it).
2746 -- The caller has checked that the first token is a legitimate multiplying
2747 -- operator token (i.e. is one of the operator tokens listed above).
2749 -- Error recovery: cannot raise Error_Resync
2751 function P_Multiplying_Operator
return Node_Kind
is
2752 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
2753 (Tok_Asterisk
=> N_Op_Multiply
,
2754 Tok_Mod
=> N_Op_Mod
,
2755 Tok_Rem
=> N_Op_Rem
,
2756 Tok_Slash
=> N_Op_Divide
);
2758 return Mulop_Node
(Token
);
2759 end P_Multiplying_Operator
;
2761 --------------------------------------
2762 -- 4.5 Highest Precedence Operator --
2763 --------------------------------------
2765 -- Parsed by P_Factor (4.4)
2767 -- Note: this rule is not in fact used by the grammar at any point!
2769 --------------------------
2770 -- 4.6 Type Conversion --
2771 --------------------------
2773 -- Parsed by P_Primary as a Name (4.1)
2775 -------------------------------
2776 -- 4.7 Qualified Expression --
2777 -------------------------------
2779 -- QUALIFIED_EXPRESSION ::=
2780 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2782 -- The caller has scanned the name which is the Subtype_Mark parameter
2783 -- and scanned past the single quote following the subtype mark. The
2784 -- caller has not checked that this name is in fact appropriate for
2785 -- a subtype mark name (i.e. it is a selected component or identifier).
2787 -- Error_Recovery: cannot raise Error_Resync
2789 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
2790 Qual_Node
: Node_Id
;
2792 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
2793 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
2794 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
2796 end P_Qualified_Expression
;
2798 --------------------
2800 --------------------
2803 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
2804 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
2806 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
2808 -- The caller has checked that the initial token is NEW
2810 -- Error recovery: can raise Error_Resync
2812 function P_Allocator
return Node_Id
is
2813 Alloc_Node
: Node_Id
;
2814 Type_Node
: Node_Id
;
2815 Null_Exclusion_Present
: Boolean;
2818 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
2821 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
2823 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2825 if Token
= Tok_Left_Paren
then
2827 Set_Subpool_Handle_Name
(Alloc_Node
, P_Name
);
2830 if Ada_Version
< Ada_2012
then
2832 ("|subpool specification is an Ada 2012 feature",
2833 Subpool_Handle_Name
(Alloc_Node
));
2835 ("\|unit must be compiled with -gnat2012 switch",
2836 Subpool_Handle_Name
(Alloc_Node
));
2840 Null_Exclusion_Present
:= P_Null_Exclusion
;
2841 Set_Null_Exclusion_Present
(Alloc_Node
, Null_Exclusion_Present
);
2842 Type_Node
:= P_Subtype_Mark_Resync
;
2844 if Token
= Tok_Apostrophe
then
2845 Scan
; -- past apostrophe
2846 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
2850 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));
2856 -----------------------
2857 -- P_Case_Expression --
2858 -----------------------
2860 function P_Case_Expression
return Node_Id
is
2861 Loc
: constant Source_Ptr
:= Token_Ptr
;
2862 Case_Node
: Node_Id
;
2863 Save_State
: Saved_Scan_State
;
2866 if Ada_Version
< Ada_2012
then
2867 Error_Msg_SC
("|case expression is an Ada 2012 feature");
2868 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
2873 Make_Case_Expression
(Loc
,
2874 Expression
=> P_Expression_No_Right_Paren
,
2875 Alternatives
=> New_List
);
2878 -- We now have scanned out CASE expression IS, scan alternatives
2882 Append_To
(Alternatives
(Case_Node
), P_Case_Expression_Alternative
);
2884 -- Missing comma if WHEN (more alternatives present)
2886 if Token
= Tok_When
then
2889 -- If comma/WHEN, skip comma and we have another alternative
2891 elsif Token
= Tok_Comma
then
2892 Save_Scan_State
(Save_State
);
2895 if Token
/= Tok_When
then
2896 Restore_Scan_State
(Save_State
);
2900 -- If no comma or WHEN, definitely done
2907 -- If we have an END CASE, diagnose as not needed
2909 if Token
= Tok_End
then
2910 Error_Msg_SC
("`END CASE` not allowed at end of case expression");
2913 if Token
= Tok_Case
then
2918 -- Return the Case_Expression node
2921 end P_Case_Expression
;
2923 -----------------------------------
2924 -- P_Case_Expression_Alternative --
2925 -----------------------------------
2927 -- CASE_STATEMENT_ALTERNATIVE ::=
2928 -- when DISCRETE_CHOICE_LIST =>
2931 -- The caller has checked that and scanned past the initial WHEN token
2932 -- Error recovery: can raise Error_Resync
2934 function P_Case_Expression_Alternative
return Node_Id
is
2935 Case_Alt_Node
: Node_Id
;
2937 Case_Alt_Node
:= New_Node
(N_Case_Expression_Alternative
, Token_Ptr
);
2938 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
2940 Set_Expression
(Case_Alt_Node
, P_Expression
);
2941 return Case_Alt_Node
;
2942 end P_Case_Expression_Alternative
;
2944 ------------------------------
2945 -- P_Conditional_Expression --
2946 ------------------------------
2948 function P_Conditional_Expression
return Node_Id
is
2949 Exprs
: constant List_Id
:= New_List
;
2950 Loc
: constant Source_Ptr
:= Token_Ptr
;
2952 State
: Saved_Scan_State
;
2955 Inside_Conditional_Expression
:= Inside_Conditional_Expression
+ 1;
2957 if Token
= Tok_If
and then Ada_Version
< Ada_2012
then
2958 Error_Msg_SC
("|conditional expression is an Ada 2012 feature");
2959 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
2962 Scan
; -- past IF or ELSIF
2963 Append_To
(Exprs
, P_Condition
);
2965 Append_To
(Exprs
, P_Expression
);
2967 -- We now have scanned out IF expr THEN expr
2969 -- Check for common error of semicolon before the ELSE
2971 if Token
= Tok_Semicolon
then
2972 Save_Scan_State
(State
);
2973 Scan
; -- past semicolon
2975 if Token
= Tok_Else
or else Token
= Tok_Elsif
then
2976 Error_Msg_SP
-- CODEFIX
2977 ("|extra "";"" ignored");
2980 Restore_Scan_State
(State
);
2984 -- Scan out ELSIF sequence if present
2986 if Token
= Tok_Elsif
then
2987 Expr
:= P_Conditional_Expression
;
2988 Set_Is_Elsif
(Expr
);
2989 Append_To
(Exprs
, Expr
);
2991 -- Scan out ELSE phrase if present
2993 elsif Token
= Tok_Else
then
2995 -- Scan out ELSE expression
2998 Append_To
(Exprs
, P_Expression
);
3000 -- Two expression case (implied True, filled in during semantics)
3006 -- If we have an END IF, diagnose as not needed
3008 if Token
= Tok_End
then
3010 ("`END IF` not allowed at end of conditional expression");
3013 if Token
= Tok_If
then
3018 Inside_Conditional_Expression
:= Inside_Conditional_Expression
- 1;
3020 -- Return the Conditional_Expression node
3023 Make_Conditional_Expression
(Loc
,
3024 Expressions
=> Exprs
);
3025 end P_Conditional_Expression
;
3027 -----------------------
3028 -- P_Membership_Test --
3029 -----------------------
3031 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3032 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3034 procedure P_Membership_Test
(N
: Node_Id
) is
3035 Alt
: constant Node_Id
:=
3036 P_Range_Or_Subtype_Mark
3037 (Allow_Simple_Expression
=> (Ada_Version
>= Ada_2012
));
3042 if Token
= Tok_Vertical_Bar
then
3043 if Ada_Version
< Ada_2012
then
3044 Error_Msg_SC
("set notation is an Ada 2012 feature");
3045 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
3048 Set_Alternatives
(N
, New_List
(Alt
));
3049 Set_Right_Opnd
(N
, Empty
);
3051 -- Loop to accumulate alternatives
3053 while Token
= Tok_Vertical_Bar
loop
3054 Scan
; -- past vertical bar
3057 P_Range_Or_Subtype_Mark
(Allow_Simple_Expression
=> True));
3063 Set_Right_Opnd
(N
, Alt
);
3064 Set_Alternatives
(N
, No_List
);
3066 end P_Membership_Test
;
3068 ------------------------------------------
3069 -- P_Unparen_Cond_Case_Quant_Expression --
3070 ------------------------------------------
3072 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
is
3073 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
3079 if Token
= Tok_Case
then
3080 Result
:= P_Case_Expression
;
3082 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3084 ("case expression must be parenthesized!", Result
);
3087 -- Conditional expression
3089 elsif Token
= Tok_If
then
3090 Result
:= P_Conditional_Expression
;
3092 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3094 ("conditional expression must be parenthesized!", Result
);
3097 -- Quantified expression
3099 elsif Token
= Tok_For
then
3100 Result
:= P_Quantified_Expression
;
3102 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3104 ("quantified expression must be parenthesized!", Result
);
3107 -- No other possibility should exist (caller was supposed to check)
3110 raise Program_Error
;
3113 -- Return expression (possibly after having given message)
3116 end P_Unparen_Cond_Case_Quant_Expression
;