1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2009, 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_Record_Or_Array_Component_Association return Node_Id;
67 function P_Factor return Node_Id;
68 function P_Primary return Node_Id;
69 function P_Relation return Node_Id;
70 function P_Term return Node_Id;
72 function P_Binary_Adding_Operator return Node_Kind;
73 function P_Logical_Operator return Node_Kind;
74 function P_Multiplying_Operator return Node_Kind;
75 function P_Relational_Operator return Node_Kind;
76 function P_Unary_Adding_Operator return Node_Kind;
78 procedure Bad_Range_Attribute (Loc : Source_Ptr);
79 -- Called to place complaint about bad range attribute at the given
80 -- source location. Terminates by raising Error_Resync.
82 procedure P_Membership_Test (N : Node_Id);
83 -- N is the node for a N_In or N_Not_In node whose right operand has not
84 -- yet been processed. It is called just after scanning out the IN keyword.
85 -- On return, either Right_Opnd or Alternatives is set, as appropriate.
87 function P_Range_Attribute_Reference (Prefix_Node : Node_Id) return Node_Id;
88 -- Scan a range attribute reference. The caller has scanned out the
89 -- prefix. The current token is known to be an apostrophe and the
90 -- following token is known to be RANGE.
92 procedure Set_Op_Name (Node : Node_Id);
93 -- Procedure to set name field (Chars) in operator node
95 -------------------------
96 -- Bad_Range_Attribute --
97 -------------------------
99 procedure Bad_Range_Attribute (Loc : Source_Ptr) is
101 Error_Msg ("range attribute cannot be used in expression!", Loc);
103 end Bad_Range_Attribute;
109 procedure Set_Op_Name (Node : Node_Id) is
110 type Name_Of_Type is array (N_Op) of Name_Id;
111 Name_Of : constant Name_Of_Type := Name_Of_Type'(
112 N_Op_And => Name_Op_And,
113 N_Op_Or => Name_Op_Or,
114 N_Op_Xor => Name_Op_Xor,
115 N_Op_Eq => Name_Op_Eq,
116 N_Op_Ne => Name_Op_Ne,
117 N_Op_Lt => Name_Op_Lt,
118 N_Op_Le => Name_Op_Le,
119 N_Op_Gt => Name_Op_Gt,
120 N_Op_Ge => Name_Op_Ge,
121 N_Op_Add => Name_Op_Add,
122 N_Op_Subtract => Name_Op_Subtract,
123 N_Op_Concat => Name_Op_Concat,
124 N_Op_Multiply => Name_Op_Multiply,
125 N_Op_Divide => Name_Op_Divide,
126 N_Op_Mod => Name_Op_Mod,
127 N_Op_Rem => Name_Op_Rem,
128 N_Op_Expon => Name_Op_Expon,
129 N_Op_Plus => Name_Op_Add,
130 N_Op_Minus => Name_Op_Subtract,
131 N_Op_Abs => Name_Op_Abs,
132 N_Op_Not => Name_Op_Not,
134 -- We don't really need these shift operators, since they never
135 -- appear as operators in the source, but the path of least
136 -- resistance is to put them in (the aggregate must be complete)
138 N_Op_Rotate_Left => Name_Rotate_Left,
139 N_Op_Rotate_Right => Name_Rotate_Right,
140 N_Op_Shift_Left => Name_Shift_Left,
141 N_Op_Shift_Right => Name_Shift_Right,
142 N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
145 if Nkind (Node) in N_Op then
146 Set_Chars (Node, Name_Of (Nkind (Node)));
150 --------------------------
151 -- 4.1 Name (also 6.4) --
152 --------------------------
155 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
156 -- | INDEXED_COMPONENT | SLICE
157 -- | SELECTED_COMPONENT | ATTRIBUTE
158 -- | TYPE_CONVERSION | FUNCTION_CALL
159 -- | CHARACTER_LITERAL
161 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
163 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
165 -- EXPLICIT_DEREFERENCE ::= NAME . all
167 -- IMPLICIT_DEREFERENCE ::= NAME
169 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
171 -- SLICE ::= PREFIX (DISCRETE_RANGE)
173 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
175 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
177 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
179 -- ATTRIBUTE_DESIGNATOR ::=
180 -- IDENTIFIER [(static_EXPRESSION)]
181 -- | access | delta | digits
185 -- | function_PREFIX ACTUAL_PARAMETER_PART
187 -- ACTUAL_PARAMETER_PART ::=
188 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
190 -- PARAMETER_ASSOCIATION ::=
191 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
193 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
195 -- Note: syntactically a procedure call looks just like a function call,
196 -- so this routine is in practice used to scan out procedure calls as well.
198 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
200 -- Error recovery: can raise Error_Resync
202 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
203 -- followed by either a left paren (qualified expression case), or by
204 -- range (range attribute case). All other uses of apostrophe (i.e. all
205 -- other attributes) are handled in this routine.
207 -- Error recovery: can raise Error_Resync
209 function P_Name return Node_Id is
210 Scan_State : Saved_Scan_State;
212 Prefix_Node : Node_Id;
213 Ident_Node : Node_Id;
215 Range_Node : Node_Id;
218 Arg_List : List_Id := No_List; -- kill junk warning
219 Attr_Name : Name_Id := No_Name; -- kill junk warning
222 -- Case of not a name
224 if Token not in Token_Class_Name then
226 -- If it looks like start of expression, complain and scan expression
228 if Token in Token_Class_Literal
229 or else Token = Tok_Left_Paren
231 Error_Msg_SC ("name expected");
234 -- Otherwise some other junk, not much we can do
237 Error_Msg_AP ("name expected");
242 -- Loop through designators in qualified name
244 Name_Node := Token_Node;
247 Scan; -- past designator
248 exit when Token /= Tok_Dot;
249 Save_Scan_State (Scan_State); -- at dot
252 -- If we do not have another designator after the dot, then join
253 -- the normal circuit to handle a dot extension (may be .all or
254 -- character literal case). Otherwise loop back to scan the next
257 if Token not in Token_Class_Desig then
258 goto Scan_Name_Extension_Dot;
260 Prefix_Node := Name_Node;
261 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
262 Set_Prefix (Name_Node, Prefix_Node);
263 Set_Selector_Name (Name_Node, Token_Node);
267 -- We have now scanned out a qualified designator. If the last token is
268 -- an operator symbol, then we certainly do not have the Snam case, so
269 -- we can just use the normal name extension check circuit
271 if Prev_Token = Tok_Operator_Symbol then
272 goto Scan_Name_Extension;
275 -- We have scanned out a qualified simple name, check for name extension
276 -- Note that we know there is no dot here at this stage, so the only
277 -- possible cases of name extension are apostrophe and left paren.
279 if Token = Tok_Apostrophe then
280 Save_Scan_State (Scan_State); -- at apostrophe
281 Scan; -- past apostrophe
283 -- If left paren, then this might be a qualified expression, but we
284 -- are only in the business of scanning out names, so return with
285 -- Token backed up to point to the apostrophe. The treatment for
286 -- the range attribute is similar (we do not consider x'range to
287 -- be a name in this grammar).
289 if Token = Tok_Left_Paren or else Token = Tok_Range then
290 Restore_Scan_State (Scan_State); -- to apostrophe
291 Expr_Form := EF_Simple_Name;
294 -- Otherwise we have the case of a name extended by an attribute
297 goto Scan_Name_Extension_Apostrophe;
300 -- Check case of qualified simple name extended by a left parenthesis
302 elsif Token = Tok_Left_Paren then
303 Scan; -- past left paren
304 goto Scan_Name_Extension_Left_Paren;
306 -- Otherwise the qualified simple name is not extended, so return
309 Expr_Form := EF_Simple_Name;
313 -- Loop scanning past name extensions. A label is used for control
314 -- transfer for this loop for ease of interfacing with the finite state
315 -- machine in the parenthesis scanning circuit, and also to allow for
316 -- passing in control to the appropriate point from the above code.
318 <<Scan_Name_Extension>>
320 -- Character literal used as name cannot be extended. Also this
321 -- cannot be a call, since the name for a call must be a designator.
322 -- Return in these cases, or if there is no name extension
324 if Token not in Token_Class_Namext
325 or else Prev_Token = Tok_Char_Literal
327 Expr_Form := EF_Name;
331 -- Merge here when we know there is a name extension
333 <<Scan_Name_Extension_OK>>
335 if Token = Tok_Left_Paren then
336 Scan; -- past left paren
337 goto Scan_Name_Extension_Left_Paren;
339 elsif Token = Tok_Apostrophe then
340 Save_Scan_State (Scan_State); -- at apostrophe
341 Scan; -- past apostrophe
342 goto Scan_Name_Extension_Apostrophe;
344 else -- Token = Tok_Dot
345 Save_Scan_State (Scan_State); -- at dot
347 goto Scan_Name_Extension_Dot;
350 -- Case of name extended by dot (selection), dot is already skipped
351 -- and the scan state at the point of the dot is saved in Scan_State.
353 <<Scan_Name_Extension_Dot>>
355 -- Explicit dereference case
357 if Token = Tok_All then
358 Prefix_Node := Name_Node;
359 Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
360 Set_Prefix (Name_Node, Prefix_Node);
362 goto Scan_Name_Extension;
364 -- Selected component case
366 elsif Token in Token_Class_Name then
367 Prefix_Node := Name_Node;
368 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
369 Set_Prefix (Name_Node, Prefix_Node);
370 Set_Selector_Name (Name_Node, Token_Node);
371 Scan; -- past selector
372 goto Scan_Name_Extension;
374 -- Reserved identifier as selector
376 elsif Is_Reserved_Identifier then
377 Scan_Reserved_Identifier (Force_Msg => False);
378 Prefix_Node := Name_Node;
379 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
380 Set_Prefix (Name_Node, Prefix_Node);
381 Set_Selector_Name (Name_Node, Token_Node);
382 Scan; -- past identifier used as selector
383 goto Scan_Name_Extension;
385 -- If dot is at end of line and followed by nothing legal,
386 -- then assume end of name and quit (dot will be taken as
387 -- an erroneous form of some other punctuation by our caller).
389 elsif Token_Is_At_Start_Of_Line then
390 Restore_Scan_State (Scan_State);
393 -- Here if nothing legal after the dot
396 Error_Msg_AP ("selector expected");
400 -- Here for an apostrophe as name extension. The scan position at the
401 -- apostrophe has already been saved, and the apostrophe scanned out.
403 <<Scan_Name_Extension_Apostrophe>>
405 Scan_Apostrophe : declare
406 function Apostrophe_Should_Be_Semicolon return Boolean;
407 -- Checks for case where apostrophe should probably be
408 -- a semicolon, and if so, gives appropriate message,
409 -- resets the scan pointer to the apostrophe, changes
410 -- the current token to Tok_Semicolon, and returns True.
411 -- Otherwise returns False.
413 function Apostrophe_Should_Be_Semicolon return Boolean is
415 if Token_Is_At_Start_Of_Line then
416 Restore_Scan_State (Scan_State); -- to apostrophe
417 Error_Msg_SC ("|""''"" should be "";""");
418 Token := Tok_Semicolon;
423 end Apostrophe_Should_Be_Semicolon;
425 -- Start of processing for Scan_Apostrophe
428 -- If range attribute after apostrophe, then return with Token
429 -- pointing to the apostrophe. Note that in this case the prefix
430 -- need not be a simple name (cases like A.all'range). Similarly
431 -- if there is a left paren after the apostrophe, then we also
432 -- return with Token pointing to the apostrophe (this is the
433 -- qualified expression case).
435 if Token = Tok_Range or else Token = Tok_Left_Paren then
436 Restore_Scan_State (Scan_State); -- to apostrophe
437 Expr_Form := EF_Name;
440 -- Here for cases where attribute designator is an identifier
442 elsif Token = Tok_Identifier then
443 Attr_Name := Token_Name;
445 if not Is_Attribute_Name (Attr_Name) then
446 if Apostrophe_Should_Be_Semicolon then
447 Expr_Form := EF_Name;
450 -- Here for a bad attribute name
453 Signal_Bad_Attribute;
454 Scan; -- past bad identifier
456 if Token = Tok_Left_Paren then
457 Scan; -- past left paren
460 Discard_Junk_Node (P_Expression_If_OK);
461 exit when not Comma_Present;
472 Style.Check_Attribute_Name (False);
475 -- Here for case of attribute designator is not an identifier
478 if Token = Tok_Delta then
479 Attr_Name := Name_Delta;
481 elsif Token = Tok_Digits then
482 Attr_Name := Name_Digits;
484 elsif Token = Tok_Access then
485 Attr_Name := Name_Access;
487 elsif Token = Tok_Mod and then Ada_Version = Ada_05 then
488 Attr_Name := Name_Mod;
490 elsif Apostrophe_Should_Be_Semicolon then
491 Expr_Form := EF_Name;
495 Error_Msg_AP ("attribute designator expected");
500 Style.Check_Attribute_Name (True);
504 -- We come here with an OK attribute scanned, and the
505 -- corresponding Attribute identifier node stored in Ident_Node.
507 Prefix_Node := Name_Node;
508 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
509 Scan; -- past attribute designator
510 Set_Prefix (Name_Node, Prefix_Node);
511 Set_Attribute_Name (Name_Node, Attr_Name);
513 -- Scan attribute arguments/designator. We skip this if we know
514 -- that the attribute cannot have an argument.
516 if Token = Tok_Left_Paren
518 Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
520 Set_Expressions (Name_Node, New_List);
521 Scan; -- past left paren
525 Expr : constant Node_Id := P_Expression_If_OK;
528 if Token = Tok_Arrow then
530 ("named parameters not permitted for attributes");
531 Scan; -- past junk arrow
534 Append (Expr, Expressions (Name_Node));
535 exit when not Comma_Present;
543 goto Scan_Name_Extension;
546 -- Here for left parenthesis extending name (left paren skipped)
548 <<Scan_Name_Extension_Left_Paren>>
550 -- We now have to scan through a list of items, terminated by a
551 -- right parenthesis. The scan is handled by a finite state
552 -- machine. The possibilities are:
556 -- This is a slice. This case is handled in LP_State_Init
558 -- (expression, expression, ..)
560 -- This is interpreted as an indexed component, i.e. as a
561 -- case of a name which can be extended in the normal manner.
562 -- This case is handled by LP_State_Name or LP_State_Expr.
564 -- Note: conditional expressions (without an extra level of
565 -- parentheses) are permitted in this context).
567 -- (..., identifier => expression , ...)
569 -- If there is at least one occurrence of identifier => (but
570 -- none of the other cases apply), then we have a call.
572 -- Test for Id => case
574 if Token = Tok_Identifier then
575 Save_Scan_State (Scan_State); -- at Id
578 -- Test for => (allow := as an error substitute)
580 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
581 Restore_Scan_State (Scan_State); -- to Id
582 Arg_List := New_List;
586 Restore_Scan_State (Scan_State); -- to Id
590 -- Here we have an expression after all
592 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
594 -- Check cases of discrete range for a slice
596 -- First possibility: Range_Attribute_Reference
598 if Expr_Form = EF_Range_Attr then
599 Range_Node := Expr_Node;
601 -- Second possibility: Simple_expression .. Simple_expression
603 elsif Token = Tok_Dot_Dot then
604 Check_Simple_Expression (Expr_Node);
605 Range_Node := New_Node (N_Range, Token_Ptr);
606 Set_Low_Bound (Range_Node, Expr_Node);
608 Expr_Node := P_Expression;
609 Check_Simple_Expression (Expr_Node);
610 Set_High_Bound (Range_Node, Expr_Node);
612 -- Third possibility: Type_name range Range
614 elsif Token = Tok_Range then
615 if Expr_Form /= EF_Simple_Name then
616 Error_Msg_SC -- CODEFIX???
617 ("subtype mark must precede RANGE");
621 Range_Node := P_Subtype_Indication (Expr_Node);
623 -- Otherwise we just have an expression. It is true that we might
624 -- have a subtype mark without a range constraint but this case
625 -- is syntactically indistinguishable from the expression case.
628 Arg_List := New_List;
632 -- Fall through here with unmistakable Discrete range scanned,
633 -- which means that we definitely have the case of a slice. The
634 -- Discrete range is in Range_Node.
636 if Token = Tok_Comma then
637 Error_Msg_SC ("slice cannot have more than one dimension");
640 elsif Token /= Tok_Right_Paren then
645 Scan; -- past right paren
646 Prefix_Node := Name_Node;
647 Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
648 Set_Prefix (Name_Node, Prefix_Node);
649 Set_Discrete_Range (Name_Node, Range_Node);
651 -- An operator node is legal as a prefix to other names,
652 -- but not for a slice.
654 if Nkind (Prefix_Node) = N_Operator_Symbol then
655 Error_Msg_N ("illegal prefix for slice", Prefix_Node);
658 -- If we have a name extension, go scan it
660 if Token in Token_Class_Namext then
661 goto Scan_Name_Extension_OK;
663 -- Otherwise return (a slice is a name, but is not a call)
666 Expr_Form := EF_Name;
671 -- In LP_State_Expr, we have scanned one or more expressions, and
672 -- so we have a call or an indexed component which is a name. On
673 -- entry we have the expression just scanned in Expr_Node and
674 -- Arg_List contains the list of expressions encountered so far
677 Append (Expr_Node, Arg_List);
679 if Token = Tok_Arrow then
681 ("expect identifier in parameter association",
685 elsif not Comma_Present then
687 Prefix_Node := Name_Node;
688 Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
689 Set_Prefix (Name_Node, Prefix_Node);
690 Set_Expressions (Name_Node, Arg_List);
691 goto Scan_Name_Extension;
694 -- Comma present (and scanned out), test for identifier => case
695 -- Test for identifier => case
697 if Token = Tok_Identifier then
698 Save_Scan_State (Scan_State); -- at Id
701 -- Test for => (allow := as error substitute)
703 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
704 Restore_Scan_State (Scan_State); -- to Id
707 -- Otherwise it's just an expression after all, so backup
710 Restore_Scan_State (Scan_State); -- to Id
714 -- Here we have an expression after all, so stay in this state
716 Expr_Node := P_Expression_If_OK;
719 -- LP_State_Call corresponds to the situation in which at least
720 -- one instance of Id => Expression has been encountered, so we
721 -- know that we do not have a name, but rather a call. We enter
722 -- it with the scan pointer pointing to the next argument to scan,
723 -- and Arg_List containing the list of arguments scanned so far.
727 -- Test for case of Id => Expression (named parameter)
729 if Token = Tok_Identifier then
730 Save_Scan_State (Scan_State); -- at Id
731 Ident_Node := Token_Node;
734 -- Deal with => (allow := as erroneous substitute)
736 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
737 Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);
738 Set_Selector_Name (Arg_Node, Ident_Node);
740 Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
741 Append (Arg_Node, Arg_List);
743 -- If a comma follows, go back and scan next entry
745 if Comma_Present then
748 -- Otherwise we have the end of a call
751 Prefix_Node := Name_Node;
752 Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
753 Set_Name (Name_Node, Prefix_Node);
754 Set_Parameter_Associations (Name_Node, Arg_List);
757 if Token in Token_Class_Namext then
758 goto Scan_Name_Extension_OK;
760 -- This is a case of a call which cannot be a name
763 Expr_Form := EF_Name;
768 -- Not named parameter: Id started an expression after all
771 Restore_Scan_State (Scan_State); -- to Id
775 -- Here if entry did not start with Id => which means that it
776 -- is a positional parameter, which is not allowed, since we
777 -- have seen at least one named parameter already.
780 ("positional parameter association " &
781 "not allowed after named one");
783 Expr_Node := P_Expression_If_OK;
785 -- Leaving the '>' in an association is not unusual, so suggest
788 if Nkind (Expr_Node) = N_Op_Eq then
789 Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
792 -- We go back to scanning out expressions, so that we do not get
793 -- multiple error messages when several positional parameters
794 -- follow a named parameter.
798 -- End of treatment for name extensions starting with left paren
800 -- End of loop through name extensions
804 -- This function parses a restricted form of Names which are either
805 -- designators, or designators preceded by a sequence of prefixes
806 -- that are direct names.
808 -- Error recovery: cannot raise Error_Resync
810 function P_Function_Name return Node_Id is
811 Designator_Node : Node_Id;
812 Prefix_Node : Node_Id;
813 Selector_Node : Node_Id;
814 Dot_Sloc : Source_Ptr := No_Location;
817 -- Prefix_Node is set to the gathered prefix so far, Empty means that
818 -- no prefix has been scanned. This allows us to build up the result
819 -- in the required right recursive manner.
821 Prefix_Node := Empty;
823 -- Loop through prefixes
826 Designator_Node := Token_Node;
828 if Token not in Token_Class_Desig then
829 return P_Identifier; -- let P_Identifier issue the error message
831 else -- Token in Token_Class_Desig
832 Scan; -- past designator
833 exit when Token /= Tok_Dot;
836 -- Here at a dot, with token just before it in Designator_Node
838 if No (Prefix_Node) then
839 Prefix_Node := Designator_Node;
841 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
842 Set_Prefix (Selector_Node, Prefix_Node);
843 Set_Selector_Name (Selector_Node, Designator_Node);
844 Prefix_Node := Selector_Node;
847 Dot_Sloc := Token_Ptr;
851 -- Fall out of the loop having just scanned a designator
853 if No (Prefix_Node) then
854 return Designator_Node;
856 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
857 Set_Prefix (Selector_Node, Prefix_Node);
858 Set_Selector_Name (Selector_Node, Designator_Node);
859 return Selector_Node;
867 -- This function parses a restricted form of Names which are either
868 -- identifiers, or identifiers preceded by a sequence of prefixes
869 -- that are direct names.
871 -- Error recovery: cannot raise Error_Resync
873 function P_Qualified_Simple_Name return Node_Id is
874 Designator_Node : Node_Id;
875 Prefix_Node : Node_Id;
876 Selector_Node : Node_Id;
877 Dot_Sloc : Source_Ptr := No_Location;
880 -- Prefix node is set to the gathered prefix so far, Empty means that
881 -- no prefix has been scanned. This allows us to build up the result
882 -- in the required right recursive manner.
884 Prefix_Node := Empty;
886 -- Loop through prefixes
889 Designator_Node := Token_Node;
891 if Token = Tok_Identifier then
892 Scan; -- past identifier
893 exit when Token /= Tok_Dot;
895 elsif Token not in Token_Class_Desig then
896 return P_Identifier; -- let P_Identifier issue the error message
899 Scan; -- past designator
901 if Token /= Tok_Dot then
902 Error_Msg_SP ("identifier expected");
907 -- Here at a dot, with token just before it in Designator_Node
909 if No (Prefix_Node) then
910 Prefix_Node := Designator_Node;
912 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
913 Set_Prefix (Selector_Node, Prefix_Node);
914 Set_Selector_Name (Selector_Node, Designator_Node);
915 Prefix_Node := Selector_Node;
918 Dot_Sloc := Token_Ptr;
922 -- Fall out of the loop having just scanned an identifier
924 if No (Prefix_Node) then
925 return Designator_Node;
927 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
928 Set_Prefix (Selector_Node, Prefix_Node);
929 Set_Selector_Name (Selector_Node, Designator_Node);
930 return Selector_Node;
936 end P_Qualified_Simple_Name;
938 -- This procedure differs from P_Qualified_Simple_Name only in that it
939 -- raises Error_Resync if any error is encountered. It only returns after
940 -- scanning a valid qualified simple name.
942 -- Error recovery: can raise Error_Resync
944 function P_Qualified_Simple_Name_Resync return Node_Id is
945 Designator_Node : Node_Id;
946 Prefix_Node : Node_Id;
947 Selector_Node : Node_Id;
948 Dot_Sloc : Source_Ptr := No_Location;
951 Prefix_Node := Empty;
953 -- Loop through prefixes
956 Designator_Node := Token_Node;
958 if Token = Tok_Identifier then
959 Scan; -- past identifier
960 exit when Token /= Tok_Dot;
962 elsif Token not in Token_Class_Desig then
963 Discard_Junk_Node (P_Identifier); -- to issue the error message
967 Scan; -- past designator
969 if Token /= Tok_Dot then
970 Error_Msg_SP ("identifier expected");
975 -- Here at a dot, with token just before it in Designator_Node
977 if No (Prefix_Node) then
978 Prefix_Node := Designator_Node;
980 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
981 Set_Prefix (Selector_Node, Prefix_Node);
982 Set_Selector_Name (Selector_Node, Designator_Node);
983 Prefix_Node := Selector_Node;
986 Dot_Sloc := Token_Ptr;
990 -- Fall out of the loop having just scanned an identifier
992 if No (Prefix_Node) then
993 return Designator_Node;
995 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
996 Set_Prefix (Selector_Node, Prefix_Node);
997 Set_Selector_Name (Selector_Node, Designator_Node);
998 return Selector_Node;
1000 end P_Qualified_Simple_Name_Resync;
1002 ----------------------
1003 -- 4.1 Direct_Name --
1004 ----------------------
1006 -- Parsed by P_Name and other functions in section 4.1
1012 -- Parsed by P_Name (4.1)
1014 -------------------------------
1015 -- 4.1 Explicit Dereference --
1016 -------------------------------
1018 -- Parsed by P_Name (4.1)
1020 -------------------------------
1021 -- 4.1 Implicit_Dereference --
1022 -------------------------------
1024 -- Parsed by P_Name (4.1)
1026 ----------------------------
1027 -- 4.1 Indexed Component --
1028 ----------------------------
1030 -- Parsed by P_Name (4.1)
1036 -- Parsed by P_Name (4.1)
1038 -----------------------------
1039 -- 4.1 Selected_Component --
1040 -----------------------------
1042 -- Parsed by P_Name (4.1)
1044 ------------------------
1045 -- 4.1 Selector Name --
1046 ------------------------
1048 -- Parsed by P_Name (4.1)
1050 ------------------------------
1051 -- 4.1 Attribute Reference --
1052 ------------------------------
1054 -- Parsed by P_Name (4.1)
1056 -------------------------------
1057 -- 4.1 Attribute Designator --
1058 -------------------------------
1060 -- Parsed by P_Name (4.1)
1062 --------------------------------------
1063 -- 4.1.4 Range Attribute Reference --
1064 --------------------------------------
1066 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1068 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1070 -- In the grammar, a RANGE attribute is simply a name, but its use is
1071 -- highly restricted, so in the parser, we do not regard it as a name.
1072 -- Instead, P_Name returns without scanning the 'RANGE part of the
1073 -- attribute, and the caller uses the following function to construct
1074 -- a range attribute in places where it is appropriate.
1076 -- Note that RANGE here is treated essentially as an identifier,
1077 -- rather than a reserved word.
1079 -- The caller has parsed the prefix, i.e. a name, and Token points to
1080 -- the apostrophe. The token after the apostrophe is known to be RANGE
1081 -- at this point. The prefix node becomes the prefix of the attribute.
1083 -- Error_Recovery: Cannot raise Error_Resync
1085 function P_Range_Attribute_Reference
1086 (Prefix_Node : Node_Id)
1089 Attr_Node : Node_Id;
1092 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1093 Set_Prefix (Attr_Node, Prefix_Node);
1094 Scan; -- past apostrophe
1097 Style.Check_Attribute_Name (True);
1100 Set_Attribute_Name (Attr_Node, Name_Range);
1103 if Token = Tok_Left_Paren then
1104 Scan; -- past left paren
1105 Set_Expressions (Attr_Node, New_List (P_Expression_If_OK));
1110 end P_Range_Attribute_Reference;
1112 ---------------------------------------
1113 -- 4.1.4 Range Attribute Designator --
1114 ---------------------------------------
1116 -- Parsed by P_Range_Attribute_Reference (4.4)
1118 --------------------
1120 --------------------
1122 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1124 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1125 -- an aggregate is known to be required (code statement, extension
1126 -- aggregate), in which cases this routine performs the necessary check
1127 -- that we have an aggregate rather than a parenthesized expression
1129 -- Error recovery: can raise Error_Resync
1131 function P_Aggregate return Node_Id is
1132 Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1133 Aggr_Node : constant Node_Id := P_Aggregate_Or_Paren_Expr;
1136 if Nkind (Aggr_Node) /= N_Aggregate
1138 Nkind (Aggr_Node) /= N_Extension_Aggregate
1141 ("aggregate may not have single positional component", Aggr_Sloc);
1148 ------------------------------------------------
1149 -- 4.3 Aggregate or Parenthesized Expression --
1150 ------------------------------------------------
1152 -- This procedure parses out either an aggregate or a parenthesized
1153 -- expression (these two constructs are closely related, since a
1154 -- parenthesized expression looks like an aggregate with a single
1155 -- positional component).
1158 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1160 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1162 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1163 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1166 -- RECORD_COMPONENT_ASSOCIATION ::=
1167 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1169 -- COMPONENT_CHOICE_LIST ::=
1170 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1173 -- EXTENSION_AGGREGATE ::=
1174 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1176 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1178 -- ARRAY_AGGREGATE ::=
1179 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1181 -- POSITIONAL_ARRAY_AGGREGATE ::=
1182 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1183 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1184 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1186 -- NAMED_ARRAY_AGGREGATE ::=
1187 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1189 -- PRIMARY ::= (EXPRESSION);
1191 -- Error recovery: can raise Error_Resync
1193 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1194 -- to Ada 2005 limited aggregates (AI-287)
1196 function P_Aggregate_Or_Paren_Expr return Node_Id is
1197 Aggregate_Node : Node_Id;
1198 Expr_List : List_Id;
1199 Assoc_List : List_Id;
1200 Expr_Node : Node_Id;
1201 Lparen_Sloc : Source_Ptr;
1202 Scan_State : Saved_Scan_State;
1205 Lparen_Sloc := Token_Ptr;
1208 -- Conditional expression case
1210 if Token = Tok_If then
1211 Expr_Node := P_Conditional_Expression;
1215 -- Note: the mechanism used here of rescanning the initial expression
1216 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1217 -- out the discrete choice list.
1219 -- Deal with expression and extension aggregate cases first
1221 elsif Token /= Tok_Others then
1222 Save_Scan_State (Scan_State); -- at start of expression
1224 -- Deal with (NULL RECORD) case
1226 if Token = Tok_Null then
1229 if Token = Tok_Record then
1230 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1231 Set_Null_Record_Present (Aggregate_Node, True);
1232 Scan; -- past RECORD
1234 return Aggregate_Node;
1236 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1240 -- Ada 2005 (AI-287): The box notation is allowed only with named
1241 -- notation because positional notation might be error prone. For
1242 -- example, in "(X, <>, Y, <>)", there is no type associated with
1243 -- the boxes, so you might not be leaving out the components you
1244 -- thought you were leaving out.
1246 if Ada_Version >= Ada_05 and then Token = Tok_Box then
1247 Error_Msg_SC ("(Ada 2005) box notation only allowed with "
1248 & "named notation");
1250 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1251 return Aggregate_Node;
1254 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1256 -- Extension aggregate case
1258 if Token = Tok_With then
1260 if Nkind (Expr_Node) = N_Attribute_Reference
1261 and then Attribute_Name (Expr_Node) = Name_Range
1263 Bad_Range_Attribute (Sloc (Expr_Node));
1267 if Ada_Version = Ada_83 then
1268 Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1271 Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1272 Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1275 -- Deal with WITH NULL RECORD case
1277 if Token = Tok_Null then
1278 Save_Scan_State (Scan_State); -- at NULL
1281 if Token = Tok_Record then
1282 Scan; -- past RECORD
1283 Set_Null_Record_Present (Aggregate_Node, True);
1285 return Aggregate_Node;
1288 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1292 if Token /= Tok_Others then
1293 Save_Scan_State (Scan_State);
1294 Expr_Node := P_Expression;
1301 elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1302 if Nkind (Expr_Node) = N_Attribute_Reference
1303 and then Attribute_Name (Expr_Node) = Name_Range
1306 ("|parentheses not allowed for range attribute", Lparen_Sloc);
1307 Scan; -- past right paren
1311 -- Bump paren count of expression
1313 if Expr_Node /= Error then
1314 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1317 T_Right_Paren; -- past right paren (error message if none)
1320 -- Normal aggregate case
1323 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1329 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1333 -- Prepare to scan list of component associations
1335 Expr_List := No_List; -- don't set yet, maybe all named entries
1336 Assoc_List := No_List; -- don't set yet, maybe all positional entries
1338 -- This loop scans through component associations. On entry to the
1339 -- loop, an expression has been scanned at the start of the current
1340 -- association unless initial token was OTHERS, in which case
1341 -- Expr_Node is set to Empty.
1344 -- Deal with others association first. This is a named association
1346 if No (Expr_Node) then
1347 if No (Assoc_List) then
1348 Assoc_List := New_List;
1351 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1353 -- Improper use of WITH
1355 elsif Token = Tok_With then
1356 Error_Msg_SC ("WITH must be preceded by single expression in " &
1357 "extension aggregate");
1360 -- A range attribute can only appear as part of a discrete choice
1363 elsif Nkind (Expr_Node) = N_Attribute_Reference
1364 and then Attribute_Name (Expr_Node) = Name_Range
1365 and then Token /= Tok_Arrow
1366 and then Token /= Tok_Vertical_Bar
1368 Bad_Range_Attribute (Sloc (Expr_Node));
1371 -- Assume positional case if comma, right paren, or literal or
1372 -- identifier or OTHERS follows (the latter cases are missing
1373 -- comma cases). Also assume positional if a semicolon follows,
1374 -- which can happen if there are missing parens
1376 elsif Token = Tok_Comma
1377 or else Token = Tok_Right_Paren
1378 or else Token = Tok_Others
1379 or else Token in Token_Class_Lit_Or_Name
1380 or else Token = Tok_Semicolon
1382 if Present (Assoc_List) then
1384 ("""='>"" expected (positional association cannot follow " &
1385 "named association)");
1388 if No (Expr_List) then
1389 Expr_List := New_List;
1392 Append (Expr_Node, Expr_List);
1394 -- Check for aggregate followed by left parent, maybe missing comma
1396 elsif Nkind (Expr_Node) = N_Aggregate
1397 and then Token = Tok_Left_Paren
1401 if No (Expr_List) then
1402 Expr_List := New_List;
1405 Append (Expr_Node, Expr_List);
1407 -- Anything else is assumed to be a named association
1410 Restore_Scan_State (Scan_State); -- to start of expression
1412 if No (Assoc_List) then
1413 Assoc_List := New_List;
1416 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1419 exit when not Comma_Present;
1421 -- If we are at an expression terminator, something is seriously
1422 -- wrong, so let's get out now, before we start eating up stuff
1423 -- that doesn't belong to us!
1425 if Token in Token_Class_Eterm then
1426 Error_Msg_AP ("expecting expression or component association");
1430 -- Otherwise initiate for reentry to top of loop by scanning an
1431 -- initial expression, unless the first token is OTHERS.
1433 if Token = Tok_Others then
1436 Save_Scan_State (Scan_State); -- at start of expression
1437 Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
1442 -- All component associations (positional and named) have been scanned
1445 Set_Expressions (Aggregate_Node, Expr_List);
1446 Set_Component_Associations (Aggregate_Node, Assoc_List);
1447 return Aggregate_Node;
1448 end P_Aggregate_Or_Paren_Expr;
1450 ------------------------------------------------
1451 -- 4.3 Record or Array Component Association --
1452 ------------------------------------------------
1454 -- RECORD_COMPONENT_ASSOCIATION ::=
1455 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1456 -- | COMPONENT_CHOICE_LIST => <>
1458 -- COMPONENT_CHOICE_LIST =>
1459 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1462 -- ARRAY_COMPONENT_ASSOCIATION ::=
1463 -- DISCRETE_CHOICE_LIST => EXPRESSION
1464 -- | DISCRETE_CHOICE_LIST => <>
1466 -- Note: this routine only handles the named cases, including others.
1467 -- Cases where the component choice list is not present have already
1468 -- been handled directly.
1470 -- Error recovery: can raise Error_Resync
1472 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1473 -- rules have been extended to give support to Ada 2005 limited
1474 -- aggregates (AI-287)
1476 function P_Record_Or_Array_Component_Association return Node_Id is
1477 Assoc_Node : Node_Id;
1480 Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1481 Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1482 Set_Sloc (Assoc_Node, Token_Ptr);
1485 if Token = Tok_Box then
1487 -- Ada 2005(AI-287): The box notation is used to indicate the
1488 -- default initialization of aggregate components
1490 if Ada_Version < Ada_05 then
1492 ("component association with '<'> is an Ada 2005 extension");
1493 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1496 Set_Box_Present (Assoc_Node);
1499 Set_Expression (Assoc_Node, P_Expression);
1503 end P_Record_Or_Array_Component_Association;
1505 -----------------------------
1506 -- 4.3.1 Record Aggregate --
1507 -----------------------------
1509 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1510 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1512 ----------------------------------------------
1513 -- 4.3.1 Record Component Association List --
1514 ----------------------------------------------
1516 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1518 ----------------------------------
1519 -- 4.3.1 Component Choice List --
1520 ----------------------------------
1522 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1524 --------------------------------
1525 -- 4.3.1 Extension Aggregate --
1526 --------------------------------
1528 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1530 --------------------------
1531 -- 4.3.1 Ancestor Part --
1532 --------------------------
1534 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1536 ----------------------------
1537 -- 4.3.1 Array Aggregate --
1538 ----------------------------
1540 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1542 ---------------------------------------
1543 -- 4.3.1 Positional Array Aggregate --
1544 ---------------------------------------
1546 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1548 ----------------------------------
1549 -- 4.3.1 Named Array Aggregate --
1550 ----------------------------------
1552 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1554 ----------------------------------------
1555 -- 4.3.1 Array Component Association --
1556 ----------------------------------------
1558 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1560 ---------------------
1561 -- 4.4 Expression --
1562 ---------------------
1565 -- RELATION {and RELATION} | RELATION {and then RELATION}
1566 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1567 -- | RELATION {xor RELATION}
1569 -- On return, Expr_Form indicates the categorization of the expression
1570 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1571 -- an error message is given, and Error is returned).
1573 -- Error recovery: cannot raise Error_Resync
1575 function P_Expression return Node_Id is
1576 Logical_Op : Node_Kind;
1577 Prev_Logical_Op : Node_Kind;
1578 Op_Location : Source_Ptr;
1583 Node1 := P_Relation;
1585 if Token in Token_Class_Logop then
1586 Prev_Logical_Op := N_Empty;
1589 Op_Location := Token_Ptr;
1590 Logical_Op := P_Logical_Operator;
1592 if Prev_Logical_Op /= N_Empty and then
1593 Logical_Op /= Prev_Logical_Op
1596 ("mixed logical operators in expression", Op_Location);
1597 Prev_Logical_Op := N_Empty;
1599 Prev_Logical_Op := Logical_Op;
1603 Node1 := New_Node (Logical_Op, Op_Location);
1604 Set_Left_Opnd (Node1, Node2);
1605 Set_Right_Opnd (Node1, P_Relation);
1606 Set_Op_Name (Node1);
1607 exit when Token not in Token_Class_Logop;
1610 Expr_Form := EF_Non_Simple;
1613 if Token = Tok_Apostrophe then
1614 Bad_Range_Attribute (Token_Ptr);
1621 -- This function is identical to the normal P_Expression, except that it
1622 -- also permits the appearence of a conditional expression without the
1623 -- usual surrounding parentheses.
1625 function P_Expression_If_OK return Node_Id is
1627 if Token = Tok_If then
1628 return P_Conditional_Expression;
1630 return P_Expression;
1632 end P_Expression_If_OK;
1634 -- This function is identical to the normal P_Expression, except that it
1635 -- checks that the expression scan did not stop on a right paren. It is
1636 -- called in all contexts where a right parenthesis cannot legitimately
1637 -- follow an expression.
1639 -- Error recovery: can not raise Error_Resync
1641 function P_Expression_No_Right_Paren return Node_Id is
1642 Expr : constant Node_Id := P_Expression;
1644 Ignore (Tok_Right_Paren);
1646 end P_Expression_No_Right_Paren;
1648 ----------------------------------------
1649 -- 4.4 Expression_Or_Range_Attribute --
1650 ----------------------------------------
1653 -- RELATION {and RELATION} | RELATION {and then RELATION}
1654 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1655 -- | RELATION {xor RELATION}
1657 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1659 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1661 -- On return, Expr_Form indicates the categorization of the expression
1662 -- and EF_Range_Attr is one of the possibilities.
1664 -- Error recovery: cannot raise Error_Resync
1666 -- In the grammar, a RANGE attribute is simply a name, but its use is
1667 -- highly restricted, so in the parser, we do not regard it as a name.
1668 -- Instead, P_Name returns without scanning the 'RANGE part of the
1669 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1670 -- attribute reference. In the normal case where a range attribute is
1671 -- not allowed, an error message is issued by P_Expression.
1673 function P_Expression_Or_Range_Attribute return Node_Id is
1674 Logical_Op : Node_Kind;
1675 Prev_Logical_Op : Node_Kind;
1676 Op_Location : Source_Ptr;
1679 Attr_Node : Node_Id;
1682 Node1 := P_Relation;
1684 if Token = Tok_Apostrophe then
1685 Attr_Node := P_Range_Attribute_Reference (Node1);
1686 Expr_Form := EF_Range_Attr;
1689 elsif 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_Node (Logical_Op, Op_Location);
1708 Set_Left_Opnd (Node1, Node2);
1709 Set_Right_Opnd (Node1, P_Relation);
1710 Set_Op_Name (Node1);
1711 exit when Token not in Token_Class_Logop;
1714 Expr_Form := EF_Non_Simple;
1717 if Token = Tok_Apostrophe then
1718 Bad_Range_Attribute (Token_Ptr);
1723 end P_Expression_Or_Range_Attribute;
1725 -- Version that allows a non-parenthesized conditional expression
1727 function P_Expression_Or_Range_Attribute_If_OK return Node_Id is
1729 if Token = Tok_If then
1730 return P_Conditional_Expression;
1732 return P_Expression_Or_Range_Attribute;
1734 end P_Expression_Or_Range_Attribute_If_OK;
1741 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1742 -- | SIMPLE_EXPRESSION [not] in RANGE
1743 -- | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1745 -- On return, Expr_Form indicates the categorization of the expression
1747 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1748 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1750 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1751 -- expression, then tokens are scanned until either a non-expression token,
1752 -- a right paren (not matched by a left paren) or a comma, is encountered.
1754 function P_Relation return Node_Id is
1755 Node1, Node2 : Node_Id;
1759 Node1 := P_Simple_Expression;
1761 if Token not in Token_Class_Relop then
1765 -- Here we have a relational operator following. If so then scan it
1766 -- out. Note that the assignment symbol := is treated as a relational
1767 -- operator to improve the error recovery when it is misused for =.
1768 -- P_Relational_Operator also parses the IN and NOT IN operations.
1771 Node2 := New_Node (P_Relational_Operator, Optok);
1772 Set_Left_Opnd (Node2, Node1);
1773 Set_Op_Name (Node2);
1775 -- Case of IN or NOT IN
1777 if Prev_Token = Tok_In then
1778 P_Membership_Test (Node2);
1780 -- Case of relational operator (= /= < <= > >=)
1783 Set_Right_Opnd (Node2, P_Simple_Expression);
1786 Expr_Form := EF_Non_Simple;
1788 if Token in Token_Class_Relop then
1789 Error_Msg_SC ("unexpected relational operator");
1796 -- If any error occurs, then scan to the next expression terminator symbol
1797 -- or comma or right paren at the outer (i.e. current) parentheses level.
1798 -- The flags are set to indicate a normal simple expression.
1801 when Error_Resync =>
1803 Expr_Form := EF_Simple;
1807 ----------------------------
1808 -- 4.4 Simple Expression --
1809 ----------------------------
1811 -- SIMPLE_EXPRESSION ::=
1812 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1814 -- On return, Expr_Form indicates the categorization of the expression
1816 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1817 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1819 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1820 -- expression, then tokens are scanned until either a non-expression token,
1821 -- a right paren (not matched by a left paren) or a comma, is encountered.
1823 -- Note: P_Simple_Expression is called only internally by higher level
1824 -- expression routines. In cases in the grammar where a simple expression
1825 -- is required, the approach is to scan an expression, and then post an
1826 -- appropriate error message if the expression obtained is not simple. This
1827 -- gives better error recovery and treatment.
1829 function P_Simple_Expression return Node_Id is
1830 Scan_State : Saved_Scan_State;
1833 Tokptr : Source_Ptr;
1836 -- Check for cases starting with a name. There are two reasons for
1837 -- special casing. First speed things up by catching a common case
1838 -- without going through several routine layers. Second the caller must
1839 -- be informed via Expr_Form when the simple expression is a name.
1841 if Token in Token_Class_Name then
1844 -- Deal with apostrophe cases
1846 if Token = Tok_Apostrophe then
1847 Save_Scan_State (Scan_State); -- at apostrophe
1848 Scan; -- past apostrophe
1850 -- If qualified expression, scan it out and fall through
1852 if Token = Tok_Left_Paren then
1853 Node1 := P_Qualified_Expression (Node1);
1854 Expr_Form := EF_Simple;
1856 -- If range attribute, then we return with Token pointing to the
1857 -- apostrophe. Note: avoid the normal error check on exit. We
1858 -- know that the expression really is complete in this case!
1860 else -- Token = Tok_Range then
1861 Restore_Scan_State (Scan_State); -- to apostrophe
1862 Expr_Form := EF_Simple_Name;
1867 -- If an expression terminator follows, the previous processing
1868 -- completely scanned out the expression (a common case), and
1869 -- left Expr_Form set appropriately for returning to our caller.
1871 if Token in Token_Class_Sterm then
1874 -- If we do not have an expression terminator, then complete the
1875 -- scan of a simple expression. This code duplicates the code
1876 -- found in P_Term and P_Factor.
1879 if Token = Tok_Double_Asterisk then
1881 Style.Check_Exponentiation_Operator;
1884 Node2 := New_Node (N_Op_Expon, Token_Ptr);
1886 Set_Left_Opnd (Node2, Node1);
1887 Set_Right_Opnd (Node2, P_Primary);
1888 Set_Op_Name (Node2);
1893 exit when Token not in Token_Class_Mulop;
1894 Tokptr := Token_Ptr;
1895 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1898 Style.Check_Binary_Operator;
1901 Scan; -- past operator
1902 Set_Left_Opnd (Node2, Node1);
1903 Set_Right_Opnd (Node2, P_Factor);
1904 Set_Op_Name (Node2);
1909 exit when Token not in Token_Class_Binary_Addop;
1910 Tokptr := Token_Ptr;
1911 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1914 Style.Check_Binary_Operator;
1917 Scan; -- past operator
1918 Set_Left_Opnd (Node2, Node1);
1919 Set_Right_Opnd (Node2, P_Term);
1920 Set_Op_Name (Node2);
1924 Expr_Form := EF_Simple;
1927 -- Cases where simple expression does not start with a name
1930 -- Scan initial sign and initial Term
1932 if Token in Token_Class_Unary_Addop then
1933 Tokptr := Token_Ptr;
1934 Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
1937 Style.Check_Unary_Plus_Or_Minus;
1940 Scan; -- past operator
1941 Set_Right_Opnd (Node1, P_Term);
1942 Set_Op_Name (Node1);
1947 -- In the following, we special-case a sequence of concatenations of
1948 -- string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
1949 -- else mixed in. For such a sequence, we return a tree representing
1950 -- "" & "aaabbb...ccc" (a single concatenation). This is done only if
1951 -- the number of concatenations is large. If semantic analysis
1952 -- resolves the "&" to a predefined one, then this folding gives the
1953 -- right answer. Otherwise, semantic analysis will complain about a
1954 -- capacity-exceeded error. The purpose of this trick is to avoid
1955 -- creating a deeply nested tree, which would cause deep recursion
1956 -- during semantics, causing stack overflow. This way, we can handle
1957 -- enormous concatenations in the normal case of predefined "&". We
1958 -- first build up the normal tree, and then rewrite it if
1962 Num_Concats_Threshold : constant Positive := 1000;
1963 -- Arbitrary threshold value to enable optimization
1965 First_Node : constant Node_Id := Node1;
1966 Is_Strlit_Concat : Boolean;
1967 -- True iff we've parsed a sequence of concatenations of string
1968 -- literals, with nothing else mixed in.
1970 Num_Concats : Natural;
1971 -- Number of "&" operators if Is_Strlit_Concat is True
1975 Nkind (Node1) = N_String_Literal
1976 and then Token = Tok_Ampersand;
1979 -- Scan out sequence of terms separated by binary adding operators
1982 exit when Token not in Token_Class_Binary_Addop;
1983 Tokptr := Token_Ptr;
1984 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1985 Scan; -- past operator
1986 Set_Left_Opnd (Node2, Node1);
1988 Set_Right_Opnd (Node2, Node1);
1989 Set_Op_Name (Node2);
1991 -- Check if we're still concatenating string literals
1995 and then Nkind (Node2) = N_Op_Concat
1996 and then Nkind (Node1) = N_String_Literal;
1998 if Is_Strlit_Concat then
1999 Num_Concats := Num_Concats + 1;
2005 -- If we have an enormous series of concatenations of string
2006 -- literals, rewrite as explained above. The Is_Folded_In_Parser
2007 -- flag tells semantic analysis that if the "&" is not predefined,
2008 -- the folded value is wrong.
2011 and then Num_Concats >= Num_Concats_Threshold
2014 Empty_String_Val : String_Id;
2017 Strlit_Concat_Val : String_Id;
2018 -- Contains the folded value (which will be correct if the
2019 -- "&" operators are the predefined ones).
2022 -- For walking up the tree
2025 -- Folded node to replace Node1
2027 Loc : constant Source_Ptr := Sloc (First_Node);
2030 -- Walk up the tree starting at the leftmost string literal
2031 -- (First_Node), building up the Strlit_Concat_Val as we
2032 -- go. Note that we do not use recursion here -- the whole
2033 -- point is to avoid recursively walking that enormous tree.
2036 Store_String_Chars (Strval (First_Node));
2038 Cur_Node := Parent (First_Node);
2039 while Present (Cur_Node) loop
2040 pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
2041 Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
2043 Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
2044 Cur_Node := Parent (Cur_Node);
2047 Strlit_Concat_Val := End_String;
2049 -- Create new folded node, and rewrite result with a concat-
2050 -- enation of an empty string literal and the folded node.
2053 Empty_String_Val := End_String;
2055 Make_Op_Concat (Loc,
2056 Make_String_Literal (Loc, Empty_String_Val),
2057 Make_String_Literal (Loc, Strlit_Concat_Val,
2058 Is_Folded_In_Parser => True));
2059 Rewrite (Node1, New_Node);
2064 -- All done, we clearly do not have name or numeric literal so this
2065 -- is a case of a simple expression which is some other possibility.
2067 Expr_Form := EF_Simple;
2070 -- Come here at end of simple expression, where we do a couple of
2071 -- special checks to improve error recovery.
2073 -- Special test to improve error recovery. If the current token
2074 -- is a period, then someone is trying to do selection on something
2075 -- that is not a name, e.g. a qualified expression.
2077 if Token = Tok_Dot then
2078 Error_Msg_SC ("prefix for selection is not a name");
2082 -- Special test to improve error recovery: If the current token is
2083 -- not the first token on a line (as determined by checking the
2084 -- previous token position with the start of the current line),
2085 -- then we insist that we have an appropriate terminating token.
2086 -- Consider the following two examples:
2088 -- 1) if A nad B then ...
2093 -- In the first example, we would like to issue a binary operator
2094 -- expected message and resynchronize to the then. In the second
2095 -- example, we do not want to issue a binary operator message, so
2096 -- that instead we will get the missing semicolon message. This
2097 -- distinction is of course a heuristic which does not always work,
2098 -- but in practice it is quite effective.
2100 -- Note: the one case in which we do not go through this circuit is
2101 -- when we have scanned a range attribute and want to return with
2102 -- Token pointing to the apostrophe. The apostrophe is not normally
2103 -- an expression terminator, and is not in Token_Class_Sterm, but
2104 -- in this special case we know that the expression is complete.
2106 if not Token_Is_At_Start_Of_Line
2107 and then Token not in Token_Class_Sterm
2109 -- Normally the right error message is indeed that we expected a
2110 -- binary operator, but in the case of being between a right and left
2111 -- paren, e.g. in an aggregate, a more likely error is missing comma.
2113 if Prev_Token = Tok_Right_Paren and then Token = Tok_Left_Paren then
2116 Error_Msg_AP ("binary operator expected");
2125 -- If any error occurs, then scan to next expression terminator symbol
2126 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
2127 -- level. Expr_Form is set to indicate a normal simple expression.
2130 when Error_Resync =>
2132 Expr_Form := EF_Simple;
2134 end P_Simple_Expression;
2136 -----------------------------------------------
2137 -- 4.4 Simple Expression or Range Attribute --
2138 -----------------------------------------------
2140 -- SIMPLE_EXPRESSION ::=
2141 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2143 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2145 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2147 -- Error recovery: cannot raise Error_Resync
2149 function P_Simple_Expression_Or_Range_Attribute return Node_Id is
2151 Attr_Node : Node_Id;
2154 -- We don't just want to roar ahead and call P_Simple_Expression
2155 -- here, since we want to handle the case of a parenthesized range
2156 -- attribute cleanly.
2158 if Token = Tok_Left_Paren then
2160 Lptr : constant Source_Ptr := Token_Ptr;
2161 Scan_State : Saved_Scan_State;
2164 Save_Scan_State (Scan_State);
2165 Scan; -- past left paren
2166 Sexpr := P_Simple_Expression;
2168 if Token = Tok_Apostrophe then
2169 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2170 Expr_Form := EF_Range_Attr;
2172 if Token = Tok_Right_Paren then
2173 Scan; -- scan past right paren if present
2176 Error_Msg ("parentheses not allowed for range attribute", Lptr);
2181 Restore_Scan_State (Scan_State);
2185 -- Here after dealing with parenthesized range attribute
2187 Sexpr := P_Simple_Expression;
2189 if Token = Tok_Apostrophe then
2190 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2191 Expr_Form := EF_Range_Attr;
2197 end P_Simple_Expression_Or_Range_Attribute;
2203 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2205 -- Error recovery: can raise Error_Resync
2207 function P_Term return Node_Id is
2208 Node1, Node2 : Node_Id;
2209 Tokptr : Source_Ptr;
2215 exit when Token not in Token_Class_Mulop;
2216 Tokptr := Token_Ptr;
2217 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
2218 Scan; -- past operator
2219 Set_Left_Opnd (Node2, Node1);
2220 Set_Right_Opnd (Node2, P_Factor);
2221 Set_Op_Name (Node2);
2232 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2234 -- Error recovery: can raise Error_Resync
2236 function P_Factor return Node_Id is
2241 if Token = Tok_Abs then
2242 Node1 := New_Node (N_Op_Abs, Token_Ptr);
2245 Style.Check_Abs_Not;
2249 Set_Right_Opnd (Node1, P_Primary);
2250 Set_Op_Name (Node1);
2253 elsif Token = Tok_Not then
2254 Node1 := New_Node (N_Op_Not, Token_Ptr);
2257 Style.Check_Abs_Not;
2261 Set_Right_Opnd (Node1, P_Primary);
2262 Set_Op_Name (Node1);
2268 if Token = Tok_Double_Asterisk then
2269 Node2 := New_Node (N_Op_Expon, Token_Ptr);
2271 Set_Left_Opnd (Node2, Node1);
2272 Set_Right_Opnd (Node2, P_Primary);
2273 Set_Op_Name (Node2);
2286 -- NUMERIC_LITERAL | null
2287 -- | STRING_LITERAL | AGGREGATE
2288 -- | NAME | QUALIFIED_EXPRESSION
2289 -- | ALLOCATOR | (EXPRESSION)
2291 -- Error recovery: can raise Error_Resync
2293 function P_Primary return Node_Id is
2294 Scan_State : Saved_Scan_State;
2298 -- The loop runs more than once only if misplaced pragmas are found
2303 -- Name token can start a name, call or qualified expression, all
2304 -- of which are acceptable possibilities for primary. Note also
2305 -- that string literal is included in name (as operator symbol)
2306 -- and type conversion is included in name (as indexed component).
2308 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2311 -- All done unless apostrophe follows
2313 if Token /= Tok_Apostrophe then
2316 -- Apostrophe following means that we have either just parsed
2317 -- the subtype mark of a qualified expression, or the prefix
2318 -- or a range attribute.
2320 else -- Token = Tok_Apostrophe
2321 Save_Scan_State (Scan_State); -- at apostrophe
2322 Scan; -- past apostrophe
2324 -- If range attribute, then this is always an error, since
2325 -- the only legitimate case (where the scanned expression is
2326 -- a qualified simple name) is handled at the level of the
2327 -- Simple_Expression processing. This case corresponds to a
2328 -- usage such as 3 + A'Range, which is always illegal.
2330 if Token = Tok_Range then
2331 Restore_Scan_State (Scan_State); -- to apostrophe
2332 Bad_Range_Attribute (Token_Ptr);
2335 -- If left paren, then we have a qualified expression.
2336 -- Note that P_Name guarantees that in this case, where
2337 -- Token = Tok_Apostrophe on return, the only two possible
2338 -- tokens following the apostrophe are left paren and
2339 -- RANGE, so we know we have a left paren here.
2341 else -- Token = Tok_Left_Paren
2342 return P_Qualified_Expression (Node1);
2347 -- Numeric or string literal
2349 when Tok_Integer_Literal |
2351 Tok_String_Literal =>
2353 Node1 := Token_Node;
2354 Scan; -- past number
2357 -- Left paren, starts aggregate or parenthesized expression
2359 when Tok_Left_Paren =>
2361 Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2364 if Nkind (Expr) = N_Attribute_Reference
2365 and then Attribute_Name (Expr) = Name_Range
2367 Bad_Range_Attribute (Sloc (Expr));
2382 return New_Node (N_Null, Prev_Token_Ptr);
2384 -- Pragma, not allowed here, so just skip past it
2387 P_Pragmas_Misplaced;
2389 -- Deal with IF (possible unparenthesized conditional expression)
2393 -- If this looks like a real if, defined as an IF appearing at
2394 -- the start of a new line, then we consider we have a missing
2397 if Token_Is_At_Start_Of_Line then
2398 Error_Msg_AP ("missing operand");
2401 -- If this looks like a conditional expression, then treat it
2402 -- that way with an error messasge.
2404 elsif Extensions_Allowed then
2406 ("conditional expression must be parenthesized");
2407 return P_Conditional_Expression;
2409 -- Otherwise treat as misused identifier
2412 return P_Identifier;
2415 -- Anything else is illegal as the first token of a primary, but
2416 -- we test for a reserved identifier so that it is treated nicely
2419 if Is_Reserved_Identifier then
2420 return P_Identifier;
2422 elsif Prev_Token = Tok_Comma then
2423 Error_Msg_SP ("|extra "","" ignored");
2427 Error_Msg_AP ("missing operand");
2435 ---------------------------
2436 -- 4.5 Logical Operator --
2437 ---------------------------
2439 -- LOGICAL_OPERATOR ::= and | or | xor
2441 -- Note: AND THEN and OR ELSE are also treated as logical operators
2442 -- by the parser (even though they are not operators semantically)
2444 -- The value returned is the appropriate Node_Kind code for the operator
2445 -- On return, Token points to the token following the scanned operator.
2447 -- The caller has checked that the first token is a legitimate logical
2448 -- operator token (i.e. is either XOR, AND, OR).
2450 -- Error recovery: cannot raise Error_Resync
2452 function P_Logical_Operator return Node_Kind is
2454 if Token = Tok_And then
2456 Style.Check_Binary_Operator;
2461 if Token = Tok_Then then
2468 elsif Token = Tok_Or then
2470 Style.Check_Binary_Operator;
2475 if Token = Tok_Else then
2482 else -- Token = Tok_Xor
2484 Style.Check_Binary_Operator;
2490 end P_Logical_Operator;
2492 ------------------------------
2493 -- 4.5 Relational Operator --
2494 ------------------------------
2496 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2498 -- The value returned is the appropriate Node_Kind code for the operator.
2499 -- On return, Token points to the operator token, NOT past it.
2501 -- The caller has checked that the first token is a legitimate relational
2502 -- operator token (i.e. is one of the operator tokens listed above).
2504 -- Error recovery: cannot raise Error_Resync
2506 function P_Relational_Operator return Node_Kind is
2507 Op_Kind : Node_Kind;
2508 Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2509 (Tok_Less => N_Op_Lt,
2510 Tok_Equal => N_Op_Eq,
2511 Tok_Greater => N_Op_Gt,
2512 Tok_Not_Equal => N_Op_Ne,
2513 Tok_Greater_Equal => N_Op_Ge,
2514 Tok_Less_Equal => N_Op_Le,
2516 Tok_Not => N_Not_In,
2517 Tok_Box => N_Op_Ne);
2520 if Token = Tok_Box then
2521 Error_Msg_SC ("|""'<'>"" should be ""/=""");
2524 Op_Kind := Relop_Node (Token);
2527 Style.Check_Binary_Operator;
2530 Scan; -- past operator token
2532 if Prev_Token = Tok_Not then
2537 end P_Relational_Operator;
2539 ---------------------------------
2540 -- 4.5 Binary Adding Operator --
2541 ---------------------------------
2543 -- BINARY_ADDING_OPERATOR ::= + | - | &
2545 -- The value returned is the appropriate Node_Kind code for the operator.
2546 -- On return, Token points to the operator token (NOT past it).
2548 -- The caller has checked that the first token is a legitimate adding
2549 -- operator token (i.e. is one of the operator tokens listed above).
2551 -- Error recovery: cannot raise Error_Resync
2553 function P_Binary_Adding_Operator return Node_Kind is
2554 Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2555 (Tok_Ampersand => N_Op_Concat,
2556 Tok_Minus => N_Op_Subtract,
2557 Tok_Plus => N_Op_Add);
2559 return Addop_Node (Token);
2560 end P_Binary_Adding_Operator;
2562 --------------------------------
2563 -- 4.5 Unary Adding Operator --
2564 --------------------------------
2566 -- UNARY_ADDING_OPERATOR ::= + | -
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 adding
2572 -- operator token (i.e. is one of the operator tokens listed above).
2574 -- Error recovery: cannot raise Error_Resync
2576 function P_Unary_Adding_Operator return Node_Kind is
2577 Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2578 (Tok_Minus => N_Op_Minus,
2579 Tok_Plus => N_Op_Plus);
2581 return Addop_Node (Token);
2582 end P_Unary_Adding_Operator;
2584 -------------------------------
2585 -- 4.5 Multiplying Operator --
2586 -------------------------------
2588 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2590 -- The value returned is the appropriate Node_Kind code for the operator.
2591 -- On return, Token points to the operator token (NOT past it).
2593 -- The caller has checked that the first token is a legitimate multiplying
2594 -- operator token (i.e. is one of the operator tokens listed above).
2596 -- Error recovery: cannot raise Error_Resync
2598 function P_Multiplying_Operator return Node_Kind is
2599 Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2600 (Tok_Asterisk => N_Op_Multiply,
2601 Tok_Mod => N_Op_Mod,
2602 Tok_Rem => N_Op_Rem,
2603 Tok_Slash => N_Op_Divide);
2605 return Mulop_Node (Token);
2606 end P_Multiplying_Operator;
2608 --------------------------------------
2609 -- 4.5 Highest Precedence Operator --
2610 --------------------------------------
2612 -- Parsed by P_Factor (4.4)
2614 -- Note: this rule is not in fact used by the grammar at any point!
2616 --------------------------
2617 -- 4.6 Type Conversion --
2618 --------------------------
2620 -- Parsed by P_Primary as a Name (4.1)
2622 -------------------------------
2623 -- 4.7 Qualified Expression --
2624 -------------------------------
2626 -- QUALIFIED_EXPRESSION ::=
2627 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2629 -- The caller has scanned the name which is the Subtype_Mark parameter
2630 -- and scanned past the single quote following the subtype mark. The
2631 -- caller has not checked that this name is in fact appropriate for
2632 -- a subtype mark name (i.e. it is a selected component or identifier).
2634 -- Error_Recovery: cannot raise Error_Resync
2636 function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2637 Qual_Node : Node_Id;
2639 Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2640 Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2641 Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2643 end P_Qualified_Expression;
2645 --------------------
2647 --------------------
2650 -- new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2652 -- The caller has checked that the initial token is NEW
2654 -- Error recovery: can raise Error_Resync
2656 function P_Allocator return Node_Id is
2657 Alloc_Node : Node_Id;
2658 Type_Node : Node_Id;
2659 Null_Exclusion_Present : Boolean;
2662 Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2665 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2667 Null_Exclusion_Present := P_Null_Exclusion;
2668 Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
2669 Type_Node := P_Subtype_Mark_Resync;
2671 if Token = Tok_Apostrophe then
2672 Scan; -- past apostrophe
2673 Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2677 P_Subtype_Indication (Type_Node, Null_Exclusion_Present));
2683 ------------------------------
2684 -- P_Conditional_Expression --
2685 ------------------------------
2687 function P_Conditional_Expression return Node_Id is
2688 Exprs : constant List_Id := New_List;
2689 Loc : constant Source_Ptr := Token_Ptr;
2691 State : Saved_Scan_State;
2694 Inside_Conditional_Expression := Inside_Conditional_Expression + 1;
2696 if Token = Tok_If and then not Extensions_Allowed then
2697 Error_Msg_SC ("|conditional expression is an Ada extension");
2698 Error_Msg_SC ("\|use -gnatX switch to compile this unit");
2701 Scan; -- past IF or ELSIF
2702 Append_To (Exprs, P_Expression_No_Right_Paren);
2704 Append_To (Exprs, P_Expression);
2706 -- We now have scanned out IF expr THEN expr
2708 -- Check for common error of semicolon before the ELSE
2710 if Token = Tok_Semicolon then
2711 Save_Scan_State (State);
2712 Scan; -- past semicolon
2714 if Token = Tok_Else or else Token = Tok_Elsif then
2715 Error_Msg_SP ("|extra "";"" ignored");
2718 Restore_Scan_State (State);
2722 -- Scan out ELSIF sequence if present
2724 if Token = Tok_Elsif then
2725 Expr := P_Conditional_Expression;
2726 Set_Is_Elsif (Expr);
2727 Append_To (Exprs, Expr);
2729 -- Scan out ELSE phrase if present
2731 elsif Token = Tok_Else then
2733 -- Scan out ELSE expression
2736 Append_To (Exprs, P_Expression);
2738 -- Two expression case (implied True, filled in during semantics)
2744 -- If we have an END IF, diagnose as not needed
2746 if Token = Tok_End then
2748 ("`END IF` not allowed at end of conditional expression");
2751 if Token = Tok_If then
2756 Inside_Conditional_Expression := Inside_Conditional_Expression - 1;
2758 -- Return the Conditional_Expression node
2761 Make_Conditional_Expression (Loc,
2762 Expressions => Exprs);
2763 end P_Conditional_Expression;
2765 -----------------------
2766 -- P_Membership_Test --
2767 -----------------------
2769 procedure P_Membership_Test (N : Node_Id) is
2770 Alt : constant Node_Id :=
2771 P_Range_Or_Subtype_Mark
2772 (Allow_Simple_Expression => Extensions_Allowed);
2777 if Token = Tok_Vertical_Bar then
2778 if not Extensions_Allowed then
2779 Error_Msg_SC ("set notation is a language extension");
2780 Error_Msg_SC ("\|use -gnatX switch to compile this unit");
2783 Set_Alternatives (N, New_List (Alt));
2784 Set_Right_Opnd (N, Empty);
2786 -- Loop to accumulate alternatives
2788 while Token = Tok_Vertical_Bar loop
2789 Scan; -- past vertical bar
2792 P_Range_Or_Subtype_Mark (Allow_Simple_Expression => True));
2798 Set_Right_Opnd (N, Alt);
2799 Set_Alternatives (N, No_List);
2801 end P_Membership_Test;