1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 pragma Style_Checks (All_Checks);
28 -- Turn off subprogram body ordering check. Subprograms are in order
29 -- by RM section rather than alphabetical
34 -----------------------
35 -- Local Subprograms --
36 -----------------------
38 function P_Aggregate_Or_Paren_Expr return Node_Id;
39 function P_Allocator return Node_Id;
40 function P_Record_Or_Array_Component_Association return Node_Id;
41 function P_Factor return Node_Id;
42 function P_Primary return Node_Id;
43 function P_Relation return Node_Id;
44 function P_Term return Node_Id;
46 function P_Binary_Adding_Operator return Node_Kind;
47 function P_Logical_Operator return Node_Kind;
48 function P_Multiplying_Operator return Node_Kind;
49 function P_Relational_Operator return Node_Kind;
50 function P_Unary_Adding_Operator return Node_Kind;
52 procedure Bad_Range_Attribute (Loc : Source_Ptr);
53 -- Called to place complaint about bad range attribute at the given
54 -- source location. Terminates by raising Error_Resync.
56 function P_Range_Attribute_Reference
57 (Prefix_Node : Node_Id)
59 -- Scan a range attribute reference. The caller has scanned out the
60 -- prefix. The current token is known to be an apostrophe and the
61 -- following token is known to be RANGE.
63 procedure Set_Op_Name (Node : Node_Id);
64 -- Procedure to set name field (Chars) in operator node
66 -------------------------
67 -- Bad_Range_Attribute --
68 -------------------------
70 procedure Bad_Range_Attribute (Loc : Source_Ptr) is
72 Error_Msg ("range attribute cannot be used in expression!", Loc);
74 end Bad_Range_Attribute;
80 procedure Set_Op_Name (Node : Node_Id) is
81 type Name_Of_Type is array (N_Op) of Name_Id;
82 Name_Of : constant Name_Of_Type := Name_Of_Type'(
83 N_Op_And => Name_Op_And,
84 N_Op_Or => Name_Op_Or,
85 N_Op_Xor => Name_Op_Xor,
86 N_Op_Eq => Name_Op_Eq,
87 N_Op_Ne => Name_Op_Ne,
88 N_Op_Lt => Name_Op_Lt,
89 N_Op_Le => Name_Op_Le,
90 N_Op_Gt => Name_Op_Gt,
91 N_Op_Ge => Name_Op_Ge,
92 N_Op_Add => Name_Op_Add,
93 N_Op_Subtract => Name_Op_Subtract,
94 N_Op_Concat => Name_Op_Concat,
95 N_Op_Multiply => Name_Op_Multiply,
96 N_Op_Divide => Name_Op_Divide,
97 N_Op_Mod => Name_Op_Mod,
98 N_Op_Rem => Name_Op_Rem,
99 N_Op_Expon => Name_Op_Expon,
100 N_Op_Plus => Name_Op_Add,
101 N_Op_Minus => Name_Op_Subtract,
102 N_Op_Abs => Name_Op_Abs,
103 N_Op_Not => Name_Op_Not,
105 -- We don't really need these shift operators, since they never
106 -- appear as operators in the source, but the path of least
107 -- resistance is to put them in (the aggregate must be complete)
109 N_Op_Rotate_Left => Name_Rotate_Left,
110 N_Op_Rotate_Right => Name_Rotate_Right,
111 N_Op_Shift_Left => Name_Shift_Left,
112 N_Op_Shift_Right => Name_Shift_Right,
113 N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
116 if Nkind (Node) in N_Op then
117 Set_Chars (Node, Name_Of (Nkind (Node)));
121 --------------------------
122 -- 4.1 Name (also 6.4) --
123 --------------------------
126 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
127 -- | INDEXED_COMPONENT | SLICE
128 -- | SELECTED_COMPONENT | ATTRIBUTE
129 -- | TYPE_CONVERSION | FUNCTION_CALL
130 -- | CHARACTER_LITERAL
132 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
134 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
136 -- EXPLICIT_DEREFERENCE ::= NAME . all
138 -- IMPLICIT_DEREFERENCE ::= NAME
140 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
142 -- SLICE ::= PREFIX (DISCRETE_RANGE)
144 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
146 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
148 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
150 -- ATTRIBUTE_DESIGNATOR ::=
151 -- IDENTIFIER [(static_EXPRESSION)]
152 -- | access | delta | digits
156 -- | function_PREFIX ACTUAL_PARAMETER_PART
158 -- ACTUAL_PARAMETER_PART ::=
159 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
161 -- PARAMETER_ASSOCIATION ::=
162 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
164 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
166 -- Note: syntactically a procedure call looks just like a function call,
167 -- so this routine is in practice used to scan out procedure calls as well.
169 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
171 -- Error recovery: can raise Error_Resync
173 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
174 -- followed by either a left paren (qualified expression case), or by
175 -- range (range attribute case). All other uses of apostrophe (i.e. all
176 -- other attributes) are handled in this routine.
178 -- Error recovery: can raise Error_Resync
180 function P_Name return Node_Id is
181 Scan_State : Saved_Scan_State;
183 Prefix_Node : Node_Id;
184 Ident_Node : Node_Id;
186 Range_Node : Node_Id;
189 Arg_List : List_Id := No_List; -- kill junk warning
190 Attr_Name : Name_Id := No_Name; -- kill junk warning
193 -- Case of not a name
195 if Token not in Token_Class_Name then
197 -- If it looks like start of expression, complain and scan expression
199 if Token in Token_Class_Literal
200 or else Token = Tok_Left_Paren
202 Error_Msg_SC ("name expected");
205 -- Otherwise some other junk, not much we can do
208 Error_Msg_AP ("name expected");
213 -- Loop through designators in qualified name
215 Name_Node := Token_Node;
218 Scan; -- past designator
219 exit when Token /= Tok_Dot;
220 Save_Scan_State (Scan_State); -- at dot
223 -- If we do not have another designator after the dot, then join
224 -- the normal circuit to handle a dot extension (may be .all or
225 -- character literal case). Otherwise loop back to scan the next
228 if Token not in Token_Class_Desig then
229 goto Scan_Name_Extension_Dot;
231 Prefix_Node := Name_Node;
232 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
233 Set_Prefix (Name_Node, Prefix_Node);
234 Set_Selector_Name (Name_Node, Token_Node);
238 -- We have now scanned out a qualified designator. If the last token is
239 -- an operator symbol, then we certainly do not have the Snam case, so
240 -- we can just use the normal name extension check circuit
242 if Prev_Token = Tok_Operator_Symbol then
243 goto Scan_Name_Extension;
246 -- We have scanned out a qualified simple name, check for name extension
247 -- Note that we know there is no dot here at this stage, so the only
248 -- possible cases of name extension are apostrophe and left paren.
250 if Token = Tok_Apostrophe then
251 Save_Scan_State (Scan_State); -- at apostrophe
252 Scan; -- past apostrophe
254 -- If left paren, then this might be a qualified expression, but we
255 -- are only in the business of scanning out names, so return with
256 -- Token backed up to point to the apostrophe. The treatment for
257 -- the range attribute is similar (we do not consider x'range to
258 -- be a name in this grammar).
260 if Token = Tok_Left_Paren or else Token = Tok_Range then
261 Restore_Scan_State (Scan_State); -- to apostrophe
262 Expr_Form := EF_Simple_Name;
265 -- Otherwise we have the case of a name extended by an attribute
268 goto Scan_Name_Extension_Apostrophe;
271 -- Check case of qualified simple name extended by a left parenthesis
273 elsif Token = Tok_Left_Paren then
274 Scan; -- past left paren
275 goto Scan_Name_Extension_Left_Paren;
277 -- Otherwise the qualified simple name is not extended, so return
280 Expr_Form := EF_Simple_Name;
284 -- Loop scanning past name extensions. A label is used for control
285 -- transfer for this loop for ease of interfacing with the finite state
286 -- machine in the parenthesis scanning circuit, and also to allow for
287 -- passing in control to the appropriate point from the above code.
289 <<Scan_Name_Extension>>
291 -- Character literal used as name cannot be extended. Also this
292 -- cannot be a call, since the name for a call must be a designator.
293 -- Return in these cases, or if there is no name extension
295 if Token not in Token_Class_Namext
296 or else Prev_Token = Tok_Char_Literal
298 Expr_Form := EF_Name;
302 -- Merge here when we know there is a name extension
304 <<Scan_Name_Extension_OK>>
306 if Token = Tok_Left_Paren then
307 Scan; -- past left paren
308 goto Scan_Name_Extension_Left_Paren;
310 elsif Token = Tok_Apostrophe then
311 Save_Scan_State (Scan_State); -- at apostrophe
312 Scan; -- past apostrophe
313 goto Scan_Name_Extension_Apostrophe;
315 else -- Token = Tok_Dot
316 Save_Scan_State (Scan_State); -- at dot
318 goto Scan_Name_Extension_Dot;
321 -- Case of name extended by dot (selection), dot is already skipped
322 -- and the scan state at the point of the dot is saved in Scan_State.
324 <<Scan_Name_Extension_Dot>>
326 -- Explicit dereference case
328 if Token = Tok_All then
329 Prefix_Node := Name_Node;
330 Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
331 Set_Prefix (Name_Node, Prefix_Node);
333 goto Scan_Name_Extension;
335 -- Selected component case
337 elsif Token in Token_Class_Name then
338 Prefix_Node := Name_Node;
339 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
340 Set_Prefix (Name_Node, Prefix_Node);
341 Set_Selector_Name (Name_Node, Token_Node);
342 Scan; -- past selector
343 goto Scan_Name_Extension;
345 -- Reserved identifier as selector
347 elsif Is_Reserved_Identifier then
348 Scan_Reserved_Identifier (Force_Msg => False);
349 Prefix_Node := Name_Node;
350 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
351 Set_Prefix (Name_Node, Prefix_Node);
352 Set_Selector_Name (Name_Node, Token_Node);
353 Scan; -- past identifier used as selector
354 goto Scan_Name_Extension;
356 -- If dot is at end of line and followed by nothing legal,
357 -- then assume end of name and quit (dot will be taken as
358 -- an erroneous form of some other punctuation by our caller).
360 elsif Token_Is_At_Start_Of_Line then
361 Restore_Scan_State (Scan_State);
364 -- Here if nothing legal after the dot
367 Error_Msg_AP ("selector expected");
371 -- Here for an apostrophe as name extension. The scan position at the
372 -- apostrophe has already been saved, and the apostrophe scanned out.
374 <<Scan_Name_Extension_Apostrophe>>
376 Scan_Apostrophe : declare
377 function Apostrophe_Should_Be_Semicolon return Boolean;
378 -- Checks for case where apostrophe should probably be
379 -- a semicolon, and if so, gives appropriate message,
380 -- resets the scan pointer to the apostrophe, changes
381 -- the current token to Tok_Semicolon, and returns True.
382 -- Otherwise returns False.
384 function Apostrophe_Should_Be_Semicolon return Boolean is
386 if Token_Is_At_Start_Of_Line then
387 Restore_Scan_State (Scan_State); -- to apostrophe
388 Error_Msg_SC ("""''"" should be "";""");
389 Token := Tok_Semicolon;
394 end Apostrophe_Should_Be_Semicolon;
396 -- Start of processing for Scan_Apostrophe
399 -- If range attribute after apostrophe, then return with Token
400 -- pointing to the apostrophe. Note that in this case the prefix
401 -- need not be a simple name (cases like A.all'range). Similarly
402 -- if there is a left paren after the apostrophe, then we also
403 -- return with Token pointing to the apostrophe (this is the
404 -- qualified expression case).
406 if Token = Tok_Range or else Token = Tok_Left_Paren then
407 Restore_Scan_State (Scan_State); -- to apostrophe
408 Expr_Form := EF_Name;
411 -- Here for cases where attribute designator is an identifier
413 elsif Token = Tok_Identifier then
414 Attr_Name := Token_Name;
416 if not Is_Attribute_Name (Attr_Name) then
417 if Apostrophe_Should_Be_Semicolon then
418 Expr_Form := EF_Name;
421 -- Here for a bad attribute name
424 Signal_Bad_Attribute;
425 Scan; -- past bad identifier
427 if Token = Tok_Left_Paren then
428 Scan; -- past left paren
431 Discard_Junk_Node (P_Expression);
432 exit when not Comma_Present;
443 Style.Check_Attribute_Name (False);
446 Delete_Node (Token_Node);
448 -- Here for case of attribute designator is not an identifier
451 if Token = Tok_Delta then
452 Attr_Name := Name_Delta;
454 elsif Token = Tok_Digits then
455 Attr_Name := Name_Digits;
457 elsif Token = Tok_Access then
458 Attr_Name := Name_Access;
460 elsif Token = Tok_Mod and then Ada_Version = Ada_05 then
461 Attr_Name := Name_Mod;
463 elsif Apostrophe_Should_Be_Semicolon then
464 Expr_Form := EF_Name;
468 Error_Msg_AP ("attribute designator expected");
473 Style.Check_Attribute_Name (True);
477 -- We come here with an OK attribute scanned, and the
478 -- corresponding Attribute identifier node stored in Ident_Node.
480 Prefix_Node := Name_Node;
481 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
482 Scan; -- past attribute designator
483 Set_Prefix (Name_Node, Prefix_Node);
484 Set_Attribute_Name (Name_Node, Attr_Name);
486 -- Scan attribute arguments/designator
488 if Token = Tok_Left_Paren then
489 Set_Expressions (Name_Node, New_List);
490 Scan; -- past left paren
494 Expr : constant Node_Id := P_Expression;
497 if Token = Tok_Arrow then
499 ("named parameters not permitted for attributes");
500 Scan; -- past junk arrow
503 Append (Expr, Expressions (Name_Node));
504 exit when not Comma_Present;
512 goto Scan_Name_Extension;
515 -- Here for left parenthesis extending name (left paren skipped)
517 <<Scan_Name_Extension_Left_Paren>>
519 -- We now have to scan through a list of items, terminated by a
520 -- right parenthesis. The scan is handled by a finite state
521 -- machine. The possibilities are:
525 -- This is a slice. This case is handled in LP_State_Init
527 -- (expression, expression, ..)
529 -- This is interpreted as an indexed component, i.e. as a
530 -- case of a name which can be extended in the normal manner.
531 -- This case is handled by LP_State_Name or LP_State_Expr.
533 -- (..., identifier => expression , ...)
535 -- If there is at least one occurrence of identifier => (but
536 -- none of the other cases apply), then we have a call.
538 -- Test for Id => case
540 if Token = Tok_Identifier then
541 Save_Scan_State (Scan_State); -- at Id
544 -- Test for => (allow := as an error substitute)
546 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
547 Restore_Scan_State (Scan_State); -- to Id
548 Arg_List := New_List;
552 Restore_Scan_State (Scan_State); -- to Id
556 -- Here we have an expression after all
558 Expr_Node := P_Expression_Or_Range_Attribute;
560 -- Check cases of discrete range for a slice
562 -- First possibility: Range_Attribute_Reference
564 if Expr_Form = EF_Range_Attr then
565 Range_Node := Expr_Node;
567 -- Second possibility: Simple_expression .. Simple_expression
569 elsif Token = Tok_Dot_Dot then
570 Check_Simple_Expression (Expr_Node);
571 Range_Node := New_Node (N_Range, Token_Ptr);
572 Set_Low_Bound (Range_Node, Expr_Node);
574 Expr_Node := P_Expression;
575 Check_Simple_Expression (Expr_Node);
576 Set_High_Bound (Range_Node, Expr_Node);
578 -- Third possibility: Type_name range Range
580 elsif Token = Tok_Range then
581 if Expr_Form /= EF_Simple_Name then
582 Error_Msg_SC ("subtype mark must precede RANGE");
586 Range_Node := P_Subtype_Indication (Expr_Node);
588 -- Otherwise we just have an expression. It is true that we might
589 -- have a subtype mark without a range constraint but this case
590 -- is syntactically indistinguishable from the expression case.
593 Arg_List := New_List;
597 -- Fall through here with unmistakable Discrete range scanned,
598 -- which means that we definitely have the case of a slice. The
599 -- Discrete range is in Range_Node.
601 if Token = Tok_Comma then
602 Error_Msg_SC ("slice cannot have more than one dimension");
605 elsif Token /= Tok_Right_Paren then
610 Scan; -- past right paren
611 Prefix_Node := Name_Node;
612 Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
613 Set_Prefix (Name_Node, Prefix_Node);
614 Set_Discrete_Range (Name_Node, Range_Node);
616 -- An operator node is legal as a prefix to other names,
617 -- but not for a slice.
619 if Nkind (Prefix_Node) = N_Operator_Symbol then
620 Error_Msg_N ("illegal prefix for slice", Prefix_Node);
623 -- If we have a name extension, go scan it
625 if Token in Token_Class_Namext then
626 goto Scan_Name_Extension_OK;
628 -- Otherwise return (a slice is a name, but is not a call)
631 Expr_Form := EF_Name;
636 -- In LP_State_Expr, we have scanned one or more expressions, and
637 -- so we have a call or an indexed component which is a name. On
638 -- entry we have the expression just scanned in Expr_Node and
639 -- Arg_List contains the list of expressions encountered so far
642 Append (Expr_Node, Arg_List);
644 if Token = Tok_Arrow then
646 ("expect identifier in parameter association",
650 elsif not Comma_Present then
652 Prefix_Node := Name_Node;
653 Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
654 Set_Prefix (Name_Node, Prefix_Node);
655 Set_Expressions (Name_Node, Arg_List);
656 goto Scan_Name_Extension;
659 -- Comma present (and scanned out), test for identifier => case
660 -- Test for identifier => case
662 if Token = Tok_Identifier then
663 Save_Scan_State (Scan_State); -- at Id
666 -- Test for => (allow := as error substitute)
668 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
669 Restore_Scan_State (Scan_State); -- to Id
672 -- Otherwise it's just an expression after all, so backup
675 Restore_Scan_State (Scan_State); -- to Id
679 -- Here we have an expression after all, so stay in this state
681 Expr_Node := P_Expression;
684 -- LP_State_Call corresponds to the situation in which at least
685 -- one instance of Id => Expression has been encountered, so we
686 -- know that we do not have a name, but rather a call. We enter
687 -- it with the scan pointer pointing to the next argument to scan,
688 -- and Arg_List containing the list of arguments scanned so far.
692 -- Test for case of Id => Expression (named parameter)
694 if Token = Tok_Identifier then
695 Save_Scan_State (Scan_State); -- at Id
696 Ident_Node := Token_Node;
699 -- Deal with => (allow := as erroneous substitute)
701 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
703 New_Node (N_Parameter_Association, Prev_Token_Ptr);
704 Set_Selector_Name (Arg_Node, Ident_Node);
706 Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
707 Append (Arg_Node, Arg_List);
709 -- If a comma follows, go back and scan next entry
711 if Comma_Present then
714 -- Otherwise we have the end of a call
717 Prefix_Node := Name_Node;
719 New_Node (N_Function_Call, Sloc (Prefix_Node));
720 Set_Name (Name_Node, Prefix_Node);
721 Set_Parameter_Associations (Name_Node, Arg_List);
724 if Token in Token_Class_Namext then
725 goto Scan_Name_Extension_OK;
727 -- This is a case of a call which cannot be a name
730 Expr_Form := EF_Name;
735 -- Not named parameter: Id started an expression after all
738 Restore_Scan_State (Scan_State); -- to Id
742 -- Here if entry did not start with Id => which means that it
743 -- is a positional parameter, which is not allowed, since we
744 -- have seen at least one named parameter already.
747 ("positional parameter association " &
748 "not allowed after named one");
750 Expr_Node := P_Expression;
752 -- Leaving the '>' in an association is not unusual, so suggest
755 if Nkind (Expr_Node) = N_Op_Eq then
756 Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
759 -- We go back to scanning out expressions, so that we do not get
760 -- multiple error messages when several positional parameters
761 -- follow a named parameter.
765 -- End of treatment for name extensions starting with left paren
767 -- End of loop through name extensions
771 -- This function parses a restricted form of Names which are either
772 -- designators, or designators preceded by a sequence of prefixes
773 -- that are direct names.
775 -- Error recovery: cannot raise Error_Resync
777 function P_Function_Name return Node_Id is
778 Designator_Node : Node_Id;
779 Prefix_Node : Node_Id;
780 Selector_Node : Node_Id;
781 Dot_Sloc : Source_Ptr := No_Location;
784 -- Prefix_Node is set to the gathered prefix so far, Empty means that
785 -- no prefix has been scanned. This allows us to build up the result
786 -- in the required right recursive manner.
788 Prefix_Node := Empty;
790 -- Loop through prefixes
793 Designator_Node := Token_Node;
795 if Token not in Token_Class_Desig then
796 return P_Identifier; -- let P_Identifier issue the error message
798 else -- Token in Token_Class_Desig
799 Scan; -- past designator
800 exit when Token /= Tok_Dot;
803 -- Here at a dot, with token just before it in Designator_Node
805 if No (Prefix_Node) then
806 Prefix_Node := Designator_Node;
808 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
809 Set_Prefix (Selector_Node, Prefix_Node);
810 Set_Selector_Name (Selector_Node, Designator_Node);
811 Prefix_Node := Selector_Node;
814 Dot_Sloc := Token_Ptr;
818 -- Fall out of the loop having just scanned a designator
820 if No (Prefix_Node) then
821 return Designator_Node;
823 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
824 Set_Prefix (Selector_Node, Prefix_Node);
825 Set_Selector_Name (Selector_Node, Designator_Node);
826 return Selector_Node;
835 -- This function parses a restricted form of Names which are either
836 -- identifiers, or identifiers preceded by a sequence of prefixes
837 -- that are direct names.
839 -- Error recovery: cannot raise Error_Resync
841 function P_Qualified_Simple_Name return Node_Id is
842 Designator_Node : Node_Id;
843 Prefix_Node : Node_Id;
844 Selector_Node : Node_Id;
845 Dot_Sloc : Source_Ptr := No_Location;
848 -- Prefix node is set to the gathered prefix so far, Empty means that
849 -- no prefix has been scanned. This allows us to build up the result
850 -- in the required right recursive manner.
852 Prefix_Node := Empty;
854 -- Loop through prefixes
857 Designator_Node := Token_Node;
859 if Token = Tok_Identifier then
860 Scan; -- past identifier
861 exit when Token /= Tok_Dot;
863 elsif Token not in Token_Class_Desig then
864 return P_Identifier; -- let P_Identifier issue the error message
867 Scan; -- past designator
869 if Token /= Tok_Dot then
870 Error_Msg_SP ("identifier expected");
875 -- Here at a dot, with token just before it in Designator_Node
877 if No (Prefix_Node) then
878 Prefix_Node := Designator_Node;
880 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
881 Set_Prefix (Selector_Node, Prefix_Node);
882 Set_Selector_Name (Selector_Node, Designator_Node);
883 Prefix_Node := Selector_Node;
886 Dot_Sloc := Token_Ptr;
890 -- Fall out of the loop having just scanned an identifier
892 if No (Prefix_Node) then
893 return Designator_Node;
895 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
896 Set_Prefix (Selector_Node, Prefix_Node);
897 Set_Selector_Name (Selector_Node, Designator_Node);
898 return Selector_Node;
905 end P_Qualified_Simple_Name;
907 -- This procedure differs from P_Qualified_Simple_Name only in that it
908 -- raises Error_Resync if any error is encountered. It only returns after
909 -- scanning a valid qualified simple name.
911 -- Error recovery: can raise Error_Resync
913 function P_Qualified_Simple_Name_Resync return Node_Id is
914 Designator_Node : Node_Id;
915 Prefix_Node : Node_Id;
916 Selector_Node : Node_Id;
917 Dot_Sloc : Source_Ptr := No_Location;
920 Prefix_Node := Empty;
922 -- Loop through prefixes
925 Designator_Node := Token_Node;
927 if Token = Tok_Identifier then
928 Scan; -- past identifier
929 exit when Token /= Tok_Dot;
931 elsif Token not in Token_Class_Desig then
932 Discard_Junk_Node (P_Identifier); -- to issue the error message
936 Scan; -- past designator
938 if Token /= Tok_Dot then
939 Error_Msg_SP ("identifier expected");
944 -- Here at a dot, with token just before it in Designator_Node
946 if No (Prefix_Node) then
947 Prefix_Node := Designator_Node;
949 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
950 Set_Prefix (Selector_Node, Prefix_Node);
951 Set_Selector_Name (Selector_Node, Designator_Node);
952 Prefix_Node := Selector_Node;
955 Dot_Sloc := Token_Ptr;
959 -- Fall out of the loop having just scanned an identifier
961 if No (Prefix_Node) then
962 return Designator_Node;
964 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
965 Set_Prefix (Selector_Node, Prefix_Node);
966 Set_Selector_Name (Selector_Node, Designator_Node);
967 return Selector_Node;
970 end P_Qualified_Simple_Name_Resync;
972 ----------------------
973 -- 4.1 Direct_Name --
974 ----------------------
976 -- Parsed by P_Name and other functions in section 4.1
982 -- Parsed by P_Name (4.1)
984 -------------------------------
985 -- 4.1 Explicit Dereference --
986 -------------------------------
988 -- Parsed by P_Name (4.1)
990 -------------------------------
991 -- 4.1 Implicit_Dereference --
992 -------------------------------
994 -- Parsed by P_Name (4.1)
996 ----------------------------
997 -- 4.1 Indexed Component --
998 ----------------------------
1000 -- Parsed by P_Name (4.1)
1006 -- Parsed by P_Name (4.1)
1008 -----------------------------
1009 -- 4.1 Selected_Component --
1010 -----------------------------
1012 -- Parsed by P_Name (4.1)
1014 ------------------------
1015 -- 4.1 Selector Name --
1016 ------------------------
1018 -- Parsed by P_Name (4.1)
1020 ------------------------------
1021 -- 4.1 Attribute Reference --
1022 ------------------------------
1024 -- Parsed by P_Name (4.1)
1026 -------------------------------
1027 -- 4.1 Attribute Designator --
1028 -------------------------------
1030 -- Parsed by P_Name (4.1)
1032 --------------------------------------
1033 -- 4.1.4 Range Attribute Reference --
1034 --------------------------------------
1036 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1038 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1040 -- In the grammar, a RANGE attribute is simply a name, but its use is
1041 -- highly restricted, so in the parser, we do not regard it as a name.
1042 -- Instead, P_Name returns without scanning the 'RANGE part of the
1043 -- attribute, and the caller uses the following function to construct
1044 -- a range attribute in places where it is appropriate.
1046 -- Note that RANGE here is treated essentially as an identifier,
1047 -- rather than a reserved word.
1049 -- The caller has parsed the prefix, i.e. a name, and Token points to
1050 -- the apostrophe. The token after the apostrophe is known to be RANGE
1051 -- at this point. The prefix node becomes the prefix of the attribute.
1053 -- Error_Recovery: Cannot raise Error_Resync
1055 function P_Range_Attribute_Reference
1056 (Prefix_Node : Node_Id)
1059 Attr_Node : Node_Id;
1062 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1063 Set_Prefix (Attr_Node, Prefix_Node);
1064 Scan; -- past apostrophe
1067 Style.Check_Attribute_Name (True);
1070 Set_Attribute_Name (Attr_Node, Name_Range);
1073 if Token = Tok_Left_Paren then
1074 Scan; -- past left paren
1075 Set_Expressions (Attr_Node, New_List (P_Expression));
1080 end P_Range_Attribute_Reference;
1082 ---------------------------------------
1083 -- 4.1.4 Range Attribute Designator --
1084 ---------------------------------------
1086 -- Parsed by P_Range_Attribute_Reference (4.4)
1088 --------------------
1090 --------------------
1092 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1094 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1095 -- an aggregate is known to be required (code statement, extension
1096 -- aggregate), in which cases this routine performs the necessary check
1097 -- that we have an aggregate rather than a parenthesized expression
1099 -- Error recovery: can raise Error_Resync
1101 function P_Aggregate return Node_Id is
1102 Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1103 Aggr_Node : constant Node_Id := P_Aggregate_Or_Paren_Expr;
1106 if Nkind (Aggr_Node) /= N_Aggregate
1108 Nkind (Aggr_Node) /= N_Extension_Aggregate
1111 ("aggregate may not have single positional component", Aggr_Sloc);
1118 -------------------------------------------------
1119 -- 4.3 Aggregate or Parenthesized Expresssion --
1120 -------------------------------------------------
1122 -- This procedure parses out either an aggregate or a parenthesized
1123 -- expression (these two constructs are closely related, since a
1124 -- parenthesized expression looks like an aggregate with a single
1125 -- positional component).
1128 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1130 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1132 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1133 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1136 -- RECORD_COMPONENT_ASSOCIATION ::=
1137 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1139 -- COMPONENT_CHOICE_LIST ::=
1140 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1143 -- EXTENSION_AGGREGATE ::=
1144 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1146 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1148 -- ARRAY_AGGREGATE ::=
1149 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1151 -- POSITIONAL_ARRAY_AGGREGATE ::=
1152 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1153 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1154 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1156 -- NAMED_ARRAY_AGGREGATE ::=
1157 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1159 -- PRIMARY ::= (EXPRESSION);
1161 -- Error recovery: can raise Error_Resync
1163 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1164 -- to Ada 2005 limited aggregates (AI-287)
1166 function P_Aggregate_Or_Paren_Expr return Node_Id is
1167 Aggregate_Node : Node_Id;
1168 Expr_List : List_Id;
1169 Assoc_List : List_Id;
1170 Expr_Node : Node_Id;
1171 Lparen_Sloc : Source_Ptr;
1172 Scan_State : Saved_Scan_State;
1175 Lparen_Sloc := Token_Ptr;
1178 -- Note: the mechanism used here of rescanning the initial expression
1179 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1180 -- out the discrete choice list.
1182 -- Deal with expression and extension aggregate cases first
1184 if Token /= Tok_Others then
1185 Save_Scan_State (Scan_State); -- at start of expression
1187 -- Deal with (NULL RECORD) case
1189 if Token = Tok_Null then
1192 if Token = Tok_Record then
1193 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1194 Set_Null_Record_Present (Aggregate_Node, True);
1195 Scan; -- past RECORD
1197 return Aggregate_Node;
1199 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1203 -- Ada 2005 (AI-287): The box notation is allowed only with named
1204 -- notation because positional notation might be error prone. For
1205 -- example, in "(X, <>, Y, <>)", there is no type associated with
1206 -- the boxes, so you might not be leaving out the components you
1207 -- thought you were leaving out.
1209 if Ada_Version >= Ada_05 and then Token = Tok_Box then
1210 Error_Msg_SC ("(Ada 2005) box notation only allowed with "
1211 & "named notation");
1213 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1214 return Aggregate_Node;
1217 Expr_Node := P_Expression_Or_Range_Attribute;
1219 -- Extension aggregate case
1221 if Token = Tok_With then
1223 if Nkind (Expr_Node) = N_Attribute_Reference
1224 and then Attribute_Name (Expr_Node) = Name_Range
1226 Bad_Range_Attribute (Sloc (Expr_Node));
1230 if Ada_Version = Ada_83 then
1231 Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1234 Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1235 Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1238 -- Deal with WITH NULL RECORD case
1240 if Token = Tok_Null then
1241 Save_Scan_State (Scan_State); -- at NULL
1244 if Token = Tok_Record then
1245 Scan; -- past RECORD
1246 Set_Null_Record_Present (Aggregate_Node, True);
1248 return Aggregate_Node;
1251 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1255 if Token /= Tok_Others then
1256 Save_Scan_State (Scan_State);
1257 Expr_Node := P_Expression;
1264 elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1265 if Nkind (Expr_Node) = N_Attribute_Reference
1266 and then Attribute_Name (Expr_Node) = Name_Range
1269 ("|parentheses not allowed for range attribute", Lparen_Sloc);
1270 Scan; -- past right paren
1274 -- Bump paren count of expression
1276 if Expr_Node /= Error then
1277 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1280 T_Right_Paren; -- past right paren (error message if none)
1283 -- Normal aggregate case
1286 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1292 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1296 -- Prepare to scan list of component associations
1298 Expr_List := No_List; -- don't set yet, maybe all named entries
1299 Assoc_List := No_List; -- don't set yet, maybe all positional entries
1301 -- This loop scans through component associations. On entry to the
1302 -- loop, an expression has been scanned at the start of the current
1303 -- association unless initial token was OTHERS, in which case
1304 -- Expr_Node is set to Empty.
1307 -- Deal with others association first. This is a named association
1309 if No (Expr_Node) then
1310 if No (Assoc_List) then
1311 Assoc_List := New_List;
1314 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1316 -- Improper use of WITH
1318 elsif Token = Tok_With then
1319 Error_Msg_SC ("WITH must be preceded by single expression in " &
1320 "extension aggregate");
1323 -- A range attribute can only appear as part of a discrete choice
1326 elsif Nkind (Expr_Node) = N_Attribute_Reference
1327 and then Attribute_Name (Expr_Node) = Name_Range
1328 and then Token /= Tok_Arrow
1329 and then Token /= Tok_Vertical_Bar
1331 Bad_Range_Attribute (Sloc (Expr_Node));
1334 -- Assume positional case if comma, right paren, or literal or
1335 -- identifier or OTHERS follows (the latter cases are missing
1336 -- comma cases). Also assume positional if a semicolon follows,
1337 -- which can happen if there are missing parens
1339 elsif Token = Tok_Comma
1340 or else Token = Tok_Right_Paren
1341 or else Token = Tok_Others
1342 or else Token in Token_Class_Lit_Or_Name
1343 or else Token = Tok_Semicolon
1345 if Present (Assoc_List) then
1347 ("""='>"" expected (positional association cannot follow " &
1348 "named association)");
1351 if No (Expr_List) then
1352 Expr_List := New_List;
1355 Append (Expr_Node, Expr_List);
1357 -- Anything else is assumed to be a named association
1360 Restore_Scan_State (Scan_State); -- to start of expression
1362 if No (Assoc_List) then
1363 Assoc_List := New_List;
1366 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1369 exit when not Comma_Present;
1371 -- If we are at an expression terminator, something is seriously
1372 -- wrong, so let's get out now, before we start eating up stuff
1373 -- that doesn't belong to us!
1375 if Token in Token_Class_Eterm then
1376 Error_Msg_AP ("expecting expression or component association");
1380 -- Otherwise initiate for reentry to top of loop by scanning an
1381 -- initial expression, unless the first token is OTHERS.
1383 if Token = Tok_Others then
1386 Save_Scan_State (Scan_State); -- at start of expression
1387 Expr_Node := P_Expression_Or_Range_Attribute;
1392 -- All component associations (positional and named) have been scanned
1395 Set_Expressions (Aggregate_Node, Expr_List);
1396 Set_Component_Associations (Aggregate_Node, Assoc_List);
1397 return Aggregate_Node;
1398 end P_Aggregate_Or_Paren_Expr;
1400 ------------------------------------------------
1401 -- 4.3 Record or Array Component Association --
1402 ------------------------------------------------
1404 -- RECORD_COMPONENT_ASSOCIATION ::=
1405 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1406 -- | COMPONENT_CHOICE_LIST => <>
1408 -- COMPONENT_CHOICE_LIST =>
1409 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1412 -- ARRAY_COMPONENT_ASSOCIATION ::=
1413 -- DISCRETE_CHOICE_LIST => EXPRESSION
1414 -- | DISCRETE_CHOICE_LIST => <>
1416 -- Note: this routine only handles the named cases, including others.
1417 -- Cases where the component choice list is not present have already
1418 -- been handled directly.
1420 -- Error recovery: can raise Error_Resync
1422 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1423 -- rules have been extended to give support to Ada 2005 limited
1424 -- aggregates (AI-287)
1426 function P_Record_Or_Array_Component_Association return Node_Id is
1427 Assoc_Node : Node_Id;
1430 Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1431 Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1432 Set_Sloc (Assoc_Node, Token_Ptr);
1435 if Token = Tok_Box then
1437 -- Ada 2005(AI-287): The box notation is used to indicate the
1438 -- default initialization of limited aggregate components
1440 if Ada_Version < Ada_05 then
1442 ("limited aggregate is an Ada 2005 extension");
1443 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1446 Set_Box_Present (Assoc_Node);
1449 Set_Expression (Assoc_Node, P_Expression);
1453 end P_Record_Or_Array_Component_Association;
1455 -----------------------------
1456 -- 4.3.1 Record Aggregate --
1457 -----------------------------
1459 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1460 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1462 ----------------------------------------------
1463 -- 4.3.1 Record Component Association List --
1464 ----------------------------------------------
1466 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1468 ----------------------------------
1469 -- 4.3.1 Component Choice List --
1470 ----------------------------------
1472 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1474 --------------------------------
1475 -- 4.3.1 Extension Aggregate --
1476 --------------------------------
1478 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1480 --------------------------
1481 -- 4.3.1 Ancestor Part --
1482 --------------------------
1484 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1486 ----------------------------
1487 -- 4.3.1 Array Aggregate --
1488 ----------------------------
1490 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1492 ---------------------------------------
1493 -- 4.3.1 Positional Array Aggregate --
1494 ---------------------------------------
1496 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1498 ----------------------------------
1499 -- 4.3.1 Named Array Aggregate --
1500 ----------------------------------
1502 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1504 ----------------------------------------
1505 -- 4.3.1 Array Component Association --
1506 ----------------------------------------
1508 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1510 ---------------------
1511 -- 4.4 Expression --
1512 ---------------------
1515 -- RELATION {and RELATION} | RELATION {and then RELATION}
1516 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1517 -- | RELATION {xor RELATION}
1519 -- On return, Expr_Form indicates the categorization of the expression
1520 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1521 -- an error message is given, and Error is returned).
1523 -- Error recovery: cannot raise Error_Resync
1525 function P_Expression return Node_Id is
1526 Logical_Op : Node_Kind;
1527 Prev_Logical_Op : Node_Kind;
1528 Op_Location : Source_Ptr;
1533 Node1 := P_Relation;
1535 if Token in Token_Class_Logop then
1536 Prev_Logical_Op := N_Empty;
1539 Op_Location := Token_Ptr;
1540 Logical_Op := P_Logical_Operator;
1542 if Prev_Logical_Op /= N_Empty and then
1543 Logical_Op /= Prev_Logical_Op
1546 ("mixed logical operators in expression", Op_Location);
1547 Prev_Logical_Op := N_Empty;
1549 Prev_Logical_Op := Logical_Op;
1553 Node1 := New_Node (Logical_Op, Op_Location);
1554 Set_Left_Opnd (Node1, Node2);
1555 Set_Right_Opnd (Node1, P_Relation);
1556 Set_Op_Name (Node1);
1557 exit when Token not in Token_Class_Logop;
1560 Expr_Form := EF_Non_Simple;
1563 if Token = Tok_Apostrophe then
1564 Bad_Range_Attribute (Token_Ptr);
1571 -- This function is identical to the normal P_Expression, except that it
1572 -- checks that the expression scan did not stop on a right paren. It is
1573 -- called in all contexts where a right parenthesis cannot legitimately
1574 -- follow an expression.
1576 -- Error recovery: can not raise Error_Resync
1578 function P_Expression_No_Right_Paren return Node_Id is
1579 Expr : constant Node_Id := P_Expression;
1581 Check_No_Right_Paren;
1583 end P_Expression_No_Right_Paren;
1585 ----------------------------------------
1586 -- 4.4 Expression_Or_Range_Attribute --
1587 ----------------------------------------
1590 -- RELATION {and RELATION} | RELATION {and then RELATION}
1591 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1592 -- | RELATION {xor RELATION}
1594 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1596 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1598 -- On return, Expr_Form indicates the categorization of the expression
1599 -- and EF_Range_Attr is one of the possibilities.
1601 -- Error recovery: cannot raise Error_Resync
1603 -- In the grammar, a RANGE attribute is simply a name, but its use is
1604 -- highly restricted, so in the parser, we do not regard it as a name.
1605 -- Instead, P_Name returns without scanning the 'RANGE part of the
1606 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1607 -- attribute reference. In the normal case where a range attribute is
1608 -- not allowed, an error message is issued by P_Expression.
1610 function P_Expression_Or_Range_Attribute return Node_Id is
1611 Logical_Op : Node_Kind;
1612 Prev_Logical_Op : Node_Kind;
1613 Op_Location : Source_Ptr;
1616 Attr_Node : Node_Id;
1619 Node1 := P_Relation;
1621 if Token = Tok_Apostrophe then
1622 Attr_Node := P_Range_Attribute_Reference (Node1);
1623 Expr_Form := EF_Range_Attr;
1626 elsif Token in Token_Class_Logop then
1627 Prev_Logical_Op := N_Empty;
1630 Op_Location := Token_Ptr;
1631 Logical_Op := P_Logical_Operator;
1633 if Prev_Logical_Op /= N_Empty and then
1634 Logical_Op /= Prev_Logical_Op
1637 ("mixed logical operators in expression", Op_Location);
1638 Prev_Logical_Op := N_Empty;
1640 Prev_Logical_Op := Logical_Op;
1644 Node1 := New_Node (Logical_Op, Op_Location);
1645 Set_Left_Opnd (Node1, Node2);
1646 Set_Right_Opnd (Node1, P_Relation);
1647 Set_Op_Name (Node1);
1648 exit when Token not in Token_Class_Logop;
1651 Expr_Form := EF_Non_Simple;
1654 if Token = Tok_Apostrophe then
1655 Bad_Range_Attribute (Token_Ptr);
1660 end P_Expression_Or_Range_Attribute;
1667 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1668 -- | SIMPLE_EXPRESSION [not] in RANGE
1669 -- | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1671 -- On return, Expr_Form indicates the categorization of the expression
1673 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1674 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1676 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1677 -- expression, then tokens are scanned until either a non-expression token,
1678 -- a right paren (not matched by a left paren) or a comma, is encountered.
1680 function P_Relation return Node_Id is
1681 Node1, Node2 : Node_Id;
1685 Node1 := P_Simple_Expression;
1687 if Token not in Token_Class_Relop then
1691 -- Here we have a relational operator following. If so then scan it
1692 -- out. Note that the assignment symbol := is treated as a relational
1693 -- operator to improve the error recovery when it is misused for =.
1694 -- P_Relational_Operator also parses the IN and NOT IN operations.
1697 Node2 := New_Node (P_Relational_Operator, Optok);
1698 Set_Left_Opnd (Node2, Node1);
1699 Set_Op_Name (Node2);
1701 -- Case of IN or NOT IN
1703 if Prev_Token = Tok_In then
1704 Set_Right_Opnd (Node2, P_Range_Or_Subtype_Mark);
1706 -- Case of relational operator (= /= < <= > >=)
1709 Set_Right_Opnd (Node2, P_Simple_Expression);
1712 Expr_Form := EF_Non_Simple;
1714 if Token in Token_Class_Relop then
1715 Error_Msg_SC ("unexpected relational operator");
1722 -- If any error occurs, then scan to the next expression terminator symbol
1723 -- or comma or right paren at the outer (i.e. current) parentheses level.
1724 -- The flags are set to indicate a normal simple expression.
1727 when Error_Resync =>
1729 Expr_Form := EF_Simple;
1733 ----------------------------
1734 -- 4.4 Simple Expression --
1735 ----------------------------
1737 -- SIMPLE_EXPRESSION ::=
1738 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1740 -- On return, Expr_Form indicates the categorization of the expression
1742 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1743 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1745 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1746 -- expression, then tokens are scanned until either a non-expression token,
1747 -- a right paren (not matched by a left paren) or a comma, is encountered.
1749 -- Note: P_Simple_Expression is called only internally by higher level
1750 -- expression routines. In cases in the grammar where a simple expression
1751 -- is required, the approach is to scan an expression, and then post an
1752 -- appropriate error message if the expression obtained is not simple. This
1753 -- gives better error recovery and treatment.
1755 function P_Simple_Expression return Node_Id is
1756 Scan_State : Saved_Scan_State;
1759 Tokptr : Source_Ptr;
1762 -- Check for cases starting with a name. There are two reasons for
1763 -- special casing. First speed things up by catching a common case
1764 -- without going through several routine layers. Second the caller must
1765 -- be informed via Expr_Form when the simple expression is a name.
1767 if Token in Token_Class_Name then
1770 -- Deal with apostrophe cases
1772 if Token = Tok_Apostrophe then
1773 Save_Scan_State (Scan_State); -- at apostrophe
1774 Scan; -- past apostrophe
1776 -- If qualified expression, scan it out and fall through
1778 if Token = Tok_Left_Paren then
1779 Node1 := P_Qualified_Expression (Node1);
1780 Expr_Form := EF_Simple;
1782 -- If range attribute, then we return with Token pointing to the
1783 -- apostrophe. Note: avoid the normal error check on exit. We
1784 -- know that the expression really is complete in this case!
1786 else -- Token = Tok_Range then
1787 Restore_Scan_State (Scan_State); -- to apostrophe
1788 Expr_Form := EF_Simple_Name;
1793 -- If an expression terminator follows, the previous processing
1794 -- completely scanned out the expression (a common case), and
1795 -- left Expr_Form set appropriately for returning to our caller.
1797 if Token in Token_Class_Sterm then
1800 -- If we do not have an expression terminator, then complete the
1801 -- scan of a simple expression. This code duplicates the code
1802 -- found in P_Term and P_Factor.
1805 if Token = Tok_Double_Asterisk then
1807 Style.Check_Exponentiation_Operator;
1810 Node2 := New_Node (N_Op_Expon, Token_Ptr);
1812 Set_Left_Opnd (Node2, Node1);
1813 Set_Right_Opnd (Node2, P_Primary);
1814 Set_Op_Name (Node2);
1819 exit when Token not in Token_Class_Mulop;
1820 Tokptr := Token_Ptr;
1821 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1824 Style.Check_Binary_Operator;
1827 Scan; -- past operator
1828 Set_Left_Opnd (Node2, Node1);
1829 Set_Right_Opnd (Node2, P_Factor);
1830 Set_Op_Name (Node2);
1835 exit when Token not in Token_Class_Binary_Addop;
1836 Tokptr := Token_Ptr;
1837 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1840 Style.Check_Binary_Operator;
1843 Scan; -- past operator
1844 Set_Left_Opnd (Node2, Node1);
1845 Set_Right_Opnd (Node2, P_Term);
1846 Set_Op_Name (Node2);
1850 Expr_Form := EF_Simple;
1853 -- Cases where simple expression does not start with a name
1856 -- Scan initial sign and initial Term
1858 if Token in Token_Class_Unary_Addop then
1859 Tokptr := Token_Ptr;
1860 Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
1863 Style.Check_Unary_Plus_Or_Minus;
1866 Scan; -- past operator
1867 Set_Right_Opnd (Node1, P_Term);
1868 Set_Op_Name (Node1);
1873 -- Scan out sequence of terms separated by binary adding operators
1876 exit when Token not in Token_Class_Binary_Addop;
1877 Tokptr := Token_Ptr;
1878 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1879 Scan; -- past operator
1880 Set_Left_Opnd (Node2, Node1);
1881 Set_Right_Opnd (Node2, P_Term);
1882 Set_Op_Name (Node2);
1886 -- All done, we clearly do not have name or numeric literal so this
1887 -- is a case of a simple expression which is some other possibility.
1889 Expr_Form := EF_Simple;
1892 -- Come here at end of simple expression, where we do a couple of
1893 -- special checks to improve error recovery.
1895 -- Special test to improve error recovery. If the current token
1896 -- is a period, then someone is trying to do selection on something
1897 -- that is not a name, e.g. a qualified expression.
1899 if Token = Tok_Dot then
1900 Error_Msg_SC ("prefix for selection is not a name");
1904 -- Special test to improve error recovery: If the current token is
1905 -- not the first token on a line (as determined by checking the
1906 -- previous token position with the start of the current line),
1907 -- then we insist that we have an appropriate terminating token.
1908 -- Consider the following two examples:
1910 -- 1) if A nad B then ...
1915 -- In the first example, we would like to issue a binary operator
1916 -- expected message and resynchronize to the then. In the second
1917 -- example, we do not want to issue a binary operator message, so
1918 -- that instead we will get the missing semicolon message. This
1919 -- distinction is of course a heuristic which does not always work,
1920 -- but in practice it is quite effective.
1922 -- Note: the one case in which we do not go through this circuit is
1923 -- when we have scanned a range attribute and want to return with
1924 -- Token pointing to the apostrophe. The apostrophe is not normally
1925 -- an expression terminator, and is not in Token_Class_Sterm, but
1926 -- in this special case we know that the expression is complete.
1928 if not Token_Is_At_Start_Of_Line
1929 and then Token not in Token_Class_Sterm
1931 Error_Msg_AP ("binary operator expected");
1937 -- If any error occurs, then scan to next expression terminator symbol
1938 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
1939 -- level. Expr_Form is set to indicate a normal simple expression.
1942 when Error_Resync =>
1944 Expr_Form := EF_Simple;
1947 end P_Simple_Expression;
1949 -----------------------------------------------
1950 -- 4.4 Simple Expression or Range Attribute --
1951 -----------------------------------------------
1953 -- SIMPLE_EXPRESSION ::=
1954 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1956 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1958 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1960 -- Error recovery: cannot raise Error_Resync
1962 function P_Simple_Expression_Or_Range_Attribute return Node_Id is
1964 Attr_Node : Node_Id;
1967 -- We don't just want to roar ahead and call P_Simple_Expression
1968 -- here, since we want to handle the case of a parenthesized range
1969 -- attribute cleanly.
1971 if Token = Tok_Left_Paren then
1973 Lptr : constant Source_Ptr := Token_Ptr;
1974 Scan_State : Saved_Scan_State;
1977 Save_Scan_State (Scan_State);
1978 Scan; -- past left paren
1979 Sexpr := P_Simple_Expression;
1981 if Token = Tok_Apostrophe then
1982 Attr_Node := P_Range_Attribute_Reference (Sexpr);
1983 Expr_Form := EF_Range_Attr;
1985 if Token = Tok_Right_Paren then
1986 Scan; -- scan past right paren if present
1989 Error_Msg ("parentheses not allowed for range attribute", Lptr);
1994 Restore_Scan_State (Scan_State);
1998 -- Here after dealing with parenthesized range attribute
2000 Sexpr := P_Simple_Expression;
2002 if Token = Tok_Apostrophe then
2003 Attr_Node := P_Range_Attribute_Reference (Sexpr);
2004 Expr_Form := EF_Range_Attr;
2010 end P_Simple_Expression_Or_Range_Attribute;
2016 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2018 -- Error recovery: can raise Error_Resync
2020 function P_Term return Node_Id is
2021 Node1, Node2 : Node_Id;
2022 Tokptr : Source_Ptr;
2028 exit when Token not in Token_Class_Mulop;
2029 Tokptr := Token_Ptr;
2030 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
2031 Scan; -- past operator
2032 Set_Left_Opnd (Node2, Node1);
2033 Set_Right_Opnd (Node2, P_Factor);
2034 Set_Op_Name (Node2);
2045 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2047 -- Error recovery: can raise Error_Resync
2049 function P_Factor return Node_Id is
2054 if Token = Tok_Abs then
2055 Node1 := New_Node (N_Op_Abs, Token_Ptr);
2058 Style.Check_Abs_Not;
2062 Set_Right_Opnd (Node1, P_Primary);
2063 Set_Op_Name (Node1);
2066 elsif Token = Tok_Not then
2067 Node1 := New_Node (N_Op_Not, Token_Ptr);
2070 Style.Check_Abs_Not;
2074 Set_Right_Opnd (Node1, P_Primary);
2075 Set_Op_Name (Node1);
2081 if Token = Tok_Double_Asterisk then
2082 Node2 := New_Node (N_Op_Expon, Token_Ptr);
2084 Set_Left_Opnd (Node2, Node1);
2085 Set_Right_Opnd (Node2, P_Primary);
2086 Set_Op_Name (Node2);
2099 -- NUMERIC_LITERAL | null
2100 -- | STRING_LITERAL | AGGREGATE
2101 -- | NAME | QUALIFIED_EXPRESSION
2102 -- | ALLOCATOR | (EXPRESSION)
2104 -- Error recovery: can raise Error_Resync
2106 function P_Primary return Node_Id is
2107 Scan_State : Saved_Scan_State;
2111 -- The loop runs more than once only if misplaced pragmas are found
2116 -- Name token can start a name, call or qualified expression, all
2117 -- of which are acceptable possibilities for primary. Note also
2118 -- that string literal is included in name (as operator symbol)
2119 -- and type conversion is included in name (as indexed component).
2121 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2124 -- All done unless apostrophe follows
2126 if Token /= Tok_Apostrophe then
2129 -- Apostrophe following means that we have either just parsed
2130 -- the subtype mark of a qualified expression, or the prefix
2131 -- or a range attribute.
2133 else -- Token = Tok_Apostrophe
2134 Save_Scan_State (Scan_State); -- at apostrophe
2135 Scan; -- past apostrophe
2137 -- If range attribute, then this is always an error, since
2138 -- the only legitimate case (where the scanned expression is
2139 -- a qualified simple name) is handled at the level of the
2140 -- Simple_Expression processing. This case corresponds to a
2141 -- usage such as 3 + A'Range, which is always illegal.
2143 if Token = Tok_Range then
2144 Restore_Scan_State (Scan_State); -- to apostrophe
2145 Bad_Range_Attribute (Token_Ptr);
2148 -- If left paren, then we have a qualified expression.
2149 -- Note that P_Name guarantees that in this case, where
2150 -- Token = Tok_Apostrophe on return, the only two possible
2151 -- tokens following the apostrophe are left paren and
2152 -- RANGE, so we know we have a left paren here.
2154 else -- Token = Tok_Left_Paren
2155 return P_Qualified_Expression (Node1);
2160 -- Numeric or string literal
2162 when Tok_Integer_Literal |
2164 Tok_String_Literal =>
2166 Node1 := Token_Node;
2167 Scan; -- past number
2170 -- Left paren, starts aggregate or parenthesized expression
2172 when Tok_Left_Paren =>
2174 Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2177 if Nkind (Expr) = N_Attribute_Reference
2178 and then Attribute_Name (Expr) = Name_Range
2180 Bad_Range_Attribute (Sloc (Expr));
2195 return New_Node (N_Null, Prev_Token_Ptr);
2197 -- Pragma, not allowed here, so just skip past it
2200 P_Pragmas_Misplaced;
2202 -- Anything else is illegal as the first token of a primary, but
2203 -- we test for a reserved identifier so that it is treated nicely
2206 if Is_Reserved_Identifier then
2207 return P_Identifier;
2209 elsif Prev_Token = Tok_Comma then
2210 Error_Msg_SP ("extra "","" ignored");
2214 Error_Msg_AP ("missing operand");
2222 ---------------------------
2223 -- 4.5 Logical Operator --
2224 ---------------------------
2226 -- LOGICAL_OPERATOR ::= and | or | xor
2228 -- Note: AND THEN and OR ELSE are also treated as logical operators
2229 -- by the parser (even though they are not operators semantically)
2231 -- The value returned is the appropriate Node_Kind code for the operator
2232 -- On return, Token points to the token following the scanned operator.
2234 -- The caller has checked that the first token is a legitimate logical
2235 -- operator token (i.e. is either XOR, AND, OR).
2237 -- Error recovery: cannot raise Error_Resync
2239 function P_Logical_Operator return Node_Kind is
2241 if Token = Tok_And then
2243 Style.Check_Binary_Operator;
2248 if Token = Tok_Then then
2255 elsif Token = Tok_Or then
2257 Style.Check_Binary_Operator;
2262 if Token = Tok_Else then
2269 else -- Token = Tok_Xor
2271 Style.Check_Binary_Operator;
2277 end P_Logical_Operator;
2279 ------------------------------
2280 -- 4.5 Relational Operator --
2281 ------------------------------
2283 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2285 -- The value returned is the appropriate Node_Kind code for the operator.
2286 -- On return, Token points to the operator token, NOT past it.
2288 -- The caller has checked that the first token is a legitimate relational
2289 -- operator token (i.e. is one of the operator tokens listed above).
2291 -- Error recovery: cannot raise Error_Resync
2293 function P_Relational_Operator return Node_Kind is
2294 Op_Kind : Node_Kind;
2295 Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2296 (Tok_Less => N_Op_Lt,
2297 Tok_Equal => N_Op_Eq,
2298 Tok_Greater => N_Op_Gt,
2299 Tok_Not_Equal => N_Op_Ne,
2300 Tok_Greater_Equal => N_Op_Ge,
2301 Tok_Less_Equal => N_Op_Le,
2303 Tok_Not => N_Not_In,
2304 Tok_Box => N_Op_Ne);
2307 if Token = Tok_Box then
2308 Error_Msg_SC ("""'<'>"" should be ""/=""");
2311 Op_Kind := Relop_Node (Token);
2314 Style.Check_Binary_Operator;
2317 Scan; -- past operator token
2319 if Prev_Token = Tok_Not then
2324 end P_Relational_Operator;
2326 ---------------------------------
2327 -- 4.5 Binary Adding Operator --
2328 ---------------------------------
2330 -- BINARY_ADDING_OPERATOR ::= + | - | &
2332 -- The value returned is the appropriate Node_Kind code for the operator.
2333 -- On return, Token points to the operator token (NOT past it).
2335 -- The caller has checked that the first token is a legitimate adding
2336 -- operator token (i.e. is one of the operator tokens listed above).
2338 -- Error recovery: cannot raise Error_Resync
2340 function P_Binary_Adding_Operator return Node_Kind is
2341 Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2342 (Tok_Ampersand => N_Op_Concat,
2343 Tok_Minus => N_Op_Subtract,
2344 Tok_Plus => N_Op_Add);
2346 return Addop_Node (Token);
2347 end P_Binary_Adding_Operator;
2349 --------------------------------
2350 -- 4.5 Unary Adding Operator --
2351 --------------------------------
2353 -- UNARY_ADDING_OPERATOR ::= + | -
2355 -- The value returned is the appropriate Node_Kind code for the operator.
2356 -- On return, Token points to the operator token (NOT past it).
2358 -- The caller has checked that the first token is a legitimate adding
2359 -- operator token (i.e. is one of the operator tokens listed above).
2361 -- Error recovery: cannot raise Error_Resync
2363 function P_Unary_Adding_Operator return Node_Kind is
2364 Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2365 (Tok_Minus => N_Op_Minus,
2366 Tok_Plus => N_Op_Plus);
2368 return Addop_Node (Token);
2369 end P_Unary_Adding_Operator;
2371 -------------------------------
2372 -- 4.5 Multiplying Operator --
2373 -------------------------------
2375 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2377 -- The value returned is the appropriate Node_Kind code for the operator.
2378 -- On return, Token points to the operator token (NOT past it).
2380 -- The caller has checked that the first token is a legitimate multiplying
2381 -- operator token (i.e. is one of the operator tokens listed above).
2383 -- Error recovery: cannot raise Error_Resync
2385 function P_Multiplying_Operator return Node_Kind is
2386 Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2387 (Tok_Asterisk => N_Op_Multiply,
2388 Tok_Mod => N_Op_Mod,
2389 Tok_Rem => N_Op_Rem,
2390 Tok_Slash => N_Op_Divide);
2392 return Mulop_Node (Token);
2393 end P_Multiplying_Operator;
2395 --------------------------------------
2396 -- 4.5 Highest Precedence Operator --
2397 --------------------------------------
2399 -- Parsed by P_Factor (4.4)
2401 -- Note: this rule is not in fact used by the grammar at any point!
2403 --------------------------
2404 -- 4.6 Type Conversion --
2405 --------------------------
2407 -- Parsed by P_Primary as a Name (4.1)
2409 -------------------------------
2410 -- 4.7 Qualified Expression --
2411 -------------------------------
2413 -- QUALIFIED_EXPRESSION ::=
2414 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2416 -- The caller has scanned the name which is the Subtype_Mark parameter
2417 -- and scanned past the single quote following the subtype mark. The
2418 -- caller has not checked that this name is in fact appropriate for
2419 -- a subtype mark name (i.e. it is a selected component or identifier).
2421 -- Error_Recovery: cannot raise Error_Resync
2423 function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2424 Qual_Node : Node_Id;
2426 Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2427 Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2428 Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2430 end P_Qualified_Expression;
2432 --------------------
2434 --------------------
2437 -- new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2439 -- The caller has checked that the initial token is NEW
2441 -- Error recovery: can raise Error_Resync
2443 function P_Allocator return Node_Id is
2444 Alloc_Node : Node_Id;
2445 Type_Node : Node_Id;
2446 Null_Exclusion_Present : Boolean;
2449 Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2452 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2454 Null_Exclusion_Present := P_Null_Exclusion;
2455 Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
2456 Type_Node := P_Subtype_Mark_Resync;
2458 if Token = Tok_Apostrophe then
2459 Scan; -- past apostrophe
2460 Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2464 P_Subtype_Indication (Type_Node, Null_Exclusion_Present));