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,
46 -- This map contains True for parameterless attributes that return a
47 -- string or a type. For those attributes, a left parenthesis after
48 -- the attribute should not be analyzed as the beginning of a parameters
49 -- list because it may denote a slice operation (X'Img (1 .. 2)) or
50 -- a type conversion (X'Class (Y)).
52 -- Note that this map designates the minimum set of attributes where a
53 -- construct in parentheses that is not an argument can appear right
54 -- after the attribute. For attributes like 'Size, we do not put them
55 -- in the map. If someone writes X'Size (3), that's illegal in any case,
56 -- but we get a better error message by parsing the (3) as an illegal
57 -- argument to the attribute, rather than some meaningless junk that
58 -- follows the attribute.
60 -----------------------
61 -- Local Subprograms --
62 -----------------------
64 function P_Aggregate_Or_Paren_Expr
return Node_Id
;
65 function P_Allocator
return Node_Id
;
66 function P_Case_Expression_Alternative
return Node_Id
;
67 function P_Record_Or_Array_Component_Association
return Node_Id
;
68 function P_Factor
return Node_Id
;
69 function P_Primary
return Node_Id
;
70 function P_Relation
return Node_Id
;
71 function P_Term
return Node_Id
;
73 function P_Binary_Adding_Operator
return Node_Kind
;
74 function P_Logical_Operator
return Node_Kind
;
75 function P_Multiplying_Operator
return Node_Kind
;
76 function P_Relational_Operator
return Node_Kind
;
77 function P_Unary_Adding_Operator
return Node_Kind
;
79 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
);
80 -- Called to place complaint about bad range attribute at the given
81 -- source location. Terminates by raising Error_Resync.
83 procedure P_Membership_Test
(N
: Node_Id
);
84 -- N is the node for a N_In or N_Not_In node whose right operand has not
85 -- yet been processed. It is called just after scanning out the IN keyword.
86 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
88 function P_Range_Attribute_Reference
(Prefix_Node
: Node_Id
) return Node_Id
;
89 -- Scan a range attribute reference. The caller has scanned out the
90 -- prefix. The current token is known to be an apostrophe and the
91 -- following token is known to be RANGE.
93 -------------------------
94 -- Bad_Range_Attribute --
95 -------------------------
97 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
99 Error_Msg
("range attribute cannot be used in expression!", Loc
);
101 end Bad_Range_Attribute
;
103 --------------------------
104 -- 4.1 Name (also 6.4) --
105 --------------------------
108 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
109 -- | INDEXED_COMPONENT | SLICE
110 -- | SELECTED_COMPONENT | ATTRIBUTE
111 -- | TYPE_CONVERSION | FUNCTION_CALL
112 -- | CHARACTER_LITERAL
114 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
116 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
118 -- EXPLICIT_DEREFERENCE ::= NAME . all
120 -- IMPLICIT_DEREFERENCE ::= NAME
122 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
124 -- SLICE ::= PREFIX (DISCRETE_RANGE)
126 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
128 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
130 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
132 -- ATTRIBUTE_DESIGNATOR ::=
133 -- IDENTIFIER [(static_EXPRESSION)]
134 -- | access | delta | digits
138 -- | function_PREFIX ACTUAL_PARAMETER_PART
140 -- ACTUAL_PARAMETER_PART ::=
141 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
143 -- PARAMETER_ASSOCIATION ::=
144 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
146 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
148 -- Note: syntactically a procedure call looks just like a function call,
149 -- so this routine is in practice used to scan out procedure calls as well.
151 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
153 -- Error recovery: can raise Error_Resync
155 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
156 -- followed by either a left paren (qualified expression case), or by
157 -- range (range attribute case). All other uses of apostrophe (i.e. all
158 -- other attributes) are handled in this routine.
160 -- Error recovery: can raise Error_Resync
162 function P_Name
return Node_Id
is
163 Scan_State
: Saved_Scan_State
;
165 Prefix_Node
: Node_Id
;
166 Ident_Node
: Node_Id
;
168 Range_Node
: Node_Id
;
171 Arg_List
: List_Id
:= No_List
; -- kill junk warning
172 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
175 -- Case of not a name
177 if Token
not in Token_Class_Name
then
179 -- If it looks like start of expression, complain and scan expression
181 if Token
in Token_Class_Literal
182 or else Token
= Tok_Left_Paren
184 Error_Msg_SC
("name expected");
187 -- Otherwise some other junk, not much we can do
190 Error_Msg_AP
("name expected");
195 -- Loop through designators in qualified name
197 Name_Node
:= Token_Node
;
200 Scan
; -- past designator
201 exit when Token
/= Tok_Dot
;
202 Save_Scan_State
(Scan_State
); -- at dot
205 -- If we do not have another designator after the dot, then join
206 -- the normal circuit to handle a dot extension (may be .all or
207 -- character literal case). Otherwise loop back to scan the next
210 if Token
not in Token_Class_Desig
then
211 goto Scan_Name_Extension_Dot
;
213 Prefix_Node
:= Name_Node
;
214 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
215 Set_Prefix
(Name_Node
, Prefix_Node
);
216 Set_Selector_Name
(Name_Node
, Token_Node
);
220 -- We have now scanned out a qualified designator. If the last token is
221 -- an operator symbol, then we certainly do not have the Snam case, so
222 -- we can just use the normal name extension check circuit
224 if Prev_Token
= Tok_Operator_Symbol
then
225 goto Scan_Name_Extension
;
228 -- We have scanned out a qualified simple name, check for name extension
229 -- Note that we know there is no dot here at this stage, so the only
230 -- possible cases of name extension are apostrophe and left paren.
232 if Token
= Tok_Apostrophe
then
233 Save_Scan_State
(Scan_State
); -- at apostrophe
234 Scan
; -- past apostrophe
236 -- If left paren, then this might be a qualified expression, but we
237 -- are only in the business of scanning out names, so return with
238 -- Token backed up to point to the apostrophe. The treatment for
239 -- the range attribute is similar (we do not consider x'range to
240 -- be a name in this grammar).
242 if Token
= Tok_Left_Paren
or else Token
= Tok_Range
then
243 Restore_Scan_State
(Scan_State
); -- to apostrophe
244 Expr_Form
:= EF_Simple_Name
;
247 -- Otherwise we have the case of a name extended by an attribute
250 goto Scan_Name_Extension_Apostrophe
;
253 -- Check case of qualified simple name extended by a left parenthesis
255 elsif Token
= Tok_Left_Paren
then
256 Scan
; -- past left paren
257 goto Scan_Name_Extension_Left_Paren
;
259 -- Otherwise the qualified simple name is not extended, so return
262 Expr_Form
:= EF_Simple_Name
;
266 -- Loop scanning past name extensions. A label is used for control
267 -- transfer for this loop for ease of interfacing with the finite state
268 -- machine in the parenthesis scanning circuit, and also to allow for
269 -- passing in control to the appropriate point from the above code.
271 <<Scan_Name_Extension
>>
273 -- Character literal used as name cannot be extended. Also this
274 -- cannot be a call, since the name for a call must be a designator.
275 -- Return in these cases, or if there is no name extension
277 if Token
not in Token_Class_Namext
278 or else Prev_Token
= Tok_Char_Literal
280 Expr_Form
:= EF_Name
;
284 -- Merge here when we know there is a name extension
286 <<Scan_Name_Extension_OK
>>
288 if Token
= Tok_Left_Paren
then
289 Scan
; -- past left paren
290 goto Scan_Name_Extension_Left_Paren
;
292 elsif Token
= Tok_Apostrophe
then
293 Save_Scan_State
(Scan_State
); -- at apostrophe
294 Scan
; -- past apostrophe
295 goto Scan_Name_Extension_Apostrophe
;
297 else -- Token = Tok_Dot
298 Save_Scan_State
(Scan_State
); -- at dot
300 goto Scan_Name_Extension_Dot
;
303 -- Case of name extended by dot (selection), dot is already skipped
304 -- and the scan state at the point of the dot is saved in Scan_State.
306 <<Scan_Name_Extension_Dot
>>
308 -- Explicit dereference case
310 if Token
= Tok_All
then
311 Prefix_Node
:= Name_Node
;
312 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
313 Set_Prefix
(Name_Node
, Prefix_Node
);
315 goto Scan_Name_Extension
;
317 -- Selected component case
319 elsif Token
in Token_Class_Name
then
320 Prefix_Node
:= Name_Node
;
321 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
322 Set_Prefix
(Name_Node
, Prefix_Node
);
323 Set_Selector_Name
(Name_Node
, Token_Node
);
324 Scan
; -- past selector
325 goto Scan_Name_Extension
;
327 -- Reserved identifier as selector
329 elsif Is_Reserved_Identifier
then
330 Scan_Reserved_Identifier
(Force_Msg
=> False);
331 Prefix_Node
:= Name_Node
;
332 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
333 Set_Prefix
(Name_Node
, Prefix_Node
);
334 Set_Selector_Name
(Name_Node
, Token_Node
);
335 Scan
; -- past identifier used as selector
336 goto Scan_Name_Extension
;
338 -- If dot is at end of line and followed by nothing legal,
339 -- then assume end of name and quit (dot will be taken as
340 -- an erroneous form of some other punctuation by our caller).
342 elsif Token_Is_At_Start_Of_Line
then
343 Restore_Scan_State
(Scan_State
);
346 -- Here if nothing legal after the dot
349 Error_Msg_AP
("selector expected");
353 -- Here for an apostrophe as name extension. The scan position at the
354 -- apostrophe has already been saved, and the apostrophe scanned out.
356 <<Scan_Name_Extension_Apostrophe
>>
358 Scan_Apostrophe
: declare
359 function Apostrophe_Should_Be_Semicolon
return Boolean;
360 -- Checks for case where apostrophe should probably be
361 -- a semicolon, and if so, gives appropriate message,
362 -- resets the scan pointer to the apostrophe, changes
363 -- the current token to Tok_Semicolon, and returns True.
364 -- Otherwise returns False.
366 function Apostrophe_Should_Be_Semicolon
return Boolean is
368 if Token_Is_At_Start_Of_Line
then
369 Restore_Scan_State
(Scan_State
); -- to apostrophe
370 Error_Msg_SC
("|""''"" should be "";""");
371 Token
:= Tok_Semicolon
;
376 end Apostrophe_Should_Be_Semicolon
;
378 -- Start of processing for Scan_Apostrophe
381 -- If range attribute after apostrophe, then return with Token
382 -- pointing to the apostrophe. Note that in this case the prefix
383 -- need not be a simple name (cases like A.all'range). Similarly
384 -- if there is a left paren after the apostrophe, then we also
385 -- return with Token pointing to the apostrophe (this is the
386 -- qualified expression case).
388 if Token
= Tok_Range
or else Token
= Tok_Left_Paren
then
389 Restore_Scan_State
(Scan_State
); -- to apostrophe
390 Expr_Form
:= EF_Name
;
393 -- Here for cases where attribute designator is an identifier
395 elsif Token
= Tok_Identifier
then
396 Attr_Name
:= Token_Name
;
398 if not Is_Attribute_Name
(Attr_Name
) then
399 if Apostrophe_Should_Be_Semicolon
then
400 Expr_Form
:= EF_Name
;
403 -- Here for a bad attribute name
406 Signal_Bad_Attribute
;
407 Scan
; -- past bad identifier
409 if Token
= Tok_Left_Paren
then
410 Scan
; -- past left paren
413 Discard_Junk_Node
(P_Expression_If_OK
);
414 exit when not Comma_Present
;
425 Style
.Check_Attribute_Name
(False);
428 -- Here for case of attribute designator is not an identifier
431 if Token
= Tok_Delta
then
432 Attr_Name
:= Name_Delta
;
434 elsif Token
= Tok_Digits
then
435 Attr_Name
:= Name_Digits
;
437 elsif Token
= Tok_Access
then
438 Attr_Name
:= Name_Access
;
440 elsif Token
= Tok_Mod
and then Ada_Version
>= Ada_95
then
441 Attr_Name
:= Name_Mod
;
443 elsif Apostrophe_Should_Be_Semicolon
then
444 Expr_Form
:= EF_Name
;
448 Error_Msg_AP
("attribute designator expected");
453 Style
.Check_Attribute_Name
(True);
457 -- We come here with an OK attribute scanned, and the
458 -- corresponding Attribute identifier node stored in Ident_Node.
460 Prefix_Node
:= Name_Node
;
461 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
462 Scan
; -- past attribute designator
463 Set_Prefix
(Name_Node
, Prefix_Node
);
464 Set_Attribute_Name
(Name_Node
, Attr_Name
);
466 -- Scan attribute arguments/designator. We skip this if we know
467 -- that the attribute cannot have an argument.
469 if Token
= Tok_Left_Paren
471 Is_Parameterless_Attribute
(Get_Attribute_Id
(Attr_Name
))
473 Set_Expressions
(Name_Node
, New_List
);
474 Scan
; -- past left paren
478 Expr
: constant Node_Id
:= P_Expression_If_OK
;
481 if Token
= Tok_Arrow
then
483 ("named parameters not permitted for attributes");
484 Scan
; -- past junk arrow
487 Append
(Expr
, Expressions
(Name_Node
));
488 exit when not Comma_Present
;
496 goto Scan_Name_Extension
;
499 -- Here for left parenthesis extending name (left paren skipped)
501 <<Scan_Name_Extension_Left_Paren
>>
503 -- We now have to scan through a list of items, terminated by a
504 -- right parenthesis. The scan is handled by a finite state
505 -- machine. The possibilities are:
509 -- This is a slice. This case is handled in LP_State_Init
511 -- (expression, expression, ..)
513 -- This is interpreted as an indexed component, i.e. as a
514 -- case of a name which can be extended in the normal manner.
515 -- This case is handled by LP_State_Name or LP_State_Expr.
517 -- Note: conditional expressions (without an extra level of
518 -- parentheses) are permitted in this context).
520 -- (..., identifier => expression , ...)
522 -- If there is at least one occurrence of identifier => (but
523 -- none of the other cases apply), then we have a call.
525 -- Test for Id => case
527 if Token
= Tok_Identifier
then
528 Save_Scan_State
(Scan_State
); -- at Id
531 -- Test for => (allow := as an error substitute)
533 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
534 Restore_Scan_State
(Scan_State
); -- to Id
535 Arg_List
:= New_List
;
539 Restore_Scan_State
(Scan_State
); -- to Id
543 -- Here we have an expression after all
545 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
547 -- Check cases of discrete range for a slice
549 -- First possibility: Range_Attribute_Reference
551 if Expr_Form
= EF_Range_Attr
then
552 Range_Node
:= Expr_Node
;
554 -- Second possibility: Simple_expression .. Simple_expression
556 elsif Token
= Tok_Dot_Dot
then
557 Check_Simple_Expression
(Expr_Node
);
558 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
559 Set_Low_Bound
(Range_Node
, Expr_Node
);
561 Expr_Node
:= P_Expression
;
562 Check_Simple_Expression
(Expr_Node
);
563 Set_High_Bound
(Range_Node
, Expr_Node
);
565 -- Third possibility: Type_name range Range
567 elsif Token
= Tok_Range
then
568 if Expr_Form
/= EF_Simple_Name
then
569 Error_Msg_SC
("subtype mark must precede RANGE");
573 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
575 -- Otherwise we just have an expression. It is true that we might
576 -- have a subtype mark without a range constraint but this case
577 -- is syntactically indistinguishable from the expression case.
580 Arg_List
:= New_List
;
584 -- Fall through here with unmistakable Discrete range scanned,
585 -- which means that we definitely have the case of a slice. The
586 -- Discrete range is in Range_Node.
588 if Token
= Tok_Comma
then
589 Error_Msg_SC
("slice cannot have more than one dimension");
592 elsif Token
/= Tok_Right_Paren
then
597 Scan
; -- past right paren
598 Prefix_Node
:= Name_Node
;
599 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
600 Set_Prefix
(Name_Node
, Prefix_Node
);
601 Set_Discrete_Range
(Name_Node
, Range_Node
);
603 -- An operator node is legal as a prefix to other names,
604 -- but not for a slice.
606 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
607 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
610 -- If we have a name extension, go scan it
612 if Token
in Token_Class_Namext
then
613 goto Scan_Name_Extension_OK
;
615 -- Otherwise return (a slice is a name, but is not a call)
618 Expr_Form
:= EF_Name
;
623 -- In LP_State_Expr, we have scanned one or more expressions, and
624 -- so we have a call or an indexed component which is a name. On
625 -- entry we have the expression just scanned in Expr_Node and
626 -- Arg_List contains the list of expressions encountered so far
629 Append
(Expr_Node
, Arg_List
);
631 if Token
= Tok_Arrow
then
633 ("expect identifier in parameter association",
637 elsif not Comma_Present
then
639 Prefix_Node
:= Name_Node
;
640 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
641 Set_Prefix
(Name_Node
, Prefix_Node
);
642 Set_Expressions
(Name_Node
, Arg_List
);
643 goto Scan_Name_Extension
;
646 -- Comma present (and scanned out), test for identifier => case
647 -- Test for identifier => case
649 if Token
= Tok_Identifier
then
650 Save_Scan_State
(Scan_State
); -- at Id
653 -- Test for => (allow := as error substitute)
655 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
656 Restore_Scan_State
(Scan_State
); -- to Id
659 -- Otherwise it's just an expression after all, so backup
662 Restore_Scan_State
(Scan_State
); -- to Id
666 -- Here we have an expression after all, so stay in this state
668 Expr_Node
:= P_Expression_If_OK
;
671 -- LP_State_Call corresponds to the situation in which at least
672 -- one instance of Id => Expression has been encountered, so we
673 -- know that we do not have a name, but rather a call. We enter
674 -- it with the scan pointer pointing to the next argument to scan,
675 -- and Arg_List containing the list of arguments scanned so far.
679 -- Test for case of Id => Expression (named parameter)
681 if Token
= Tok_Identifier
then
682 Save_Scan_State
(Scan_State
); -- at Id
683 Ident_Node
:= Token_Node
;
686 -- Deal with => (allow := as erroneous substitute)
688 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
689 Arg_Node
:= New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
690 Set_Selector_Name
(Arg_Node
, Ident_Node
);
692 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
693 Append
(Arg_Node
, Arg_List
);
695 -- If a comma follows, go back and scan next entry
697 if Comma_Present
then
700 -- Otherwise we have the end of a call
703 Prefix_Node
:= Name_Node
;
704 Name_Node
:= New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
705 Set_Name
(Name_Node
, Prefix_Node
);
706 Set_Parameter_Associations
(Name_Node
, Arg_List
);
709 if Token
in Token_Class_Namext
then
710 goto Scan_Name_Extension_OK
;
712 -- This is a case of a call which cannot be a name
715 Expr_Form
:= EF_Name
;
720 -- Not named parameter: Id started an expression after all
723 Restore_Scan_State
(Scan_State
); -- to Id
727 -- Here if entry did not start with Id => which means that it
728 -- is a positional parameter, which is not allowed, since we
729 -- have seen at least one named parameter already.
732 ("positional parameter association " &
733 "not allowed after named one");
735 Expr_Node
:= P_Expression_If_OK
;
737 -- Leaving the '>' in an association is not unusual, so suggest
740 if Nkind
(Expr_Node
) = N_Op_Eq
then
741 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
744 -- We go back to scanning out expressions, so that we do not get
745 -- multiple error messages when several positional parameters
746 -- follow a named parameter.
750 -- End of treatment for name extensions starting with left paren
752 -- End of loop through name extensions
756 -- This function parses a restricted form of Names which are either
757 -- designators, or designators preceded by a sequence of prefixes
758 -- that are direct names.
760 -- Error recovery: cannot raise Error_Resync
762 function P_Function_Name
return Node_Id
is
763 Designator_Node
: Node_Id
;
764 Prefix_Node
: Node_Id
;
765 Selector_Node
: Node_Id
;
766 Dot_Sloc
: Source_Ptr
:= No_Location
;
769 -- Prefix_Node is set to the gathered prefix so far, Empty means that
770 -- no prefix has been scanned. This allows us to build up the result
771 -- in the required right recursive manner.
773 Prefix_Node
:= Empty
;
775 -- Loop through prefixes
778 Designator_Node
:= Token_Node
;
780 if Token
not in Token_Class_Desig
then
781 return P_Identifier
; -- let P_Identifier issue the error message
783 else -- Token in Token_Class_Desig
784 Scan
; -- past designator
785 exit when Token
/= Tok_Dot
;
788 -- Here at a dot, with token just before it in Designator_Node
790 if No
(Prefix_Node
) then
791 Prefix_Node
:= Designator_Node
;
793 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
794 Set_Prefix
(Selector_Node
, Prefix_Node
);
795 Set_Selector_Name
(Selector_Node
, Designator_Node
);
796 Prefix_Node
:= Selector_Node
;
799 Dot_Sloc
:= Token_Ptr
;
803 -- Fall out of the loop having just scanned a designator
805 if No
(Prefix_Node
) then
806 return Designator_Node
;
808 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
809 Set_Prefix
(Selector_Node
, Prefix_Node
);
810 Set_Selector_Name
(Selector_Node
, Designator_Node
);
811 return Selector_Node
;
819 -- This function parses a restricted form of Names which are either
820 -- identifiers, or identifiers preceded by a sequence of prefixes
821 -- that are direct names.
823 -- Error recovery: cannot raise Error_Resync
825 function P_Qualified_Simple_Name
return Node_Id
is
826 Designator_Node
: Node_Id
;
827 Prefix_Node
: Node_Id
;
828 Selector_Node
: Node_Id
;
829 Dot_Sloc
: Source_Ptr
:= No_Location
;
832 -- Prefix node is set to the gathered prefix so far, Empty means that
833 -- no prefix has been scanned. This allows us to build up the result
834 -- in the required right recursive manner.
836 Prefix_Node
:= Empty
;
838 -- Loop through prefixes
841 Designator_Node
:= Token_Node
;
843 if Token
= Tok_Identifier
then
844 Scan
; -- past identifier
845 exit when Token
/= Tok_Dot
;
847 elsif Token
not in Token_Class_Desig
then
848 return P_Identifier
; -- let P_Identifier issue the error message
851 Scan
; -- past designator
853 if Token
/= Tok_Dot
then
854 Error_Msg_SP
("identifier expected");
859 -- Here at a dot, with token just before it in Designator_Node
861 if No
(Prefix_Node
) then
862 Prefix_Node
:= Designator_Node
;
864 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
865 Set_Prefix
(Selector_Node
, Prefix_Node
);
866 Set_Selector_Name
(Selector_Node
, Designator_Node
);
867 Prefix_Node
:= Selector_Node
;
870 Dot_Sloc
:= Token_Ptr
;
874 -- Fall out of the loop having just scanned an identifier
876 if No
(Prefix_Node
) then
877 return Designator_Node
;
879 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
880 Set_Prefix
(Selector_Node
, Prefix_Node
);
881 Set_Selector_Name
(Selector_Node
, Designator_Node
);
882 return Selector_Node
;
888 end P_Qualified_Simple_Name
;
890 -- This procedure differs from P_Qualified_Simple_Name only in that it
891 -- raises Error_Resync if any error is encountered. It only returns after
892 -- scanning a valid qualified simple name.
894 -- Error recovery: can raise Error_Resync
896 function P_Qualified_Simple_Name_Resync
return Node_Id
is
897 Designator_Node
: Node_Id
;
898 Prefix_Node
: Node_Id
;
899 Selector_Node
: Node_Id
;
900 Dot_Sloc
: Source_Ptr
:= No_Location
;
903 Prefix_Node
:= Empty
;
905 -- Loop through prefixes
908 Designator_Node
:= Token_Node
;
910 if Token
= Tok_Identifier
then
911 Scan
; -- past identifier
912 exit when Token
/= Tok_Dot
;
914 elsif Token
not in Token_Class_Desig
then
915 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
919 Scan
; -- past designator
921 if Token
/= Tok_Dot
then
922 Error_Msg_SP
("identifier expected");
927 -- Here at a dot, with token just before it in Designator_Node
929 if No
(Prefix_Node
) then
930 Prefix_Node
:= Designator_Node
;
932 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
933 Set_Prefix
(Selector_Node
, Prefix_Node
);
934 Set_Selector_Name
(Selector_Node
, Designator_Node
);
935 Prefix_Node
:= Selector_Node
;
938 Dot_Sloc
:= Token_Ptr
;
942 -- Fall out of the loop having just scanned an identifier
944 if No
(Prefix_Node
) then
945 return Designator_Node
;
947 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
948 Set_Prefix
(Selector_Node
, Prefix_Node
);
949 Set_Selector_Name
(Selector_Node
, Designator_Node
);
950 return Selector_Node
;
952 end P_Qualified_Simple_Name_Resync
;
954 ----------------------
955 -- 4.1 Direct_Name --
956 ----------------------
958 -- Parsed by P_Name and other functions in section 4.1
964 -- Parsed by P_Name (4.1)
966 -------------------------------
967 -- 4.1 Explicit Dereference --
968 -------------------------------
970 -- Parsed by P_Name (4.1)
972 -------------------------------
973 -- 4.1 Implicit_Dereference --
974 -------------------------------
976 -- Parsed by P_Name (4.1)
978 ----------------------------
979 -- 4.1 Indexed Component --
980 ----------------------------
982 -- Parsed by P_Name (4.1)
988 -- Parsed by P_Name (4.1)
990 -----------------------------
991 -- 4.1 Selected_Component --
992 -----------------------------
994 -- Parsed by P_Name (4.1)
996 ------------------------
997 -- 4.1 Selector Name --
998 ------------------------
1000 -- Parsed by P_Name (4.1)
1002 ------------------------------
1003 -- 4.1 Attribute Reference --
1004 ------------------------------
1006 -- Parsed by P_Name (4.1)
1008 -------------------------------
1009 -- 4.1 Attribute Designator --
1010 -------------------------------
1012 -- Parsed by P_Name (4.1)
1014 --------------------------------------
1015 -- 4.1.4 Range Attribute Reference --
1016 --------------------------------------
1018 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1020 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1022 -- In the grammar, a RANGE attribute is simply a name, but its use is
1023 -- highly restricted, so in the parser, we do not regard it as a name.
1024 -- Instead, P_Name returns without scanning the 'RANGE part of the
1025 -- attribute, and the caller uses the following function to construct
1026 -- a range attribute in places where it is appropriate.
1028 -- Note that RANGE here is treated essentially as an identifier,
1029 -- rather than a reserved word.
1031 -- The caller has parsed the prefix, i.e. a name, and Token points to
1032 -- the apostrophe. The token after the apostrophe is known to be RANGE
1033 -- at this point. The prefix node becomes the prefix of the attribute.
1035 -- Error_Recovery: Cannot raise Error_Resync
1037 function P_Range_Attribute_Reference
1038 (Prefix_Node
: Node_Id
)
1041 Attr_Node
: Node_Id
;
1044 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1045 Set_Prefix
(Attr_Node
, Prefix_Node
);
1046 Scan
; -- past apostrophe
1049 Style
.Check_Attribute_Name
(True);
1052 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1055 if Token
= Tok_Left_Paren
then
1056 Scan
; -- past left paren
1057 Set_Expressions
(Attr_Node
, New_List
(P_Expression_If_OK
));
1062 end P_Range_Attribute_Reference
;
1064 ---------------------------------------
1065 -- 4.1.4 Range Attribute Designator --
1066 ---------------------------------------
1068 -- Parsed by P_Range_Attribute_Reference (4.4)
1070 --------------------
1072 --------------------
1074 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1076 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1077 -- an aggregate is known to be required (code statement, extension
1078 -- aggregate), in which cases this routine performs the necessary check
1079 -- that we have an aggregate rather than a parenthesized expression
1081 -- Error recovery: can raise Error_Resync
1083 function P_Aggregate
return Node_Id
is
1084 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1085 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1088 if Nkind
(Aggr_Node
) /= N_Aggregate
1090 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1093 ("aggregate may not have single positional component", Aggr_Sloc
);
1100 ------------------------------------------------
1101 -- 4.3 Aggregate or Parenthesized Expression --
1102 ------------------------------------------------
1104 -- This procedure parses out either an aggregate or a parenthesized
1105 -- expression (these two constructs are closely related, since a
1106 -- parenthesized expression looks like an aggregate with a single
1107 -- positional component).
1110 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1112 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1114 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1115 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1118 -- RECORD_COMPONENT_ASSOCIATION ::=
1119 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1121 -- COMPONENT_CHOICE_LIST ::=
1122 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1125 -- EXTENSION_AGGREGATE ::=
1126 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1128 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1130 -- ARRAY_AGGREGATE ::=
1131 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1133 -- POSITIONAL_ARRAY_AGGREGATE ::=
1134 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1135 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1136 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1138 -- NAMED_ARRAY_AGGREGATE ::=
1139 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1141 -- PRIMARY ::= (EXPRESSION);
1143 -- Error recovery: can raise Error_Resync
1145 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1146 -- to Ada 2005 limited aggregates (AI-287)
1148 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1149 Aggregate_Node
: Node_Id
;
1150 Expr_List
: List_Id
;
1151 Assoc_List
: List_Id
;
1152 Expr_Node
: Node_Id
;
1153 Lparen_Sloc
: Source_Ptr
;
1154 Scan_State
: Saved_Scan_State
;
1157 Lparen_Sloc
:= Token_Ptr
;
1160 -- Conditional expression case
1162 if Token
= Tok_If
then
1163 Expr_Node
:= P_Conditional_Expression
;
1167 -- Case expression case
1169 elsif Token
= Tok_Case
then
1170 Expr_Node
:= P_Case_Expression
;
1174 -- Note: the mechanism used here of rescanning the initial expression
1175 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1176 -- out the discrete choice list.
1178 -- Deal with expression and extension aggregate cases first
1180 elsif Token
/= Tok_Others
then
1181 Save_Scan_State
(Scan_State
); -- at start of expression
1183 -- Deal with (NULL RECORD) case
1185 if Token
= Tok_Null
then
1188 if Token
= Tok_Record
then
1189 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1190 Set_Null_Record_Present
(Aggregate_Node
, True);
1191 Scan
; -- past RECORD
1193 return Aggregate_Node
;
1195 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1199 -- Ada 2005 (AI-287): The box notation is allowed only with named
1200 -- notation because positional notation might be error prone. For
1201 -- example, in "(X, <>, Y, <>)", there is no type associated with
1202 -- the boxes, so you might not be leaving out the components you
1203 -- thought you were leaving out.
1205 if Ada_Version
>= Ada_05
and then Token
= Tok_Box
then
1206 Error_Msg_SC
("(Ada 2005) box notation only allowed with "
1207 & "named notation");
1209 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1210 return Aggregate_Node
;
1213 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1215 -- Extension aggregate case
1217 if Token
= Tok_With
then
1219 if Nkind
(Expr_Node
) = N_Attribute_Reference
1220 and then Attribute_Name
(Expr_Node
) = Name_Range
1222 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1226 if Ada_Version
= Ada_83
then
1227 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1230 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1231 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1234 -- Deal with WITH NULL RECORD case
1236 if Token
= Tok_Null
then
1237 Save_Scan_State
(Scan_State
); -- at NULL
1240 if Token
= Tok_Record
then
1241 Scan
; -- past RECORD
1242 Set_Null_Record_Present
(Aggregate_Node
, True);
1244 return Aggregate_Node
;
1247 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1251 if Token
/= Tok_Others
then
1252 Save_Scan_State
(Scan_State
);
1253 Expr_Node
:= P_Expression
;
1260 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1261 if Nkind
(Expr_Node
) = N_Attribute_Reference
1262 and then Attribute_Name
(Expr_Node
) = Name_Range
1265 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
1266 Scan
; -- past right paren
1270 -- Bump paren count of expression
1272 if Expr_Node
/= Error
then
1273 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1276 T_Right_Paren
; -- past right paren (error message if none)
1279 -- Normal aggregate case
1282 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1288 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1292 -- Prepare to scan list of component associations
1294 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1295 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1297 -- This loop scans through component associations. On entry to the
1298 -- loop, an expression has been scanned at the start of the current
1299 -- association unless initial token was OTHERS, in which case
1300 -- Expr_Node is set to Empty.
1303 -- Deal with others association first. This is a named association
1305 if No
(Expr_Node
) then
1306 if No
(Assoc_List
) then
1307 Assoc_List
:= New_List
;
1310 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1312 -- Improper use of WITH
1314 elsif Token
= Tok_With
then
1315 Error_Msg_SC
("WITH must be preceded by single expression in " &
1316 "extension aggregate");
1319 -- A range attribute can only appear as part of a discrete choice
1322 elsif Nkind
(Expr_Node
) = N_Attribute_Reference
1323 and then Attribute_Name
(Expr_Node
) = Name_Range
1324 and then Token
/= Tok_Arrow
1325 and then Token
/= Tok_Vertical_Bar
1327 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1330 -- Assume positional case if comma, right paren, or literal or
1331 -- identifier or OTHERS follows (the latter cases are missing
1332 -- comma cases). Also assume positional if a semicolon follows,
1333 -- which can happen if there are missing parens
1335 elsif Token
= Tok_Comma
1336 or else Token
= Tok_Right_Paren
1337 or else Token
= Tok_Others
1338 or else Token
in Token_Class_Lit_Or_Name
1339 or else Token
= Tok_Semicolon
1341 if Present
(Assoc_List
) then
1342 Error_Msg_BC
-- CODEFIX
1343 ("""='>"" expected (positional association cannot follow " &
1344 "named association)");
1347 if No
(Expr_List
) then
1348 Expr_List
:= New_List
;
1351 Append
(Expr_Node
, Expr_List
);
1353 -- Check for aggregate followed by left parent, maybe missing comma
1355 elsif Nkind
(Expr_Node
) = N_Aggregate
1356 and then Token
= Tok_Left_Paren
1360 if No
(Expr_List
) then
1361 Expr_List
:= New_List
;
1364 Append
(Expr_Node
, Expr_List
);
1366 -- Anything else is assumed to be a named association
1369 Restore_Scan_State
(Scan_State
); -- to start of expression
1371 if No
(Assoc_List
) then
1372 Assoc_List
:= New_List
;
1375 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1378 exit when not Comma_Present
;
1380 -- If we are at an expression terminator, something is seriously
1381 -- wrong, so let's get out now, before we start eating up stuff
1382 -- that doesn't belong to us!
1384 if Token
in Token_Class_Eterm
then
1385 Error_Msg_AP
("expecting expression or component association");
1389 -- Otherwise initiate for reentry to top of loop by scanning an
1390 -- initial expression, unless the first token is OTHERS.
1392 if Token
= Tok_Others
then
1395 Save_Scan_State
(Scan_State
); -- at start of expression
1396 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1401 -- All component associations (positional and named) have been scanned
1404 Set_Expressions
(Aggregate_Node
, Expr_List
);
1405 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1406 return Aggregate_Node
;
1407 end P_Aggregate_Or_Paren_Expr
;
1409 ------------------------------------------------
1410 -- 4.3 Record or Array Component Association --
1411 ------------------------------------------------
1413 -- RECORD_COMPONENT_ASSOCIATION ::=
1414 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1415 -- | COMPONENT_CHOICE_LIST => <>
1417 -- COMPONENT_CHOICE_LIST =>
1418 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1421 -- ARRAY_COMPONENT_ASSOCIATION ::=
1422 -- DISCRETE_CHOICE_LIST => EXPRESSION
1423 -- | DISCRETE_CHOICE_LIST => <>
1425 -- Note: this routine only handles the named cases, including others.
1426 -- Cases where the component choice list is not present have already
1427 -- been handled directly.
1429 -- Error recovery: can raise Error_Resync
1431 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1432 -- rules have been extended to give support to Ada 2005 limited
1433 -- aggregates (AI-287)
1435 function P_Record_Or_Array_Component_Association
return Node_Id
is
1436 Assoc_Node
: Node_Id
;
1439 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1440 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1441 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1444 if Token
= Tok_Box
then
1446 -- Ada 2005(AI-287): The box notation is used to indicate the
1447 -- default initialization of aggregate components
1449 if Ada_Version
< Ada_05
then
1451 ("component association with '<'> is an Ada 2005 extension");
1452 Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
1455 Set_Box_Present
(Assoc_Node
);
1458 Set_Expression
(Assoc_Node
, P_Expression
);
1462 end P_Record_Or_Array_Component_Association
;
1464 -----------------------------
1465 -- 4.3.1 Record Aggregate --
1466 -----------------------------
1468 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1469 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1471 ----------------------------------------------
1472 -- 4.3.1 Record Component Association List --
1473 ----------------------------------------------
1475 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1477 ----------------------------------
1478 -- 4.3.1 Component Choice List --
1479 ----------------------------------
1481 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1483 --------------------------------
1484 -- 4.3.1 Extension Aggregate --
1485 --------------------------------
1487 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1489 --------------------------
1490 -- 4.3.1 Ancestor Part --
1491 --------------------------
1493 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1495 ----------------------------
1496 -- 4.3.1 Array Aggregate --
1497 ----------------------------
1499 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1501 ---------------------------------------
1502 -- 4.3.1 Positional Array Aggregate --
1503 ---------------------------------------
1505 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1507 ----------------------------------
1508 -- 4.3.1 Named Array Aggregate --
1509 ----------------------------------
1511 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1513 ----------------------------------------
1514 -- 4.3.1 Array Component Association --
1515 ----------------------------------------
1517 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1519 ---------------------
1520 -- 4.4 Expression --
1521 ---------------------
1524 -- RELATION {and RELATION} | RELATION {and then RELATION}
1525 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1526 -- | RELATION {xor RELATION}
1528 -- On return, Expr_Form indicates the categorization of the expression
1529 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1530 -- an error message is given, and Error is returned).
1532 -- Error recovery: cannot raise Error_Resync
1534 function P_Expression
return Node_Id
is
1535 Logical_Op
: Node_Kind
;
1536 Prev_Logical_Op
: Node_Kind
;
1537 Op_Location
: Source_Ptr
;
1542 Node1
:= P_Relation
;
1544 if Token
in Token_Class_Logop
then
1545 Prev_Logical_Op
:= N_Empty
;
1548 Op_Location
:= Token_Ptr
;
1549 Logical_Op
:= P_Logical_Operator
;
1551 if Prev_Logical_Op
/= N_Empty
and then
1552 Logical_Op
/= Prev_Logical_Op
1555 ("mixed logical operators in expression", Op_Location
);
1556 Prev_Logical_Op
:= N_Empty
;
1558 Prev_Logical_Op
:= Logical_Op
;
1562 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1563 Set_Left_Opnd
(Node1
, Node2
);
1564 Set_Right_Opnd
(Node1
, P_Relation
);
1565 exit when Token
not in Token_Class_Logop
;
1568 Expr_Form
:= EF_Non_Simple
;
1571 if Token
= Tok_Apostrophe
then
1572 Bad_Range_Attribute
(Token_Ptr
);
1579 -- This function is identical to the normal P_Expression, except that it
1580 -- also permits the appearence of a case of conditional expression without
1581 -- the usual surrounding parentheses.
1583 function P_Expression_If_OK
return Node_Id
is
1585 if Token
= Tok_Case
then
1586 return P_Case_Expression
;
1587 elsif Token
= Tok_If
then
1588 return P_Conditional_Expression
;
1590 return P_Expression
;
1592 end P_Expression_If_OK
;
1594 -- This function is identical to the normal P_Expression, except that it
1595 -- checks that the expression scan did not stop on a right paren. It is
1596 -- called in all contexts where a right parenthesis cannot legitimately
1597 -- follow an expression.
1599 -- Error recovery: can not raise Error_Resync
1601 function P_Expression_No_Right_Paren
return Node_Id
is
1602 Expr
: constant Node_Id
:= P_Expression
;
1604 Ignore
(Tok_Right_Paren
);
1606 end P_Expression_No_Right_Paren
;
1608 ----------------------------------------
1609 -- 4.4 Expression_Or_Range_Attribute --
1610 ----------------------------------------
1613 -- RELATION {and RELATION} | RELATION {and then RELATION}
1614 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1615 -- | RELATION {xor RELATION}
1617 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1619 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1621 -- On return, Expr_Form indicates the categorization of the expression
1622 -- and EF_Range_Attr is one of the possibilities.
1624 -- Error recovery: cannot raise Error_Resync
1626 -- In the grammar, a RANGE attribute is simply a name, but its use is
1627 -- highly restricted, so in the parser, we do not regard it as a name.
1628 -- Instead, P_Name returns without scanning the 'RANGE part of the
1629 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1630 -- attribute reference. In the normal case where a range attribute is
1631 -- not allowed, an error message is issued by P_Expression.
1633 function P_Expression_Or_Range_Attribute
return Node_Id
is
1634 Logical_Op
: Node_Kind
;
1635 Prev_Logical_Op
: Node_Kind
;
1636 Op_Location
: Source_Ptr
;
1639 Attr_Node
: Node_Id
;
1642 Node1
:= P_Relation
;
1644 if Token
= Tok_Apostrophe
then
1645 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
1646 Expr_Form
:= EF_Range_Attr
;
1649 elsif Token
in Token_Class_Logop
then
1650 Prev_Logical_Op
:= N_Empty
;
1653 Op_Location
:= Token_Ptr
;
1654 Logical_Op
:= P_Logical_Operator
;
1656 if Prev_Logical_Op
/= N_Empty
and then
1657 Logical_Op
/= Prev_Logical_Op
1660 ("mixed logical operators in expression", Op_Location
);
1661 Prev_Logical_Op
:= N_Empty
;
1663 Prev_Logical_Op
:= Logical_Op
;
1667 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1668 Set_Left_Opnd
(Node1
, Node2
);
1669 Set_Right_Opnd
(Node1
, P_Relation
);
1670 exit when Token
not in Token_Class_Logop
;
1673 Expr_Form
:= EF_Non_Simple
;
1676 if Token
= Tok_Apostrophe
then
1677 Bad_Range_Attribute
(Token_Ptr
);
1682 end P_Expression_Or_Range_Attribute
;
1684 -- Version that allows a non-parenthesized case or conditional expression
1686 function P_Expression_Or_Range_Attribute_If_OK
return Node_Id
is
1688 if Token
= Tok_Case
then
1689 return P_Case_Expression
;
1690 elsif Token
= Tok_If
then
1691 return P_Conditional_Expression
;
1693 return P_Expression_Or_Range_Attribute
;
1695 end P_Expression_Or_Range_Attribute_If_OK
;
1702 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1703 -- | SIMPLE_EXPRESSION [not] in RANGE
1704 -- | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1706 -- On return, Expr_Form indicates the categorization of the expression
1708 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1709 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1711 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1712 -- expression, then tokens are scanned until either a non-expression token,
1713 -- a right paren (not matched by a left paren) or a comma, is encountered.
1715 function P_Relation
return Node_Id
is
1716 Node1
, Node2
: Node_Id
;
1720 Node1
:= P_Simple_Expression
;
1722 if Token
not in Token_Class_Relop
then
1726 -- Here we have a relational operator following. If so then scan it
1727 -- out. Note that the assignment symbol := is treated as a relational
1728 -- operator to improve the error recovery when it is misused for =.
1729 -- P_Relational_Operator also parses the IN and NOT IN operations.
1732 Node2
:= New_Op_Node
(P_Relational_Operator
, Optok
);
1733 Set_Left_Opnd
(Node2
, Node1
);
1735 -- Case of IN or NOT IN
1737 if Prev_Token
= Tok_In
then
1738 P_Membership_Test
(Node2
);
1740 -- Case of relational operator (= /= < <= > >=)
1743 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
1746 Expr_Form
:= EF_Non_Simple
;
1748 if Token
in Token_Class_Relop
then
1749 Error_Msg_SC
("unexpected relational operator");
1756 -- If any error occurs, then scan to the next expression terminator symbol
1757 -- or comma or right paren at the outer (i.e. current) parentheses level.
1758 -- The flags are set to indicate a normal simple expression.
1761 when Error_Resync
=>
1763 Expr_Form
:= EF_Simple
;
1767 ----------------------------
1768 -- 4.4 Simple Expression --
1769 ----------------------------
1771 -- SIMPLE_EXPRESSION ::=
1772 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1774 -- On return, Expr_Form indicates the categorization of the expression
1776 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1777 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1779 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1780 -- expression, then tokens are scanned until either a non-expression token,
1781 -- a right paren (not matched by a left paren) or a comma, is encountered.
1783 -- Note: P_Simple_Expression is called only internally by higher level
1784 -- expression routines. In cases in the grammar where a simple expression
1785 -- is required, the approach is to scan an expression, and then post an
1786 -- appropriate error message if the expression obtained is not simple. This
1787 -- gives better error recovery and treatment.
1789 function P_Simple_Expression
return Node_Id
is
1790 Scan_State
: Saved_Scan_State
;
1793 Tokptr
: Source_Ptr
;
1796 -- Check for cases starting with a name. There are two reasons for
1797 -- special casing. First speed things up by catching a common case
1798 -- without going through several routine layers. Second the caller must
1799 -- be informed via Expr_Form when the simple expression is a name.
1801 if Token
in Token_Class_Name
then
1804 -- Deal with apostrophe cases
1806 if Token
= Tok_Apostrophe
then
1807 Save_Scan_State
(Scan_State
); -- at apostrophe
1808 Scan
; -- past apostrophe
1810 -- If qualified expression, scan it out and fall through
1812 if Token
= Tok_Left_Paren
then
1813 Node1
:= P_Qualified_Expression
(Node1
);
1814 Expr_Form
:= EF_Simple
;
1816 -- If range attribute, then we return with Token pointing to the
1817 -- apostrophe. Note: avoid the normal error check on exit. We
1818 -- know that the expression really is complete in this case!
1820 else -- Token = Tok_Range then
1821 Restore_Scan_State
(Scan_State
); -- to apostrophe
1822 Expr_Form
:= EF_Simple_Name
;
1827 -- If an expression terminator follows, the previous processing
1828 -- completely scanned out the expression (a common case), and
1829 -- left Expr_Form set appropriately for returning to our caller.
1831 if Token
in Token_Class_Sterm
then
1834 -- If we do not have an expression terminator, then complete the
1835 -- scan of a simple expression. This code duplicates the code
1836 -- found in P_Term and P_Factor.
1839 if Token
= Tok_Double_Asterisk
then
1841 Style
.Check_Exponentiation_Operator
;
1844 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
1846 Set_Left_Opnd
(Node2
, Node1
);
1847 Set_Right_Opnd
(Node2
, P_Primary
);
1852 exit when Token
not in Token_Class_Mulop
;
1853 Tokptr
:= Token_Ptr
;
1854 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
1857 Style
.Check_Binary_Operator
;
1860 Scan
; -- past operator
1861 Set_Left_Opnd
(Node2
, Node1
);
1862 Set_Right_Opnd
(Node2
, P_Factor
);
1867 exit when Token
not in Token_Class_Binary_Addop
;
1868 Tokptr
:= Token_Ptr
;
1869 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
1872 Style
.Check_Binary_Operator
;
1875 Scan
; -- past operator
1876 Set_Left_Opnd
(Node2
, Node1
);
1877 Set_Right_Opnd
(Node2
, P_Term
);
1881 Expr_Form
:= EF_Simple
;
1884 -- Cases where simple expression does not start with a name
1887 -- Scan initial sign and initial Term
1889 if Token
in Token_Class_Unary_Addop
then
1890 Tokptr
:= Token_Ptr
;
1891 Node1
:= New_Op_Node
(P_Unary_Adding_Operator
, Tokptr
);
1894 Style
.Check_Unary_Plus_Or_Minus
;
1897 Scan
; -- past operator
1898 Set_Right_Opnd
(Node1
, P_Term
);
1903 -- In the following, we special-case a sequence of concatenations of
1904 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
1905 -- else mixed in. For such a sequence, we return a tree representing
1906 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
1907 -- the number of concatenations is large. If semantic analysis
1908 -- resolves the "&" to a predefined one, then this folding gives the
1909 -- right answer. Otherwise, semantic analysis will complain about a
1910 -- capacity-exceeded error. The purpose of this trick is to avoid
1911 -- creating a deeply nested tree, which would cause deep recursion
1912 -- during semantics, causing stack overflow. This way, we can handle
1913 -- enormous concatenations in the normal case of predefined "&". We
1914 -- first build up the normal tree, and then rewrite it if
1918 Num_Concats_Threshold
: constant Positive := 1000;
1919 -- Arbitrary threshold value to enable optimization
1921 First_Node
: constant Node_Id
:= Node1
;
1922 Is_Strlit_Concat
: Boolean;
1923 -- True iff we've parsed a sequence of concatenations of string
1924 -- literals, with nothing else mixed in.
1926 Num_Concats
: Natural;
1927 -- Number of "&" operators if Is_Strlit_Concat is True
1931 Nkind
(Node1
) = N_String_Literal
1932 and then Token
= Tok_Ampersand
;
1935 -- Scan out sequence of terms separated by binary adding operators
1938 exit when Token
not in Token_Class_Binary_Addop
;
1939 Tokptr
:= Token_Ptr
;
1940 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
1941 Scan
; -- past operator
1942 Set_Left_Opnd
(Node2
, Node1
);
1944 Set_Right_Opnd
(Node2
, Node1
);
1946 -- Check if we're still concatenating string literals
1950 and then Nkind
(Node2
) = N_Op_Concat
1951 and then Nkind
(Node1
) = N_String_Literal
;
1953 if Is_Strlit_Concat
then
1954 Num_Concats
:= Num_Concats
+ 1;
1960 -- If we have an enormous series of concatenations of string
1961 -- literals, rewrite as explained above. The Is_Folded_In_Parser
1962 -- flag tells semantic analysis that if the "&" is not predefined,
1963 -- the folded value is wrong.
1966 and then Num_Concats
>= Num_Concats_Threshold
1969 Empty_String_Val
: String_Id
;
1972 Strlit_Concat_Val
: String_Id
;
1973 -- Contains the folded value (which will be correct if the
1974 -- "&" operators are the predefined ones).
1977 -- For walking up the tree
1980 -- Folded node to replace Node1
1982 Loc
: constant Source_Ptr
:= Sloc
(First_Node
);
1985 -- Walk up the tree starting at the leftmost string literal
1986 -- (First_Node), building up the Strlit_Concat_Val as we
1987 -- go. Note that we do not use recursion here -- the whole
1988 -- point is to avoid recursively walking that enormous tree.
1991 Store_String_Chars
(Strval
(First_Node
));
1993 Cur_Node
:= Parent
(First_Node
);
1994 while Present
(Cur_Node
) loop
1995 pragma Assert
(Nkind
(Cur_Node
) = N_Op_Concat
and then
1996 Nkind
(Right_Opnd
(Cur_Node
)) = N_String_Literal
);
1998 Store_String_Chars
(Strval
(Right_Opnd
(Cur_Node
)));
1999 Cur_Node
:= Parent
(Cur_Node
);
2002 Strlit_Concat_Val
:= End_String
;
2004 -- Create new folded node, and rewrite result with a concat-
2005 -- enation of an empty string literal and the folded node.
2008 Empty_String_Val
:= End_String
;
2010 Make_Op_Concat
(Loc
,
2011 Make_String_Literal
(Loc
, Empty_String_Val
),
2012 Make_String_Literal
(Loc
, Strlit_Concat_Val
,
2013 Is_Folded_In_Parser
=> True));
2014 Rewrite
(Node1
, New_Node
);
2019 -- All done, we clearly do not have name or numeric literal so this
2020 -- is a case of a simple expression which is some other possibility.
2022 Expr_Form
:= EF_Simple
;
2025 -- Come here at end of simple expression, where we do a couple of
2026 -- special checks to improve error recovery.
2028 -- Special test to improve error recovery. If the current token
2029 -- is a period, then someone is trying to do selection on something
2030 -- that is not a name, e.g. a qualified expression.
2032 if Token
= Tok_Dot
then
2033 Error_Msg_SC
("prefix for selection is not a name");
2037 -- Special test to improve error recovery: If the current token is
2038 -- not the first token on a line (as determined by checking the
2039 -- previous token position with the start of the current line),
2040 -- then we insist that we have an appropriate terminating token.
2041 -- Consider the following two examples:
2043 -- 1) if A nad B then ...
2048 -- In the first example, we would like to issue a binary operator
2049 -- expected message and resynchronize to the then. In the second
2050 -- example, we do not want to issue a binary operator message, so
2051 -- that instead we will get the missing semicolon message. This
2052 -- distinction is of course a heuristic which does not always work,
2053 -- but in practice it is quite effective.
2055 -- Note: the one case in which we do not go through this circuit is
2056 -- when we have scanned a range attribute and want to return with
2057 -- Token pointing to the apostrophe. The apostrophe is not normally
2058 -- an expression terminator, and is not in Token_Class_Sterm, but
2059 -- in this special case we know that the expression is complete.
2061 if not Token_Is_At_Start_Of_Line
2062 and then Token
not in Token_Class_Sterm
2064 -- Normally the right error message is indeed that we expected a
2065 -- binary operator, but in the case of being between a right and left
2066 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2068 if Prev_Token
= Tok_Right_Paren
and then Token
= Tok_Left_Paren
then
2071 Error_Msg_AP
("binary operator expected");
2080 -- If any error occurs, then scan to next expression terminator symbol
2081 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2082 -- level. Expr_Form is set to indicate a normal simple expression.
2085 when Error_Resync
=>
2087 Expr_Form
:= EF_Simple
;
2089 end P_Simple_Expression
;
2091 -----------------------------------------------
2092 -- 4.4 Simple Expression or Range Attribute --
2093 -----------------------------------------------
2095 -- SIMPLE_EXPRESSION ::=
2096 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2098 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2100 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2102 -- Error recovery: cannot raise Error_Resync
2104 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
2106 Attr_Node
: Node_Id
;
2109 -- We don't just want to roar ahead and call P_Simple_Expression
2110 -- here, since we want to handle the case of a parenthesized range
2111 -- attribute cleanly.
2113 if Token
= Tok_Left_Paren
then
2115 Lptr
: constant Source_Ptr
:= Token_Ptr
;
2116 Scan_State
: Saved_Scan_State
;
2119 Save_Scan_State
(Scan_State
);
2120 Scan
; -- past left paren
2121 Sexpr
:= P_Simple_Expression
;
2123 if Token
= Tok_Apostrophe
then
2124 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2125 Expr_Form
:= EF_Range_Attr
;
2127 if Token
= Tok_Right_Paren
then
2128 Scan
; -- scan past right paren if present
2131 Error_Msg
("parentheses not allowed for range attribute", Lptr
);
2136 Restore_Scan_State
(Scan_State
);
2140 -- Here after dealing with parenthesized range attribute
2142 Sexpr
:= P_Simple_Expression
;
2144 if Token
= Tok_Apostrophe
then
2145 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2146 Expr_Form
:= EF_Range_Attr
;
2152 end P_Simple_Expression_Or_Range_Attribute
;
2158 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2160 -- Error recovery: can raise Error_Resync
2162 function P_Term
return Node_Id
is
2163 Node1
, Node2
: Node_Id
;
2164 Tokptr
: Source_Ptr
;
2170 exit when Token
not in Token_Class_Mulop
;
2171 Tokptr
:= Token_Ptr
;
2172 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2173 Scan
; -- past operator
2174 Set_Left_Opnd
(Node2
, Node1
);
2175 Set_Right_Opnd
(Node2
, P_Factor
);
2186 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2188 -- Error recovery: can raise Error_Resync
2190 function P_Factor
return Node_Id
is
2195 if Token
= Tok_Abs
then
2196 Node1
:= New_Op_Node
(N_Op_Abs
, Token_Ptr
);
2199 Style
.Check_Abs_Not
;
2203 Set_Right_Opnd
(Node1
, P_Primary
);
2206 elsif Token
= Tok_Not
then
2207 Node1
:= New_Op_Node
(N_Op_Not
, Token_Ptr
);
2210 Style
.Check_Abs_Not
;
2214 Set_Right_Opnd
(Node1
, P_Primary
);
2220 if Token
= Tok_Double_Asterisk
then
2221 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2223 Set_Left_Opnd
(Node2
, Node1
);
2224 Set_Right_Opnd
(Node2
, P_Primary
);
2237 -- NUMERIC_LITERAL | null
2238 -- | STRING_LITERAL | AGGREGATE
2239 -- | NAME | QUALIFIED_EXPRESSION
2240 -- | ALLOCATOR | (EXPRESSION)
2242 -- Error recovery: can raise Error_Resync
2244 function P_Primary
return Node_Id
is
2245 Scan_State
: Saved_Scan_State
;
2249 -- The loop runs more than once only if misplaced pragmas are found
2254 -- Name token can start a name, call or qualified expression, all
2255 -- of which are acceptable possibilities for primary. Note also
2256 -- that string literal is included in name (as operator symbol)
2257 -- and type conversion is included in name (as indexed component).
2259 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier
=>
2262 -- All done unless apostrophe follows
2264 if Token
/= Tok_Apostrophe
then
2267 -- Apostrophe following means that we have either just parsed
2268 -- the subtype mark of a qualified expression, or the prefix
2269 -- or a range attribute.
2271 else -- Token = Tok_Apostrophe
2272 Save_Scan_State
(Scan_State
); -- at apostrophe
2273 Scan
; -- past apostrophe
2275 -- If range attribute, then this is always an error, since
2276 -- the only legitimate case (where the scanned expression is
2277 -- a qualified simple name) is handled at the level of the
2278 -- Simple_Expression processing. This case corresponds to a
2279 -- usage such as 3 + A'Range, which is always illegal.
2281 if Token
= Tok_Range
then
2282 Restore_Scan_State
(Scan_State
); -- to apostrophe
2283 Bad_Range_Attribute
(Token_Ptr
);
2286 -- If left paren, then we have a qualified expression.
2287 -- Note that P_Name guarantees that in this case, where
2288 -- Token = Tok_Apostrophe on return, the only two possible
2289 -- tokens following the apostrophe are left paren and
2290 -- RANGE, so we know we have a left paren here.
2292 else -- Token = Tok_Left_Paren
2293 return P_Qualified_Expression
(Node1
);
2298 -- Numeric or string literal
2300 when Tok_Integer_Literal |
2302 Tok_String_Literal
=>
2304 Node1
:= Token_Node
;
2305 Scan
; -- past number
2308 -- Left paren, starts aggregate or parenthesized expression
2310 when Tok_Left_Paren
=>
2312 Expr
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
2315 if Nkind
(Expr
) = N_Attribute_Reference
2316 and then Attribute_Name
(Expr
) = Name_Range
2318 Bad_Range_Attribute
(Sloc
(Expr
));
2333 return New_Node
(N_Null
, Prev_Token_Ptr
);
2335 -- Pragma, not allowed here, so just skip past it
2338 P_Pragmas_Misplaced
;
2340 -- Deal with IF (possible unparenthesized conditional expression)
2344 -- If this looks like a real if, defined as an IF appearing at
2345 -- the start of a new line, then we consider we have a missing
2348 if Token_Is_At_Start_Of_Line
then
2349 Error_Msg_AP
("missing operand");
2352 -- If this looks like a conditional expression, then treat it
2353 -- that way with an error message.
2355 elsif Ada_Version
>= Ada_12
then
2357 ("conditional expression must be parenthesized");
2358 return P_Conditional_Expression
;
2360 -- Otherwise treat as misused identifier
2363 return P_Identifier
;
2366 -- Deal with CASE (possible unparenthesized case expression)
2370 -- If this looks like a real case, defined as a CASE appearing
2371 -- the start of a new line, then we consider we have a missing
2374 if Token_Is_At_Start_Of_Line
then
2375 Error_Msg_AP
("missing operand");
2378 -- If this looks like a case expression, then treat it that way
2379 -- with an error message.
2381 elsif Ada_Version
>= Ada_12
then
2382 Error_Msg_SC
("case expression must be parenthesized");
2383 return P_Case_Expression
;
2385 -- Otherwise treat as misused identifier
2388 return P_Identifier
;
2391 -- Anything else is illegal as the first token of a primary, but
2392 -- we test for a reserved identifier so that it is treated nicely
2395 if Is_Reserved_Identifier
then
2396 return P_Identifier
;
2398 elsif Prev_Token
= Tok_Comma
then
2399 Error_Msg_SP
-- CODEFIX
2400 ("|extra "","" ignored");
2404 Error_Msg_AP
("missing operand");
2412 ---------------------------
2413 -- 4.5 Logical Operator --
2414 ---------------------------
2416 -- LOGICAL_OPERATOR ::= and | or | xor
2418 -- Note: AND THEN and OR ELSE are also treated as logical operators
2419 -- by the parser (even though they are not operators semantically)
2421 -- The value returned is the appropriate Node_Kind code for the operator
2422 -- On return, Token points to the token following the scanned operator.
2424 -- The caller has checked that the first token is a legitimate logical
2425 -- operator token (i.e. is either XOR, AND, OR).
2427 -- Error recovery: cannot raise Error_Resync
2429 function P_Logical_Operator
return Node_Kind
is
2431 if Token
= Tok_And
then
2433 Style
.Check_Binary_Operator
;
2438 if Token
= Tok_Then
then
2445 elsif Token
= Tok_Or
then
2447 Style
.Check_Binary_Operator
;
2452 if Token
= Tok_Else
then
2459 else -- Token = Tok_Xor
2461 Style
.Check_Binary_Operator
;
2467 end P_Logical_Operator
;
2469 ------------------------------
2470 -- 4.5 Relational Operator --
2471 ------------------------------
2473 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2475 -- The value returned is the appropriate Node_Kind code for the operator.
2476 -- On return, Token points to the operator token, NOT past it.
2478 -- The caller has checked that the first token is a legitimate relational
2479 -- operator token (i.e. is one of the operator tokens listed above).
2481 -- Error recovery: cannot raise Error_Resync
2483 function P_Relational_Operator
return Node_Kind
is
2484 Op_Kind
: Node_Kind
;
2485 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
2486 (Tok_Less
=> N_Op_Lt
,
2487 Tok_Equal
=> N_Op_Eq
,
2488 Tok_Greater
=> N_Op_Gt
,
2489 Tok_Not_Equal
=> N_Op_Ne
,
2490 Tok_Greater_Equal
=> N_Op_Ge
,
2491 Tok_Less_Equal
=> N_Op_Le
,
2493 Tok_Not
=> N_Not_In
,
2494 Tok_Box
=> N_Op_Ne
);
2497 if Token
= Tok_Box
then
2498 Error_Msg_SC
-- CODEFIX
2499 ("|""'<'>"" should be ""/=""");
2502 Op_Kind
:= Relop_Node
(Token
);
2505 Style
.Check_Binary_Operator
;
2508 Scan
; -- past operator token
2510 if Prev_Token
= Tok_Not
then
2515 end P_Relational_Operator
;
2517 ---------------------------------
2518 -- 4.5 Binary Adding Operator --
2519 ---------------------------------
2521 -- BINARY_ADDING_OPERATOR ::= + | - | &
2523 -- The value returned is the appropriate Node_Kind code for the operator.
2524 -- On return, Token points to the operator token (NOT past it).
2526 -- The caller has checked that the first token is a legitimate adding
2527 -- operator token (i.e. is one of the operator tokens listed above).
2529 -- Error recovery: cannot raise Error_Resync
2531 function P_Binary_Adding_Operator
return Node_Kind
is
2532 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
2533 (Tok_Ampersand
=> N_Op_Concat
,
2534 Tok_Minus
=> N_Op_Subtract
,
2535 Tok_Plus
=> N_Op_Add
);
2537 return Addop_Node
(Token
);
2538 end P_Binary_Adding_Operator
;
2540 --------------------------------
2541 -- 4.5 Unary Adding Operator --
2542 --------------------------------
2544 -- UNARY_ADDING_OPERATOR ::= + | -
2546 -- The value returned is the appropriate Node_Kind code for the operator.
2547 -- On return, Token points to the operator token (NOT past it).
2549 -- The caller has checked that the first token is a legitimate adding
2550 -- operator token (i.e. is one of the operator tokens listed above).
2552 -- Error recovery: cannot raise Error_Resync
2554 function P_Unary_Adding_Operator
return Node_Kind
is
2555 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
2556 (Tok_Minus
=> N_Op_Minus
,
2557 Tok_Plus
=> N_Op_Plus
);
2559 return Addop_Node
(Token
);
2560 end P_Unary_Adding_Operator
;
2562 -------------------------------
2563 -- 4.5 Multiplying Operator --
2564 -------------------------------
2566 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2568 -- The value returned is the appropriate Node_Kind code for the operator.
2569 -- On return, Token points to the operator token (NOT past it).
2571 -- The caller has checked that the first token is a legitimate multiplying
2572 -- operator token (i.e. is one of the operator tokens listed above).
2574 -- Error recovery: cannot raise Error_Resync
2576 function P_Multiplying_Operator
return Node_Kind
is
2577 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
2578 (Tok_Asterisk
=> N_Op_Multiply
,
2579 Tok_Mod
=> N_Op_Mod
,
2580 Tok_Rem
=> N_Op_Rem
,
2581 Tok_Slash
=> N_Op_Divide
);
2583 return Mulop_Node
(Token
);
2584 end P_Multiplying_Operator
;
2586 --------------------------------------
2587 -- 4.5 Highest Precedence Operator --
2588 --------------------------------------
2590 -- Parsed by P_Factor (4.4)
2592 -- Note: this rule is not in fact used by the grammar at any point!
2594 --------------------------
2595 -- 4.6 Type Conversion --
2596 --------------------------
2598 -- Parsed by P_Primary as a Name (4.1)
2600 -------------------------------
2601 -- 4.7 Qualified Expression --
2602 -------------------------------
2604 -- QUALIFIED_EXPRESSION ::=
2605 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2607 -- The caller has scanned the name which is the Subtype_Mark parameter
2608 -- and scanned past the single quote following the subtype mark. The
2609 -- caller has not checked that this name is in fact appropriate for
2610 -- a subtype mark name (i.e. it is a selected component or identifier).
2612 -- Error_Recovery: cannot raise Error_Resync
2614 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
2615 Qual_Node
: Node_Id
;
2617 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
2618 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
2619 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
2621 end P_Qualified_Expression
;
2623 --------------------
2625 --------------------
2628 -- new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2630 -- The caller has checked that the initial token is NEW
2632 -- Error recovery: can raise Error_Resync
2634 function P_Allocator
return Node_Id
is
2635 Alloc_Node
: Node_Id
;
2636 Type_Node
: Node_Id
;
2637 Null_Exclusion_Present
: Boolean;
2640 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
2643 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2645 Null_Exclusion_Present
:= P_Null_Exclusion
;
2646 Set_Null_Exclusion_Present
(Alloc_Node
, Null_Exclusion_Present
);
2647 Type_Node
:= P_Subtype_Mark_Resync
;
2649 if Token
= Tok_Apostrophe
then
2650 Scan
; -- past apostrophe
2651 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
2655 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));
2661 -----------------------
2662 -- P_Case_Expression --
2663 -----------------------
2665 function P_Case_Expression
return Node_Id
is
2666 Loc
: constant Source_Ptr
:= Token_Ptr
;
2667 Case_Node
: Node_Id
;
2668 Save_State
: Saved_Scan_State
;
2671 if Ada_Version
< Ada_12
then
2672 Error_Msg_SC
("|case expression is an Ada 2012 feature");
2673 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
2678 Make_Case_Expression
(Loc
,
2679 Expression
=> P_Expression_No_Right_Paren
,
2680 Alternatives
=> New_List
);
2683 -- We now have scanned out CASE expression IS, scan alternatives
2687 Append_To
(Alternatives
(Case_Node
), P_Case_Expression_Alternative
);
2689 -- Missing comma if WHEN (more alternatives present)
2691 if Token
= Tok_When
then
2694 -- If comma/WHEN, skip comma and we have another alternative
2696 elsif Token
= Tok_Comma
then
2697 Save_Scan_State
(Save_State
);
2700 if Token
/= Tok_When
then
2701 Restore_Scan_State
(Save_State
);
2705 -- If no comma or WHEN, definitely done
2712 -- If we have an END CASE, diagnose as not needed
2714 if Token
= Tok_End
then
2715 Error_Msg_SC
("`END CASE` not allowed at end of case expression");
2718 if Token
= Tok_Case
then
2723 -- Return the Case_Expression node
2726 end P_Case_Expression
;
2728 -----------------------------------
2729 -- P_Case_Expression_Alternative --
2730 -----------------------------------
2732 -- CASE_STATEMENT_ALTERNATIVE ::=
2733 -- when DISCRETE_CHOICE_LIST =>
2736 -- The caller has checked that and scanned past the initial WHEN token
2737 -- Error recovery: can raise Error_Resync
2739 function P_Case_Expression_Alternative
return Node_Id
is
2740 Case_Alt_Node
: Node_Id
;
2742 Case_Alt_Node
:= New_Node
(N_Case_Expression_Alternative
, Token_Ptr
);
2743 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
2745 Set_Expression
(Case_Alt_Node
, P_Expression
);
2746 return Case_Alt_Node
;
2747 end P_Case_Expression_Alternative
;
2749 ------------------------------
2750 -- P_Conditional_Expression --
2751 ------------------------------
2753 function P_Conditional_Expression
return Node_Id
is
2754 Exprs
: constant List_Id
:= New_List
;
2755 Loc
: constant Source_Ptr
:= Token_Ptr
;
2757 State
: Saved_Scan_State
;
2760 Inside_Conditional_Expression
:= Inside_Conditional_Expression
+ 1;
2762 if Token
= Tok_If
and then Ada_Version
< Ada_12
then
2763 Error_Msg_SC
("|conditional expression is an Ada 2012 feature");
2764 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
2767 Scan
; -- past IF or ELSIF
2768 Append_To
(Exprs
, P_Expression_No_Right_Paren
);
2770 Append_To
(Exprs
, P_Expression
);
2772 -- We now have scanned out IF expr THEN expr
2774 -- Check for common error of semicolon before the ELSE
2776 if Token
= Tok_Semicolon
then
2777 Save_Scan_State
(State
);
2778 Scan
; -- past semicolon
2780 if Token
= Tok_Else
or else Token
= Tok_Elsif
then
2781 Error_Msg_SP
-- CODEFIX
2782 ("|extra "";"" ignored");
2785 Restore_Scan_State
(State
);
2789 -- Scan out ELSIF sequence if present
2791 if Token
= Tok_Elsif
then
2792 Expr
:= P_Conditional_Expression
;
2793 Set_Is_Elsif
(Expr
);
2794 Append_To
(Exprs
, Expr
);
2796 -- Scan out ELSE phrase if present
2798 elsif Token
= Tok_Else
then
2800 -- Scan out ELSE expression
2803 Append_To
(Exprs
, P_Expression
);
2805 -- Two expression case (implied True, filled in during semantics)
2811 -- If we have an END IF, diagnose as not needed
2813 if Token
= Tok_End
then
2815 ("`END IF` not allowed at end of conditional expression");
2818 if Token
= Tok_If
then
2823 Inside_Conditional_Expression
:= Inside_Conditional_Expression
- 1;
2825 -- Return the Conditional_Expression node
2828 Make_Conditional_Expression
(Loc
,
2829 Expressions
=> Exprs
);
2830 end P_Conditional_Expression
;
2832 -----------------------
2833 -- P_Membership_Test --
2834 -----------------------
2836 procedure P_Membership_Test
(N
: Node_Id
) is
2837 Alt
: constant Node_Id
:=
2838 P_Range_Or_Subtype_Mark
2839 (Allow_Simple_Expression
=> (Ada_Version
>= Ada_12
));
2844 if Token
= Tok_Vertical_Bar
then
2845 if Ada_Version
< Ada_12
then
2846 Error_Msg_SC
("set notation is an Ada 2012 feature");
2847 Error_Msg_SC
("\|unit must be compiled with -gnat2012 switch");
2850 Set_Alternatives
(N
, New_List
(Alt
));
2851 Set_Right_Opnd
(N
, Empty
);
2853 -- Loop to accumulate alternatives
2855 while Token
= Tok_Vertical_Bar
loop
2856 Scan
; -- past vertical bar
2859 P_Range_Or_Subtype_Mark
(Allow_Simple_Expression
=> True));
2865 Set_Right_Opnd
(N
, Alt
);
2866 Set_Alternatives
(N
, No_List
);
2868 end P_Membership_Test
;