1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 pragma Style_Checks
(All_Checks
);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
30 with Stringt
; use Stringt
;
35 -- Attributes that cannot have arguments
37 Is_Parameterless_Attribute
: constant Attribute_Class_Array
:=
38 (Attribute_Base
=> True,
39 Attribute_Body_Version
=> True,
40 Attribute_Class
=> True,
41 Attribute_External_Tag
=> True,
42 Attribute_Img
=> True,
43 Attribute_Loop_Entry
=> True,
44 Attribute_Old
=> True,
45 Attribute_Stub_Type
=> True,
46 Attribute_Version
=> True,
47 Attribute_Type_Key
=> True,
49 -- This map contains True for parameterless attributes that return a
50 -- string or a type. For those attributes, a left parenthesis after
51 -- the attribute should not be analyzed as the beginning of a parameters
52 -- list because it may denote a slice operation (X'Img (1 .. 2)) or
53 -- a type conversion (X'Class (Y)). The Ada2012 attribute 'Old is in
56 -- Note: Loop_Entry is in this list because, although it can take an
57 -- optional argument (the loop name), we can't distinguish that at parse
58 -- time from the case where no loop name is given and a legitimate index
59 -- expression is present. So we parse the argument as an indexed component
60 -- and the semantic analysis sorts out this syntactic ambiguity based on
61 -- the type and form of the expression.
63 -- Note that this map designates the minimum set of attributes where a
64 -- construct in parentheses that is not an argument can appear right
65 -- after the attribute. For attributes like 'Size, we do not put them
66 -- in the map. If someone writes X'Size (3), that's illegal in any case,
67 -- but we get a better error message by parsing the (3) as an illegal
68 -- argument to the attribute, rather than some meaningless junk that
69 -- follows the attribute.
71 -----------------------
72 -- Local Subprograms --
73 -----------------------
75 function P_Aggregate_Or_Paren_Expr
return Node_Id
;
76 function P_Allocator
return Node_Id
;
77 function P_Case_Expression_Alternative
return Node_Id
;
78 function P_Record_Or_Array_Component_Association
return Node_Id
;
79 function P_Factor
return Node_Id
;
80 function P_Primary
return Node_Id
;
81 function P_Relation
return Node_Id
;
82 function P_Term
return Node_Id
;
84 function P_Binary_Adding_Operator
return Node_Kind
;
85 function P_Logical_Operator
return Node_Kind
;
86 function P_Multiplying_Operator
return Node_Kind
;
87 function P_Relational_Operator
return Node_Kind
;
88 function P_Unary_Adding_Operator
return Node_Kind
;
90 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
);
91 -- Called to place complaint about bad range attribute at the given
92 -- source location. Terminates by raising Error_Resync.
94 procedure Check_Bad_Exp
;
95 -- Called after scanning a**b, posts error if ** detected
97 procedure P_Membership_Test
(N
: Node_Id
);
98 -- N is the node for a N_In or N_Not_In node whose right operand has not
99 -- yet been processed. It is called just after scanning out the IN keyword.
100 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
102 function P_Range_Attribute_Reference
(Prefix_Node
: Node_Id
) return Node_Id
;
103 -- Scan a range attribute reference. The caller has scanned out the
104 -- prefix. The current token is known to be an apostrophe and the
105 -- following token is known to be RANGE.
107 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
;
108 -- This function is called with Token pointing to IF, CASE, or FOR, in a
109 -- context that allows a case, conditional, or quantified expression if
110 -- it is surrounded by parentheses. If not surrounded by parentheses, the
111 -- expression is still returned, but an error message is issued.
113 -------------------------
114 -- Bad_Range_Attribute --
115 -------------------------
117 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
119 Error_Msg
("range attribute cannot be used in expression!", Loc
);
121 end Bad_Range_Attribute
;
127 procedure Check_Bad_Exp
is
129 if Token
= Tok_Double_Asterisk
then
130 Error_Msg_SC
("parenthesization required for '*'*");
132 Discard_Junk_Node
(P_Primary
);
137 --------------------------
138 -- 4.1 Name (also 6.4) --
139 --------------------------
142 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
143 -- | INDEXED_COMPONENT | SLICE
144 -- | SELECTED_COMPONENT | ATTRIBUTE
145 -- | TYPE_CONVERSION | FUNCTION_CALL
146 -- | CHARACTER_LITERAL
148 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
150 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
152 -- EXPLICIT_DEREFERENCE ::= NAME . all
154 -- IMPLICIT_DEREFERENCE ::= NAME
156 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
158 -- SLICE ::= PREFIX (DISCRETE_RANGE)
160 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
162 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
164 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
166 -- ATTRIBUTE_DESIGNATOR ::=
167 -- IDENTIFIER [(static_EXPRESSION)]
168 -- | access | delta | digits
172 -- | function_PREFIX ACTUAL_PARAMETER_PART
174 -- ACTUAL_PARAMETER_PART ::=
175 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
177 -- PARAMETER_ASSOCIATION ::=
178 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
180 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
182 -- Note: syntactically a procedure call looks just like a function call,
183 -- so this routine is in practice used to scan out procedure calls as well.
185 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
187 -- Error recovery: can raise Error_Resync
189 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
190 -- followed by either a left paren (qualified expression case), or by
191 -- range (range attribute case). All other uses of apostrophe (i.e. all
192 -- other attributes) are handled in this routine.
194 -- Error recovery: can raise Error_Resync
196 function P_Name
return Node_Id
is
197 Scan_State
: Saved_Scan_State
;
199 Prefix_Node
: Node_Id
;
200 Ident_Node
: Node_Id
;
202 Range_Node
: Node_Id
;
205 Arg_List
: List_Id
:= No_List
; -- kill junk warning
206 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
209 -- Case of not a name
211 if Token
not in Token_Class_Name
then
213 -- If it looks like start of expression, complain and scan expression
215 if Token
in Token_Class_Literal
216 or else Token
= Tok_Left_Paren
218 Error_Msg_SC
("name expected");
221 -- Otherwise some other junk, not much we can do
224 Error_Msg_AP
("name expected");
229 -- Loop through designators in qualified name
231 Name_Node
:= Token_Node
;
234 Scan
; -- past designator
235 exit when Token
/= Tok_Dot
;
236 Save_Scan_State
(Scan_State
); -- at dot
239 -- If we do not have another designator after the dot, then join
240 -- the normal circuit to handle a dot extension (may be .all or
241 -- character literal case). Otherwise loop back to scan the next
244 if Token
not in Token_Class_Desig
then
245 goto Scan_Name_Extension_Dot
;
247 Prefix_Node
:= Name_Node
;
248 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
249 Set_Prefix
(Name_Node
, Prefix_Node
);
250 Set_Selector_Name
(Name_Node
, Token_Node
);
254 -- We have now scanned out a qualified designator. If the last token is
255 -- an operator symbol, then we certainly do not have the Snam case, so
256 -- we can just use the normal name extension check circuit
258 if Prev_Token
= Tok_Operator_Symbol
then
259 goto Scan_Name_Extension
;
262 -- We have scanned out a qualified simple name, check for name extension
263 -- Note that we know there is no dot here at this stage, so the only
264 -- possible cases of name extension are apostrophe and left paren.
266 if Token
= Tok_Apostrophe
then
267 Save_Scan_State
(Scan_State
); -- at apostrophe
268 Scan
; -- past apostrophe
270 -- Qualified expression in Ada 2012 mode (treated as a name)
272 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
273 goto Scan_Name_Extension_Apostrophe
;
275 -- If left paren not in Ada 2012, then it is not part of the name,
276 -- since qualified expressions are not names in prior versions of
277 -- Ada, so return with Token backed up to point to the apostrophe.
278 -- The treatment for the range attribute is similar (we do not
279 -- consider x'range to be a name in this grammar).
281 elsif Token
= Tok_Left_Paren
or else Token
= Tok_Range
then
282 Restore_Scan_State
(Scan_State
); -- to apostrophe
283 Expr_Form
:= EF_Simple_Name
;
286 -- Otherwise we have the case of a name extended by an attribute
289 goto Scan_Name_Extension_Apostrophe
;
292 -- Check case of qualified simple name extended by a left parenthesis
294 elsif Token
= Tok_Left_Paren
then
295 Scan
; -- past left paren
296 goto Scan_Name_Extension_Left_Paren
;
298 -- Otherwise the qualified simple name is not extended, so return
301 Expr_Form
:= EF_Simple_Name
;
305 -- Loop scanning past name extensions. A label is used for control
306 -- transfer for this loop for ease of interfacing with the finite state
307 -- machine in the parenthesis scanning circuit, and also to allow for
308 -- passing in control to the appropriate point from the above code.
310 <<Scan_Name_Extension
>>
312 -- Character literal used as name cannot be extended. Also this
313 -- cannot be a call, since the name for a call must be a designator.
314 -- Return in these cases, or if there is no name extension
316 if Token
not in Token_Class_Namext
317 or else Prev_Token
= Tok_Char_Literal
319 Expr_Form
:= EF_Name
;
323 -- Merge here when we know there is a name extension
325 <<Scan_Name_Extension_OK
>>
327 if Token
= Tok_Left_Paren
then
328 Scan
; -- past left paren
329 goto Scan_Name_Extension_Left_Paren
;
331 elsif Token
= Tok_Apostrophe
then
332 Save_Scan_State
(Scan_State
); -- at apostrophe
333 Scan
; -- past apostrophe
334 goto Scan_Name_Extension_Apostrophe
;
336 else -- Token = Tok_Dot
337 Save_Scan_State
(Scan_State
); -- at dot
339 goto Scan_Name_Extension_Dot
;
342 -- Case of name extended by dot (selection), dot is already skipped
343 -- and the scan state at the point of the dot is saved in Scan_State.
345 <<Scan_Name_Extension_Dot
>>
347 -- Explicit dereference case
349 if Token
= Tok_All
then
350 Prefix_Node
:= Name_Node
;
351 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
352 Set_Prefix
(Name_Node
, Prefix_Node
);
354 goto Scan_Name_Extension
;
356 -- Selected component case
358 elsif Token
in Token_Class_Name
then
359 Prefix_Node
:= Name_Node
;
360 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
361 Set_Prefix
(Name_Node
, Prefix_Node
);
362 Set_Selector_Name
(Name_Node
, Token_Node
);
363 Scan
; -- past selector
364 goto Scan_Name_Extension
;
366 -- Reserved identifier as selector
368 elsif Is_Reserved_Identifier
then
369 Scan_Reserved_Identifier
(Force_Msg
=> False);
370 Prefix_Node
:= Name_Node
;
371 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
372 Set_Prefix
(Name_Node
, Prefix_Node
);
373 Set_Selector_Name
(Name_Node
, Token_Node
);
374 Scan
; -- past identifier used as selector
375 goto Scan_Name_Extension
;
377 -- If dot is at end of line and followed by nothing legal,
378 -- then assume end of name and quit (dot will be taken as
379 -- an incorrect form of some other punctuation by our caller).
381 elsif Token_Is_At_Start_Of_Line
then
382 Restore_Scan_State
(Scan_State
);
385 -- Here if nothing legal after the dot
388 Error_Msg_AP
("selector expected");
392 -- Here for an apostrophe as name extension. The scan position at the
393 -- apostrophe has already been saved, and the apostrophe scanned out.
395 <<Scan_Name_Extension_Apostrophe
>>
397 Scan_Apostrophe
: declare
398 function Apostrophe_Should_Be_Semicolon
return Boolean;
399 -- Checks for case where apostrophe should probably be
400 -- a semicolon, and if so, gives appropriate message,
401 -- resets the scan pointer to the apostrophe, changes
402 -- the current token to Tok_Semicolon, and returns True.
403 -- Otherwise returns False.
405 ------------------------------------
406 -- Apostrophe_Should_Be_Semicolon --
407 ------------------------------------
409 function Apostrophe_Should_Be_Semicolon
return Boolean is
411 if Token_Is_At_Start_Of_Line
then
412 Restore_Scan_State
(Scan_State
); -- to apostrophe
413 Error_Msg_SC
("|""''"" should be "";""");
414 Token
:= Tok_Semicolon
;
419 end Apostrophe_Should_Be_Semicolon
;
421 -- Start of processing for Scan_Apostrophe
424 -- Check for qualified expression case in Ada 2012 mode
426 if Ada_Version
>= Ada_2012
and then Token
= Tok_Left_Paren
then
427 Name_Node
:= P_Qualified_Expression
(Name_Node
);
428 goto Scan_Name_Extension
;
430 -- If range attribute after apostrophe, then return with Token
431 -- pointing to the apostrophe. Note that in this case the prefix
432 -- need not be a simple name (cases like A.all'range). Similarly
433 -- if there is a left paren after the apostrophe, then we also
434 -- return with Token pointing to the apostrophe (this is the
435 -- aggregate case, or some error case).
437 elsif Token
= Tok_Range
or else Token
= Tok_Left_Paren
then
438 Restore_Scan_State
(Scan_State
); -- to apostrophe
439 Expr_Form
:= EF_Name
;
442 -- Here for cases where attribute designator is an identifier
444 elsif Token
= Tok_Identifier
then
445 Attr_Name
:= Token_Name
;
447 if not Is_Attribute_Name
(Attr_Name
) then
448 if Apostrophe_Should_Be_Semicolon
then
449 Expr_Form
:= EF_Name
;
452 -- Here for a bad attribute name
455 Signal_Bad_Attribute
;
456 Scan
; -- past bad identifier
458 if Token
= Tok_Left_Paren
then
459 Scan
; -- past left paren
462 Discard_Junk_Node
(P_Expression_If_OK
);
463 exit when not Comma_Present
;
474 Style
.Check_Attribute_Name
(False);
477 -- Here for case of attribute designator is not an identifier
480 if Token
= Tok_Delta
then
481 Attr_Name
:= Name_Delta
;
483 elsif Token
= Tok_Digits
then
484 Attr_Name
:= Name_Digits
;
486 elsif Token
= Tok_Access
then
487 Attr_Name
:= Name_Access
;
489 elsif Token
= Tok_Mod
and then Ada_Version
>= Ada_95
then
490 Attr_Name
:= Name_Mod
;
492 elsif Apostrophe_Should_Be_Semicolon
then
493 Expr_Form
:= EF_Name
;
497 Error_Msg_AP
("attribute designator expected");
502 Style
.Check_Attribute_Name
(True);
506 -- We come here with an OK attribute scanned, and corresponding
507 -- Attribute identifier node stored in Ident_Node.
509 Prefix_Node
:= Name_Node
;
510 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
511 Scan
; -- past attribute designator
512 Set_Prefix
(Name_Node
, Prefix_Node
);
513 Set_Attribute_Name
(Name_Node
, Attr_Name
);
515 -- Scan attribute arguments/designator. We skip this if we know
516 -- that the attribute cannot have an argument (see documentation
517 -- of Is_Parameterless_Attribute for further details).
519 if Token
= Tok_Left_Paren
521 Is_Parameterless_Attribute
(Get_Attribute_Id
(Attr_Name
))
523 -- Attribute Update contains an array or record association
524 -- list which provides new values for various components or
525 -- elements. The list is parsed as an aggregate, and we get
526 -- better error handling by knowing that in the parser.
528 if Attr_Name
= Name_Update
then
529 Set_Expressions
(Name_Node
, New_List
);
530 Append
(P_Aggregate
, Expressions
(Name_Node
));
532 -- All other cases of parsing attribute arguments
535 Set_Expressions
(Name_Node
, New_List
);
536 Scan
; -- past left paren
540 Expr
: constant Node_Id
:= P_Expression_If_OK
;
544 -- Case of => for named notation
546 if Token
= Tok_Arrow
then
548 -- Named notation allowed only for the special
549 -- case of System'Restriction_Set (No_Dependence =>
550 -- unit_NAME), in which case construct a parameter
551 -- assocation node and append to the arguments.
553 if Attr_Name
= Name_Restriction_Set
554 and then Nkind
(Expr
) = N_Identifier
555 and then Chars
(Expr
) = Name_No_Dependence
559 Append_To
(Expressions
(Name_Node
),
560 Make_Parameter_Association
(Sloc
(Rnam
),
561 Selector_Name
=> Expr
,
562 Explicit_Actual_Parameter
=> Rnam
));
565 -- For all other cases named notation is illegal
569 ("named parameters not permitted "
571 Scan
; -- past junk arrow
574 -- Here for normal case (not => for named parameter)
577 Append
(Expr
, Expressions
(Name_Node
));
578 exit when not Comma_Present
;
587 goto Scan_Name_Extension
;
590 -- Here for left parenthesis extending name (left paren skipped)
592 <<Scan_Name_Extension_Left_Paren
>>
594 -- We now have to scan through a list of items, terminated by a
595 -- right parenthesis. The scan is handled by a finite state
596 -- machine. The possibilities are:
600 -- This is a slice. This case is handled in LP_State_Init
602 -- (expression, expression, ..)
604 -- This is interpreted as an indexed component, i.e. as a
605 -- case of a name which can be extended in the normal manner.
606 -- This case is handled by LP_State_Name or LP_State_Expr.
608 -- Note: if and case expressions (without an extra level of
609 -- parentheses) are permitted in this context).
611 -- (..., identifier => expression , ...)
613 -- If there is at least one occurrence of identifier => (but
614 -- none of the other cases apply), then we have a call.
616 -- Test for Id => case
618 if Token
= Tok_Identifier
then
619 Save_Scan_State
(Scan_State
); -- at Id
622 -- Test for => (allow := as an error substitute)
624 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
625 Restore_Scan_State
(Scan_State
); -- to Id
626 Arg_List
:= New_List
;
630 Restore_Scan_State
(Scan_State
); -- to Id
634 -- Here we have an expression after all
636 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
638 -- Check cases of discrete range for a slice
640 -- First possibility: Range_Attribute_Reference
642 if Expr_Form
= EF_Range_Attr
then
643 Range_Node
:= Expr_Node
;
645 -- Second possibility: Simple_expression .. Simple_expression
647 elsif Token
= Tok_Dot_Dot
then
648 Check_Simple_Expression
(Expr_Node
);
649 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
650 Set_Low_Bound
(Range_Node
, Expr_Node
);
652 Expr_Node
:= P_Expression
;
653 Check_Simple_Expression
(Expr_Node
);
654 Set_High_Bound
(Range_Node
, Expr_Node
);
656 -- Third possibility: Type_name range Range
658 elsif Token
= Tok_Range
then
659 if Expr_Form
/= EF_Simple_Name
then
660 Error_Msg_SC
("subtype mark must precede RANGE");
664 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
666 -- Otherwise we just have an expression. It is true that we might
667 -- have a subtype mark without a range constraint but this case
668 -- is syntactically indistinguishable from the expression case.
671 Arg_List
:= New_List
;
675 -- Fall through here with unmistakable Discrete range scanned,
676 -- which means that we definitely have the case of a slice. The
677 -- Discrete range is in Range_Node.
679 if Token
= Tok_Comma
then
680 Error_Msg_SC
("slice cannot have more than one dimension");
683 elsif Token
/= Tok_Right_Paren
then
684 if Token
= Tok_Arrow
then
686 -- This may be an aggregate that is missing a qualification
689 ("context of aggregate must be a qualified expression");
698 Scan
; -- past right paren
699 Prefix_Node
:= Name_Node
;
700 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
701 Set_Prefix
(Name_Node
, Prefix_Node
);
702 Set_Discrete_Range
(Name_Node
, Range_Node
);
704 -- An operator node is legal as a prefix to other names,
705 -- but not for a slice.
707 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
708 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
711 -- If we have a name extension, go scan it
713 if Token
in Token_Class_Namext
then
714 goto Scan_Name_Extension_OK
;
716 -- Otherwise return (a slice is a name, but is not a call)
719 Expr_Form
:= EF_Name
;
724 -- In LP_State_Expr, we have scanned one or more expressions, and
725 -- so we have a call or an indexed component which is a name. On
726 -- entry we have the expression just scanned in Expr_Node and
727 -- Arg_List contains the list of expressions encountered so far
730 Append
(Expr_Node
, Arg_List
);
732 if Token
= Tok_Arrow
then
734 ("expect identifier in parameter association", Sloc
(Expr_Node
));
737 elsif not Comma_Present
then
740 Prefix_Node
:= Name_Node
;
741 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
742 Set_Prefix
(Name_Node
, Prefix_Node
);
743 Set_Expressions
(Name_Node
, Arg_List
);
745 goto Scan_Name_Extension
;
748 -- Comma present (and scanned out), test for identifier => case
749 -- Test for identifier => case
751 if Token
= Tok_Identifier
then
752 Save_Scan_State
(Scan_State
); -- at Id
755 -- Test for => (allow := as error substitute)
757 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
758 Restore_Scan_State
(Scan_State
); -- to Id
761 -- Otherwise it's just an expression after all, so backup
764 Restore_Scan_State
(Scan_State
); -- to Id
768 -- Here we have an expression after all, so stay in this state
770 Expr_Node
:= P_Expression_If_OK
;
773 -- LP_State_Call corresponds to the situation in which at least one
774 -- instance of Id => Expression has been encountered, so we know that
775 -- we do not have a name, but rather a call. We enter it with the
776 -- scan pointer pointing to the next argument to scan, and Arg_List
777 -- containing the list of arguments scanned so far.
781 -- Test for case of Id => Expression (named parameter)
783 if Token
= Tok_Identifier
then
784 Save_Scan_State
(Scan_State
); -- at Id
785 Ident_Node
:= Token_Node
;
788 -- Deal with => (allow := as incorrect substitute)
790 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
791 Arg_Node
:= New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
792 Set_Selector_Name
(Arg_Node
, Ident_Node
);
794 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
795 Append
(Arg_Node
, Arg_List
);
797 -- If a comma follows, go back and scan next entry
799 if Comma_Present
then
802 -- Otherwise we have the end of a call
805 Prefix_Node
:= Name_Node
;
806 Name_Node
:= New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
807 Set_Name
(Name_Node
, Prefix_Node
);
808 Set_Parameter_Associations
(Name_Node
, Arg_List
);
811 if Token
in Token_Class_Namext
then
812 goto Scan_Name_Extension_OK
;
814 -- This is a case of a call which cannot be a name
817 Expr_Form
:= EF_Name
;
822 -- Not named parameter: Id started an expression after all
825 Restore_Scan_State
(Scan_State
); -- to Id
829 -- Here if entry did not start with Id => which means that it
830 -- is a positional parameter, which is not allowed, since we
831 -- have seen at least one named parameter already.
834 ("positional parameter association " &
835 "not allowed after named one");
837 Expr_Node
:= P_Expression_If_OK
;
839 -- Leaving the '>' in an association is not unusual, so suggest
842 if Nkind
(Expr_Node
) = N_Op_Eq
then
843 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
846 -- We go back to scanning out expressions, so that we do not get
847 -- multiple error messages when several positional parameters
848 -- follow a named parameter.
852 -- End of treatment for name extensions starting with left paren
854 -- End of loop through name extensions
858 -- This function parses a restricted form of Names which are either
859 -- designators, or designators preceded by a sequence of prefixes
860 -- that are direct names.
862 -- Error recovery: cannot raise Error_Resync
864 function P_Function_Name
return Node_Id
is
865 Designator_Node
: Node_Id
;
866 Prefix_Node
: Node_Id
;
867 Selector_Node
: Node_Id
;
868 Dot_Sloc
: Source_Ptr
:= No_Location
;
871 -- Prefix_Node is set to the gathered prefix so far, Empty means that
872 -- no prefix has been scanned. This allows us to build up the result
873 -- in the required right recursive manner.
875 Prefix_Node
:= Empty
;
877 -- Loop through prefixes
880 Designator_Node
:= Token_Node
;
882 if Token
not in Token_Class_Desig
then
883 return P_Identifier
; -- let P_Identifier issue the error message
885 else -- Token in Token_Class_Desig
886 Scan
; -- past designator
887 exit when Token
/= Tok_Dot
;
890 -- Here at a dot, with token just before it in Designator_Node
892 if No
(Prefix_Node
) then
893 Prefix_Node
:= Designator_Node
;
895 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
896 Set_Prefix
(Selector_Node
, Prefix_Node
);
897 Set_Selector_Name
(Selector_Node
, Designator_Node
);
898 Prefix_Node
:= Selector_Node
;
901 Dot_Sloc
:= Token_Ptr
;
905 -- Fall out of the loop having just scanned a designator
907 if No
(Prefix_Node
) then
908 return Designator_Node
;
910 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
911 Set_Prefix
(Selector_Node
, Prefix_Node
);
912 Set_Selector_Name
(Selector_Node
, Designator_Node
);
913 return Selector_Node
;
921 -- This function parses a restricted form of Names which are either
922 -- identifiers, or identifiers preceded by a sequence of prefixes
923 -- that are direct names.
925 -- Error recovery: cannot raise Error_Resync
927 function P_Qualified_Simple_Name
return Node_Id
is
928 Designator_Node
: Node_Id
;
929 Prefix_Node
: Node_Id
;
930 Selector_Node
: Node_Id
;
931 Dot_Sloc
: Source_Ptr
:= No_Location
;
934 -- Prefix node is set to the gathered prefix so far, Empty means that
935 -- no prefix has been scanned. This allows us to build up the result
936 -- in the required right recursive manner.
938 Prefix_Node
:= Empty
;
940 -- Loop through prefixes
943 Designator_Node
:= Token_Node
;
945 if Token
= Tok_Identifier
then
946 Scan
; -- past identifier
947 exit when Token
/= Tok_Dot
;
949 elsif Token
not in Token_Class_Desig
then
950 return P_Identifier
; -- let P_Identifier issue the error message
953 Scan
; -- past designator
955 if Token
/= Tok_Dot
then
956 Error_Msg_SP
("identifier expected");
961 -- Here at a dot, with token just before it in Designator_Node
963 if No
(Prefix_Node
) then
964 Prefix_Node
:= Designator_Node
;
966 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
967 Set_Prefix
(Selector_Node
, Prefix_Node
);
968 Set_Selector_Name
(Selector_Node
, Designator_Node
);
969 Prefix_Node
:= Selector_Node
;
972 Dot_Sloc
:= Token_Ptr
;
976 -- Fall out of the loop having just scanned an identifier
978 if No
(Prefix_Node
) then
979 return Designator_Node
;
981 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
982 Set_Prefix
(Selector_Node
, Prefix_Node
);
983 Set_Selector_Name
(Selector_Node
, Designator_Node
);
984 return Selector_Node
;
990 end P_Qualified_Simple_Name
;
992 -- This procedure differs from P_Qualified_Simple_Name only in that it
993 -- raises Error_Resync if any error is encountered. It only returns after
994 -- scanning a valid qualified simple name.
996 -- Error recovery: can raise Error_Resync
998 function P_Qualified_Simple_Name_Resync
return Node_Id
is
999 Designator_Node
: Node_Id
;
1000 Prefix_Node
: Node_Id
;
1001 Selector_Node
: Node_Id
;
1002 Dot_Sloc
: Source_Ptr
:= No_Location
;
1005 Prefix_Node
:= Empty
;
1007 -- Loop through prefixes
1010 Designator_Node
:= Token_Node
;
1012 if Token
= Tok_Identifier
then
1013 Scan
; -- past identifier
1014 exit when Token
/= Tok_Dot
;
1016 elsif Token
not in Token_Class_Desig
then
1017 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
1021 Scan
; -- past designator
1023 if Token
/= Tok_Dot
then
1024 Error_Msg_SP
("identifier expected");
1029 -- Here at a dot, with token just before it in Designator_Node
1031 if No
(Prefix_Node
) then
1032 Prefix_Node
:= Designator_Node
;
1034 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1035 Set_Prefix
(Selector_Node
, Prefix_Node
);
1036 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1037 Prefix_Node
:= Selector_Node
;
1040 Dot_Sloc
:= Token_Ptr
;
1041 Scan
; -- past period
1044 -- Fall out of the loop having just scanned an identifier
1046 if No
(Prefix_Node
) then
1047 return Designator_Node
;
1049 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
1050 Set_Prefix
(Selector_Node
, Prefix_Node
);
1051 Set_Selector_Name
(Selector_Node
, Designator_Node
);
1052 return Selector_Node
;
1054 end P_Qualified_Simple_Name_Resync
;
1056 ----------------------
1057 -- 4.1 Direct_Name --
1058 ----------------------
1060 -- Parsed by P_Name and other functions in section 4.1
1066 -- Parsed by P_Name (4.1)
1068 -------------------------------
1069 -- 4.1 Explicit Dereference --
1070 -------------------------------
1072 -- Parsed by P_Name (4.1)
1074 -------------------------------
1075 -- 4.1 Implicit_Dereference --
1076 -------------------------------
1078 -- Parsed by P_Name (4.1)
1080 ----------------------------
1081 -- 4.1 Indexed Component --
1082 ----------------------------
1084 -- Parsed by P_Name (4.1)
1090 -- Parsed by P_Name (4.1)
1092 -----------------------------
1093 -- 4.1 Selected_Component --
1094 -----------------------------
1096 -- Parsed by P_Name (4.1)
1098 ------------------------
1099 -- 4.1 Selector Name --
1100 ------------------------
1102 -- Parsed by P_Name (4.1)
1104 ------------------------------
1105 -- 4.1 Attribute Reference --
1106 ------------------------------
1108 -- Parsed by P_Name (4.1)
1110 -------------------------------
1111 -- 4.1 Attribute Designator --
1112 -------------------------------
1114 -- Parsed by P_Name (4.1)
1116 --------------------------------------
1117 -- 4.1.4 Range Attribute Reference --
1118 --------------------------------------
1120 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1122 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1124 -- In the grammar, a RANGE attribute is simply a name, but its use is
1125 -- highly restricted, so in the parser, we do not regard it as a name.
1126 -- Instead, P_Name returns without scanning the 'RANGE part of the
1127 -- attribute, and the caller uses the following function to construct
1128 -- a range attribute in places where it is appropriate.
1130 -- Note that RANGE here is treated essentially as an identifier,
1131 -- rather than a reserved word.
1133 -- The caller has parsed the prefix, i.e. a name, and Token points to
1134 -- the apostrophe. The token after the apostrophe is known to be RANGE
1135 -- at this point. The prefix node becomes the prefix of the attribute.
1137 -- Error_Recovery: Cannot raise Error_Resync
1139 function P_Range_Attribute_Reference
1140 (Prefix_Node
: Node_Id
)
1143 Attr_Node
: Node_Id
;
1146 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1147 Set_Prefix
(Attr_Node
, Prefix_Node
);
1148 Scan
; -- past apostrophe
1151 Style
.Check_Attribute_Name
(True);
1154 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1157 if Token
= Tok_Left_Paren
then
1158 Scan
; -- past left paren
1159 Set_Expressions
(Attr_Node
, New_List
(P_Expression_If_OK
));
1164 end P_Range_Attribute_Reference
;
1166 ---------------------------------------
1167 -- 4.1.4 Range Attribute Designator --
1168 ---------------------------------------
1170 -- Parsed by P_Range_Attribute_Reference (4.4)
1172 --------------------
1174 --------------------
1176 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1178 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1179 -- an aggregate is known to be required (code statement, extension
1180 -- aggregate), in which cases this routine performs the necessary check
1181 -- that we have an aggregate rather than a parenthesized expression
1183 -- Error recovery: can raise Error_Resync
1185 function P_Aggregate
return Node_Id
is
1186 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1187 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1190 if Nkind
(Aggr_Node
) /= N_Aggregate
1192 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1195 ("aggregate may not have single positional component", Aggr_Sloc
);
1202 ------------------------------------------------
1203 -- 4.3 Aggregate or Parenthesized Expression --
1204 ------------------------------------------------
1206 -- This procedure parses out either an aggregate or a parenthesized
1207 -- expression (these two constructs are closely related, since a
1208 -- parenthesized expression looks like an aggregate with a single
1209 -- positional component).
1212 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1214 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1216 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1217 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1220 -- RECORD_COMPONENT_ASSOCIATION ::=
1221 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1223 -- COMPONENT_CHOICE_LIST ::=
1224 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1227 -- EXTENSION_AGGREGATE ::=
1228 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1230 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1232 -- ARRAY_AGGREGATE ::=
1233 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1235 -- POSITIONAL_ARRAY_AGGREGATE ::=
1236 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1237 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1238 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1240 -- NAMED_ARRAY_AGGREGATE ::=
1241 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1243 -- PRIMARY ::= (EXPRESSION);
1245 -- Error recovery: can raise Error_Resync
1247 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1248 -- to Ada 2005 limited aggregates (AI-287)
1250 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1251 Aggregate_Node
: Node_Id
;
1252 Expr_List
: List_Id
;
1253 Assoc_List
: List_Id
;
1254 Expr_Node
: Node_Id
;
1255 Lparen_Sloc
: Source_Ptr
;
1256 Scan_State
: Saved_Scan_State
;
1258 procedure Box_Error
;
1259 -- Called if <> is encountered as positional aggregate element. Issues
1260 -- error message and sets Expr_Node to Error.
1266 procedure Box_Error
is
1268 if Ada_Version
< Ada_2005
then
1269 Error_Msg_SC
("box in aggregate is an Ada 2005 extension");
1272 -- Ada 2005 (AI-287): The box notation is allowed only with named
1273 -- notation because positional notation might be error prone. For
1274 -- example, in "(X, <>, Y, <>)", there is no type associated with
1275 -- the boxes, so you might not be leaving out the components you
1276 -- thought you were leaving out.
1278 Error_Msg_SC
("(Ada 2005) box only allowed with named notation");
1283 -- Start of processing for P_Aggregate_Or_Paren_Expr
1286 Lparen_Sloc
:= Token_Ptr
;
1289 -- Note on parentheses count. For cases like an if expression, the
1290 -- parens here really count as real parentheses for the paren count,
1291 -- so we adjust the paren count accordingly after scanning the expr.
1295 if Token
= Tok_If
then
1296 Expr_Node
:= P_If_Expression
;
1298 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1303 elsif Token
= Tok_Case
then
1304 Expr_Node
:= P_Case_Expression
;
1306 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1309 -- Quantified expression
1311 elsif Token
= Tok_For
then
1312 Expr_Node
:= P_Quantified_Expression
;
1314 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1317 -- Note: the mechanism used here of rescanning the initial expression
1318 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1319 -- out the discrete choice list.
1321 -- Deal with expression and extension aggregates first
1323 elsif Token
/= Tok_Others
then
1324 Save_Scan_State
(Scan_State
); -- at start of expression
1326 -- Deal with (NULL RECORD)
1328 if Token
= Tok_Null
then
1331 if Token
= Tok_Record
then
1332 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1333 Set_Null_Record_Present
(Aggregate_Node
, True);
1334 Scan
; -- past RECORD
1336 return Aggregate_Node
;
1338 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1342 -- Scan expression, handling box appearing as positional argument
1344 if Token
= Tok_Box
then
1347 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1350 -- Extension aggregate
1352 if Token
= Tok_With
then
1353 if Nkind
(Expr_Node
) = N_Attribute_Reference
1354 and then Attribute_Name
(Expr_Node
) = Name_Range
1356 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1360 if Ada_Version
= Ada_83
then
1361 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1364 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1365 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1368 -- Deal with WITH NULL RECORD case
1370 if Token
= Tok_Null
then
1371 Save_Scan_State
(Scan_State
); -- at NULL
1374 if Token
= Tok_Record
then
1375 Scan
; -- past RECORD
1376 Set_Null_Record_Present
(Aggregate_Node
, True);
1378 return Aggregate_Node
;
1381 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1385 if Token
/= Tok_Others
then
1386 Save_Scan_State
(Scan_State
);
1387 Expr_Node
:= P_Expression
;
1394 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1395 if Nkind
(Expr_Node
) = N_Attribute_Reference
1396 and then Attribute_Name
(Expr_Node
) = Name_Range
1399 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
1400 Scan
; -- past right paren
1404 -- Bump paren count of expression
1406 if Expr_Node
/= Error
then
1407 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1410 T_Right_Paren
; -- past right paren (error message if none)
1416 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1422 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1426 -- Prepare to scan list of component associations
1428 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1429 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1431 -- This loop scans through component associations. On entry to the
1432 -- loop, an expression has been scanned at the start of the current
1433 -- association unless initial token was OTHERS, in which case
1434 -- Expr_Node is set to Empty.
1437 -- Deal with others association first. This is a named association
1439 if No
(Expr_Node
) then
1440 if No
(Assoc_List
) then
1441 Assoc_List
:= New_List
;
1444 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1446 -- Improper use of WITH
1448 elsif Token
= Tok_With
then
1449 Error_Msg_SC
("WITH must be preceded by single expression in " &
1450 "extension aggregate");
1453 -- Range attribute can only appear as part of a discrete choice list
1455 elsif Nkind
(Expr_Node
) = N_Attribute_Reference
1456 and then Attribute_Name
(Expr_Node
) = Name_Range
1457 and then Token
/= Tok_Arrow
1458 and then Token
/= Tok_Vertical_Bar
1460 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1463 -- Assume positional case if comma, right paren, or literal or
1464 -- identifier or OTHERS follows (the latter cases are missing
1465 -- comma cases). Also assume positional if a semicolon follows,
1466 -- which can happen if there are missing parens
1468 elsif Token
= Tok_Comma
1469 or else Token
= Tok_Right_Paren
1470 or else Token
= Tok_Others
1471 or else Token
in Token_Class_Lit_Or_Name
1472 or else Token
= Tok_Semicolon
1474 if Present
(Assoc_List
) then
1475 Error_Msg_BC
-- CODEFIX
1476 ("""='>"" expected (positional association cannot follow " &
1477 "named association)");
1480 if No
(Expr_List
) then
1481 Expr_List
:= New_List
;
1484 Append
(Expr_Node
, Expr_List
);
1486 -- Check for aggregate followed by left parent, maybe missing comma
1488 elsif Nkind
(Expr_Node
) = N_Aggregate
1489 and then Token
= Tok_Left_Paren
1493 if No
(Expr_List
) then
1494 Expr_List
:= New_List
;
1497 Append
(Expr_Node
, Expr_List
);
1499 -- Anything else is assumed to be a named association
1502 Restore_Scan_State
(Scan_State
); -- to start of expression
1504 if No
(Assoc_List
) then
1505 Assoc_List
:= New_List
;
1508 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1511 exit when not Comma_Present
;
1513 -- If we are at an expression terminator, something is seriously
1514 -- wrong, so let's get out now, before we start eating up stuff
1515 -- that doesn't belong to us.
1517 if Token
in Token_Class_Eterm
then
1519 ("expecting expression or component association");
1523 -- Deal with misused box
1525 if Token
= Tok_Box
then
1528 -- Otherwise initiate for reentry to top of loop by scanning an
1529 -- initial expression, unless the first token is OTHERS.
1531 elsif Token
= Tok_Others
then
1535 Save_Scan_State
(Scan_State
); -- at start of expression
1536 Expr_Node
:= P_Expression_Or_Range_Attribute_If_OK
;
1541 -- All component associations (positional and named) have been scanned
1544 Set_Expressions
(Aggregate_Node
, Expr_List
);
1545 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1546 return Aggregate_Node
;
1547 end P_Aggregate_Or_Paren_Expr
;
1549 ------------------------------------------------
1550 -- 4.3 Record or Array Component Association --
1551 ------------------------------------------------
1553 -- RECORD_COMPONENT_ASSOCIATION ::=
1554 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1555 -- | COMPONENT_CHOICE_LIST => <>
1557 -- COMPONENT_CHOICE_LIST =>
1558 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1561 -- ARRAY_COMPONENT_ASSOCIATION ::=
1562 -- DISCRETE_CHOICE_LIST => EXPRESSION
1563 -- | DISCRETE_CHOICE_LIST => <>
1565 -- Note: this routine only handles the named cases, including others.
1566 -- Cases where the component choice list is not present have already
1567 -- been handled directly.
1569 -- Error recovery: can raise Error_Resync
1571 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1572 -- rules have been extended to give support to Ada 2005 limited
1573 -- aggregates (AI-287)
1575 function P_Record_Or_Array_Component_Association
return Node_Id
is
1576 Assoc_Node
: Node_Id
;
1579 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1580 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1581 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1584 if Token
= Tok_Box
then
1586 -- Ada 2005(AI-287): The box notation is used to indicate the
1587 -- default initialization of aggregate components
1589 if Ada_Version
< Ada_2005
then
1591 ("component association with '<'> is an Ada 2005 extension");
1592 Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
1595 Set_Box_Present
(Assoc_Node
);
1598 Set_Expression
(Assoc_Node
, P_Expression
);
1602 end P_Record_Or_Array_Component_Association
;
1604 -----------------------------
1605 -- 4.3.1 Record Aggregate --
1606 -----------------------------
1608 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1609 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1611 ----------------------------------------------
1612 -- 4.3.1 Record Component Association List --
1613 ----------------------------------------------
1615 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1617 ----------------------------------
1618 -- 4.3.1 Component Choice List --
1619 ----------------------------------
1621 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1623 --------------------------------
1624 -- 4.3.1 Extension Aggregate --
1625 --------------------------------
1627 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1629 --------------------------
1630 -- 4.3.1 Ancestor Part --
1631 --------------------------
1633 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1635 ----------------------------
1636 -- 4.3.1 Array Aggregate --
1637 ----------------------------
1639 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1641 ---------------------------------------
1642 -- 4.3.1 Positional Array Aggregate --
1643 ---------------------------------------
1645 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1647 ----------------------------------
1648 -- 4.3.1 Named Array Aggregate --
1649 ----------------------------------
1651 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1653 ----------------------------------------
1654 -- 4.3.1 Array Component Association --
1655 ----------------------------------------
1657 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1659 ---------------------
1660 -- 4.4 Expression --
1661 ---------------------
1663 -- This procedure parses EXPRESSION or CHOICE_EXPRESSION
1666 -- RELATION {LOGICAL_OPERATOR RELATION}
1668 -- CHOICE_EXPRESSION ::=
1669 -- CHOICE_RELATION {LOGICAL_OPERATOR CHOICE_RELATION}
1671 -- LOGICAL_OPERATOR ::= and | and then | or | or else | xor
1673 -- On return, Expr_Form indicates the categorization of the expression
1674 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1675 -- an error message is given, and Error is returned).
1677 -- Error recovery: cannot raise Error_Resync
1679 function P_Expression
return Node_Id
is
1680 Logical_Op
: Node_Kind
;
1681 Prev_Logical_Op
: Node_Kind
;
1682 Op_Location
: Source_Ptr
;
1687 Node1
:= P_Relation
;
1689 if Token
in Token_Class_Logop
then
1690 Prev_Logical_Op
:= N_Empty
;
1693 Op_Location
:= Token_Ptr
;
1694 Logical_Op
:= P_Logical_Operator
;
1696 if Prev_Logical_Op
/= N_Empty
and then
1697 Logical_Op
/= Prev_Logical_Op
1700 ("mixed logical operators in expression", Op_Location
);
1701 Prev_Logical_Op
:= N_Empty
;
1703 Prev_Logical_Op
:= Logical_Op
;
1707 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1708 Set_Left_Opnd
(Node1
, Node2
);
1709 Set_Right_Opnd
(Node1
, P_Relation
);
1710 exit when Token
not in Token_Class_Logop
;
1713 Expr_Form
:= EF_Non_Simple
;
1716 if Token
= Tok_Apostrophe
then
1717 Bad_Range_Attribute
(Token_Ptr
);
1724 -- This function is identical to the normal P_Expression, except that it
1725 -- also permits the appearance of a case, conditional, or quantified
1726 -- expression if the call immediately follows a left paren, and followed
1727 -- by a right parenthesis. These forms are allowed if these conditions
1728 -- are not met, but an error message will be issued.
1730 function P_Expression_If_OK
return Node_Id
is
1732 -- Case of conditional, case or quantified expression
1734 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1735 return P_Unparen_Cond_Case_Quant_Expression
;
1737 -- Normal case, not case/conditional/quantified expression
1740 return P_Expression
;
1742 end P_Expression_If_OK
;
1744 -- This function is identical to the normal P_Expression, except that it
1745 -- checks that the expression scan did not stop on a right paren. It is
1746 -- called in all contexts where a right parenthesis cannot legitimately
1747 -- follow an expression.
1749 -- Error recovery: can not raise Error_Resync
1751 function P_Expression_No_Right_Paren
return Node_Id
is
1752 Expr
: constant Node_Id
:= P_Expression
;
1754 Ignore
(Tok_Right_Paren
);
1756 end P_Expression_No_Right_Paren
;
1758 ----------------------------------------
1759 -- 4.4 Expression_Or_Range_Attribute --
1760 ----------------------------------------
1763 -- RELATION {and RELATION} | RELATION {and then RELATION}
1764 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1765 -- | RELATION {xor RELATION}
1767 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1769 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1771 -- On return, Expr_Form indicates the categorization of the expression
1772 -- and EF_Range_Attr is one of the possibilities.
1774 -- Error recovery: cannot raise Error_Resync
1776 -- In the grammar, a RANGE attribute is simply a name, but its use is
1777 -- highly restricted, so in the parser, we do not regard it as a name.
1778 -- Instead, P_Name returns without scanning the 'RANGE part of the
1779 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1780 -- attribute reference. In the normal case where a range attribute is
1781 -- not allowed, an error message is issued by P_Expression.
1783 function P_Expression_Or_Range_Attribute
return Node_Id
is
1784 Logical_Op
: Node_Kind
;
1785 Prev_Logical_Op
: Node_Kind
;
1786 Op_Location
: Source_Ptr
;
1789 Attr_Node
: Node_Id
;
1792 Node1
:= P_Relation
;
1794 if Token
= Tok_Apostrophe
then
1795 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
1796 Expr_Form
:= EF_Range_Attr
;
1799 elsif Token
in Token_Class_Logop
then
1800 Prev_Logical_Op
:= N_Empty
;
1803 Op_Location
:= Token_Ptr
;
1804 Logical_Op
:= P_Logical_Operator
;
1806 if Prev_Logical_Op
/= N_Empty
and then
1807 Logical_Op
/= Prev_Logical_Op
1810 ("mixed logical operators in expression", Op_Location
);
1811 Prev_Logical_Op
:= N_Empty
;
1813 Prev_Logical_Op
:= Logical_Op
;
1817 Node1
:= New_Op_Node
(Logical_Op
, Op_Location
);
1818 Set_Left_Opnd
(Node1
, Node2
);
1819 Set_Right_Opnd
(Node1
, P_Relation
);
1820 exit when Token
not in Token_Class_Logop
;
1823 Expr_Form
:= EF_Non_Simple
;
1826 if Token
= Tok_Apostrophe
then
1827 Bad_Range_Attribute
(Token_Ptr
);
1832 end P_Expression_Or_Range_Attribute
;
1834 -- Version that allows a non-parenthesized case, conditional, or quantified
1835 -- expression if the call immediately follows a left paren, and followed
1836 -- by a right parenthesis. These forms are allowed if these conditions
1837 -- are not met, but an error message will be issued.
1839 function P_Expression_Or_Range_Attribute_If_OK
return Node_Id
is
1841 -- Case of conditional, case or quantified expression
1843 if Token
= Tok_Case
or else Token
= Tok_If
or else Token
= Tok_For
then
1844 return P_Unparen_Cond_Case_Quant_Expression
;
1846 -- Normal case, not one of the above expression types
1849 return P_Expression_Or_Range_Attribute
;
1851 end P_Expression_Or_Range_Attribute_If_OK
;
1857 -- This procedure scans both relations and choice relations
1859 -- CHOICE_RELATION ::=
1860 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1863 -- SIMPLE_EXPRESSION [not] in MEMBERSHIP_CHOICE_LIST
1864 -- | RAISE_EXPRESSION
1866 -- MEMBERSHIP_CHOICE_LIST ::=
1867 -- MEMBERSHIP_CHOICE {'|' MEMBERSHIP CHOICE}
1869 -- MEMBERSHIP_CHOICE ::=
1870 -- CHOICE_EXPRESSION | RANGE | SUBTYPE_MARK
1872 -- RAISE_EXPRESSION ::= raise exception_NAME [with string_EXPRESSION]
1874 -- On return, Expr_Form indicates the categorization of the expression
1876 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1877 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1879 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1880 -- expression, then tokens are scanned until either a non-expression token,
1881 -- a right paren (not matched by a left paren) or a comma, is encountered.
1883 function P_Relation
return Node_Id
is
1884 Node1
, Node2
: Node_Id
;
1888 -- First check for raise expression
1890 if Token
= Tok_Raise
then
1891 Expr_Form
:= EF_Non_Simple
;
1892 return P_Raise_Expression
;
1897 Node1
:= P_Simple_Expression
;
1899 if Token
not in Token_Class_Relop
then
1903 -- Here we have a relational operator following. If so then scan it
1904 -- out. Note that the assignment symbol := is treated as a relational
1905 -- operator to improve the error recovery when it is misused for =.
1906 -- P_Relational_Operator also parses the IN and NOT IN operations.
1909 Node2
:= New_Op_Node
(P_Relational_Operator
, Optok
);
1910 Set_Left_Opnd
(Node2
, Node1
);
1912 -- Case of IN or NOT IN
1914 if Prev_Token
= Tok_In
then
1915 P_Membership_Test
(Node2
);
1917 -- Case of relational operator (= /= < <= > >=)
1920 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
1923 Expr_Form
:= EF_Non_Simple
;
1925 if Token
in Token_Class_Relop
then
1926 Error_Msg_SC
("unexpected relational operator");
1933 -- If any error occurs, then scan to the next expression terminator symbol
1934 -- or comma or right paren at the outer (i.e. current) parentheses level.
1935 -- The flags are set to indicate a normal simple expression.
1938 when Error_Resync
=>
1940 Expr_Form
:= EF_Simple
;
1944 ----------------------------
1945 -- 4.4 Simple Expression --
1946 ----------------------------
1948 -- SIMPLE_EXPRESSION ::=
1949 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1951 -- On return, Expr_Form indicates the categorization of the expression
1953 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1954 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1956 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1957 -- expression, then tokens are scanned until either a non-expression token,
1958 -- a right paren (not matched by a left paren) or a comma, is encountered.
1960 -- Note: P_Simple_Expression is called only internally by higher level
1961 -- expression routines. In cases in the grammar where a simple expression
1962 -- is required, the approach is to scan an expression, and then post an
1963 -- appropriate error message if the expression obtained is not simple. This
1964 -- gives better error recovery and treatment.
1966 function P_Simple_Expression
return Node_Id
is
1967 Scan_State
: Saved_Scan_State
;
1970 Tokptr
: Source_Ptr
;
1973 -- Check for cases starting with a name. There are two reasons for
1974 -- special casing. First speed things up by catching a common case
1975 -- without going through several routine layers. Second the caller must
1976 -- be informed via Expr_Form when the simple expression is a name.
1978 if Token
in Token_Class_Name
then
1981 -- Deal with apostrophe cases
1983 if Token
= Tok_Apostrophe
then
1984 Save_Scan_State
(Scan_State
); -- at apostrophe
1985 Scan
; -- past apostrophe
1987 -- If qualified expression, scan it out and fall through
1989 if Token
= Tok_Left_Paren
then
1990 Node1
:= P_Qualified_Expression
(Node1
);
1991 Expr_Form
:= EF_Simple
;
1993 -- If range attribute, then we return with Token pointing to the
1994 -- apostrophe. Note: avoid the normal error check on exit. We
1995 -- know that the expression really is complete in this case.
1997 else -- Token = Tok_Range then
1998 Restore_Scan_State
(Scan_State
); -- to apostrophe
1999 Expr_Form
:= EF_Simple_Name
;
2004 -- If an expression terminator follows, the previous processing
2005 -- completely scanned out the expression (a common case), and
2006 -- left Expr_Form set appropriately for returning to our caller.
2008 if Token
in Token_Class_Sterm
then
2011 -- If we do not have an expression terminator, then complete the
2012 -- scan of a simple expression. This code duplicates the code
2013 -- found in P_Term and P_Factor.
2016 if Token
= Tok_Double_Asterisk
then
2018 Style
.Check_Exponentiation_Operator
;
2021 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2023 Set_Left_Opnd
(Node2
, Node1
);
2024 Set_Right_Opnd
(Node2
, P_Primary
);
2030 exit when Token
not in Token_Class_Mulop
;
2031 Tokptr
:= Token_Ptr
;
2032 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2035 Style
.Check_Binary_Operator
;
2038 Scan
; -- past operator
2039 Set_Left_Opnd
(Node2
, Node1
);
2040 Set_Right_Opnd
(Node2
, P_Factor
);
2045 exit when Token
not in Token_Class_Binary_Addop
;
2046 Tokptr
:= Token_Ptr
;
2047 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2050 Style
.Check_Binary_Operator
;
2053 Scan
; -- past operator
2054 Set_Left_Opnd
(Node2
, Node1
);
2055 Set_Right_Opnd
(Node2
, P_Term
);
2059 Expr_Form
:= EF_Simple
;
2062 -- Cases where simple expression does not start with a name
2065 -- Scan initial sign and initial Term
2067 if Token
in Token_Class_Unary_Addop
then
2068 Tokptr
:= Token_Ptr
;
2069 Node1
:= New_Op_Node
(P_Unary_Adding_Operator
, Tokptr
);
2072 Style
.Check_Unary_Plus_Or_Minus
;
2075 Scan
; -- past operator
2076 Set_Right_Opnd
(Node1
, P_Term
);
2081 -- In the following, we special-case a sequence of concatenations of
2082 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
2083 -- else mixed in. For such a sequence, we return a tree representing
2084 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
2085 -- the number of concatenations is large. If semantic analysis
2086 -- resolves the "&" to a predefined one, then this folding gives the
2087 -- right answer. Otherwise, semantic analysis will complain about a
2088 -- capacity-exceeded error. The purpose of this trick is to avoid
2089 -- creating a deeply nested tree, which would cause deep recursion
2090 -- during semantics, causing stack overflow. This way, we can handle
2091 -- enormous concatenations in the normal case of predefined "&". We
2092 -- first build up the normal tree, and then rewrite it if
2096 Num_Concats_Threshold
: constant Positive := 1000;
2097 -- Arbitrary threshold value to enable optimization
2099 First_Node
: constant Node_Id
:= Node1
;
2100 Is_Strlit_Concat
: Boolean;
2101 -- True iff we've parsed a sequence of concatenations of string
2102 -- literals, with nothing else mixed in.
2104 Num_Concats
: Natural;
2105 -- Number of "&" operators if Is_Strlit_Concat is True
2109 Nkind
(Node1
) = N_String_Literal
2110 and then Token
= Tok_Ampersand
;
2113 -- Scan out sequence of terms separated by binary adding operators
2116 exit when Token
not in Token_Class_Binary_Addop
;
2117 Tokptr
:= Token_Ptr
;
2118 Node2
:= New_Op_Node
(P_Binary_Adding_Operator
, Tokptr
);
2119 Scan
; -- past operator
2120 Set_Left_Opnd
(Node2
, Node1
);
2122 Set_Right_Opnd
(Node2
, Node1
);
2124 -- Check if we're still concatenating string literals
2128 and then Nkind
(Node2
) = N_Op_Concat
2129 and then Nkind
(Node1
) = N_String_Literal
;
2131 if Is_Strlit_Concat
then
2132 Num_Concats
:= Num_Concats
+ 1;
2138 -- If we have an enormous series of concatenations of string
2139 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2140 -- flag tells semantic analysis that if the "&" is not predefined,
2141 -- the folded value is wrong.
2144 and then Num_Concats
>= Num_Concats_Threshold
2147 Empty_String_Val
: String_Id
;
2150 Strlit_Concat_Val
: String_Id
;
2151 -- Contains the folded value (which will be correct if the
2152 -- "&" operators are the predefined ones).
2155 -- For walking up the tree
2158 -- Folded node to replace Node1
2160 Loc
: constant Source_Ptr
:= Sloc
(First_Node
);
2163 -- Walk up the tree starting at the leftmost string literal
2164 -- (First_Node), building up the Strlit_Concat_Val as we
2165 -- go. Note that we do not use recursion here -- the whole
2166 -- point is to avoid recursively walking that enormous tree.
2169 Store_String_Chars
(Strval
(First_Node
));
2171 Cur_Node
:= Parent
(First_Node
);
2172 while Present
(Cur_Node
) loop
2173 pragma Assert
(Nkind
(Cur_Node
) = N_Op_Concat
and then
2174 Nkind
(Right_Opnd
(Cur_Node
)) = N_String_Literal
);
2176 Store_String_Chars
(Strval
(Right_Opnd
(Cur_Node
)));
2177 Cur_Node
:= Parent
(Cur_Node
);
2180 Strlit_Concat_Val
:= End_String
;
2182 -- Create new folded node, and rewrite result with a concat-
2183 -- enation of an empty string literal and the folded node.
2186 Empty_String_Val
:= End_String
;
2188 Make_Op_Concat
(Loc
,
2189 Make_String_Literal
(Loc
, Empty_String_Val
),
2190 Make_String_Literal
(Loc
, Strlit_Concat_Val
,
2191 Is_Folded_In_Parser
=> True));
2192 Rewrite
(Node1
, New_Node
);
2197 -- All done, we clearly do not have name or numeric literal so this
2198 -- is a case of a simple expression which is some other possibility.
2200 Expr_Form
:= EF_Simple
;
2203 -- Come here at end of simple expression, where we do a couple of
2204 -- special checks to improve error recovery.
2206 -- Special test to improve error recovery. If the current token
2207 -- is a period, then someone is trying to do selection on something
2208 -- that is not a name, e.g. a qualified expression.
2210 if Token
= Tok_Dot
then
2211 Error_Msg_SC
("prefix for selection is not a name");
2213 -- If qualified expression, comment and continue, otherwise something
2214 -- is pretty nasty so do an Error_Resync call.
2216 if Ada_Version
< Ada_2012
2217 and then Nkind
(Node1
) = N_Qualified_Expression
2219 Error_Msg_SC
("\would be legal in Ada 2012 mode");
2225 -- Special test to improve error recovery: If the current token is
2226 -- not the first token on a line (as determined by checking the
2227 -- previous token position with the start of the current line),
2228 -- then we insist that we have an appropriate terminating token.
2229 -- Consider the following two examples:
2231 -- 1) if A nad B then ...
2236 -- In the first example, we would like to issue a binary operator
2237 -- expected message and resynchronize to the then. In the second
2238 -- example, we do not want to issue a binary operator message, so
2239 -- that instead we will get the missing semicolon message. This
2240 -- distinction is of course a heuristic which does not always work,
2241 -- but in practice it is quite effective.
2243 -- Note: the one case in which we do not go through this circuit is
2244 -- when we have scanned a range attribute and want to return with
2245 -- Token pointing to the apostrophe. The apostrophe is not normally
2246 -- an expression terminator, and is not in Token_Class_Sterm, but
2247 -- in this special case we know that the expression is complete.
2249 if not Token_Is_At_Start_Of_Line
2250 and then Token
not in Token_Class_Sterm
2252 -- Normally the right error message is indeed that we expected a
2253 -- binary operator, but in the case of being between a right and left
2254 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2256 if Prev_Token
= Tok_Right_Paren
and then Token
= Tok_Left_Paren
then
2259 Error_Msg_AP
("binary operator expected");
2268 -- If any error occurs, then scan to next expression terminator symbol
2269 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2270 -- level. Expr_Form is set to indicate a normal simple expression.
2273 when Error_Resync
=>
2275 Expr_Form
:= EF_Simple
;
2277 end P_Simple_Expression
;
2279 -----------------------------------------------
2280 -- 4.4 Simple Expression or Range Attribute --
2281 -----------------------------------------------
2283 -- SIMPLE_EXPRESSION ::=
2284 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2286 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2288 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2290 -- Error recovery: cannot raise Error_Resync
2292 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
2294 Attr_Node
: Node_Id
;
2297 -- We don't just want to roar ahead and call P_Simple_Expression
2298 -- here, since we want to handle the case of a parenthesized range
2299 -- attribute cleanly.
2301 if Token
= Tok_Left_Paren
then
2303 Lptr
: constant Source_Ptr
:= Token_Ptr
;
2304 Scan_State
: Saved_Scan_State
;
2307 Save_Scan_State
(Scan_State
);
2308 Scan
; -- past left paren
2309 Sexpr
:= P_Simple_Expression
;
2311 if Token
= Tok_Apostrophe
then
2312 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2313 Expr_Form
:= EF_Range_Attr
;
2315 if Token
= Tok_Right_Paren
then
2316 Scan
; -- scan past right paren if present
2319 Error_Msg
("parentheses not allowed for range attribute", Lptr
);
2324 Restore_Scan_State
(Scan_State
);
2328 -- Here after dealing with parenthesized range attribute
2330 Sexpr
:= P_Simple_Expression
;
2332 if Token
= Tok_Apostrophe
then
2333 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
2334 Expr_Form
:= EF_Range_Attr
;
2340 end P_Simple_Expression_Or_Range_Attribute
;
2346 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2348 -- Error recovery: can raise Error_Resync
2350 function P_Term
return Node_Id
is
2351 Node1
, Node2
: Node_Id
;
2352 Tokptr
: Source_Ptr
;
2358 exit when Token
not in Token_Class_Mulop
;
2359 Tokptr
:= Token_Ptr
;
2360 Node2
:= New_Op_Node
(P_Multiplying_Operator
, Tokptr
);
2361 Scan
; -- past operator
2362 Set_Left_Opnd
(Node2
, Node1
);
2363 Set_Right_Opnd
(Node2
, P_Factor
);
2374 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2376 -- Error recovery: can raise Error_Resync
2378 function P_Factor
return Node_Id
is
2383 if Token
= Tok_Abs
then
2384 Node1
:= New_Op_Node
(N_Op_Abs
, Token_Ptr
);
2387 Style
.Check_Abs_Not
;
2391 Set_Right_Opnd
(Node1
, P_Primary
);
2394 elsif Token
= Tok_Not
then
2395 Node1
:= New_Op_Node
(N_Op_Not
, Token_Ptr
);
2398 Style
.Check_Abs_Not
;
2402 Set_Right_Opnd
(Node1
, P_Primary
);
2408 if Token
= Tok_Double_Asterisk
then
2409 Node2
:= New_Op_Node
(N_Op_Expon
, Token_Ptr
);
2411 Set_Left_Opnd
(Node2
, Node1
);
2412 Set_Right_Opnd
(Node2
, P_Primary
);
2426 -- NUMERIC_LITERAL | null
2427 -- | STRING_LITERAL | AGGREGATE
2428 -- | NAME | QUALIFIED_EXPRESSION
2429 -- | ALLOCATOR | (EXPRESSION) | QUANTIFIED_EXPRESSION
2431 -- Error recovery: can raise Error_Resync
2433 function P_Primary
return Node_Id
is
2434 Scan_State
: Saved_Scan_State
;
2437 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
2438 -- Remember if previous token is a left parenthesis. This is used to
2439 -- deal with checking whether IF/CASE/FOR expressions appearing as
2440 -- primaries require extra parenthesization.
2443 -- The loop runs more than once only if misplaced pragmas are found
2444 -- or if a misplaced unary minus is skipped.
2449 -- Name token can start a name, call or qualified expression, all
2450 -- of which are acceptable possibilities for primary. Note also
2451 -- that string literal is included in name (as operator symbol)
2452 -- and type conversion is included in name (as indexed component).
2454 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier
=>
2457 -- All done unless apostrophe follows
2459 if Token
/= Tok_Apostrophe
then
2462 -- Apostrophe following means that we have either just parsed
2463 -- the subtype mark of a qualified expression, or the prefix
2464 -- or a range attribute.
2466 else -- Token = Tok_Apostrophe
2467 Save_Scan_State
(Scan_State
); -- at apostrophe
2468 Scan
; -- past apostrophe
2470 -- If range attribute, then this is always an error, since
2471 -- the only legitimate case (where the scanned expression is
2472 -- a qualified simple name) is handled at the level of the
2473 -- Simple_Expression processing. This case corresponds to a
2474 -- usage such as 3 + A'Range, which is always illegal.
2476 if Token
= Tok_Range
then
2477 Restore_Scan_State
(Scan_State
); -- to apostrophe
2478 Bad_Range_Attribute
(Token_Ptr
);
2481 -- If left paren, then we have a qualified expression.
2482 -- Note that P_Name guarantees that in this case, where
2483 -- Token = Tok_Apostrophe on return, the only two possible
2484 -- tokens following the apostrophe are left paren and
2485 -- RANGE, so we know we have a left paren here.
2487 else -- Token = Tok_Left_Paren
2488 return P_Qualified_Expression
(Node1
);
2493 -- Numeric or string literal
2495 when Tok_Integer_Literal |
2497 Tok_String_Literal
=>
2499 Node1
:= Token_Node
;
2500 Scan
; -- past number
2503 -- Left paren, starts aggregate or parenthesized expression
2505 when Tok_Left_Paren
=>
2507 Expr
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
2510 if Nkind
(Expr
) = N_Attribute_Reference
2511 and then Attribute_Name
(Expr
) = Name_Range
2513 Bad_Range_Attribute
(Sloc
(Expr
));
2528 return New_Node
(N_Null
, Prev_Token_Ptr
);
2530 -- Pragma, not allowed here, so just skip past it
2533 P_Pragmas_Misplaced
;
2535 -- Deal with IF (possible unparenthesized if expression)
2539 -- If this looks like a real if, defined as an IF appearing at
2540 -- the start of a new line, then we consider we have a missing
2541 -- operand. If in Ada 2012 and the IF is not properly indented
2542 -- for a statement, we prefer to issue a message about an ill-
2543 -- parenthesized if expression.
2545 if Token_Is_At_Start_Of_Line
2547 (Ada_Version
>= Ada_2012
2548 and then Style_Check_Indentation
/= 0
2549 and then Start_Column
rem Style_Check_Indentation
/= 0)
2551 Error_Msg_AP
("missing operand");
2554 -- If this looks like an if expression, then treat it that way
2555 -- with an error message if not explicitly surrounded by
2558 elsif Ada_Version
>= Ada_2012
then
2559 Node1
:= P_If_Expression
;
2561 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2563 ("if expression must be parenthesized", Sloc
(Node1
));
2568 -- Otherwise treat as misused identifier
2571 return P_Identifier
;
2574 -- Deal with CASE (possible unparenthesized case expression)
2578 -- If this looks like a real case, defined as a CASE appearing
2579 -- the start of a new line, then we consider we have a missing
2580 -- operand. If in Ada 2012 and the CASE is not properly
2581 -- indented for a statement, we prefer to issue a message about
2582 -- an ill-parenthesized case expression.
2584 if Token_Is_At_Start_Of_Line
2586 (Ada_Version
>= Ada_2012
2587 and then Style_Check_Indentation
/= 0
2588 and then Start_Column
rem Style_Check_Indentation
/= 0)
2590 Error_Msg_AP
("missing operand");
2593 -- If this looks like a case expression, then treat it that way
2594 -- with an error message if not within parentheses.
2596 elsif Ada_Version
>= Ada_2012
then
2597 Node1
:= P_Case_Expression
;
2599 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2601 ("case expression must be parenthesized", Sloc
(Node1
));
2606 -- Otherwise treat as misused identifier
2609 return P_Identifier
;
2612 -- For [all | some] indicates a quantified expression
2615 if Token_Is_At_Start_Of_Line
then
2616 Error_Msg_AP
("misplaced loop");
2619 elsif Ada_Version
>= Ada_2012
then
2620 Node1
:= P_Quantified_Expression
;
2622 if not (Lparen
and then Token
= Tok_Right_Paren
) then
2624 ("quantified expression must be parenthesized",
2630 -- Otherwise treat as misused identifier
2633 return P_Identifier
;
2636 -- Minus may well be an improper attempt at a unary minus. Give
2637 -- a message, skip the minus and keep going.
2640 Error_Msg_SC
("parentheses required for unary minus");
2643 -- Anything else is illegal as the first token of a primary, but
2644 -- we test for some common errors, to improve error messages.
2647 if Is_Reserved_Identifier
then
2648 return P_Identifier
;
2650 elsif Prev_Token
= Tok_Comma
then
2651 Error_Msg_SP
-- CODEFIX
2652 ("|extra "","" ignored");
2656 Error_Msg_AP
("missing operand");
2664 -------------------------------
2665 -- 4.4 Quantified_Expression --
2666 -------------------------------
2668 -- QUANTIFIED_EXPRESSION ::=
2669 -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE |
2670 -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
2672 function P_Quantified_Expression
return Node_Id
is
2677 Error_Msg_Ada_2012_Feature
("quantified expression", Token_Ptr
);
2679 Node1
:= New_Node
(N_Quantified_Expression
, Prev_Token_Ptr
);
2681 if Token
= Tok_All
then
2682 Set_All_Present
(Node1
);
2683 elsif Token
/= Tok_Some
then
2684 Error_Msg_AP
("missing quantifier");
2689 I_Spec
:= P_Loop_Parameter_Specification
;
2691 if Nkind
(I_Spec
) = N_Loop_Parameter_Specification
then
2692 Set_Loop_Parameter_Specification
(Node1
, I_Spec
);
2694 Set_Iterator_Specification
(Node1
, I_Spec
);
2697 if Token
= Tok_Arrow
then
2699 Set_Condition
(Node1
, P_Expression
);
2702 Error_Msg_AP
("missing arrow");
2705 end P_Quantified_Expression
;
2707 ---------------------------
2708 -- 4.5 Logical Operator --
2709 ---------------------------
2711 -- LOGICAL_OPERATOR ::= and | or | xor
2713 -- Note: AND THEN and OR ELSE are also treated as logical operators
2714 -- by the parser (even though they are not operators semantically)
2716 -- The value returned is the appropriate Node_Kind code for the operator
2717 -- On return, Token points to the token following the scanned operator.
2719 -- The caller has checked that the first token is a legitimate logical
2720 -- operator token (i.e. is either XOR, AND, OR).
2722 -- Error recovery: cannot raise Error_Resync
2724 function P_Logical_Operator
return Node_Kind
is
2726 if Token
= Tok_And
then
2728 Style
.Check_Binary_Operator
;
2733 if Token
= Tok_Then
then
2740 elsif Token
= Tok_Or
then
2742 Style
.Check_Binary_Operator
;
2747 if Token
= Tok_Else
then
2754 else -- Token = Tok_Xor
2756 Style
.Check_Binary_Operator
;
2762 end P_Logical_Operator
;
2764 ------------------------------
2765 -- 4.5 Relational Operator --
2766 ------------------------------
2768 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2770 -- The value returned is the appropriate Node_Kind code for the operator.
2771 -- On return, Token points to the operator token, NOT past it.
2773 -- The caller has checked that the first token is a legitimate relational
2774 -- operator token (i.e. is one of the operator tokens listed above).
2776 -- Error recovery: cannot raise Error_Resync
2778 function P_Relational_Operator
return Node_Kind
is
2779 Op_Kind
: Node_Kind
;
2780 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
2781 (Tok_Less
=> N_Op_Lt
,
2782 Tok_Equal
=> N_Op_Eq
,
2783 Tok_Greater
=> N_Op_Gt
,
2784 Tok_Not_Equal
=> N_Op_Ne
,
2785 Tok_Greater_Equal
=> N_Op_Ge
,
2786 Tok_Less_Equal
=> N_Op_Le
,
2788 Tok_Not
=> N_Not_In
,
2789 Tok_Box
=> N_Op_Ne
);
2792 if Token
= Tok_Box
then
2793 Error_Msg_SC
-- CODEFIX
2794 ("|""'<'>"" should be ""/=""");
2797 Op_Kind
:= Relop_Node
(Token
);
2800 Style
.Check_Binary_Operator
;
2803 Scan
; -- past operator token
2805 -- Deal with NOT IN, if previous token was NOT, we must have IN now
2807 if Prev_Token
= Tok_Not
then
2809 -- Style check, for NOT IN, we require one space between NOT and IN
2811 if Style_Check
and then Token
= Tok_In
then
2819 end P_Relational_Operator
;
2821 ---------------------------------
2822 -- 4.5 Binary Adding Operator --
2823 ---------------------------------
2825 -- BINARY_ADDING_OPERATOR ::= + | - | &
2827 -- The value returned is the appropriate Node_Kind code for the operator.
2828 -- On return, Token points to the operator token (NOT past it).
2830 -- The caller has checked that the first token is a legitimate adding
2831 -- operator token (i.e. is one of the operator tokens listed above).
2833 -- Error recovery: cannot raise Error_Resync
2835 function P_Binary_Adding_Operator
return Node_Kind
is
2836 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
2837 (Tok_Ampersand
=> N_Op_Concat
,
2838 Tok_Minus
=> N_Op_Subtract
,
2839 Tok_Plus
=> N_Op_Add
);
2841 return Addop_Node
(Token
);
2842 end P_Binary_Adding_Operator
;
2844 --------------------------------
2845 -- 4.5 Unary Adding Operator --
2846 --------------------------------
2848 -- UNARY_ADDING_OPERATOR ::= + | -
2850 -- The value returned is the appropriate Node_Kind code for the operator.
2851 -- On return, Token points to the operator token (NOT past it).
2853 -- The caller has checked that the first token is a legitimate adding
2854 -- operator token (i.e. is one of the operator tokens listed above).
2856 -- Error recovery: cannot raise Error_Resync
2858 function P_Unary_Adding_Operator
return Node_Kind
is
2859 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
2860 (Tok_Minus
=> N_Op_Minus
,
2861 Tok_Plus
=> N_Op_Plus
);
2863 return Addop_Node
(Token
);
2864 end P_Unary_Adding_Operator
;
2866 -------------------------------
2867 -- 4.5 Multiplying Operator --
2868 -------------------------------
2870 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2872 -- The value returned is the appropriate Node_Kind code for the operator.
2873 -- On return, Token points to the operator token (NOT past it).
2875 -- The caller has checked that the first token is a legitimate multiplying
2876 -- operator token (i.e. is one of the operator tokens listed above).
2878 -- Error recovery: cannot raise Error_Resync
2880 function P_Multiplying_Operator
return Node_Kind
is
2881 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
2882 (Tok_Asterisk
=> N_Op_Multiply
,
2883 Tok_Mod
=> N_Op_Mod
,
2884 Tok_Rem
=> N_Op_Rem
,
2885 Tok_Slash
=> N_Op_Divide
);
2887 return Mulop_Node
(Token
);
2888 end P_Multiplying_Operator
;
2890 --------------------------------------
2891 -- 4.5 Highest Precedence Operator --
2892 --------------------------------------
2894 -- Parsed by P_Factor (4.4)
2896 -- Note: this rule is not in fact used by the grammar at any point
2898 --------------------------
2899 -- 4.6 Type Conversion --
2900 --------------------------
2902 -- Parsed by P_Primary as a Name (4.1)
2904 -------------------------------
2905 -- 4.7 Qualified Expression --
2906 -------------------------------
2908 -- QUALIFIED_EXPRESSION ::=
2909 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2911 -- The caller has scanned the name which is the Subtype_Mark parameter
2912 -- and scanned past the single quote following the subtype mark. The
2913 -- caller has not checked that this name is in fact appropriate for
2914 -- a subtype mark name (i.e. it is a selected component or identifier).
2916 -- Error_Recovery: cannot raise Error_Resync
2918 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
2919 Qual_Node
: Node_Id
;
2921 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
2922 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
2923 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
2925 end P_Qualified_Expression
;
2927 --------------------
2929 --------------------
2932 -- new [SUBPOOL_SPECIFICATION] SUBTYPE_INDICATION
2933 -- | new [SUBPOOL_SPECIFICATION] QUALIFIED_EXPRESSION
2935 -- SUBPOOL_SPECIFICATION ::= (subpool_handle_NAME)
2937 -- The caller has checked that the initial token is NEW
2939 -- Error recovery: can raise Error_Resync
2941 function P_Allocator
return Node_Id
is
2942 Alloc_Node
: Node_Id
;
2943 Type_Node
: Node_Id
;
2944 Null_Exclusion_Present
: Boolean;
2947 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
2950 -- Scan subpool_specification if present (Ada 2012 (AI05-0111-3))
2952 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2954 if Token
= Tok_Left_Paren
then
2956 Set_Subpool_Handle_Name
(Alloc_Node
, P_Name
);
2959 Error_Msg_Ada_2012_Feature
2960 ("|subpool specification",
2961 Sloc
(Subpool_Handle_Name
(Alloc_Node
)));
2964 Null_Exclusion_Present
:= P_Null_Exclusion
;
2965 Set_Null_Exclusion_Present
(Alloc_Node
, Null_Exclusion_Present
);
2966 Type_Node
:= P_Subtype_Mark_Resync
;
2968 if Token
= Tok_Apostrophe
then
2969 Scan
; -- past apostrophe
2970 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
2974 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));
2976 -- AI05-0104: An explicit null exclusion is not allowed for an
2977 -- allocator without initialization. In previous versions of the
2978 -- language it just raises constraint error.
2980 if Ada_Version
>= Ada_2012
and then Null_Exclusion_Present
then
2982 ("an allocator with a subtype indication "
2983 & "cannot have a null exclusion", Alloc_Node
);
2990 -----------------------
2991 -- P_Case_Expression --
2992 -----------------------
2994 function P_Case_Expression
return Node_Id
is
2995 Loc
: constant Source_Ptr
:= Token_Ptr
;
2996 Case_Node
: Node_Id
;
2997 Save_State
: Saved_Scan_State
;
3000 Error_Msg_Ada_2012_Feature
("|case expression", Token_Ptr
);
3003 Make_Case_Expression
(Loc
,
3004 Expression
=> P_Expression_No_Right_Paren
,
3005 Alternatives
=> New_List
);
3008 -- We now have scanned out CASE expression IS, scan alternatives
3012 Append_To
(Alternatives
(Case_Node
), P_Case_Expression_Alternative
);
3014 -- Missing comma if WHEN (more alternatives present)
3016 if Token
= Tok_When
then
3019 -- If comma/WHEN, skip comma and we have another alternative
3021 elsif Token
= Tok_Comma
then
3022 Save_Scan_State
(Save_State
);
3025 if Token
/= Tok_When
then
3026 Restore_Scan_State
(Save_State
);
3030 -- If no comma or WHEN, definitely done
3037 -- If we have an END CASE, diagnose as not needed
3039 if Token
= Tok_End
then
3040 Error_Msg_SC
("`END CASE` not allowed at end of case expression");
3043 if Token
= Tok_Case
then
3048 -- Return the Case_Expression node
3051 end P_Case_Expression
;
3053 -----------------------------------
3054 -- P_Case_Expression_Alternative --
3055 -----------------------------------
3057 -- CASE_STATEMENT_ALTERNATIVE ::=
3058 -- when DISCRETE_CHOICE_LIST =>
3061 -- The caller has checked that and scanned past the initial WHEN token
3062 -- Error recovery: can raise Error_Resync
3064 function P_Case_Expression_Alternative
return Node_Id
is
3065 Case_Alt_Node
: Node_Id
;
3067 Case_Alt_Node
:= New_Node
(N_Case_Expression_Alternative
, Token_Ptr
);
3068 Set_Discrete_Choices
(Case_Alt_Node
, P_Discrete_Choice_List
);
3070 Set_Expression
(Case_Alt_Node
, P_Expression
);
3071 return Case_Alt_Node
;
3072 end P_Case_Expression_Alternative
;
3074 ---------------------
3075 -- P_If_Expression --
3076 ---------------------
3078 function P_If_Expression
return Node_Id
is
3080 function P_If_Expression_Internal
3082 Cond
: Node_Id
) return Node_Id
;
3083 -- This is the internal recursive routine that does all the work, it is
3084 -- recursive since it is used to process ELSIF parts, which internally
3085 -- are N_If_Expression nodes with the Is_Elsif flag set. The calling
3086 -- sequence is like the outer function except that the caller passes
3087 -- the conditional expression (scanned using P_Expression), and the
3088 -- scan pointer points just past this expression. Loc points to the
3089 -- IF or ELSIF token.
3091 ------------------------------
3092 -- P_If_Expression_Internal --
3093 ------------------------------
3095 function P_If_Expression_Internal
3097 Cond
: Node_Id
) return Node_Id
3099 Exprs
: constant List_Id
:= New_List
;
3101 State
: Saved_Scan_State
;
3105 -- All cases except where we are at right paren
3107 if Token
/= Tok_Right_Paren
then
3109 Append_To
(Exprs
, P_Condition
(Cond
));
3110 Append_To
(Exprs
, P_Expression
);
3112 -- Case of right paren (missing THEN phrase). Note that we know this
3113 -- is the IF case, since the caller dealt with this possibility in
3117 Error_Msg_BC
("missing THEN phrase");
3118 Append_To
(Exprs
, P_Condition
(Cond
));
3121 -- We now have scanned out IF expr THEN expr
3123 -- Check for common error of semicolon before the ELSE
3125 if Token
= Tok_Semicolon
then
3126 Save_Scan_State
(State
);
3127 Scan
; -- past semicolon
3129 if Token
= Tok_Else
or else Token
= Tok_Elsif
then
3130 Error_Msg_SP
-- CODEFIX
3131 ("|extra "";"" ignored");
3134 Restore_Scan_State
(State
);
3138 -- Scan out ELSIF sequence if present
3140 if Token
= Tok_Elsif
then
3143 Expr
:= P_Expression
;
3145 -- If we are at a right paren, we assume the ELSIF should be ELSE
3147 if Token
= Tok_Right_Paren
then
3148 Error_Msg
("ELSIF should be ELSE", Eptr
);
3149 Append_To
(Exprs
, Expr
);
3151 -- Otherwise we have an OK ELSIF
3154 Expr
:= P_If_Expression_Internal
(Eptr
, Expr
);
3155 Set_Is_Elsif
(Expr
);
3156 Append_To
(Exprs
, Expr
);
3159 -- Scan out ELSE phrase if present
3161 elsif Token
= Tok_Else
then
3163 -- Scan out ELSE expression
3166 Append_To
(Exprs
, P_Expression
);
3168 -- Skip redundant ELSE parts
3170 while Token
= Tok_Else
loop
3171 Error_Msg_SC
("only one ELSE part is allowed");
3173 Discard_Junk_Node
(P_Expression
);
3176 -- Two expression case (implied True, filled in during semantics)
3182 -- If we have an END IF, diagnose as not needed
3184 if Token
= Tok_End
then
3185 Error_Msg_SC
("`END IF` not allowed at end of if expression");
3188 if Token
= Tok_If
then
3193 -- Return the If_Expression node
3195 return Make_If_Expression
(Loc
, Expressions
=> Exprs
);
3196 end P_If_Expression_Internal
;
3200 Loc
: constant Source_Ptr
:= Token_Ptr
;
3203 -- Start of processing for P_If_Expression
3206 Error_Msg_Ada_2012_Feature
("|if expression", Token_Ptr
);
3208 Inside_If_Expression
:= Inside_If_Expression
+ 1;
3209 If_Expr
:= P_If_Expression_Internal
(Loc
, P_Expression
);
3210 Inside_If_Expression
:= Inside_If_Expression
- 1;
3212 end P_If_Expression
;
3214 -----------------------
3215 -- P_Membership_Test --
3216 -----------------------
3218 -- MEMBERSHIP_CHOICE_LIST ::= MEMBERHIP_CHOICE {'|' MEMBERSHIP_CHOICE}
3219 -- MEMBERSHIP_CHOICE ::= CHOICE_EXPRESSION | range | subtype_mark
3221 procedure P_Membership_Test
(N
: Node_Id
) is
3222 Alt
: constant Node_Id
:=
3223 P_Range_Or_Subtype_Mark
3224 (Allow_Simple_Expression
=> (Ada_Version
>= Ada_2012
));
3229 if Token
= Tok_Vertical_Bar
then
3230 Error_Msg_Ada_2012_Feature
("set notation", Token_Ptr
);
3231 Set_Alternatives
(N
, New_List
(Alt
));
3232 Set_Right_Opnd
(N
, Empty
);
3234 -- Loop to accumulate alternatives
3236 while Token
= Tok_Vertical_Bar
loop
3237 Scan
; -- past vertical bar
3240 P_Range_Or_Subtype_Mark
(Allow_Simple_Expression
=> True));
3246 Set_Right_Opnd
(N
, Alt
);
3247 Set_Alternatives
(N
, No_List
);
3249 end P_Membership_Test
;
3251 ------------------------------------------
3252 -- P_Unparen_Cond_Case_Quant_Expression --
3253 ------------------------------------------
3255 function P_Unparen_Cond_Case_Quant_Expression
return Node_Id
is
3256 Lparen
: constant Boolean := Prev_Token
= Tok_Left_Paren
;
3262 if Token
= Tok_Case
then
3263 Result
:= P_Case_Expression
;
3265 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3266 Error_Msg_N
("case expression must be parenthesized!", Result
);
3271 elsif Token
= Tok_If
then
3272 Result
:= P_If_Expression
;
3274 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3275 Error_Msg_N
("if expression must be parenthesized!", Result
);
3278 -- Quantified expression
3280 elsif Token
= Tok_For
then
3281 Result
:= P_Quantified_Expression
;
3283 if not (Lparen
and then Token
= Tok_Right_Paren
) then
3285 ("quantified expression must be parenthesized!", Result
);
3288 -- No other possibility should exist (caller was supposed to check)
3291 raise Program_Error
;
3294 -- Return expression (possibly after having given message)
3297 end P_Unparen_Cond_Case_Quant_Expression
;