* config/alpha/alpha.c, config/alpha/alpha.md,
[official-gcc.git] / gcc / ada / par-ch4.adb
blob220c0656eb548546031f45a0063e4606cc2bc35d
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P A R . C H 4 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
10 -- --
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. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
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
31 separate (Par)
32 package body Ch4 is
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)
58 return 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
71 begin
72 Error_Msg ("range attribute cannot be used in expression", Loc);
73 Resync_Expression;
74 end Bad_Range_Attribute;
76 ------------------
77 -- Set_Op_Name --
78 ------------------
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);
115 begin
116 if Nkind (Node) in N_Op then
117 Set_Chars (Node, Name_Of (Nkind (Node)));
118 end if;
119 end Set_Op_Name;
121 --------------------------
122 -- 4.1 Name (also 6.4) --
123 --------------------------
125 -- NAME ::=
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
154 -- FUNCTION_CALL ::=
155 -- function_NAME
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;
182 Name_Node : Node_Id;
183 Prefix_Node : Node_Id;
184 Ident_Node : Node_Id;
185 Expr_Node : Node_Id;
186 Range_Node : Node_Id;
187 Arg_Node : Node_Id;
189 Arg_List : List_Id := No_List; -- kill junk warning
190 Attr_Name : Name_Id := No_Name; -- kill junk warning
192 begin
193 if Token not in Token_Class_Name then
194 Error_Msg_AP ("name expected");
195 raise Error_Resync;
196 end if;
198 -- Loop through designators in qualified name
200 Name_Node := Token_Node;
202 loop
203 Scan; -- past designator
204 exit when Token /= Tok_Dot;
205 Save_Scan_State (Scan_State); -- at dot
206 Scan; -- past dot
208 -- If we do not have another designator after the dot, then join
209 -- the normal circuit to handle a dot extension (may be .all or
210 -- character literal case). Otherwise loop back to scan the next
211 -- designator.
213 if Token not in Token_Class_Desig then
214 goto Scan_Name_Extension_Dot;
215 else
216 Prefix_Node := Name_Node;
217 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
218 Set_Prefix (Name_Node, Prefix_Node);
219 Set_Selector_Name (Name_Node, Token_Node);
220 end if;
221 end loop;
223 -- We have now scanned out a qualified designator. If the last token is
224 -- an operator symbol, then we certainly do not have the Snam case, so
225 -- we can just use the normal name extension check circuit
227 if Prev_Token = Tok_Operator_Symbol then
228 goto Scan_Name_Extension;
229 end if;
231 -- We have scanned out a qualified simple name, check for name extension
232 -- Note that we know there is no dot here at this stage, so the only
233 -- possible cases of name extension are apostrophe and left paren.
235 if Token = Tok_Apostrophe then
236 Save_Scan_State (Scan_State); -- at apostrophe
237 Scan; -- past apostrophe
239 -- If left paren, then this might be a qualified expression, but we
240 -- are only in the business of scanning out names, so return with
241 -- Token backed up to point to the apostrophe. The treatment for
242 -- the range attribute is similar (we do not consider x'range to
243 -- be a name in this grammar).
245 if Token = Tok_Left_Paren or else Token = Tok_Range then
246 Restore_Scan_State (Scan_State); -- to apostrophe
247 Expr_Form := EF_Simple_Name;
248 return Name_Node;
250 -- Otherwise we have the case of a name extended by an attribute
252 else
253 goto Scan_Name_Extension_Apostrophe;
254 end if;
256 -- Check case of qualified simple name extended by a left parenthesis
258 elsif Token = Tok_Left_Paren then
259 Scan; -- past left paren
260 goto Scan_Name_Extension_Left_Paren;
262 -- Otherwise the qualified simple name is not extended, so return
264 else
265 Expr_Form := EF_Simple_Name;
266 return Name_Node;
267 end if;
269 -- Loop scanning past name extensions. A label is used for control
270 -- transfer for this loop for ease of interfacing with the finite state
271 -- machine in the parenthesis scanning circuit, and also to allow for
272 -- passing in control to the appropriate point from the above code.
274 <<Scan_Name_Extension>>
276 -- Character literal used as name cannot be extended. Also this
277 -- cannot be a call, since the name for a call must be a designator.
278 -- Return in these cases, or if there is no name extension
280 if Token not in Token_Class_Namext
281 or else Prev_Token = Tok_Char_Literal
282 then
283 Expr_Form := EF_Name;
284 return Name_Node;
285 end if;
287 -- Merge here when we know there is a name extension
289 <<Scan_Name_Extension_OK>>
291 if Token = Tok_Left_Paren then
292 Scan; -- past left paren
293 goto Scan_Name_Extension_Left_Paren;
295 elsif Token = Tok_Apostrophe then
296 Save_Scan_State (Scan_State); -- at apostrophe
297 Scan; -- past apostrophe
298 goto Scan_Name_Extension_Apostrophe;
300 else -- Token = Tok_Dot
301 Save_Scan_State (Scan_State); -- at dot
302 Scan; -- past dot
303 goto Scan_Name_Extension_Dot;
304 end if;
306 -- Case of name extended by dot (selection), dot is already skipped
307 -- and the scan state at the point of the dot is saved in Scan_State.
309 <<Scan_Name_Extension_Dot>>
311 -- Explicit dereference case
313 if Token = Tok_All then
314 Prefix_Node := Name_Node;
315 Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
316 Set_Prefix (Name_Node, Prefix_Node);
317 Scan; -- past ALL
318 goto Scan_Name_Extension;
320 -- Selected component case
322 elsif Token in Token_Class_Name then
323 Prefix_Node := Name_Node;
324 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
325 Set_Prefix (Name_Node, Prefix_Node);
326 Set_Selector_Name (Name_Node, Token_Node);
327 Scan; -- past selector
328 goto Scan_Name_Extension;
330 -- Reserved identifier as selector
332 elsif Is_Reserved_Identifier then
333 Scan_Reserved_Identifier (Force_Msg => False);
334 Prefix_Node := Name_Node;
335 Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
336 Set_Prefix (Name_Node, Prefix_Node);
337 Set_Selector_Name (Name_Node, Token_Node);
338 Scan; -- past identifier used as selector
339 goto Scan_Name_Extension;
341 -- If dot is at end of line and followed by nothing legal,
342 -- then assume end of name and quit (dot will be taken as
343 -- an erroneous form of some other punctuation by our caller).
345 elsif Token_Is_At_Start_Of_Line then
346 Restore_Scan_State (Scan_State);
347 return Name_Node;
349 -- Here if nothing legal after the dot
351 else
352 Error_Msg_AP ("selector expected");
353 raise Error_Resync;
354 end if;
356 -- Here for an apostrophe as name extension. The scan position at the
357 -- apostrophe has already been saved, and the apostrophe scanned out.
359 <<Scan_Name_Extension_Apostrophe>>
361 Scan_Apostrophe : declare
362 function Apostrophe_Should_Be_Semicolon return Boolean;
363 -- Checks for case where apostrophe should probably be
364 -- a semicolon, and if so, gives appropriate message,
365 -- resets the scan pointer to the apostrophe, changes
366 -- the current token to Tok_Semicolon, and returns True.
367 -- Otherwise returns False.
369 function Apostrophe_Should_Be_Semicolon return Boolean is
370 begin
371 if Token_Is_At_Start_Of_Line then
372 Restore_Scan_State (Scan_State); -- to apostrophe
373 Error_Msg_SC ("""''"" should be "";""");
374 Token := Tok_Semicolon;
375 return True;
376 else
377 return False;
378 end if;
379 end Apostrophe_Should_Be_Semicolon;
381 -- Start of processing for Scan_Apostrophe
383 begin
384 -- If range attribute after apostrophe, then return with Token
385 -- pointing to the apostrophe. Note that in this case the prefix
386 -- need not be a simple name (cases like A.all'range). Similarly
387 -- if there is a left paren after the apostrophe, then we also
388 -- return with Token pointing to the apostrophe (this is the
389 -- qualified expression case).
391 if Token = Tok_Range or else Token = Tok_Left_Paren then
392 Restore_Scan_State (Scan_State); -- to apostrophe
393 Expr_Form := EF_Name;
394 return Name_Node;
396 -- Here for cases where attribute designator is an identifier
398 elsif Token = Tok_Identifier then
399 Attr_Name := Token_Name;
401 if not Is_Attribute_Name (Attr_Name) then
402 if Apostrophe_Should_Be_Semicolon then
403 Expr_Form := EF_Name;
404 return Name_Node;
406 -- Here for a bad attribute name
408 else
409 Signal_Bad_Attribute;
410 Scan; -- past bad identifier
412 if Token = Tok_Left_Paren then
413 Scan; -- past left paren
415 loop
416 Discard_Junk_Node (P_Expression);
417 exit when not Comma_Present;
418 end loop;
420 T_Right_Paren;
421 end if;
423 return Error;
424 end if;
425 end if;
427 if Style_Check then
428 Style.Check_Attribute_Name (False);
429 end if;
431 Delete_Node (Token_Node);
433 -- Here for case of attribute designator is not an identifier
435 else
436 if Token = Tok_Delta then
437 Attr_Name := Name_Delta;
439 elsif Token = Tok_Digits then
440 Attr_Name := Name_Digits;
442 elsif Token = Tok_Access then
443 Attr_Name := Name_Access;
445 elsif Token = Tok_Mod and then Ada_Version = Ada_05 then
446 Attr_Name := Name_Mod;
448 elsif Apostrophe_Should_Be_Semicolon then
449 Expr_Form := EF_Name;
450 return Name_Node;
452 else
453 Error_Msg_AP ("attribute designator expected");
454 raise Error_Resync;
455 end if;
457 if Style_Check then
458 Style.Check_Attribute_Name (True);
459 end if;
460 end if;
462 -- We come here with an OK attribute scanned, and the
463 -- corresponding Attribute identifier node stored in Ident_Node.
465 Prefix_Node := Name_Node;
466 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
467 Scan; -- past attribute designator
468 Set_Prefix (Name_Node, Prefix_Node);
469 Set_Attribute_Name (Name_Node, Attr_Name);
471 -- Scan attribute arguments/designator
473 if Token = Tok_Left_Paren then
474 Set_Expressions (Name_Node, New_List);
475 Scan; -- past left paren
477 loop
478 declare
479 Expr : constant Node_Id := P_Expression;
481 begin
482 if Token = Tok_Arrow then
483 Error_Msg_SC
484 ("named parameters not permitted for attributes");
485 Scan; -- past junk arrow
487 else
488 Append (Expr, Expressions (Name_Node));
489 exit when not Comma_Present;
490 end if;
491 end;
492 end loop;
494 T_Right_Paren;
495 end if;
497 goto Scan_Name_Extension;
498 end Scan_Apostrophe;
500 -- Here for left parenthesis extending name (left paren skipped)
502 <<Scan_Name_Extension_Left_Paren>>
504 -- We now have to scan through a list of items, terminated by a
505 -- right parenthesis. The scan is handled by a finite state
506 -- machine. The possibilities are:
508 -- (discrete_range)
510 -- This is a slice. This case is handled in LP_State_Init
512 -- (expression, expression, ..)
514 -- This is interpreted as an indexed component, i.e. as a
515 -- case of a name which can be extended in the normal manner.
516 -- This case is handled by LP_State_Name or LP_State_Expr.
518 -- (..., identifier => expression , ...)
520 -- If there is at least one occurrence of identifier => (but
521 -- none of the other cases apply), then we have a call.
523 -- Test for Id => case
525 if Token = Tok_Identifier then
526 Save_Scan_State (Scan_State); -- at Id
527 Scan; -- past Id
529 -- Test for => (allow := as an error substitute)
531 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
532 Restore_Scan_State (Scan_State); -- to Id
533 Arg_List := New_List;
534 goto LP_State_Call;
536 else
537 Restore_Scan_State (Scan_State); -- to Id
538 end if;
539 end if;
541 -- Here we have an expression after all
543 Expr_Node := P_Expression_Or_Range_Attribute;
545 -- Check cases of discrete range for a slice
547 -- First possibility: Range_Attribute_Reference
549 if Expr_Form = EF_Range_Attr then
550 Range_Node := Expr_Node;
552 -- Second possibility: Simple_expression .. Simple_expression
554 elsif Token = Tok_Dot_Dot then
555 Check_Simple_Expression (Expr_Node);
556 Range_Node := New_Node (N_Range, Token_Ptr);
557 Set_Low_Bound (Range_Node, Expr_Node);
558 Scan; -- past ..
559 Expr_Node := P_Expression;
560 Check_Simple_Expression (Expr_Node);
561 Set_High_Bound (Range_Node, Expr_Node);
563 -- Third possibility: Type_name range Range
565 elsif Token = Tok_Range then
566 if Expr_Form /= EF_Simple_Name then
567 Error_Msg_SC ("subtype mark must precede RANGE");
568 raise Error_Resync;
569 end if;
571 Range_Node := P_Subtype_Indication (Expr_Node);
573 -- Otherwise we just have an expression. It is true that we might
574 -- have a subtype mark without a range constraint but this case
575 -- is syntactically indistinguishable from the expression case.
577 else
578 Arg_List := New_List;
579 goto LP_State_Expr;
580 end if;
582 -- Fall through here with unmistakable Discrete range scanned,
583 -- which means that we definitely have the case of a slice. The
584 -- Discrete range is in Range_Node.
586 if Token = Tok_Comma then
587 Error_Msg_SC ("slice cannot have more than one dimension");
588 raise Error_Resync;
590 elsif Token /= Tok_Right_Paren then
591 T_Right_Paren;
592 raise Error_Resync;
594 else
595 Scan; -- past right paren
596 Prefix_Node := Name_Node;
597 Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
598 Set_Prefix (Name_Node, Prefix_Node);
599 Set_Discrete_Range (Name_Node, Range_Node);
601 -- An operator node is legal as a prefix to other names,
602 -- but not for a slice.
604 if Nkind (Prefix_Node) = N_Operator_Symbol then
605 Error_Msg_N ("illegal prefix for slice", Prefix_Node);
606 end if;
608 -- If we have a name extension, go scan it
610 if Token in Token_Class_Namext then
611 goto Scan_Name_Extension_OK;
613 -- Otherwise return (a slice is a name, but is not a call)
615 else
616 Expr_Form := EF_Name;
617 return Name_Node;
618 end if;
619 end if;
621 -- In LP_State_Expr, we have scanned one or more expressions, and
622 -- so we have a call or an indexed component which is a name. On
623 -- entry we have the expression just scanned in Expr_Node and
624 -- Arg_List contains the list of expressions encountered so far
626 <<LP_State_Expr>>
627 Append (Expr_Node, Arg_List);
629 if Token = Tok_Arrow then
630 Error_Msg
631 ("expect identifier in parameter association",
632 Sloc (Expr_Node));
633 Scan; -- past arrow.
635 elsif not Comma_Present then
636 T_Right_Paren;
637 Prefix_Node := Name_Node;
638 Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
639 Set_Prefix (Name_Node, Prefix_Node);
640 Set_Expressions (Name_Node, Arg_List);
641 goto Scan_Name_Extension;
642 end if;
644 -- Comma present (and scanned out), test for identifier => case
645 -- Test for identifier => case
647 if Token = Tok_Identifier then
648 Save_Scan_State (Scan_State); -- at Id
649 Scan; -- past Id
651 -- Test for => (allow := as error substitute)
653 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
654 Restore_Scan_State (Scan_State); -- to Id
655 goto LP_State_Call;
657 -- Otherwise it's just an expression after all, so backup
659 else
660 Restore_Scan_State (Scan_State); -- to Id
661 end if;
662 end if;
664 -- Here we have an expression after all, so stay in this state
666 Expr_Node := P_Expression;
667 goto LP_State_Expr;
669 -- LP_State_Call corresponds to the situation in which at least
670 -- one instance of Id => Expression has been encountered, so we
671 -- know that we do not have a name, but rather a call. We enter
672 -- it with the scan pointer pointing to the next argument to scan,
673 -- and Arg_List containing the list of arguments scanned so far.
675 <<LP_State_Call>>
677 -- Test for case of Id => Expression (named parameter)
679 if Token = Tok_Identifier then
680 Save_Scan_State (Scan_State); -- at Id
681 Ident_Node := Token_Node;
682 Scan; -- past Id
684 -- Deal with => (allow := as erroneous substitute)
686 if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
687 Arg_Node :=
688 New_Node (N_Parameter_Association, Prev_Token_Ptr);
689 Set_Selector_Name (Arg_Node, Ident_Node);
690 T_Arrow;
691 Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
692 Append (Arg_Node, Arg_List);
694 -- If a comma follows, go back and scan next entry
696 if Comma_Present then
697 goto LP_State_Call;
699 -- Otherwise we have the end of a call
701 else
702 Prefix_Node := Name_Node;
703 Name_Node :=
704 New_Node (N_Function_Call, Sloc (Prefix_Node));
705 Set_Name (Name_Node, Prefix_Node);
706 Set_Parameter_Associations (Name_Node, Arg_List);
707 T_Right_Paren;
709 if Token in Token_Class_Namext then
710 goto Scan_Name_Extension_OK;
712 -- This is a case of a call which cannot be a name
714 else
715 Expr_Form := EF_Name;
716 return Name_Node;
717 end if;
718 end if;
720 -- Not named parameter: Id started an expression after all
722 else
723 Restore_Scan_State (Scan_State); -- to Id
724 end if;
725 end if;
727 -- Here if entry did not start with Id => which means that it
728 -- is a positional parameter, which is not allowed, since we
729 -- have seen at least one named parameter already.
731 Error_Msg_SC
732 ("positional parameter association " &
733 "not allowed after named one");
735 Expr_Node := P_Expression;
737 -- Leaving the '>' in an association is not unusual, so suggest
738 -- a possible fix.
740 if Nkind (Expr_Node) = N_Op_Eq then
741 Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
742 end if;
744 -- We go back to scanning out expressions, so that we do not get
745 -- multiple error messages when several positional parameters
746 -- follow a named parameter.
748 goto LP_State_Expr;
750 -- End of treatment for name extensions starting with left paren
752 -- End of loop through name extensions
754 end P_Name;
756 -- This function parses a restricted form of Names which are either
757 -- designators, or designators preceded by a sequence of prefixes
758 -- that are direct names.
760 -- Error recovery: cannot raise Error_Resync
762 function P_Function_Name return Node_Id is
763 Designator_Node : Node_Id;
764 Prefix_Node : Node_Id;
765 Selector_Node : Node_Id;
766 Dot_Sloc : Source_Ptr := No_Location;
768 begin
769 -- Prefix_Node is set to the gathered prefix so far, Empty means that
770 -- no prefix has been scanned. This allows us to build up the result
771 -- in the required right recursive manner.
773 Prefix_Node := Empty;
775 -- Loop through prefixes
777 loop
778 Designator_Node := Token_Node;
780 if Token not in Token_Class_Desig then
781 return P_Identifier; -- let P_Identifier issue the error message
783 else -- Token in Token_Class_Desig
784 Scan; -- past designator
785 exit when Token /= Tok_Dot;
786 end if;
788 -- Here at a dot, with token just before it in Designator_Node
790 if No (Prefix_Node) then
791 Prefix_Node := Designator_Node;
792 else
793 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
794 Set_Prefix (Selector_Node, Prefix_Node);
795 Set_Selector_Name (Selector_Node, Designator_Node);
796 Prefix_Node := Selector_Node;
797 end if;
799 Dot_Sloc := Token_Ptr;
800 Scan; -- past dot
801 end loop;
803 -- Fall out of the loop having just scanned a designator
805 if No (Prefix_Node) then
806 return Designator_Node;
807 else
808 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
809 Set_Prefix (Selector_Node, Prefix_Node);
810 Set_Selector_Name (Selector_Node, Designator_Node);
811 return Selector_Node;
812 end if;
814 exception
815 when Error_Resync =>
816 return Error;
818 end P_Function_Name;
820 -- This function parses a restricted form of Names which are either
821 -- identifiers, or identifiers preceded by a sequence of prefixes
822 -- that are direct names.
824 -- Error recovery: cannot raise Error_Resync
826 function P_Qualified_Simple_Name return Node_Id is
827 Designator_Node : Node_Id;
828 Prefix_Node : Node_Id;
829 Selector_Node : Node_Id;
830 Dot_Sloc : Source_Ptr := No_Location;
832 begin
833 -- Prefix node is set to the gathered prefix so far, Empty means that
834 -- no prefix has been scanned. This allows us to build up the result
835 -- in the required right recursive manner.
837 Prefix_Node := Empty;
839 -- Loop through prefixes
841 loop
842 Designator_Node := Token_Node;
844 if Token = Tok_Identifier then
845 Scan; -- past identifier
846 exit when Token /= Tok_Dot;
848 elsif Token not in Token_Class_Desig then
849 return P_Identifier; -- let P_Identifier issue the error message
851 else
852 Scan; -- past designator
854 if Token /= Tok_Dot then
855 Error_Msg_SP ("identifier expected");
856 return Error;
857 end if;
858 end if;
860 -- Here at a dot, with token just before it in Designator_Node
862 if No (Prefix_Node) then
863 Prefix_Node := Designator_Node;
864 else
865 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
866 Set_Prefix (Selector_Node, Prefix_Node);
867 Set_Selector_Name (Selector_Node, Designator_Node);
868 Prefix_Node := Selector_Node;
869 end if;
871 Dot_Sloc := Token_Ptr;
872 Scan; -- past dot
873 end loop;
875 -- Fall out of the loop having just scanned an identifier
877 if No (Prefix_Node) then
878 return Designator_Node;
879 else
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 return Selector_Node;
884 end if;
886 exception
887 when Error_Resync =>
888 return Error;
890 end P_Qualified_Simple_Name;
892 -- This procedure differs from P_Qualified_Simple_Name only in that it
893 -- raises Error_Resync if any error is encountered. It only returns after
894 -- scanning a valid qualified simple name.
896 -- Error recovery: can raise Error_Resync
898 function P_Qualified_Simple_Name_Resync return Node_Id is
899 Designator_Node : Node_Id;
900 Prefix_Node : Node_Id;
901 Selector_Node : Node_Id;
902 Dot_Sloc : Source_Ptr := No_Location;
904 begin
905 Prefix_Node := Empty;
907 -- Loop through prefixes
909 loop
910 Designator_Node := Token_Node;
912 if Token = Tok_Identifier then
913 Scan; -- past identifier
914 exit when Token /= Tok_Dot;
916 elsif Token not in Token_Class_Desig then
917 Discard_Junk_Node (P_Identifier); -- to issue the error message
918 raise Error_Resync;
920 else
921 Scan; -- past designator
923 if Token /= Tok_Dot then
924 Error_Msg_SP ("identifier expected");
925 raise Error_Resync;
926 end if;
927 end if;
929 -- Here at a dot, with token just before it in Designator_Node
931 if No (Prefix_Node) then
932 Prefix_Node := Designator_Node;
933 else
934 Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
935 Set_Prefix (Selector_Node, Prefix_Node);
936 Set_Selector_Name (Selector_Node, Designator_Node);
937 Prefix_Node := Selector_Node;
938 end if;
940 Dot_Sloc := Token_Ptr;
941 Scan; -- past period
942 end loop;
944 -- Fall out of the loop having just scanned an identifier
946 if No (Prefix_Node) then
947 return Designator_Node;
948 else
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 return Selector_Node;
953 end if;
955 end P_Qualified_Simple_Name_Resync;
957 ----------------------
958 -- 4.1 Direct_Name --
959 ----------------------
961 -- Parsed by P_Name and other functions in section 4.1
963 -----------------
964 -- 4.1 Prefix --
965 -----------------
967 -- Parsed by P_Name (4.1)
969 -------------------------------
970 -- 4.1 Explicit Dereference --
971 -------------------------------
973 -- Parsed by P_Name (4.1)
975 -------------------------------
976 -- 4.1 Implicit_Dereference --
977 -------------------------------
979 -- Parsed by P_Name (4.1)
981 ----------------------------
982 -- 4.1 Indexed Component --
983 ----------------------------
985 -- Parsed by P_Name (4.1)
987 ----------------
988 -- 4.1 Slice --
989 ----------------
991 -- Parsed by P_Name (4.1)
993 -----------------------------
994 -- 4.1 Selected_Component --
995 -----------------------------
997 -- Parsed by P_Name (4.1)
999 ------------------------
1000 -- 4.1 Selector Name --
1001 ------------------------
1003 -- Parsed by P_Name (4.1)
1005 ------------------------------
1006 -- 4.1 Attribute Reference --
1007 ------------------------------
1009 -- Parsed by P_Name (4.1)
1011 -------------------------------
1012 -- 4.1 Attribute Designator --
1013 -------------------------------
1015 -- Parsed by P_Name (4.1)
1017 --------------------------------------
1018 -- 4.1.4 Range Attribute Reference --
1019 --------------------------------------
1021 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1023 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1025 -- In the grammar, a RANGE attribute is simply a name, but its use is
1026 -- highly restricted, so in the parser, we do not regard it as a name.
1027 -- Instead, P_Name returns without scanning the 'RANGE part of the
1028 -- attribute, and the caller uses the following function to construct
1029 -- a range attribute in places where it is appropriate.
1031 -- Note that RANGE here is treated essentially as an identifier,
1032 -- rather than a reserved word.
1034 -- The caller has parsed the prefix, i.e. a name, and Token points to
1035 -- the apostrophe. The token after the apostrophe is known to be RANGE
1036 -- at this point. The prefix node becomes the prefix of the attribute.
1038 -- Error_Recovery: Cannot raise Error_Resync
1040 function P_Range_Attribute_Reference
1041 (Prefix_Node : Node_Id)
1042 return Node_Id
1044 Attr_Node : Node_Id;
1046 begin
1047 Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1048 Set_Prefix (Attr_Node, Prefix_Node);
1049 Scan; -- past apostrophe
1051 if Style_Check then
1052 Style.Check_Attribute_Name (True);
1053 end if;
1055 Set_Attribute_Name (Attr_Node, Name_Range);
1056 Scan; -- past RANGE
1058 if Token = Tok_Left_Paren then
1059 Scan; -- past left paren
1060 Set_Expressions (Attr_Node, New_List (P_Expression));
1061 T_Right_Paren;
1062 end if;
1064 return Attr_Node;
1065 end P_Range_Attribute_Reference;
1067 ---------------------------------------
1068 -- 4.1.4 Range Attribute Designator --
1069 ---------------------------------------
1071 -- Parsed by P_Range_Attribute_Reference (4.4)
1073 --------------------
1074 -- 4.3 Aggregate --
1075 --------------------
1077 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1079 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1080 -- an aggregate is known to be required (code statement, extension
1081 -- aggregate), in which cases this routine performs the necessary check
1082 -- that we have an aggregate rather than a parenthesized expression
1084 -- Error recovery: can raise Error_Resync
1086 function P_Aggregate return Node_Id is
1087 Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1088 Aggr_Node : constant Node_Id := P_Aggregate_Or_Paren_Expr;
1090 begin
1091 if Nkind (Aggr_Node) /= N_Aggregate
1092 and then
1093 Nkind (Aggr_Node) /= N_Extension_Aggregate
1094 then
1095 Error_Msg
1096 ("aggregate may not have single positional component", Aggr_Sloc);
1097 return Error;
1098 else
1099 return Aggr_Node;
1100 end if;
1101 end P_Aggregate;
1103 -------------------------------------------------
1104 -- 4.3 Aggregate or Parenthesized Expresssion --
1105 -------------------------------------------------
1107 -- This procedure parses out either an aggregate or a parenthesized
1108 -- expression (these two constructs are closely related, since a
1109 -- parenthesized expression looks like an aggregate with a single
1110 -- positional component).
1112 -- AGGREGATE ::=
1113 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1115 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1117 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1118 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1119 -- | null record
1121 -- RECORD_COMPONENT_ASSOCIATION ::=
1122 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1124 -- COMPONENT_CHOICE_LIST ::=
1125 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1126 -- | others
1128 -- EXTENSION_AGGREGATE ::=
1129 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1131 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1133 -- ARRAY_AGGREGATE ::=
1134 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1136 -- POSITIONAL_ARRAY_AGGREGATE ::=
1137 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1138 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1139 -- | (EXPRESSION {, EXPRESSION}, others => <>)
1141 -- NAMED_ARRAY_AGGREGATE ::=
1142 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1144 -- PRIMARY ::= (EXPRESSION);
1146 -- Error recovery: can raise Error_Resync
1148 -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1149 -- to Ada 2005 limited aggregates (AI-287)
1151 function P_Aggregate_Or_Paren_Expr return Node_Id is
1152 Aggregate_Node : Node_Id;
1153 Expr_List : List_Id;
1154 Assoc_List : List_Id;
1155 Expr_Node : Node_Id;
1156 Lparen_Sloc : Source_Ptr;
1157 Scan_State : Saved_Scan_State;
1159 begin
1160 Lparen_Sloc := Token_Ptr;
1161 T_Left_Paren;
1163 -- Note: the mechanism used here of rescanning the initial expression
1164 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1165 -- out the discrete choice list.
1167 -- Deal with expression and extension aggregate cases first
1169 if Token /= Tok_Others then
1170 Save_Scan_State (Scan_State); -- at start of expression
1172 -- Deal with (NULL RECORD) case
1174 if Token = Tok_Null then
1175 Scan; -- past NULL
1177 if Token = Tok_Record then
1178 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1179 Set_Null_Record_Present (Aggregate_Node, True);
1180 Scan; -- past RECORD
1181 T_Right_Paren;
1182 return Aggregate_Node;
1183 else
1184 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1185 end if;
1186 end if;
1188 -- Ada 2005 (AI-287): The box notation is allowed only with named
1189 -- notation because positional notation might be error prone. For
1190 -- example, in "(X, <>, Y, <>)", there is no type associated with
1191 -- the boxes, so you might not be leaving out the components you
1192 -- thought you were leaving out.
1194 if Ada_Version >= Ada_05 and then Token = Tok_Box then
1195 Error_Msg_SC ("(Ada 2005) box notation only allowed with "
1196 & "named notation");
1197 Scan; -- past BOX
1198 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1199 return Aggregate_Node;
1200 end if;
1202 Expr_Node := P_Expression_Or_Range_Attribute;
1204 -- Extension aggregate case
1206 if Token = Tok_With then
1208 if Nkind (Expr_Node) = N_Attribute_Reference
1209 and then Attribute_Name (Expr_Node) = Name_Range
1210 then
1211 Bad_Range_Attribute (Sloc (Expr_Node));
1212 return Error;
1213 end if;
1215 if Ada_Version = Ada_83 then
1216 Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1217 end if;
1219 Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1220 Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1221 Scan; -- past WITH
1223 -- Deal with WITH NULL RECORD case
1225 if Token = Tok_Null then
1226 Save_Scan_State (Scan_State); -- at NULL
1227 Scan; -- past NULL
1229 if Token = Tok_Record then
1230 Scan; -- past RECORD
1231 Set_Null_Record_Present (Aggregate_Node, True);
1232 T_Right_Paren;
1233 return Aggregate_Node;
1235 else
1236 Restore_Scan_State (Scan_State); -- to NULL that must be expr
1237 end if;
1238 end if;
1240 if Token /= Tok_Others then
1241 Save_Scan_State (Scan_State);
1242 Expr_Node := P_Expression;
1243 else
1244 Expr_Node := Empty;
1245 end if;
1247 -- Expression case
1249 elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1250 if Nkind (Expr_Node) = N_Attribute_Reference
1251 and then Attribute_Name (Expr_Node) = Name_Range
1252 then
1253 Error_Msg
1254 ("|parentheses not allowed for range attribute", Lparen_Sloc);
1255 return Expr_Node;
1256 end if;
1258 -- Bump paren count of expression, note that if the paren count
1259 -- is already at the maximum, then we leave it alone. This will
1260 -- cause some failures in pathalogical conformance tests, which
1261 -- we do not shed a tear over!
1263 if Expr_Node /= Error then
1264 if Paren_Count (Expr_Node) /= Paren_Count_Type'Last then
1265 Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1266 end if;
1267 end if;
1269 T_Right_Paren; -- past right paren (error message if none)
1270 return Expr_Node;
1272 -- Normal aggregate case
1274 else
1275 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1276 end if;
1278 -- Others case
1280 else
1281 Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1282 Expr_Node := Empty;
1283 end if;
1285 -- Prepare to scan list of component associations
1287 Expr_List := No_List; -- don't set yet, maybe all named entries
1288 Assoc_List := No_List; -- don't set yet, maybe all positional entries
1290 -- This loop scans through component associations. On entry to the
1291 -- loop, an expression has been scanned at the start of the current
1292 -- association unless initial token was OTHERS, in which case
1293 -- Expr_Node is set to Empty.
1295 loop
1296 -- Deal with others association first. This is a named association
1298 if No (Expr_Node) then
1299 if No (Assoc_List) then
1300 Assoc_List := New_List;
1301 end if;
1303 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1305 -- Improper use of WITH
1307 elsif Token = Tok_With then
1308 Error_Msg_SC ("WITH must be preceded by single expression in " &
1309 "extension aggregate");
1310 raise Error_Resync;
1312 -- A range attribute can only appear as part of a discrete choice
1313 -- list.
1315 elsif Nkind (Expr_Node) = N_Attribute_Reference
1316 and then Attribute_Name (Expr_Node) = Name_Range
1317 and then Token /= Tok_Arrow
1318 and then Token /= Tok_Vertical_Bar
1319 then
1320 Bad_Range_Attribute (Sloc (Expr_Node));
1321 return Error;
1323 -- Assume positional case if comma, right paren, or literal or
1324 -- identifier or OTHERS follows (the latter cases are missing
1325 -- comma cases). Also assume positional if a semicolon follows,
1326 -- which can happen if there are missing parens
1328 elsif Token = Tok_Comma
1329 or else Token = Tok_Right_Paren
1330 or else Token = Tok_Others
1331 or else Token in Token_Class_Lit_Or_Name
1332 or else Token = Tok_Semicolon
1333 then
1334 if Present (Assoc_List) then
1335 Error_Msg_BC
1336 ("""='>"" expected (positional association cannot follow " &
1337 "named association)");
1338 end if;
1340 if No (Expr_List) then
1341 Expr_List := New_List;
1342 end if;
1344 Append (Expr_Node, Expr_List);
1346 -- Anything else is assumed to be a named association
1348 else
1349 Restore_Scan_State (Scan_State); -- to start of expression
1351 if No (Assoc_List) then
1352 Assoc_List := New_List;
1353 end if;
1355 Append (P_Record_Or_Array_Component_Association, Assoc_List);
1356 end if;
1358 exit when not Comma_Present;
1360 -- If we are at an expression terminator, something is seriously
1361 -- wrong, so let's get out now, before we start eating up stuff
1362 -- that doesn't belong to us!
1364 if Token in Token_Class_Eterm then
1365 Error_Msg_AP ("expecting expression or component association");
1366 exit;
1367 end if;
1369 -- Otherwise initiate for reentry to top of loop by scanning an
1370 -- initial expression, unless the first token is OTHERS.
1372 if Token = Tok_Others then
1373 Expr_Node := Empty;
1374 else
1375 Save_Scan_State (Scan_State); -- at start of expression
1376 Expr_Node := P_Expression_Or_Range_Attribute;
1378 end if;
1379 end loop;
1381 -- All component associations (positional and named) have been scanned
1383 T_Right_Paren;
1384 Set_Expressions (Aggregate_Node, Expr_List);
1385 Set_Component_Associations (Aggregate_Node, Assoc_List);
1386 return Aggregate_Node;
1387 end P_Aggregate_Or_Paren_Expr;
1389 ------------------------------------------------
1390 -- 4.3 Record or Array Component Association --
1391 ------------------------------------------------
1393 -- RECORD_COMPONENT_ASSOCIATION ::=
1394 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1395 -- | COMPONENT_CHOICE_LIST => <>
1397 -- COMPONENT_CHOICE_LIST =>
1398 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1399 -- | others
1401 -- ARRAY_COMPONENT_ASSOCIATION ::=
1402 -- DISCRETE_CHOICE_LIST => EXPRESSION
1403 -- | DISCRETE_CHOICE_LIST => <>
1405 -- Note: this routine only handles the named cases, including others.
1406 -- Cases where the component choice list is not present have already
1407 -- been handled directly.
1409 -- Error recovery: can raise Error_Resync
1411 -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1412 -- rules have been extended to give support to Ada 2005 limited
1413 -- aggregates (AI-287)
1415 function P_Record_Or_Array_Component_Association return Node_Id is
1416 Assoc_Node : Node_Id;
1418 begin
1419 Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1420 Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1421 Set_Sloc (Assoc_Node, Token_Ptr);
1422 TF_Arrow;
1424 if Token = Tok_Box then
1426 -- Ada 2005(AI-287): The box notation is used to indicate the
1427 -- default initialization of limited aggregate components
1429 if Ada_Version < Ada_05 then
1430 Error_Msg_SP
1431 ("limited aggregate is an Ada 2005 extension");
1432 Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1433 end if;
1435 Set_Box_Present (Assoc_Node);
1436 Scan; -- Past box
1437 else
1438 Set_Expression (Assoc_Node, P_Expression);
1439 end if;
1441 return Assoc_Node;
1442 end P_Record_Or_Array_Component_Association;
1444 -----------------------------
1445 -- 4.3.1 Record Aggregate --
1446 -----------------------------
1448 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1449 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1451 ----------------------------------------------
1452 -- 4.3.1 Record Component Association List --
1453 ----------------------------------------------
1455 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1457 ----------------------------------
1458 -- 4.3.1 Component Choice List --
1459 ----------------------------------
1461 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1463 --------------------------------
1464 -- 4.3.1 Extension Aggregate --
1465 --------------------------------
1467 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1469 --------------------------
1470 -- 4.3.1 Ancestor Part --
1471 --------------------------
1473 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1475 ----------------------------
1476 -- 4.3.1 Array Aggregate --
1477 ----------------------------
1479 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1481 ---------------------------------------
1482 -- 4.3.1 Positional Array Aggregate --
1483 ---------------------------------------
1485 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1487 ----------------------------------
1488 -- 4.3.1 Named Array Aggregate --
1489 ----------------------------------
1491 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1493 ----------------------------------------
1494 -- 4.3.1 Array Component Association --
1495 ----------------------------------------
1497 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1499 ---------------------
1500 -- 4.4 Expression --
1501 ---------------------
1503 -- EXPRESSION ::=
1504 -- RELATION {and RELATION} | RELATION {and then RELATION}
1505 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1506 -- | RELATION {xor RELATION}
1508 -- On return, Expr_Form indicates the categorization of the expression
1509 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1510 -- an error message is given, and Error is returned).
1512 -- Error recovery: cannot raise Error_Resync
1514 function P_Expression return Node_Id is
1515 Logical_Op : Node_Kind;
1516 Prev_Logical_Op : Node_Kind;
1517 Op_Location : Source_Ptr;
1518 Node1 : Node_Id;
1519 Node2 : Node_Id;
1521 begin
1522 Node1 := P_Relation;
1524 if Token in Token_Class_Logop then
1525 Prev_Logical_Op := N_Empty;
1527 loop
1528 Op_Location := Token_Ptr;
1529 Logical_Op := P_Logical_Operator;
1531 if Prev_Logical_Op /= N_Empty and then
1532 Logical_Op /= Prev_Logical_Op
1533 then
1534 Error_Msg
1535 ("mixed logical operators in expression", Op_Location);
1536 Prev_Logical_Op := N_Empty;
1537 else
1538 Prev_Logical_Op := Logical_Op;
1539 end if;
1541 Node2 := Node1;
1542 Node1 := New_Node (Logical_Op, Op_Location);
1543 Set_Left_Opnd (Node1, Node2);
1544 Set_Right_Opnd (Node1, P_Relation);
1545 Set_Op_Name (Node1);
1546 exit when Token not in Token_Class_Logop;
1547 end loop;
1549 Expr_Form := EF_Non_Simple;
1550 end if;
1552 if Token = Tok_Apostrophe then
1553 Bad_Range_Attribute (Token_Ptr);
1554 return Error;
1555 else
1556 return Node1;
1557 end if;
1559 end P_Expression;
1561 -- This function is identical to the normal P_Expression, except that it
1562 -- checks that the expression scan did not stop on a right paren. It is
1563 -- called in all contexts where a right parenthesis cannot legitimately
1564 -- follow an expression.
1566 -- Error recovery: can raise Error_Resync
1568 function P_Expression_No_Right_Paren return Node_Id is
1569 begin
1570 return No_Right_Paren (P_Expression);
1571 end P_Expression_No_Right_Paren;
1573 ----------------------------------------
1574 -- 4.4 Expression_Or_Range_Attribute --
1575 ----------------------------------------
1577 -- EXPRESSION ::=
1578 -- RELATION {and RELATION} | RELATION {and then RELATION}
1579 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1580 -- | RELATION {xor RELATION}
1582 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1584 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1586 -- On return, Expr_Form indicates the categorization of the expression
1587 -- and EF_Range_Attr is one of the possibilities.
1589 -- Error recovery: cannot raise Error_Resync
1591 -- In the grammar, a RANGE attribute is simply a name, but its use is
1592 -- highly restricted, so in the parser, we do not regard it as a name.
1593 -- Instead, P_Name returns without scanning the 'RANGE part of the
1594 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1595 -- attribute reference. In the normal case where a range attribute is
1596 -- not allowed, an error message is issued by P_Expression.
1598 function P_Expression_Or_Range_Attribute return Node_Id is
1599 Logical_Op : Node_Kind;
1600 Prev_Logical_Op : Node_Kind;
1601 Op_Location : Source_Ptr;
1602 Node1 : Node_Id;
1603 Node2 : Node_Id;
1604 Attr_Node : Node_Id;
1606 begin
1607 Node1 := P_Relation;
1609 if Token = Tok_Apostrophe then
1610 Attr_Node := P_Range_Attribute_Reference (Node1);
1611 Expr_Form := EF_Range_Attr;
1612 return Attr_Node;
1614 elsif Token in Token_Class_Logop then
1615 Prev_Logical_Op := N_Empty;
1617 loop
1618 Op_Location := Token_Ptr;
1619 Logical_Op := P_Logical_Operator;
1621 if Prev_Logical_Op /= N_Empty and then
1622 Logical_Op /= Prev_Logical_Op
1623 then
1624 Error_Msg
1625 ("mixed logical operators in expression", Op_Location);
1626 Prev_Logical_Op := N_Empty;
1627 else
1628 Prev_Logical_Op := Logical_Op;
1629 end if;
1631 Node2 := Node1;
1632 Node1 := New_Node (Logical_Op, Op_Location);
1633 Set_Left_Opnd (Node1, Node2);
1634 Set_Right_Opnd (Node1, P_Relation);
1635 Set_Op_Name (Node1);
1636 exit when Token not in Token_Class_Logop;
1637 end loop;
1639 Expr_Form := EF_Non_Simple;
1640 end if;
1642 if Token = Tok_Apostrophe then
1643 Bad_Range_Attribute (Token_Ptr);
1644 return Error;
1645 else
1646 return Node1;
1647 end if;
1648 end P_Expression_Or_Range_Attribute;
1650 -------------------
1651 -- 4.4 Relation --
1652 -------------------
1654 -- RELATION ::=
1655 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1656 -- | SIMPLE_EXPRESSION [not] in RANGE
1657 -- | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1659 -- On return, Expr_Form indicates the categorization of the expression
1661 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1662 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1664 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1665 -- expression, then tokens are scanned until either a non-expression token,
1666 -- a right paren (not matched by a left paren) or a comma, is encountered.
1668 function P_Relation return Node_Id is
1669 Node1, Node2 : Node_Id;
1670 Optok : Source_Ptr;
1672 begin
1673 Node1 := P_Simple_Expression;
1675 if Token not in Token_Class_Relop then
1676 return Node1;
1678 else
1679 -- Here we have a relational operator following. If so then scan it
1680 -- out. Note that the assignment symbol := is treated as a relational
1681 -- operator to improve the error recovery when it is misused for =.
1682 -- P_Relational_Operator also parses the IN and NOT IN operations.
1684 Optok := Token_Ptr;
1685 Node2 := New_Node (P_Relational_Operator, Optok);
1686 Set_Left_Opnd (Node2, Node1);
1687 Set_Op_Name (Node2);
1689 -- Case of IN or NOT IN
1691 if Prev_Token = Tok_In then
1692 Set_Right_Opnd (Node2, P_Range_Or_Subtype_Mark);
1694 -- Case of relational operator (= /= < <= > >=)
1696 else
1697 Set_Right_Opnd (Node2, P_Simple_Expression);
1698 end if;
1700 Expr_Form := EF_Non_Simple;
1702 if Token in Token_Class_Relop then
1703 Error_Msg_SC ("unexpected relational operator");
1704 raise Error_Resync;
1705 end if;
1707 return Node2;
1708 end if;
1710 -- If any error occurs, then scan to the next expression terminator symbol
1711 -- or comma or right paren at the outer (i.e. current) parentheses level.
1712 -- The flags are set to indicate a normal simple expression.
1714 exception
1715 when Error_Resync =>
1716 Resync_Expression;
1717 Expr_Form := EF_Simple;
1718 return Error;
1719 end P_Relation;
1721 ----------------------------
1722 -- 4.4 Simple Expression --
1723 ----------------------------
1725 -- SIMPLE_EXPRESSION ::=
1726 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1728 -- On return, Expr_Form indicates the categorization of the expression
1730 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1731 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1733 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1734 -- expression, then tokens are scanned until either a non-expression token,
1735 -- a right paren (not matched by a left paren) or a comma, is encountered.
1737 -- Note: P_Simple_Expression is called only internally by higher level
1738 -- expression routines. In cases in the grammar where a simple expression
1739 -- is required, the approach is to scan an expression, and then post an
1740 -- appropriate error message if the expression obtained is not simple. This
1741 -- gives better error recovery and treatment.
1743 function P_Simple_Expression return Node_Id is
1744 Scan_State : Saved_Scan_State;
1745 Node1 : Node_Id;
1746 Node2 : Node_Id;
1747 Tokptr : Source_Ptr;
1749 begin
1750 -- Check for cases starting with a name. There are two reasons for
1751 -- special casing. First speed things up by catching a common case
1752 -- without going through several routine layers. Second the caller must
1753 -- be informed via Expr_Form when the simple expression is a name.
1755 if Token in Token_Class_Name then
1756 Node1 := P_Name;
1758 -- Deal with apostrophe cases
1760 if Token = Tok_Apostrophe then
1761 Save_Scan_State (Scan_State); -- at apostrophe
1762 Scan; -- past apostrophe
1764 -- If qualified expression, scan it out and fall through
1766 if Token = Tok_Left_Paren then
1767 Node1 := P_Qualified_Expression (Node1);
1768 Expr_Form := EF_Simple;
1770 -- If range attribute, then we return with Token pointing to the
1771 -- apostrophe. Note: avoid the normal error check on exit. We
1772 -- know that the expression really is complete in this case!
1774 else -- Token = Tok_Range then
1775 Restore_Scan_State (Scan_State); -- to apostrophe
1776 Expr_Form := EF_Simple_Name;
1777 return Node1;
1778 end if;
1779 end if;
1781 -- If an expression terminator follows, the previous processing
1782 -- completely scanned out the expression (a common case), and
1783 -- left Expr_Form set appropriately for returning to our caller.
1785 if Token in Token_Class_Sterm then
1786 null;
1788 -- If we do not have an expression terminator, then complete the
1789 -- scan of a simple expression. This code duplicates the code
1790 -- found in P_Term and P_Factor.
1792 else
1793 if Token = Tok_Double_Asterisk then
1794 if Style_Check then Style.Check_Exponentiation_Operator; end if;
1795 Node2 := New_Node (N_Op_Expon, Token_Ptr);
1796 Scan; -- past **
1797 Set_Left_Opnd (Node2, Node1);
1798 Set_Right_Opnd (Node2, P_Primary);
1799 Set_Op_Name (Node2);
1800 Node1 := Node2;
1801 end if;
1803 loop
1804 exit when Token not in Token_Class_Mulop;
1805 Tokptr := Token_Ptr;
1806 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1807 if Style_Check then Style.Check_Binary_Operator; end if;
1808 Scan; -- past operator
1809 Set_Left_Opnd (Node2, Node1);
1810 Set_Right_Opnd (Node2, P_Factor);
1811 Set_Op_Name (Node2);
1812 Node1 := Node2;
1813 end loop;
1815 loop
1816 exit when Token not in Token_Class_Binary_Addop;
1817 Tokptr := Token_Ptr;
1818 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1819 if Style_Check then Style.Check_Binary_Operator; end if;
1820 Scan; -- past operator
1821 Set_Left_Opnd (Node2, Node1);
1822 Set_Right_Opnd (Node2, P_Term);
1823 Set_Op_Name (Node2);
1824 Node1 := Node2;
1825 end loop;
1827 Expr_Form := EF_Simple;
1828 end if;
1830 -- Cases where simple expression does not start with a name
1832 else
1833 -- Scan initial sign and initial Term
1835 if Token in Token_Class_Unary_Addop then
1836 Tokptr := Token_Ptr;
1837 Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
1838 if Style_Check then Style.Check_Unary_Plus_Or_Minus; end if;
1839 Scan; -- past operator
1840 Set_Right_Opnd (Node1, P_Term);
1841 Set_Op_Name (Node1);
1842 else
1843 Node1 := P_Term;
1844 end if;
1846 -- Scan out sequence of terms separated by binary adding operators
1848 loop
1849 exit when Token not in Token_Class_Binary_Addop;
1850 Tokptr := Token_Ptr;
1851 Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1852 Scan; -- past operator
1853 Set_Left_Opnd (Node2, Node1);
1854 Set_Right_Opnd (Node2, P_Term);
1855 Set_Op_Name (Node2);
1856 Node1 := Node2;
1857 end loop;
1859 -- All done, we clearly do not have name or numeric literal so this
1860 -- is a case of a simple expression which is some other possibility.
1862 Expr_Form := EF_Simple;
1863 end if;
1865 -- Come here at end of simple expression, where we do a couple of
1866 -- special checks to improve error recovery.
1868 -- Special test to improve error recovery. If the current token
1869 -- is a period, then someone is trying to do selection on something
1870 -- that is not a name, e.g. a qualified expression.
1872 if Token = Tok_Dot then
1873 Error_Msg_SC ("prefix for selection is not a name");
1874 raise Error_Resync;
1875 end if;
1877 -- Special test to improve error recovery: If the current token is
1878 -- not the first token on a line (as determined by checking the
1879 -- previous token position with the start of the current line),
1880 -- then we insist that we have an appropriate terminating token.
1881 -- Consider the following two examples:
1883 -- 1) if A nad B then ...
1885 -- 2) A := B
1886 -- C := D
1888 -- In the first example, we would like to issue a binary operator
1889 -- expected message and resynchronize to the then. In the second
1890 -- example, we do not want to issue a binary operator message, so
1891 -- that instead we will get the missing semicolon message. This
1892 -- distinction is of course a heuristic which does not always work,
1893 -- but in practice it is quite effective.
1895 -- Note: the one case in which we do not go through this circuit is
1896 -- when we have scanned a range attribute and want to return with
1897 -- Token pointing to the apostrophe. The apostrophe is not normally
1898 -- an expression terminator, and is not in Token_Class_Sterm, but
1899 -- in this special case we know that the expression is complete.
1901 if not Token_Is_At_Start_Of_Line
1902 and then Token not in Token_Class_Sterm
1903 then
1904 Error_Msg_AP ("binary operator expected");
1905 raise Error_Resync;
1906 else
1907 return Node1;
1908 end if;
1910 -- If any error occurs, then scan to next expression terminator symbol
1911 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
1912 -- level. Expr_Form is set to indicate a normal simple expression.
1914 exception
1915 when Error_Resync =>
1916 Resync_Expression;
1917 Expr_Form := EF_Simple;
1918 return Error;
1920 end P_Simple_Expression;
1922 -----------------------------------------------
1923 -- 4.4 Simple Expression or Range Attribute --
1924 -----------------------------------------------
1926 -- SIMPLE_EXPRESSION ::=
1927 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1929 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1931 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1933 -- Error recovery: cannot raise Error_Resync
1935 function P_Simple_Expression_Or_Range_Attribute return Node_Id is
1936 Sexpr : Node_Id;
1937 Attr_Node : Node_Id;
1939 begin
1940 Sexpr := P_Simple_Expression;
1942 if Token = Tok_Apostrophe then
1943 Attr_Node := P_Range_Attribute_Reference (Sexpr);
1944 Expr_Form := EF_Range_Attr;
1945 return Attr_Node;
1947 else
1948 return Sexpr;
1949 end if;
1950 end P_Simple_Expression_Or_Range_Attribute;
1952 ---------------
1953 -- 4.4 Term --
1954 ---------------
1956 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
1958 -- Error recovery: can raise Error_Resync
1960 function P_Term return Node_Id is
1961 Node1, Node2 : Node_Id;
1962 Tokptr : Source_Ptr;
1964 begin
1965 Node1 := P_Factor;
1967 loop
1968 exit when Token not in Token_Class_Mulop;
1969 Tokptr := Token_Ptr;
1970 Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1971 Scan; -- past operator
1972 Set_Left_Opnd (Node2, Node1);
1973 Set_Right_Opnd (Node2, P_Factor);
1974 Set_Op_Name (Node2);
1975 Node1 := Node2;
1976 end loop;
1978 return Node1;
1979 end P_Term;
1981 -----------------
1982 -- 4.4 Factor --
1983 -----------------
1985 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
1987 -- Error recovery: can raise Error_Resync
1989 function P_Factor return Node_Id is
1990 Node1 : Node_Id;
1991 Node2 : Node_Id;
1993 begin
1994 if Token = Tok_Abs then
1995 Node1 := New_Node (N_Op_Abs, Token_Ptr);
1996 if Style_Check then Style.Check_Abs_Not; end if;
1997 Scan; -- past ABS
1998 Set_Right_Opnd (Node1, P_Primary);
1999 Set_Op_Name (Node1);
2000 return Node1;
2002 elsif Token = Tok_Not then
2003 Node1 := New_Node (N_Op_Not, Token_Ptr);
2004 if Style_Check then Style.Check_Abs_Not; end if;
2005 Scan; -- past NOT
2006 Set_Right_Opnd (Node1, P_Primary);
2007 Set_Op_Name (Node1);
2008 return Node1;
2010 else
2011 Node1 := P_Primary;
2013 if Token = Tok_Double_Asterisk then
2014 Node2 := New_Node (N_Op_Expon, Token_Ptr);
2015 Scan; -- past **
2016 Set_Left_Opnd (Node2, Node1);
2017 Set_Right_Opnd (Node2, P_Primary);
2018 Set_Op_Name (Node2);
2019 return Node2;
2020 else
2021 return Node1;
2022 end if;
2023 end if;
2024 end P_Factor;
2026 ------------------
2027 -- 4.4 Primary --
2028 ------------------
2030 -- PRIMARY ::=
2031 -- NUMERIC_LITERAL | null
2032 -- | STRING_LITERAL | AGGREGATE
2033 -- | NAME | QUALIFIED_EXPRESSION
2034 -- | ALLOCATOR | (EXPRESSION)
2036 -- Error recovery: can raise Error_Resync
2038 function P_Primary return Node_Id is
2039 Scan_State : Saved_Scan_State;
2040 Node1 : Node_Id;
2042 begin
2043 -- The loop runs more than once only if misplaced pragmas are found
2045 loop
2046 case Token is
2048 -- Name token can start a name, call or qualified expression, all
2049 -- of which are acceptable possibilities for primary. Note also
2050 -- that string literal is included in name (as operator symbol)
2051 -- and type conversion is included in name (as indexed component).
2053 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2054 Node1 := P_Name;
2056 -- All done unless apostrophe follows
2058 if Token /= Tok_Apostrophe then
2059 return Node1;
2061 -- Apostrophe following means that we have either just parsed
2062 -- the subtype mark of a qualified expression, or the prefix
2063 -- or a range attribute.
2065 else -- Token = Tok_Apostrophe
2066 Save_Scan_State (Scan_State); -- at apostrophe
2067 Scan; -- past apostrophe
2069 -- If range attribute, then this is always an error, since
2070 -- the only legitimate case (where the scanned expression is
2071 -- a qualified simple name) is handled at the level of the
2072 -- Simple_Expression processing. This case corresponds to a
2073 -- usage such as 3 + A'Range, which is always illegal.
2075 if Token = Tok_Range then
2076 Restore_Scan_State (Scan_State); -- to apostrophe
2077 Bad_Range_Attribute (Token_Ptr);
2078 return Error;
2080 -- If left paren, then we have a qualified expression.
2081 -- Note that P_Name guarantees that in this case, where
2082 -- Token = Tok_Apostrophe on return, the only two possible
2083 -- tokens following the apostrophe are left paren and
2084 -- RANGE, so we know we have a left paren here.
2086 else -- Token = Tok_Left_Paren
2087 return P_Qualified_Expression (Node1);
2089 end if;
2090 end if;
2092 -- Numeric or string literal
2094 when Tok_Integer_Literal |
2095 Tok_Real_Literal |
2096 Tok_String_Literal =>
2098 Node1 := Token_Node;
2099 Scan; -- past number
2100 return Node1;
2102 -- Left paren, starts aggregate or parenthesized expression
2104 when Tok_Left_Paren =>
2105 return P_Aggregate_Or_Paren_Expr;
2107 -- Allocator
2109 when Tok_New =>
2110 return P_Allocator;
2112 -- Null
2114 when Tok_Null =>
2115 Scan; -- past NULL
2116 return New_Node (N_Null, Prev_Token_Ptr);
2118 -- Pragma, not allowed here, so just skip past it
2120 when Tok_Pragma =>
2121 P_Pragmas_Misplaced;
2123 -- Anything else is illegal as the first token of a primary, but
2124 -- we test for a reserved identifier so that it is treated nicely
2126 when others =>
2127 if Is_Reserved_Identifier then
2128 return P_Identifier;
2130 elsif Prev_Token = Tok_Comma then
2131 Error_Msg_SP ("extra "","" ignored");
2132 raise Error_Resync;
2134 else
2135 Error_Msg_AP ("missing operand");
2136 raise Error_Resync;
2137 end if;
2139 end case;
2140 end loop;
2141 end P_Primary;
2143 ---------------------------
2144 -- 4.5 Logical Operator --
2145 ---------------------------
2147 -- LOGICAL_OPERATOR ::= and | or | xor
2149 -- Note: AND THEN and OR ELSE are also treated as logical operators
2150 -- by the parser (even though they are not operators semantically)
2152 -- The value returned is the appropriate Node_Kind code for the operator
2153 -- On return, Token points to the token following the scanned operator.
2155 -- The caller has checked that the first token is a legitimate logical
2156 -- operator token (i.e. is either XOR, AND, OR).
2158 -- Error recovery: cannot raise Error_Resync
2160 function P_Logical_Operator return Node_Kind is
2161 begin
2162 if Token = Tok_And then
2163 if Style_Check then Style.Check_Binary_Operator; end if;
2164 Scan; -- past AND
2166 if Token = Tok_Then then
2167 Scan; -- past THEN
2168 return N_And_Then;
2169 else
2170 return N_Op_And;
2171 end if;
2173 elsif Token = Tok_Or then
2174 if Style_Check then Style.Check_Binary_Operator; end if;
2175 Scan; -- past OR
2177 if Token = Tok_Else then
2178 Scan; -- past ELSE
2179 return N_Or_Else;
2180 else
2181 return N_Op_Or;
2182 end if;
2184 else -- Token = Tok_Xor
2185 if Style_Check then Style.Check_Binary_Operator; end if;
2186 Scan; -- past XOR
2187 return N_Op_Xor;
2188 end if;
2189 end P_Logical_Operator;
2191 ------------------------------
2192 -- 4.5 Relational Operator --
2193 ------------------------------
2195 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2197 -- The value returned is the appropriate Node_Kind code for the operator.
2198 -- On return, Token points to the operator token, NOT past it.
2200 -- The caller has checked that the first token is a legitimate relational
2201 -- operator token (i.e. is one of the operator tokens listed above).
2203 -- Error recovery: cannot raise Error_Resync
2205 function P_Relational_Operator return Node_Kind is
2206 Op_Kind : Node_Kind;
2207 Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2208 (Tok_Less => N_Op_Lt,
2209 Tok_Equal => N_Op_Eq,
2210 Tok_Greater => N_Op_Gt,
2211 Tok_Not_Equal => N_Op_Ne,
2212 Tok_Greater_Equal => N_Op_Ge,
2213 Tok_Less_Equal => N_Op_Le,
2214 Tok_In => N_In,
2215 Tok_Not => N_Not_In,
2216 Tok_Box => N_Op_Ne);
2218 begin
2219 if Token = Tok_Box then
2220 Error_Msg_SC ("""'<'>"" should be ""/=""");
2221 end if;
2223 Op_Kind := Relop_Node (Token);
2224 if Style_Check then Style.Check_Binary_Operator; end if;
2225 Scan; -- past operator token
2227 if Prev_Token = Tok_Not then
2228 T_In;
2229 end if;
2231 return Op_Kind;
2232 end P_Relational_Operator;
2234 ---------------------------------
2235 -- 4.5 Binary Adding Operator --
2236 ---------------------------------
2238 -- BINARY_ADDING_OPERATOR ::= + | - | &
2240 -- The value returned is the appropriate Node_Kind code for the operator.
2241 -- On return, Token points to the operator token (NOT past it).
2243 -- The caller has checked that the first token is a legitimate adding
2244 -- operator token (i.e. is one of the operator tokens listed above).
2246 -- Error recovery: cannot raise Error_Resync
2248 function P_Binary_Adding_Operator return Node_Kind is
2249 Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2250 (Tok_Ampersand => N_Op_Concat,
2251 Tok_Minus => N_Op_Subtract,
2252 Tok_Plus => N_Op_Add);
2253 begin
2254 return Addop_Node (Token);
2255 end P_Binary_Adding_Operator;
2257 --------------------------------
2258 -- 4.5 Unary Adding Operator --
2259 --------------------------------
2261 -- UNARY_ADDING_OPERATOR ::= + | -
2263 -- The value returned is the appropriate Node_Kind code for the operator.
2264 -- On return, Token points to the operator token (NOT past it).
2266 -- The caller has checked that the first token is a legitimate adding
2267 -- operator token (i.e. is one of the operator tokens listed above).
2269 -- Error recovery: cannot raise Error_Resync
2271 function P_Unary_Adding_Operator return Node_Kind is
2272 Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2273 (Tok_Minus => N_Op_Minus,
2274 Tok_Plus => N_Op_Plus);
2275 begin
2276 return Addop_Node (Token);
2277 end P_Unary_Adding_Operator;
2279 -------------------------------
2280 -- 4.5 Multiplying Operator --
2281 -------------------------------
2283 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
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 multiplying
2289 -- operator token (i.e. is one of the operator tokens listed above).
2291 -- Error recovery: cannot raise Error_Resync
2293 function P_Multiplying_Operator return Node_Kind is
2294 Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2295 (Tok_Asterisk => N_Op_Multiply,
2296 Tok_Mod => N_Op_Mod,
2297 Tok_Rem => N_Op_Rem,
2298 Tok_Slash => N_Op_Divide);
2299 begin
2300 return Mulop_Node (Token);
2301 end P_Multiplying_Operator;
2303 --------------------------------------
2304 -- 4.5 Highest Precedence Operator --
2305 --------------------------------------
2307 -- Parsed by P_Factor (4.4)
2309 -- Note: this rule is not in fact used by the grammar at any point!
2311 --------------------------
2312 -- 4.6 Type Conversion --
2313 --------------------------
2315 -- Parsed by P_Primary as a Name (4.1)
2317 -------------------------------
2318 -- 4.7 Qualified Expression --
2319 -------------------------------
2321 -- QUALIFIED_EXPRESSION ::=
2322 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2324 -- The caller has scanned the name which is the Subtype_Mark parameter
2325 -- and scanned past the single quote following the subtype mark. The
2326 -- caller has not checked that this name is in fact appropriate for
2327 -- a subtype mark name (i.e. it is a selected component or identifier).
2329 -- Error_Recovery: cannot raise Error_Resync
2331 function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2332 Qual_Node : Node_Id;
2333 begin
2334 Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2335 Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2336 Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2337 return Qual_Node;
2338 end P_Qualified_Expression;
2340 --------------------
2341 -- 4.8 Allocator --
2342 --------------------
2344 -- ALLOCATOR ::=
2345 -- new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2347 -- The caller has checked that the initial token is NEW
2349 -- Error recovery: can raise Error_Resync
2351 function P_Allocator return Node_Id is
2352 Alloc_Node : Node_Id;
2353 Type_Node : Node_Id;
2354 Null_Exclusion_Present : Boolean;
2356 begin
2357 Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2358 T_New;
2360 -- Scan Null_Exclusion if present (Ada 2005 (AI-231))
2362 Null_Exclusion_Present := P_Null_Exclusion;
2363 Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
2364 Type_Node := P_Subtype_Mark_Resync;
2366 if Token = Tok_Apostrophe then
2367 Scan; -- past apostrophe
2368 Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2369 else
2370 Set_Expression
2371 (Alloc_Node,
2372 P_Subtype_Indication (Type_Node, Null_Exclusion_Present));
2373 end if;
2375 return Alloc_Node;
2376 end P_Allocator;
2378 end Ch4;