1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 pragma Style_Checks
(All_Checks
);
29 -- Turn off subprogram body ordering check. Subprograms are in order
30 -- by RM section rather than alphabetical
35 -----------------------
36 -- Local Subprograms --
37 -----------------------
39 function P_Aggregate_Or_Paren_Expr
return Node_Id
;
40 function P_Allocator
return Node_Id
;
41 function P_Record_Or_Array_Component_Association
return Node_Id
;
42 function P_Factor
return Node_Id
;
43 function P_Primary
return Node_Id
;
44 function P_Relation
return Node_Id
;
45 function P_Term
return Node_Id
;
47 function P_Binary_Adding_Operator
return Node_Kind
;
48 function P_Logical_Operator
return Node_Kind
;
49 function P_Multiplying_Operator
return Node_Kind
;
50 function P_Relational_Operator
return Node_Kind
;
51 function P_Unary_Adding_Operator
return Node_Kind
;
53 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
);
54 -- Called to place complaint about bad range attribute at the given
55 -- source location. Terminates by raising Error_Resync.
57 function P_Range_Attribute_Reference
58 (Prefix_Node
: Node_Id
)
60 -- Scan a range attribute reference. The caller has scanned out the
61 -- prefix. The current token is known to be an apostrophe and the
62 -- following token is known to be RANGE.
64 procedure Set_Op_Name
(Node
: Node_Id
);
65 -- Procedure to set name field (Chars) in operator node
67 -------------------------
68 -- Bad_Range_Attribute --
69 -------------------------
71 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
73 Error_Msg
("range attribute cannot be used in expression", Loc
);
75 end Bad_Range_Attribute
;
81 procedure Set_Op_Name
(Node
: Node_Id
) is
82 type Name_Of_Type
is array (N_Op
) of Name_Id
;
83 Name_Of
: Name_Of_Type
:= Name_Of_Type
'(
84 N_Op_And => Name_Op_And,
85 N_Op_Or => Name_Op_Or,
86 N_Op_Xor => Name_Op_Xor,
87 N_Op_Eq => Name_Op_Eq,
88 N_Op_Ne => Name_Op_Ne,
89 N_Op_Lt => Name_Op_Lt,
90 N_Op_Le => Name_Op_Le,
91 N_Op_Gt => Name_Op_Gt,
92 N_Op_Ge => Name_Op_Ge,
93 N_Op_Add => Name_Op_Add,
94 N_Op_Subtract => Name_Op_Subtract,
95 N_Op_Concat => Name_Op_Concat,
96 N_Op_Multiply => Name_Op_Multiply,
97 N_Op_Divide => Name_Op_Divide,
98 N_Op_Mod => Name_Op_Mod,
99 N_Op_Rem => Name_Op_Rem,
100 N_Op_Expon => Name_Op_Expon,
101 N_Op_Plus => Name_Op_Add,
102 N_Op_Minus => Name_Op_Subtract,
103 N_Op_Abs => Name_Op_Abs,
104 N_Op_Not => Name_Op_Not,
106 -- We don't really need these shift operators, since they never
107 -- appear as operators in the source, but the path of least
108 -- resistance is to put them in (the aggregate must be complete)
110 N_Op_Rotate_Left => Name_Rotate_Left,
111 N_Op_Rotate_Right => Name_Rotate_Right,
112 N_Op_Shift_Left => Name_Shift_Left,
113 N_Op_Shift_Right => Name_Shift_Right,
114 N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
117 if Nkind (Node) in N_Op then
118 Set_Chars (Node, Name_Of (Nkind (Node)));
122 --------------------------
123 -- 4.1 Name (also 6.4) --
124 --------------------------
127 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
128 -- | INDEXED_COMPONENT | SLICE
129 -- | SELECTED_COMPONENT | ATTRIBUTE
130 -- | TYPE_CONVERSION | FUNCTION_CALL
131 -- | CHARACTER_LITERAL
133 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
135 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
137 -- EXPLICIT_DEREFERENCE ::= NAME . all
139 -- IMPLICIT_DEREFERENCE ::= NAME
141 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
143 -- SLICE ::= PREFIX (DISCRETE_RANGE)
145 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
147 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
149 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
151 -- ATTRIBUTE_DESIGNATOR ::=
152 -- IDENTIFIER [(static_EXPRESSION)]
153 -- | access | delta | digits
157 -- | function_PREFIX ACTUAL_PARAMETER_PART
159 -- ACTUAL_PARAMETER_PART ::=
160 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
162 -- PARAMETER_ASSOCIATION ::=
163 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
165 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
167 -- Note: syntactically a procedure call looks just like a function call,
168 -- so this routine is in practice used to scan out procedure calls as well.
170 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
172 -- Error recovery: can raise Error_Resync
174 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
175 -- followed by either a left paren (qualified expression case), or by
176 -- range (range attribute case). All other uses of apostrophe (i.e. all
177 -- other attributes) are handled in this routine.
179 -- Error recovery: can raise Error_Resync
181 function P_Name
return Node_Id
is
182 Scan_State
: Saved_Scan_State
;
184 Prefix_Node
: Node_Id
;
185 Ident_Node
: Node_Id
;
187 Range_Node
: Node_Id
;
190 Arg_List
: List_Id
:= No_List
; -- kill junk warning
191 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
194 if Token
not in Token_Class_Name
then
195 Error_Msg_AP
("name expected");
199 -- Loop through designators in qualified name
201 Name_Node
:= Token_Node
;
204 Scan
; -- past designator
205 exit when Token
/= Tok_Dot
;
206 Save_Scan_State
(Scan_State
); -- at dot
209 -- If we do not have another designator after the dot, then join
210 -- the normal circuit to handle a dot extension (may be .all or
211 -- character literal case). Otherwise loop back to scan the next
214 if Token
not in Token_Class_Desig
then
215 goto Scan_Name_Extension_Dot
;
217 Prefix_Node
:= Name_Node
;
218 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
219 Set_Prefix
(Name_Node
, Prefix_Node
);
220 Set_Selector_Name
(Name_Node
, Token_Node
);
224 -- We have now scanned out a qualified designator. If the last token is
225 -- an operator symbol, then we certainly do not have the Snam case, so
226 -- we can just use the normal name extension check circuit
228 if Prev_Token
= Tok_Operator_Symbol
then
229 goto Scan_Name_Extension
;
232 -- We have scanned out a qualified simple name, check for name extension
233 -- Note that we know there is no dot here at this stage, so the only
234 -- possible cases of name extension are apostrophe and left paren.
236 if Token
= Tok_Apostrophe
then
237 Save_Scan_State
(Scan_State
); -- at apostrophe
238 Scan
; -- past apostrophe
240 -- If left paren, then this might be a qualified expression, but we
241 -- are only in the business of scanning out names, so return with
242 -- Token backed up to point to the apostrophe. The treatment for
243 -- the range attribute is similar (we do not consider x'range to
244 -- be a name in this grammar).
246 if Token
= Tok_Left_Paren
or else Token
= Tok_Range
then
247 Restore_Scan_State
(Scan_State
); -- to apostrophe
248 Expr_Form
:= EF_Simple_Name
;
251 -- Otherwise we have the case of a name extended by an attribute
254 goto Scan_Name_Extension_Apostrophe
;
257 -- Check case of qualified simple name extended by a left parenthesis
259 elsif Token
= Tok_Left_Paren
then
260 Scan
; -- past left paren
261 goto Scan_Name_Extension_Left_Paren
;
263 -- Otherwise the qualified simple name is not extended, so return
266 Expr_Form
:= EF_Simple_Name
;
270 -- Loop scanning past name extensions. A label is used for control
271 -- transfer for this loop for ease of interfacing with the finite state
272 -- machine in the parenthesis scanning circuit, and also to allow for
273 -- passing in control to the appropriate point from the above code.
275 <<Scan_Name_Extension
>>
277 -- Character literal used as name cannot be extended. Also this
278 -- cannot be a call, since the name for a call must be a designator.
279 -- Return in these cases, or if there is no name extension
281 if Token
not in Token_Class_Namext
282 or else Prev_Token
= Tok_Char_Literal
284 Expr_Form
:= EF_Name
;
288 -- Merge here when we know there is a name extension
290 <<Scan_Name_Extension_OK
>>
292 if Token
= Tok_Left_Paren
then
293 Scan
; -- past left paren
294 goto Scan_Name_Extension_Left_Paren
;
296 elsif Token
= Tok_Apostrophe
then
297 Save_Scan_State
(Scan_State
); -- at apostrophe
298 Scan
; -- past apostrophe
299 goto Scan_Name_Extension_Apostrophe
;
301 else -- Token = Tok_Dot
302 Save_Scan_State
(Scan_State
); -- at dot
304 goto Scan_Name_Extension_Dot
;
307 -- Case of name extended by dot (selection), dot is already skipped
308 -- and the scan state at the point of the dot is saved in Scan_State.
310 <<Scan_Name_Extension_Dot
>>
312 -- Explicit dereference case
314 if Token
= Tok_All
then
315 Prefix_Node
:= Name_Node
;
316 Name_Node
:= New_Node
(N_Explicit_Dereference
, Token_Ptr
);
317 Set_Prefix
(Name_Node
, Prefix_Node
);
319 goto Scan_Name_Extension
;
321 -- Selected component case
323 elsif Token
in Token_Class_Name
then
324 Prefix_Node
:= Name_Node
;
325 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
326 Set_Prefix
(Name_Node
, Prefix_Node
);
327 Set_Selector_Name
(Name_Node
, Token_Node
);
328 Scan
; -- past selector
329 goto Scan_Name_Extension
;
331 -- Reserved identifier as selector
333 elsif Is_Reserved_Identifier
then
334 Scan_Reserved_Identifier
(Force_Msg
=> False);
335 Prefix_Node
:= Name_Node
;
336 Name_Node
:= New_Node
(N_Selected_Component
, Prev_Token_Ptr
);
337 Set_Prefix
(Name_Node
, Prefix_Node
);
338 Set_Selector_Name
(Name_Node
, Token_Node
);
339 Scan
; -- past identifier used as selector
340 goto Scan_Name_Extension
;
342 -- If dot is at end of line and followed by nothing legal,
343 -- then assume end of name and quit (dot will be taken as
344 -- an erroneous form of some other punctuation by our caller).
346 elsif Token_Is_At_Start_Of_Line
then
347 Restore_Scan_State
(Scan_State
);
350 -- Here if nothing legal after the dot
353 Error_Msg_AP
("selector expected");
357 -- Here for an apostrophe as name extension. The scan position at the
358 -- apostrophe has already been saved, and the apostrophe scanned out.
360 <<Scan_Name_Extension_Apostrophe
>>
362 Scan_Apostrophe
: declare
363 function Apostrophe_Should_Be_Semicolon
return Boolean;
364 -- Checks for case where apostrophe should probably be
365 -- a semicolon, and if so, gives appropriate message,
366 -- resets the scan pointer to the apostrophe, changes
367 -- the current token to Tok_Semicolon, and returns True.
368 -- Otherwise returns False.
370 function Apostrophe_Should_Be_Semicolon
return Boolean is
372 if Token_Is_At_Start_Of_Line
then
373 Restore_Scan_State
(Scan_State
); -- to apostrophe
374 Error_Msg_SC
("""''"" should be "";""");
375 Token
:= Tok_Semicolon
;
380 end Apostrophe_Should_Be_Semicolon
;
382 -- Start of processing for Scan_Apostrophe
385 -- If range attribute after apostrophe, then return with Token
386 -- pointing to the apostrophe. Note that in this case the prefix
387 -- need not be a simple name (cases like A.all'range). Similarly
388 -- if there is a left paren after the apostrophe, then we also
389 -- return with Token pointing to the apostrophe (this is the
390 -- qualified expression case).
392 if Token
= Tok_Range
or else Token
= Tok_Left_Paren
then
393 Restore_Scan_State
(Scan_State
); -- to apostrophe
394 Expr_Form
:= EF_Name
;
397 -- Here for cases where attribute designator is an identifier
399 elsif Token
= Tok_Identifier
then
400 Attr_Name
:= Token_Name
;
402 if not Is_Attribute_Name
(Attr_Name
) then
403 if Apostrophe_Should_Be_Semicolon
then
404 Expr_Form
:= EF_Name
;
407 Signal_Bad_Attribute
;
412 Style
.Check_Attribute_Name
(False);
415 Delete_Node
(Token_Node
);
417 -- Here for case of attribute designator is not an identifier
420 if Token
= Tok_Delta
then
421 Attr_Name
:= Name_Delta
;
423 elsif Token
= Tok_Digits
then
424 Attr_Name
:= Name_Digits
;
426 elsif Token
= Tok_Access
then
427 Attr_Name
:= Name_Access
;
429 elsif Apostrophe_Should_Be_Semicolon
then
430 Expr_Form
:= EF_Name
;
434 Error_Msg_AP
("attribute designator expected");
439 Style
.Check_Attribute_Name
(True);
443 -- We come here with an OK attribute scanned, and the
444 -- corresponding Attribute identifier node stored in Ident_Node.
446 Prefix_Node
:= Name_Node
;
447 Name_Node
:= New_Node
(N_Attribute_Reference
, Prev_Token_Ptr
);
448 Scan
; -- past attribute designator
449 Set_Prefix
(Name_Node
, Prefix_Node
);
450 Set_Attribute_Name
(Name_Node
, Attr_Name
);
452 -- Scan attribute arguments/designator
454 if Token
= Tok_Left_Paren
then
455 Set_Expressions
(Name_Node
, New_List
);
456 Scan
; -- past left paren
460 Expr
: constant Node_Id
:= P_Expression
;
463 if Token
= Tok_Arrow
then
465 ("named parameters not permitted for attributes");
466 Scan
; -- past junk arrow
469 Append
(Expr
, Expressions
(Name_Node
));
470 exit when not Comma_Present
;
478 goto Scan_Name_Extension
;
481 -- Here for left parenthesis extending name (left paren skipped)
483 <<Scan_Name_Extension_Left_Paren
>>
485 -- We now have to scan through a list of items, terminated by a
486 -- right parenthesis. The scan is handled by a finite state
487 -- machine. The possibilities are:
491 -- This is a slice. This case is handled in LP_State_Init.
493 -- (expression, expression, ..)
495 -- This is interpreted as an indexed component, i.e. as a
496 -- case of a name which can be extended in the normal manner.
497 -- This case is handled by LP_State_Name or LP_State_Expr.
499 -- (..., identifier => expression , ...)
501 -- If there is at least one occurrence of identifier => (but
502 -- none of the other cases apply), then we have a call.
504 -- Test for Id => case
506 if Token
= Tok_Identifier
then
507 Save_Scan_State
(Scan_State
); -- at Id
510 -- Test for => (allow := as an error substitute)
512 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
513 Restore_Scan_State
(Scan_State
); -- to Id
514 Arg_List
:= New_List
;
518 Restore_Scan_State
(Scan_State
); -- to Id
522 -- Here we have an expression after all
524 Expr_Node
:= P_Expression_Or_Range_Attribute
;
526 -- Check cases of discrete range for a slice
528 -- First possibility: Range_Attribute_Reference
530 if Expr_Form
= EF_Range_Attr
then
531 Range_Node
:= Expr_Node
;
533 -- Second possibility: Simple_expression .. Simple_expression
535 elsif Token
= Tok_Dot_Dot
then
536 Check_Simple_Expression
(Expr_Node
);
537 Range_Node
:= New_Node
(N_Range
, Token_Ptr
);
538 Set_Low_Bound
(Range_Node
, Expr_Node
);
540 Expr_Node
:= P_Expression
;
541 Check_Simple_Expression
(Expr_Node
);
542 Set_High_Bound
(Range_Node
, Expr_Node
);
544 -- Third possibility: Type_name range Range
546 elsif Token
= Tok_Range
then
547 if Expr_Form
/= EF_Simple_Name
then
548 Error_Msg_SC
("subtype mark must precede RANGE");
552 Range_Node
:= P_Subtype_Indication
(Expr_Node
);
554 -- Otherwise we just have an expression. It is true that we might
555 -- have a subtype mark without a range constraint but this case
556 -- is syntactically indistinguishable from the expression case.
559 Arg_List
:= New_List
;
563 -- Fall through here with unmistakable Discrete range scanned,
564 -- which means that we definitely have the case of a slice. The
565 -- Discrete range is in Range_Node.
567 if Token
= Tok_Comma
then
568 Error_Msg_SC
("slice cannot have more than one dimension");
571 elsif Token
/= Tok_Right_Paren
then
576 Scan
; -- past right paren
577 Prefix_Node
:= Name_Node
;
578 Name_Node
:= New_Node
(N_Slice
, Sloc
(Prefix_Node
));
579 Set_Prefix
(Name_Node
, Prefix_Node
);
580 Set_Discrete_Range
(Name_Node
, Range_Node
);
582 -- An operator node is legal as a prefix to other names,
583 -- but not for a slice.
585 if Nkind
(Prefix_Node
) = N_Operator_Symbol
then
586 Error_Msg_N
("illegal prefix for slice", Prefix_Node
);
589 -- If we have a name extension, go scan it
591 if Token
in Token_Class_Namext
then
592 goto Scan_Name_Extension_OK
;
594 -- Otherwise return (a slice is a name, but is not a call)
597 Expr_Form
:= EF_Name
;
602 -- In LP_State_Expr, we have scanned one or more expressions, and
603 -- so we have a call or an indexed component which is a name. On
604 -- entry we have the expression just scanned in Expr_Node and
605 -- Arg_List contains the list of expressions encountered so far
608 Append
(Expr_Node
, Arg_List
);
610 if Token
= Tok_Arrow
then
612 ("expect identifier in parameter association",
616 elsif not Comma_Present
then
618 Prefix_Node
:= Name_Node
;
619 Name_Node
:= New_Node
(N_Indexed_Component
, Sloc
(Prefix_Node
));
620 Set_Prefix
(Name_Node
, Prefix_Node
);
621 Set_Expressions
(Name_Node
, Arg_List
);
622 goto Scan_Name_Extension
;
625 -- Comma present (and scanned out), test for identifier => case
626 -- Test for identifier => case
628 if Token
= Tok_Identifier
then
629 Save_Scan_State
(Scan_State
); -- at Id
632 -- Test for => (allow := as error substitute)
634 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
635 Restore_Scan_State
(Scan_State
); -- to Id
638 -- Otherwise it's just an expression after all, so backup
641 Restore_Scan_State
(Scan_State
); -- to Id
645 -- Here we have an expression after all, so stay in this state
647 Expr_Node
:= P_Expression
;
650 -- LP_State_Call corresponds to the situation in which at least
651 -- one instance of Id => Expression has been encountered, so we
652 -- know that we do not have a name, but rather a call. We enter
653 -- it with the scan pointer pointing to the next argument to scan,
654 -- and Arg_List containing the list of arguments scanned so far.
658 -- Test for case of Id => Expression (named parameter)
660 if Token
= Tok_Identifier
then
661 Save_Scan_State
(Scan_State
); -- at Id
662 Ident_Node
:= Token_Node
;
665 -- Deal with => (allow := as erroneous substitute)
667 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
669 New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
670 Set_Selector_Name
(Arg_Node
, Ident_Node
);
672 Set_Explicit_Actual_Parameter
(Arg_Node
, P_Expression
);
673 Append
(Arg_Node
, Arg_List
);
675 -- If a comma follows, go back and scan next entry
677 if Comma_Present
then
680 -- Otherwise we have the end of a call
683 Prefix_Node
:= Name_Node
;
685 New_Node
(N_Function_Call
, Sloc
(Prefix_Node
));
686 Set_Name
(Name_Node
, Prefix_Node
);
687 Set_Parameter_Associations
(Name_Node
, Arg_List
);
690 if Token
in Token_Class_Namext
then
691 goto Scan_Name_Extension_OK
;
693 -- This is a case of a call which cannot be a name
696 Expr_Form
:= EF_Name
;
701 -- Not named parameter: Id started an expression after all
704 Restore_Scan_State
(Scan_State
); -- to Id
708 -- Here if entry did not start with Id => which means that it
709 -- is a positional parameter, which is not allowed, since we
710 -- have seen at least one named parameter already.
713 ("positional parameter association " &
714 "not allowed after named one");
716 Expr_Node
:= P_Expression
;
718 -- Leaving the '>' in an association is not unusual, so suggest
721 if Nkind
(Expr_Node
) = N_Op_Eq
then
722 Error_Msg_N
("\maybe `=>` was intended", Expr_Node
);
725 -- We go back to scanning out expressions, so that we do not get
726 -- multiple error messages when several positional parameters
727 -- follow a named parameter.
731 -- End of treatment for name extensions starting with left paren
733 -- End of loop through name extensions
737 -- This function parses a restricted form of Names which are either
738 -- designators, or designators preceded by a sequence of prefixes
739 -- that are direct names.
741 -- Error recovery: cannot raise Error_Resync
743 function P_Function_Name
return Node_Id
is
744 Designator_Node
: Node_Id
;
745 Prefix_Node
: Node_Id
;
746 Selector_Node
: Node_Id
;
747 Dot_Sloc
: Source_Ptr
:= No_Location
;
750 -- Prefix_Node is set to the gathered prefix so far, Empty means that
751 -- no prefix has been scanned. This allows us to build up the result
752 -- in the required right recursive manner.
754 Prefix_Node
:= Empty
;
756 -- Loop through prefixes
759 Designator_Node
:= Token_Node
;
761 if Token
not in Token_Class_Desig
then
762 return P_Identifier
; -- let P_Identifier issue the error message
764 else -- Token in Token_Class_Desig
765 Scan
; -- past designator
766 exit when Token
/= Tok_Dot
;
769 -- Here at a dot, with token just before it in Designator_Node
771 if No
(Prefix_Node
) then
772 Prefix_Node
:= Designator_Node
;
774 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
775 Set_Prefix
(Selector_Node
, Prefix_Node
);
776 Set_Selector_Name
(Selector_Node
, Designator_Node
);
777 Prefix_Node
:= Selector_Node
;
780 Dot_Sloc
:= Token_Ptr
;
784 -- Fall out of the loop having just scanned a designator
786 if No
(Prefix_Node
) then
787 return Designator_Node
;
789 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
790 Set_Prefix
(Selector_Node
, Prefix_Node
);
791 Set_Selector_Name
(Selector_Node
, Designator_Node
);
792 return Selector_Node
;
801 -- This function parses a restricted form of Names which are either
802 -- identifiers, or identifiers preceded by a sequence of prefixes
803 -- that are direct names.
805 -- Error recovery: cannot raise Error_Resync
807 function P_Qualified_Simple_Name
return Node_Id
is
808 Designator_Node
: Node_Id
;
809 Prefix_Node
: Node_Id
;
810 Selector_Node
: Node_Id
;
811 Dot_Sloc
: Source_Ptr
:= No_Location
;
814 -- Prefix node is set to the gathered prefix so far, Empty means that
815 -- no prefix has been scanned. This allows us to build up the result
816 -- in the required right recursive manner.
818 Prefix_Node
:= Empty
;
820 -- Loop through prefixes
823 Designator_Node
:= Token_Node
;
825 if Token
= Tok_Identifier
then
826 Scan
; -- past identifier
827 exit when Token
/= Tok_Dot
;
829 elsif Token
not in Token_Class_Desig
then
830 return P_Identifier
; -- let P_Identifier issue the error message
833 Scan
; -- past designator
835 if Token
/= Tok_Dot
then
836 Error_Msg_SP
("identifier expected");
841 -- Here at a dot, with token just before it in Designator_Node
843 if No
(Prefix_Node
) then
844 Prefix_Node
:= Designator_Node
;
846 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
847 Set_Prefix
(Selector_Node
, Prefix_Node
);
848 Set_Selector_Name
(Selector_Node
, Designator_Node
);
849 Prefix_Node
:= Selector_Node
;
852 Dot_Sloc
:= Token_Ptr
;
856 -- Fall out of the loop having just scanned an identifier
858 if No
(Prefix_Node
) then
859 return Designator_Node
;
861 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
862 Set_Prefix
(Selector_Node
, Prefix_Node
);
863 Set_Selector_Name
(Selector_Node
, Designator_Node
);
864 return Selector_Node
;
871 end P_Qualified_Simple_Name
;
873 -- This procedure differs from P_Qualified_Simple_Name only in that it
874 -- raises Error_Resync if any error is encountered. It only returns after
875 -- scanning a valid qualified simple name.
877 -- Error recovery: can raise Error_Resync
879 function P_Qualified_Simple_Name_Resync
return Node_Id
is
880 Designator_Node
: Node_Id
;
881 Prefix_Node
: Node_Id
;
882 Selector_Node
: Node_Id
;
883 Dot_Sloc
: Source_Ptr
:= No_Location
;
886 Prefix_Node
:= Empty
;
888 -- Loop through prefixes
891 Designator_Node
:= Token_Node
;
893 if Token
= Tok_Identifier
then
894 Scan
; -- past identifier
895 exit when Token
/= Tok_Dot
;
897 elsif Token
not in Token_Class_Desig
then
898 Discard_Junk_Node
(P_Identifier
); -- to issue the error message
902 Scan
; -- past designator
904 if Token
/= Tok_Dot
then
905 Error_Msg_SP
("identifier expected");
910 -- Here at a dot, with token just before it in Designator_Node
912 if No
(Prefix_Node
) then
913 Prefix_Node
:= Designator_Node
;
915 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
916 Set_Prefix
(Selector_Node
, Prefix_Node
);
917 Set_Selector_Name
(Selector_Node
, Designator_Node
);
918 Prefix_Node
:= Selector_Node
;
921 Dot_Sloc
:= Token_Ptr
;
925 -- Fall out of the loop having just scanned an identifier
927 if No
(Prefix_Node
) then
928 return Designator_Node
;
930 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
931 Set_Prefix
(Selector_Node
, Prefix_Node
);
932 Set_Selector_Name
(Selector_Node
, Designator_Node
);
933 return Selector_Node
;
936 end P_Qualified_Simple_Name_Resync
;
938 ----------------------
939 -- 4.1 Direct_Name --
940 ----------------------
942 -- Parsed by P_Name and other functions in section 4.1
948 -- Parsed by P_Name (4.1)
950 -------------------------------
951 -- 4.1 Explicit Dereference --
952 -------------------------------
954 -- Parsed by P_Name (4.1)
956 -------------------------------
957 -- 4.1 Implicit_Dereference --
958 -------------------------------
960 -- Parsed by P_Name (4.1)
962 ----------------------------
963 -- 4.1 Indexed Component --
964 ----------------------------
966 -- Parsed by P_Name (4.1)
972 -- Parsed by P_Name (4.1)
974 -----------------------------
975 -- 4.1 Selected_Component --
976 -----------------------------
978 -- Parsed by P_Name (4.1)
980 ------------------------
981 -- 4.1 Selector Name --
982 ------------------------
984 -- Parsed by P_Name (4.1)
986 ------------------------------
987 -- 4.1 Attribute Reference --
988 ------------------------------
990 -- Parsed by P_Name (4.1)
992 -------------------------------
993 -- 4.1 Attribute Designator --
994 -------------------------------
996 -- Parsed by P_Name (4.1)
998 --------------------------------------
999 -- 4.1.4 Range Attribute Reference --
1000 --------------------------------------
1002 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1004 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1006 -- In the grammar, a RANGE attribute is simply a name, but its use is
1007 -- highly restricted, so in the parser, we do not regard it as a name.
1008 -- Instead, P_Name returns without scanning the 'RANGE part of the
1009 -- attribute, and the caller uses the following function to construct
1010 -- a range attribute in places where it is appropriate.
1012 -- Note that RANGE here is treated essentially as an identifier,
1013 -- rather than a reserved word.
1015 -- The caller has parsed the prefix, i.e. a name, and Token points to
1016 -- the apostrophe. The token after the apostrophe is known to be RANGE
1017 -- at this point. The prefix node becomes the prefix of the attribute.
1019 -- Error_Recovery: Cannot raise Error_Resync
1021 function P_Range_Attribute_Reference
1022 (Prefix_Node
: Node_Id
)
1025 Attr_Node
: Node_Id
;
1028 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1029 Set_Prefix
(Attr_Node
, Prefix_Node
);
1030 Scan
; -- past apostrophe
1033 Style
.Check_Attribute_Name
(True);
1036 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1039 if Token
= Tok_Left_Paren
then
1040 Scan
; -- past left paren
1041 Set_Expressions
(Attr_Node
, New_List
(P_Expression
));
1046 end P_Range_Attribute_Reference
;
1048 ---------------------------------------
1049 -- 4.1.4 Range Attribute Designator --
1050 ---------------------------------------
1052 -- Parsed by P_Range_Attribute_Reference (4.4)
1054 --------------------
1056 --------------------
1058 -- AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1060 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1061 -- an aggregate is known to be required (code statement, extension
1062 -- aggregate), in which cases this routine performs the necessary check
1063 -- that we have an aggregate rather than a parenthesized expression
1065 -- Error recovery: can raise Error_Resync
1067 function P_Aggregate
return Node_Id
is
1068 Aggr_Sloc
: constant Source_Ptr
:= Token_Ptr
;
1069 Aggr_Node
: constant Node_Id
:= P_Aggregate_Or_Paren_Expr
;
1072 if Nkind
(Aggr_Node
) /= N_Aggregate
1074 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1077 ("aggregate may not have single positional component", Aggr_Sloc
);
1084 -------------------------------------------------
1085 -- 4.3 Aggregate or Parenthesized Expresssion --
1086 -------------------------------------------------
1088 -- This procedure parses out either an aggregate or a parenthesized
1089 -- expression (these two constructs are closely related, since a
1090 -- parenthesized expression looks like an aggregate with a single
1091 -- positional component).
1094 -- RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1096 -- RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1098 -- RECORD_COMPONENT_ASSOCIATION_LIST ::=
1099 -- RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1102 -- RECORD_COMPONENT_ASSOCIATION ::=
1103 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1105 -- COMPONENT_CHOICE_LIST ::=
1106 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1109 -- EXTENSION_AGGREGATE ::=
1110 -- (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1112 -- ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1114 -- ARRAY_AGGREGATE ::=
1115 -- POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1117 -- POSITIONAL_ARRAY_AGGREGATE ::=
1118 -- (EXPRESSION, EXPRESSION {, EXPRESSION})
1119 -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1121 -- NAMED_ARRAY_AGGREGATE ::=
1122 -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1124 -- PRIMARY ::= (EXPRESSION);
1126 -- Error recovery: can raise Error_Resync
1128 function P_Aggregate_Or_Paren_Expr
return Node_Id
is
1129 Aggregate_Node
: Node_Id
;
1130 Expr_List
: List_Id
;
1131 Assoc_List
: List_Id
;
1132 Expr_Node
: Node_Id
;
1133 Lparen_Sloc
: Source_Ptr
;
1134 Scan_State
: Saved_Scan_State
;
1137 Lparen_Sloc
:= Token_Ptr
;
1140 -- Note: the mechanism used here of rescanning the initial expression
1141 -- is distinctly unpleasant, but it saves a lot of fiddling in scanning
1142 -- out the discrete choice list.
1144 -- Deal with expression and extension aggregate cases first
1146 if Token
/= Tok_Others
then
1147 Save_Scan_State
(Scan_State
); -- at start of expression
1149 -- Deal with (NULL RECORD) case
1151 if Token
= Tok_Null
then
1154 if Token
= Tok_Record
then
1155 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1156 Set_Null_Record_Present
(Aggregate_Node
, True);
1157 Scan
; -- past RECORD
1159 return Aggregate_Node
;
1161 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1165 Expr_Node
:= P_Expression_Or_Range_Attribute
;
1167 -- Extension aggregate case
1169 if Token
= Tok_With
then
1171 if Nkind
(Expr_Node
) = N_Attribute_Reference
1172 and then Attribute_Name
(Expr_Node
) = Name_Range
1174 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1179 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1182 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1183 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1186 -- Deal with WITH NULL RECORD case
1188 if Token
= Tok_Null
then
1189 Save_Scan_State
(Scan_State
); -- at NULL
1192 if Token
= Tok_Record
then
1193 Scan
; -- past RECORD
1194 Set_Null_Record_Present
(Aggregate_Node
, True);
1196 return Aggregate_Node
;
1199 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1203 if Token
/= Tok_Others
then
1204 Save_Scan_State
(Scan_State
);
1205 Expr_Node
:= P_Expression
;
1212 elsif Token
= Tok_Right_Paren
or else Token
in Token_Class_Eterm
then
1214 if Nkind
(Expr_Node
) = N_Attribute_Reference
1215 and then Attribute_Name
(Expr_Node
) = Name_Range
1217 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1221 -- Bump paren count of expression, note that if the paren count
1222 -- is already at the maximum, then we leave it alone. This will
1223 -- cause some failures in pathalogical conformance tests, which
1224 -- we do not shed a tear over!
1226 if Expr_Node
/= Error
then
1227 if Paren_Count
(Expr_Node
) /= Paren_Count_Type
'Last then
1228 Set_Paren_Count
(Expr_Node
, Paren_Count
(Expr_Node
) + 1);
1232 T_Right_Paren
; -- past right paren (error message if none)
1235 -- Normal aggregate case
1238 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1244 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1248 -- Prepare to scan list of component associations
1250 Expr_List
:= No_List
; -- don't set yet, maybe all named entries
1251 Assoc_List
:= No_List
; -- don't set yet, maybe all positional entries
1253 -- This loop scans through component associations. On entry to the
1254 -- loop, an expression has been scanned at the start of the current
1255 -- association unless initial token was OTHERS, in which case
1256 -- Expr_Node is set to Empty.
1259 -- Deal with others association first. This is a named association
1261 if No
(Expr_Node
) then
1262 if No
(Assoc_List
) then
1263 Assoc_List
:= New_List
;
1266 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1268 -- Improper use of WITH
1270 elsif Token
= Tok_With
then
1271 Error_Msg_SC
("WITH must be preceded by single expression in " &
1272 "extension aggregate");
1275 -- Assume positional case if comma, right paren, or literal or
1276 -- identifier or OTHERS follows (the latter cases are missing
1277 -- comma cases). Also assume positional if a semicolon follows,
1278 -- which can happen if there are missing parens
1280 elsif Token
= Tok_Comma
1281 or else Token
= Tok_Right_Paren
1282 or else Token
= Tok_Others
1283 or else Token
in Token_Class_Lit_Or_Name
1284 or else Token
= Tok_Semicolon
1286 if Present
(Assoc_List
) then
1288 ("""=>"" expected (positional association cannot follow " &
1289 "named association)");
1292 if No
(Expr_List
) then
1293 Expr_List
:= New_List
;
1296 Append
(Expr_Node
, Expr_List
);
1298 -- Anything else is assumed to be a named association
1301 Restore_Scan_State
(Scan_State
); -- to start of expression
1303 if No
(Assoc_List
) then
1304 Assoc_List
:= New_List
;
1307 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
1310 exit when not Comma_Present
;
1312 -- If we are at an expression terminator, something is seriously
1313 -- wrong, so let's get out now, before we start eating up stuff
1314 -- that doesn't belong to us!
1316 if Token
in Token_Class_Eterm
then
1317 Error_Msg_AP
("expecting expression or component association");
1321 -- Otherwise initiate for reentry to top of loop by scanning an
1322 -- initial expression, unless the first token is OTHERS.
1324 if Token
= Tok_Others
then
1327 Save_Scan_State
(Scan_State
); -- at start of expression
1328 Expr_Node
:= P_Expression
;
1332 -- All component associations (positional and named) have been scanned
1335 Set_Expressions
(Aggregate_Node
, Expr_List
);
1336 Set_Component_Associations
(Aggregate_Node
, Assoc_List
);
1337 return Aggregate_Node
;
1338 end P_Aggregate_Or_Paren_Expr
;
1340 ------------------------------------------------
1341 -- 4.3 Record or Array Component Association --
1342 ------------------------------------------------
1344 -- RECORD_COMPONENT_ASSOCIATION ::=
1345 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1347 -- COMPONENT_CHOICE_LIST =>
1348 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
1351 -- ARRAY_COMPONENT_ASSOCIATION ::=
1352 -- DISCRETE_CHOICE_LIST => EXPRESSION
1354 -- Note: this routine only handles the named cases, including others.
1355 -- Cases where the component choice list is not present have already
1356 -- been handled directly.
1358 -- Error recovery: can raise Error_Resync
1360 function P_Record_Or_Array_Component_Association
return Node_Id
is
1361 Assoc_Node
: Node_Id
;
1364 Assoc_Node
:= New_Node
(N_Component_Association
, Token_Ptr
);
1365 Set_Choices
(Assoc_Node
, P_Discrete_Choice_List
);
1366 Set_Sloc
(Assoc_Node
, Token_Ptr
);
1368 Set_Expression
(Assoc_Node
, P_Expression
);
1370 end P_Record_Or_Array_Component_Association
;
1372 -----------------------------
1373 -- 4.3.1 Record Aggregate --
1374 -----------------------------
1376 -- Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1377 -- All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1379 ----------------------------------------------
1380 -- 4.3.1 Record Component Association List --
1381 ----------------------------------------------
1383 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1385 ----------------------------------
1386 -- 4.3.1 Component Choice List --
1387 ----------------------------------
1389 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1391 --------------------------------
1392 -- 4.3.1 Extension Aggregate --
1393 --------------------------------
1395 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1397 --------------------------
1398 -- 4.3.1 Ancestor Part --
1399 --------------------------
1401 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1403 ----------------------------
1404 -- 4.3.1 Array Aggregate --
1405 ----------------------------
1407 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1409 ---------------------------------------
1410 -- 4.3.1 Positional Array Aggregate --
1411 ---------------------------------------
1413 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1415 ----------------------------------
1416 -- 4.3.1 Named Array Aggregate --
1417 ----------------------------------
1419 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1421 ----------------------------------------
1422 -- 4.3.1 Array Component Association --
1423 ----------------------------------------
1425 -- Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1427 ---------------------
1428 -- 4.4 Expression --
1429 ---------------------
1432 -- RELATION {and RELATION} | RELATION {and then RELATION}
1433 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1434 -- | RELATION {xor RELATION}
1436 -- On return, Expr_Form indicates the categorization of the expression
1437 -- EF_Range_Attr is not a possible value (if a range attribute is found,
1438 -- an error message is given, and Error is returned).
1440 -- Error recovery: cannot raise Error_Resync
1442 function P_Expression
return Node_Id
is
1443 Logical_Op
: Node_Kind
;
1444 Prev_Logical_Op
: Node_Kind
;
1445 Op_Location
: Source_Ptr
;
1450 Node1
:= P_Relation
;
1452 if Token
in Token_Class_Logop
then
1453 Prev_Logical_Op
:= N_Empty
;
1456 Op_Location
:= Token_Ptr
;
1457 Logical_Op
:= P_Logical_Operator
;
1459 if Prev_Logical_Op
/= N_Empty
and then
1460 Logical_Op
/= Prev_Logical_Op
1463 ("mixed logical operators in expression", Op_Location
);
1464 Prev_Logical_Op
:= N_Empty
;
1466 Prev_Logical_Op
:= Logical_Op
;
1470 Node1
:= New_Node
(Logical_Op
, Op_Location
);
1471 Set_Left_Opnd
(Node1
, Node2
);
1472 Set_Right_Opnd
(Node1
, P_Relation
);
1473 Set_Op_Name
(Node1
);
1474 exit when Token
not in Token_Class_Logop
;
1477 Expr_Form
:= EF_Non_Simple
;
1480 if Token
= Tok_Apostrophe
then
1481 Bad_Range_Attribute
(Token_Ptr
);
1489 -- This function is identical to the normal P_Expression, except that it
1490 -- checks that the expression scan did not stop on a right paren. It is
1491 -- called in all contexts where a right parenthesis cannot legitimately
1492 -- follow an expression.
1494 function P_Expression_No_Right_Paren
return Node_Id
is
1496 return No_Right_Paren
(P_Expression
);
1497 end P_Expression_No_Right_Paren
;
1499 ----------------------------------------
1500 -- 4.4 Expression_Or_Range_Attribute --
1501 ----------------------------------------
1504 -- RELATION {and RELATION} | RELATION {and then RELATION}
1505 -- | RELATION {or RELATION} | RELATION {or else RELATION}
1506 -- | RELATION {xor RELATION}
1508 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1510 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1512 -- On return, Expr_Form indicates the categorization of the expression
1513 -- and EF_Range_Attr is one of the possibilities.
1515 -- Error recovery: cannot raise Error_Resync
1517 -- In the grammar, a RANGE attribute is simply a name, but its use is
1518 -- highly restricted, so in the parser, we do not regard it as a name.
1519 -- Instead, P_Name returns without scanning the 'RANGE part of the
1520 -- attribute, and P_Expression_Or_Range_Attribute handles the range
1521 -- attribute reference. In the normal case where a range attribute is
1522 -- not allowed, an error message is issued by P_Expression.
1524 function P_Expression_Or_Range_Attribute
return Node_Id
is
1525 Logical_Op
: Node_Kind
;
1526 Prev_Logical_Op
: Node_Kind
;
1527 Op_Location
: Source_Ptr
;
1530 Attr_Node
: Node_Id
;
1533 Node1
:= P_Relation
;
1535 if Token
= Tok_Apostrophe
then
1536 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
1537 Expr_Form
:= EF_Range_Attr
;
1540 elsif Token
in Token_Class_Logop
then
1541 Prev_Logical_Op
:= N_Empty
;
1544 Op_Location
:= Token_Ptr
;
1545 Logical_Op
:= P_Logical_Operator
;
1547 if Prev_Logical_Op
/= N_Empty
and then
1548 Logical_Op
/= Prev_Logical_Op
1551 ("mixed logical operators in expression", Op_Location
);
1552 Prev_Logical_Op
:= N_Empty
;
1554 Prev_Logical_Op
:= Logical_Op
;
1558 Node1
:= New_Node
(Logical_Op
, Op_Location
);
1559 Set_Left_Opnd
(Node1
, Node2
);
1560 Set_Right_Opnd
(Node1
, P_Relation
);
1561 Set_Op_Name
(Node1
);
1562 exit when Token
not in Token_Class_Logop
;
1565 Expr_Form
:= EF_Non_Simple
;
1568 if Token
= Tok_Apostrophe
then
1569 Bad_Range_Attribute
(Token_Ptr
);
1574 end P_Expression_Or_Range_Attribute
;
1581 -- SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1582 -- | SIMPLE_EXPRESSION [not] in RANGE
1583 -- | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1585 -- On return, Expr_Form indicates the categorization of the expression
1587 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1588 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1590 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1591 -- expression, then tokens are scanned until either a non-expression token,
1592 -- a right paren (not matched by a left paren) or a comma, is encountered.
1594 function P_Relation
return Node_Id
is
1595 Node1
, Node2
: Node_Id
;
1599 Node1
:= P_Simple_Expression
;
1601 if Token
not in Token_Class_Relop
then
1605 -- Here we have a relational operator following. If so then scan it
1606 -- out. Note that the assignment symbol := is treated as a relational
1607 -- operator to improve the error recovery when it is misused for =.
1608 -- P_Relational_Operator also parses the IN and NOT IN operations.
1611 Node2
:= New_Node
(P_Relational_Operator
, Optok
);
1612 Set_Left_Opnd
(Node2
, Node1
);
1613 Set_Op_Name
(Node2
);
1615 -- Case of IN or NOT IN
1617 if Prev_Token
= Tok_In
then
1618 Set_Right_Opnd
(Node2
, P_Range_Or_Subtype_Mark
);
1620 -- Case of relational operator (= /= < <= > >=)
1623 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
1626 Expr_Form
:= EF_Non_Simple
;
1628 if Token
in Token_Class_Relop
then
1629 Error_Msg_SC
("unexpected relational operator");
1636 -- If any error occurs, then scan to the next expression terminator symbol
1637 -- or comma or right paren at the outer (i.e. current) parentheses level.
1638 -- The flags are set to indicate a normal simple expression.
1641 when Error_Resync
=>
1643 Expr_Form
:= EF_Simple
;
1647 ----------------------------
1648 -- 4.4 Simple Expression --
1649 ----------------------------
1651 -- SIMPLE_EXPRESSION ::=
1652 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1654 -- On return, Expr_Form indicates the categorization of the expression
1656 -- Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1657 -- EF_Simple_Name and the following token is RANGE (range attribute case).
1659 -- Error recovery: cannot raise Error_Resync. If an error occurs within an
1660 -- expression, then tokens are scanned until either a non-expression token,
1661 -- a right paren (not matched by a left paren) or a comma, is encountered.
1663 -- Note: P_Simple_Expression is called only internally by higher level
1664 -- expression routines. In cases in the grammar where a simple expression
1665 -- is required, the approach is to scan an expression, and then post an
1666 -- appropriate error message if the expression obtained is not simple. This
1667 -- gives better error recovery and treatment.
1669 function P_Simple_Expression
return Node_Id
is
1670 Scan_State
: Saved_Scan_State
;
1673 Tokptr
: Source_Ptr
;
1676 -- Check for cases starting with a name. There are two reasons for
1677 -- special casing. First speed things up by catching a common case
1678 -- without going through several routine layers. Second the caller must
1679 -- be informed via Expr_Form when the simple expression is a name.
1681 if Token
in Token_Class_Name
then
1684 -- Deal with apostrophe cases
1686 if Token
= Tok_Apostrophe
then
1687 Save_Scan_State
(Scan_State
); -- at apostrophe
1688 Scan
; -- past apostrophe
1690 -- If qualified expression, scan it out and fall through
1692 if Token
= Tok_Left_Paren
then
1693 Node1
:= P_Qualified_Expression
(Node1
);
1694 Expr_Form
:= EF_Simple
;
1696 -- If range attribute, then we return with Token pointing to the
1697 -- apostrophe. Note: avoid the normal error check on exit. We
1698 -- know that the expression really is complete in this case!
1700 else -- Token = Tok_Range then
1701 Restore_Scan_State
(Scan_State
); -- to apostrophe
1702 Expr_Form
:= EF_Simple_Name
;
1707 -- If an expression terminator follows, the previous processing
1708 -- completely scanned out the expression (a common case), and
1709 -- left Expr_Form set appropriately for returning to our caller.
1711 if Token
in Token_Class_Sterm
then
1714 -- If we do not have an expression terminator, then complete the
1715 -- scan of a simple expression. This code duplicates the code
1716 -- found in P_Term and P_Factor.
1719 if Token
= Tok_Double_Asterisk
then
1720 if Style_Check
then Style
.Check_Exponentiation_Operator
; end if;
1721 Node2
:= New_Node
(N_Op_Expon
, Token_Ptr
);
1723 Set_Left_Opnd
(Node2
, Node1
);
1724 Set_Right_Opnd
(Node2
, P_Primary
);
1725 Set_Op_Name
(Node2
);
1730 exit when Token
not in Token_Class_Mulop
;
1731 Tokptr
:= Token_Ptr
;
1732 Node2
:= New_Node
(P_Multiplying_Operator
, Tokptr
);
1733 if Style_Check
then Style
.Check_Binary_Operator
; end if;
1734 Scan
; -- past operator
1735 Set_Left_Opnd
(Node2
, Node1
);
1736 Set_Right_Opnd
(Node2
, P_Factor
);
1737 Set_Op_Name
(Node2
);
1742 exit when Token
not in Token_Class_Binary_Addop
;
1743 Tokptr
:= Token_Ptr
;
1744 Node2
:= New_Node
(P_Binary_Adding_Operator
, Tokptr
);
1745 if Style_Check
then Style
.Check_Binary_Operator
; end if;
1746 Scan
; -- past operator
1747 Set_Left_Opnd
(Node2
, Node1
);
1748 Set_Right_Opnd
(Node2
, P_Term
);
1749 Set_Op_Name
(Node2
);
1753 Expr_Form
:= EF_Simple
;
1756 -- Cases where simple expression does not start with a name
1759 -- Scan initial sign and initial Term
1761 if Token
in Token_Class_Unary_Addop
then
1762 Tokptr
:= Token_Ptr
;
1763 Node1
:= New_Node
(P_Unary_Adding_Operator
, Tokptr
);
1764 if Style_Check
then Style
.Check_Unary_Plus_Or_Minus
; end if;
1765 Scan
; -- past operator
1766 Set_Right_Opnd
(Node1
, P_Term
);
1767 Set_Op_Name
(Node1
);
1772 -- Scan out sequence of terms separated by binary adding operators
1775 exit when Token
not in Token_Class_Binary_Addop
;
1776 Tokptr
:= Token_Ptr
;
1777 Node2
:= New_Node
(P_Binary_Adding_Operator
, Tokptr
);
1778 Scan
; -- past operator
1779 Set_Left_Opnd
(Node2
, Node1
);
1780 Set_Right_Opnd
(Node2
, P_Term
);
1781 Set_Op_Name
(Node2
);
1785 -- All done, we clearly do not have name or numeric literal so this
1786 -- is a case of a simple expression which is some other possibility.
1788 Expr_Form
:= EF_Simple
;
1791 -- Come here at end of simple expression, where we do a couple of
1792 -- special checks to improve error recovery.
1794 -- Special test to improve error recovery. If the current token
1795 -- is a period, then someone is trying to do selection on something
1796 -- that is not a name, e.g. a qualified expression.
1798 if Token
= Tok_Dot
then
1799 Error_Msg_SC
("prefix for selection is not a name");
1803 -- Special test to improve error recovery: If the current token is
1804 -- not the first token on a line (as determined by checking the
1805 -- previous token position with the start of the current line),
1806 -- then we insist that we have an appropriate terminating token.
1807 -- Consider the following two examples:
1809 -- 1) if A nad B then ...
1814 -- In the first example, we would like to issue a binary operator
1815 -- expected message and resynchronize to the then. In the second
1816 -- example, we do not want to issue a binary operator message, so
1817 -- that instead we will get the missing semicolon message. This
1818 -- distinction is of course a heuristic which does not always work,
1819 -- but in practice it is quite effective.
1821 -- Note: the one case in which we do not go through this circuit is
1822 -- when we have scanned a range attribute and want to return with
1823 -- Token pointing to the apostrophe. The apostrophe is not normally
1824 -- an expression terminator, and is not in Token_Class_Sterm, but
1825 -- in this special case we know that the expression is complete.
1827 if not Token_Is_At_Start_Of_Line
1828 and then Token
not in Token_Class_Sterm
1830 Error_Msg_AP
("binary operator expected");
1836 -- If any error occurs, then scan to next expression terminator symbol
1837 -- or comma, right paren or vertical bar at the outer (i.e. current) paren
1838 -- level. Expr_Form is set to indicate a normal simple expression.
1841 when Error_Resync
=>
1843 Expr_Form
:= EF_Simple
;
1846 end P_Simple_Expression
;
1848 -----------------------------------------------
1849 -- 4.4 Simple Expression or Range Attribute --
1850 -----------------------------------------------
1852 -- SIMPLE_EXPRESSION ::=
1853 -- [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1855 -- RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1857 -- RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1859 -- Error recovery: cannot raise Error_Resync
1861 function P_Simple_Expression_Or_Range_Attribute
return Node_Id
is
1863 Attr_Node
: Node_Id
;
1866 Sexpr
:= P_Simple_Expression
;
1868 if Token
= Tok_Apostrophe
then
1869 Attr_Node
:= P_Range_Attribute_Reference
(Sexpr
);
1870 Expr_Form
:= EF_Range_Attr
;
1876 end P_Simple_Expression_Or_Range_Attribute
;
1882 -- TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
1884 -- Error recovery: can raise Error_Resync
1886 function P_Term
return Node_Id
is
1887 Node1
, Node2
: Node_Id
;
1888 Tokptr
: Source_Ptr
;
1894 exit when Token
not in Token_Class_Mulop
;
1895 Tokptr
:= Token_Ptr
;
1896 Node2
:= New_Node
(P_Multiplying_Operator
, Tokptr
);
1897 Scan
; -- past operator
1898 Set_Left_Opnd
(Node2
, Node1
);
1899 Set_Right_Opnd
(Node2
, P_Factor
);
1900 Set_Op_Name
(Node2
);
1911 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
1913 -- Error recovery: can raise Error_Resync
1915 function P_Factor
return Node_Id
is
1920 if Token
= Tok_Abs
then
1921 Node1
:= New_Node
(N_Op_Abs
, Token_Ptr
);
1922 if Style_Check
then Style
.Check_Abs_Not
; end if;
1924 Set_Right_Opnd
(Node1
, P_Primary
);
1925 Set_Op_Name
(Node1
);
1928 elsif Token
= Tok_Not
then
1929 Node1
:= New_Node
(N_Op_Not
, Token_Ptr
);
1930 if Style_Check
then Style
.Check_Abs_Not
; end if;
1932 Set_Right_Opnd
(Node1
, P_Primary
);
1933 Set_Op_Name
(Node1
);
1939 if Token
= Tok_Double_Asterisk
then
1940 Node2
:= New_Node
(N_Op_Expon
, Token_Ptr
);
1942 Set_Left_Opnd
(Node2
, Node1
);
1943 Set_Right_Opnd
(Node2
, P_Primary
);
1944 Set_Op_Name
(Node2
);
1957 -- NUMERIC_LITERAL | null
1958 -- | STRING_LITERAL | AGGREGATE
1959 -- | NAME | QUALIFIED_EXPRESSION
1960 -- | ALLOCATOR | (EXPRESSION)
1962 -- Error recovery: can raise Error_Resync
1964 function P_Primary
return Node_Id
is
1965 Scan_State
: Saved_Scan_State
;
1969 -- The loop runs more than once only if misplaced pragmas are found
1974 -- Name token can start a name, call or qualified expression, all
1975 -- of which are acceptable possibilities for primary. Note also
1976 -- that string literal is included in name (as operator symbol)
1977 -- and type conversion is included in name (as indexed component).
1979 when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier
=>
1982 -- All done unless apostrophe follows
1984 if Token
/= Tok_Apostrophe
then
1987 -- Apostrophe following means that we have either just parsed
1988 -- the subtype mark of a qualified expression, or the prefix
1989 -- or a range attribute.
1991 else -- Token = Tok_Apostrophe
1992 Save_Scan_State
(Scan_State
); -- at apostrophe
1993 Scan
; -- past apostrophe
1995 -- If range attribute, then this is always an error, since
1996 -- the only legitimate case (where the scanned expression is
1997 -- a qualified simple name) is handled at the level of the
1998 -- Simple_Expression processing. This case corresponds to a
1999 -- usage such as 3 + A'Range, which is always illegal.
2001 if Token
= Tok_Range
then
2002 Restore_Scan_State
(Scan_State
); -- to apostrophe
2003 Bad_Range_Attribute
(Token_Ptr
);
2006 -- If left paren, then we have a qualified expression.
2007 -- Note that P_Name guarantees that in this case, where
2008 -- Token = Tok_Apostrophe on return, the only two possible
2009 -- tokens following the apostrophe are left paren and
2010 -- RANGE, so we know we have a left paren here.
2012 else -- Token = Tok_Left_Paren
2013 return P_Qualified_Expression
(Node1
);
2018 -- Numeric or string literal
2020 when Tok_Integer_Literal |
2022 Tok_String_Literal
=>
2024 Node1
:= Token_Node
;
2025 Scan
; -- past number
2028 -- Left paren, starts aggregate or parenthesized expression
2030 when Tok_Left_Paren
=>
2031 return P_Aggregate_Or_Paren_Expr
;
2042 return New_Node
(N_Null
, Prev_Token_Ptr
);
2044 -- Pragma, not allowed here, so just skip past it
2047 P_Pragmas_Misplaced
;
2049 -- Anything else is illegal as the first token of a primary, but
2050 -- we test for a reserved identifier so that it is treated nicely
2053 if Is_Reserved_Identifier
then
2054 return P_Identifier
;
2056 elsif Prev_Token
= Tok_Comma
then
2057 Error_Msg_SP
("extra "","" ignored");
2061 Error_Msg_AP
("missing operand");
2069 ---------------------------
2070 -- 4.5 Logical Operator --
2071 ---------------------------
2073 -- LOGICAL_OPERATOR ::= and | or | xor
2075 -- Note: AND THEN and OR ELSE are also treated as logical operators
2076 -- by the parser (even though they are not operators semantically)
2078 -- The value returned is the appropriate Node_Kind code for the operator
2079 -- On return, Token points to the token following the scanned operator.
2081 -- The caller has checked that the first token is a legitimate logical
2082 -- operator token (i.e. is either XOR, AND, OR).
2084 -- Error recovery: cannot raise Error_Resync
2086 function P_Logical_Operator
return Node_Kind
is
2088 if Token
= Tok_And
then
2089 if Style_Check
then Style
.Check_Binary_Operator
; end if;
2092 if Token
= Tok_Then
then
2099 elsif Token
= Tok_Or
then
2100 if Style_Check
then Style
.Check_Binary_Operator
; end if;
2103 if Token
= Tok_Else
then
2110 else -- Token = Tok_Xor
2111 if Style_Check
then Style
.Check_Binary_Operator
; end if;
2115 end P_Logical_Operator
;
2117 ------------------------------
2118 -- 4.5 Relational Operator --
2119 ------------------------------
2121 -- RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2123 -- The value returned is the appropriate Node_Kind code for the operator.
2124 -- On return, Token points to the operator token, NOT past it.
2126 -- The caller has checked that the first token is a legitimate relational
2127 -- operator token (i.e. is one of the operator tokens listed above).
2129 -- Error recovery: cannot raise Error_Resync
2131 function P_Relational_Operator
return Node_Kind
is
2132 Op_Kind
: Node_Kind
;
2133 Relop_Node
: constant array (Token_Class_Relop
) of Node_Kind
:=
2134 (Tok_Less
=> N_Op_Lt
,
2135 Tok_Equal
=> N_Op_Eq
,
2136 Tok_Greater
=> N_Op_Gt
,
2137 Tok_Not_Equal
=> N_Op_Ne
,
2138 Tok_Greater_Equal
=> N_Op_Ge
,
2139 Tok_Less_Equal
=> N_Op_Le
,
2141 Tok_Not
=> N_Not_In
,
2142 Tok_Box
=> N_Op_Ne
);
2145 if Token
= Tok_Box
then
2146 Error_Msg_SC
("""<>"" should be ""/=""");
2149 Op_Kind
:= Relop_Node
(Token
);
2150 if Style_Check
then Style
.Check_Binary_Operator
; end if;
2151 Scan
; -- past operator token
2153 if Prev_Token
= Tok_Not
then
2158 end P_Relational_Operator
;
2160 ---------------------------------
2161 -- 4.5 Binary Adding Operator --
2162 ---------------------------------
2164 -- BINARY_ADDING_OPERATOR ::= + | - | &
2166 -- The value returned is the appropriate Node_Kind code for the operator.
2167 -- On return, Token points to the operator token (NOT past it).
2169 -- The caller has checked that the first token is a legitimate adding
2170 -- operator token (i.e. is one of the operator tokens listed above).
2172 -- Error recovery: cannot raise Error_Resync
2174 function P_Binary_Adding_Operator
return Node_Kind
is
2175 Addop_Node
: constant array (Token_Class_Binary_Addop
) of Node_Kind
:=
2176 (Tok_Ampersand
=> N_Op_Concat
,
2177 Tok_Minus
=> N_Op_Subtract
,
2178 Tok_Plus
=> N_Op_Add
);
2180 return Addop_Node
(Token
);
2181 end P_Binary_Adding_Operator
;
2183 --------------------------------
2184 -- 4.5 Unary Adding Operator --
2185 --------------------------------
2187 -- UNARY_ADDING_OPERATOR ::= + | -
2189 -- The value returned is the appropriate Node_Kind code for the operator.
2190 -- On return, Token points to the operator token (NOT past it).
2192 -- The caller has checked that the first token is a legitimate adding
2193 -- operator token (i.e. is one of the operator tokens listed above).
2195 -- Error recovery: cannot raise Error_Resync
2197 function P_Unary_Adding_Operator
return Node_Kind
is
2198 Addop_Node
: constant array (Token_Class_Unary_Addop
) of Node_Kind
:=
2199 (Tok_Minus
=> N_Op_Minus
,
2200 Tok_Plus
=> N_Op_Plus
);
2202 return Addop_Node
(Token
);
2203 end P_Unary_Adding_Operator
;
2205 -------------------------------
2206 -- 4.5 Multiplying Operator --
2207 -------------------------------
2209 -- MULTIPLYING_OPERATOR ::= * | / | mod | rem
2211 -- The value returned is the appropriate Node_Kind code for the operator.
2212 -- On return, Token points to the operator token (NOT past it).
2214 -- The caller has checked that the first token is a legitimate multiplying
2215 -- operator token (i.e. is one of the operator tokens listed above).
2217 -- Error recovery: cannot raise Error_Resync
2219 function P_Multiplying_Operator
return Node_Kind
is
2220 Mulop_Node
: constant array (Token_Class_Mulop
) of Node_Kind
:=
2221 (Tok_Asterisk
=> N_Op_Multiply
,
2222 Tok_Mod
=> N_Op_Mod
,
2223 Tok_Rem
=> N_Op_Rem
,
2224 Tok_Slash
=> N_Op_Divide
);
2226 return Mulop_Node
(Token
);
2227 end P_Multiplying_Operator
;
2229 --------------------------------------
2230 -- 4.5 Highest Precedence Operator --
2231 --------------------------------------
2233 -- Parsed by P_Factor (4.4)
2235 -- Note: this rule is not in fact used by the grammar at any point!
2237 --------------------------
2238 -- 4.6 Type Conversion --
2239 --------------------------
2241 -- Parsed by P_Primary as a Name (4.1)
2243 -------------------------------
2244 -- 4.7 Qualified Expression --
2245 -------------------------------
2247 -- QUALIFIED_EXPRESSION ::=
2248 -- SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2250 -- The caller has scanned the name which is the Subtype_Mark parameter
2251 -- and scanned past the single quote following the subtype mark. The
2252 -- caller has not checked that this name is in fact appropriate for
2253 -- a subtype mark name (i.e. it is a selected component or identifier).
2255 -- Error_Recovery: cannot raise Error_Resync
2257 function P_Qualified_Expression
(Subtype_Mark
: Node_Id
) return Node_Id
is
2258 Qual_Node
: Node_Id
;
2261 Qual_Node
:= New_Node
(N_Qualified_Expression
, Prev_Token_Ptr
);
2262 Set_Subtype_Mark
(Qual_Node
, Check_Subtype_Mark
(Subtype_Mark
));
2263 Set_Expression
(Qual_Node
, P_Aggregate_Or_Paren_Expr
);
2265 end P_Qualified_Expression
;
2267 --------------------
2269 --------------------
2272 -- new SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2274 -- The caller has checked that the initial token is NEW
2276 -- Error recovery: can raise Error_Resync
2278 function P_Allocator
return Node_Id
is
2279 Alloc_Node
: Node_Id
;
2280 Type_Node
: Node_Id
;
2283 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
2285 Type_Node
:= P_Subtype_Mark_Resync
;
2287 if Token
= Tok_Apostrophe
then
2288 Scan
; -- past apostrophe
2289 Set_Expression
(Alloc_Node
, P_Qualified_Expression
(Type_Node
));
2291 Set_Expression
(Alloc_Node
, P_Subtype_Indication
(Type_Node
));