1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 pragma Style_Checks
(All_Checks
);
28 -- Turn off subprogram body ordering check. Subprograms are in order
29 -- by RM section rather than alphabetical
34 -----------------------
35 -- Local Subprograms --
36 -----------------------
38 function P_Aggregate_Or_Paren_Expr
return Node_Id
;
39 function P_Allocator
return Node_Id
;
40 function P_Record_Or_Array_Component_Association
return Node_Id
;
41 function P_Factor
return Node_Id
;
42 function P_Primary
return Node_Id
;
43 function P_Relation
return Node_Id
;
44 function P_Term
return Node_Id
;
46 function P_Binary_Adding_Operator
return Node_Kind
;
47 function P_Logical_Operator
return Node_Kind
;
48 function P_Multiplying_Operator
return Node_Kind
;
49 function P_Relational_Operator
return Node_Kind
;
50 function P_Unary_Adding_Operator
return Node_Kind
;
52 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
);
53 -- Called to place complaint about bad range attribute at the given
54 -- source location. Terminates by raising Error_Resync.
56 function P_Range_Attribute_Reference
57 (Prefix_Node
: Node_Id
)
59 -- Scan a range attribute reference. The caller has scanned out the
60 -- prefix. The current token is known to be an apostrophe and the
61 -- following token is known to be RANGE.
63 procedure Set_Op_Name
(Node
: Node_Id
);
64 -- Procedure to set name field (Chars) in operator node
66 -------------------------
67 -- Bad_Range_Attribute --
68 -------------------------
70 procedure Bad_Range_Attribute
(Loc
: Source_Ptr
) is
72 Error_Msg
("range attribute cannot be used in expression", Loc
);
74 end Bad_Range_Attribute
;
80 procedure Set_Op_Name
(Node
: Node_Id
) is
81 type Name_Of_Type
is array (N_Op
) of Name_Id
;
82 Name_Of
: constant Name_Of_Type
:= Name_Of_Type
'(
83 N_Op_And => Name_Op_And,
84 N_Op_Or => Name_Op_Or,
85 N_Op_Xor => Name_Op_Xor,
86 N_Op_Eq => Name_Op_Eq,
87 N_Op_Ne => Name_Op_Ne,
88 N_Op_Lt => Name_Op_Lt,
89 N_Op_Le => Name_Op_Le,
90 N_Op_Gt => Name_Op_Gt,
91 N_Op_Ge => Name_Op_Ge,
92 N_Op_Add => Name_Op_Add,
93 N_Op_Subtract => Name_Op_Subtract,
94 N_Op_Concat => Name_Op_Concat,
95 N_Op_Multiply => Name_Op_Multiply,
96 N_Op_Divide => Name_Op_Divide,
97 N_Op_Mod => Name_Op_Mod,
98 N_Op_Rem => Name_Op_Rem,
99 N_Op_Expon => Name_Op_Expon,
100 N_Op_Plus => Name_Op_Add,
101 N_Op_Minus => Name_Op_Subtract,
102 N_Op_Abs => Name_Op_Abs,
103 N_Op_Not => Name_Op_Not,
105 -- We don't really need these shift operators, since they never
106 -- appear as operators in the source, but the path of least
107 -- resistance is to put them in (the aggregate must be complete)
109 N_Op_Rotate_Left => Name_Rotate_Left,
110 N_Op_Rotate_Right => Name_Rotate_Right,
111 N_Op_Shift_Left => Name_Shift_Left,
112 N_Op_Shift_Right => Name_Shift_Right,
113 N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
116 if Nkind (Node) in N_Op then
117 Set_Chars (Node, Name_Of (Nkind (Node)));
121 --------------------------
122 -- 4.1 Name (also 6.4) --
123 --------------------------
126 -- DIRECT_NAME | EXPLICIT_DEREFERENCE
127 -- | INDEXED_COMPONENT | SLICE
128 -- | SELECTED_COMPONENT | ATTRIBUTE
129 -- | TYPE_CONVERSION | FUNCTION_CALL
130 -- | CHARACTER_LITERAL
132 -- DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
134 -- PREFIX ::= NAME | IMPLICIT_DEREFERENCE
136 -- EXPLICIT_DEREFERENCE ::= NAME . all
138 -- IMPLICIT_DEREFERENCE ::= NAME
140 -- INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
142 -- SLICE ::= PREFIX (DISCRETE_RANGE)
144 -- SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
146 -- SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
148 -- ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
150 -- ATTRIBUTE_DESIGNATOR ::=
151 -- IDENTIFIER [(static_EXPRESSION)]
152 -- | access | delta | digits
156 -- | function_PREFIX ACTUAL_PARAMETER_PART
158 -- ACTUAL_PARAMETER_PART ::=
159 -- (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
161 -- PARAMETER_ASSOCIATION ::=
162 -- [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
164 -- EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
166 -- Note: syntactically a procedure call looks just like a function call,
167 -- so this routine is in practice used to scan out procedure calls as well.
169 -- On return, Expr_Form is set to either EF_Name or EF_Simple_Name
171 -- Error recovery: can raise Error_Resync
173 -- Note: if on return Token = Tok_Apostrophe, then the apostrophe must be
174 -- followed by either a left paren (qualified expression case), or by
175 -- range (range attribute case). All other uses of apostrophe (i.e. all
176 -- other attributes) are handled in this routine.
178 -- Error recovery: can raise Error_Resync
180 function P_Name
return Node_Id
is
181 Scan_State
: Saved_Scan_State
;
183 Prefix_Node
: Node_Id
;
184 Ident_Node
: Node_Id
;
186 Range_Node
: Node_Id
;
189 Arg_List
: List_Id
:= No_List
; -- kill junk warning
190 Attr_Name
: Name_Id
:= No_Name
; -- kill junk warning
193 if Token
not in Token_Class_Name
then
194 Error_Msg_AP
("name expected");
198 -- Loop through designators in qualified name
200 Name_Node
:= Token_Node
;
203 Scan
; -- past designator
204 exit when Token
/= Tok_Dot
;
205 Save_Scan_State
(Scan_State
); -- at 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
213 if Token
not in Token_Class_Desig
then
214 goto Scan_Name_Extension_Dot
;
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
);
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
;
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
;
250 -- Otherwise we have the case of a name extended by an attribute
253 goto Scan_Name_Extension_Apostrophe
;
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
265 Expr_Form
:= EF_Simple_Name
;
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
283 Expr_Form
:= EF_Name
;
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
303 goto Scan_Name_Extension_Dot
;
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
);
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
);
349 -- Here if nothing legal after the dot
352 Error_Msg_AP
("selector expected");
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
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
;
379 end Apostrophe_Should_Be_Semicolon
;
381 -- Start of processing for Scan_Apostrophe
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
;
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
;
406 -- Here for a bad attribute name
409 Signal_Bad_Attribute
;
410 Scan
; -- past bad identifier
412 if Token
= Tok_Left_Paren
then
413 Scan
; -- past left paren
416 Discard_Junk_Node
(P_Expression
);
417 exit when not Comma_Present
;
428 Style
.Check_Attribute_Name
(False);
431 Delete_Node
(Token_Node
);
433 -- Here for case of attribute designator is not an identifier
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
;
453 Error_Msg_AP
("attribute designator expected");
458 Style
.Check_Attribute_Name
(True);
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
479 Expr
: constant Node_Id
:= P_Expression
;
482 if Token
= Tok_Arrow
then
484 ("named parameters not permitted for attributes");
485 Scan
; -- past junk arrow
488 Append
(Expr
, Expressions
(Name_Node
));
489 exit when not Comma_Present
;
497 goto Scan_Name_Extension
;
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:
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
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
;
537 Restore_Scan_State
(Scan_State
); -- to Id
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
);
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");
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.
578 Arg_List
:= New_List
;
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");
590 elsif Token
/= Tok_Right_Paren
then
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
);
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)
616 Expr_Form
:= EF_Name
;
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
627 Append
(Expr_Node
, Arg_List
);
629 if Token
= Tok_Arrow
then
631 ("expect identifier in parameter association",
635 elsif not Comma_Present
then
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
;
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
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
657 -- Otherwise it's just an expression after all, so backup
660 Restore_Scan_State
(Scan_State
); -- to Id
664 -- Here we have an expression after all, so stay in this state
666 Expr_Node
:= P_Expression
;
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.
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
;
684 -- Deal with => (allow := as erroneous substitute)
686 if Token
= Tok_Arrow
or else Token
= Tok_Colon_Equal
then
688 New_Node
(N_Parameter_Association
, Prev_Token_Ptr
);
689 Set_Selector_Name
(Arg_Node
, Ident_Node
);
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
699 -- Otherwise we have the end of a call
702 Prefix_Node
:= 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
);
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
715 Expr_Form
:= EF_Name
;
720 -- Not named parameter: Id started an expression after all
723 Restore_Scan_State
(Scan_State
); -- to Id
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.
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
740 if Nkind
(Expr_Node
) = N_Op_Eq
then
741 Error_Msg_N
("\maybe `='>` was intended", Expr_Node
);
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.
750 -- End of treatment for name extensions starting with left paren
752 -- End of loop through name extensions
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
;
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
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
;
788 -- Here at a dot, with token just before it in Designator_Node
790 if No
(Prefix_Node
) then
791 Prefix_Node
:= Designator_Node
;
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
;
799 Dot_Sloc
:= Token_Ptr
;
803 -- Fall out of the loop having just scanned a designator
805 if No
(Prefix_Node
) then
806 return Designator_Node
;
808 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
809 Set_Prefix
(Selector_Node
, Prefix_Node
);
810 Set_Selector_Name
(Selector_Node
, Designator_Node
);
811 return Selector_Node
;
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
;
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
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
852 Scan
; -- past designator
854 if Token
/= Tok_Dot
then
855 Error_Msg_SP
("identifier expected");
860 -- Here at a dot, with token just before it in Designator_Node
862 if No
(Prefix_Node
) then
863 Prefix_Node
:= Designator_Node
;
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
;
871 Dot_Sloc
:= Token_Ptr
;
875 -- Fall out of the loop having just scanned an identifier
877 if No
(Prefix_Node
) then
878 return Designator_Node
;
880 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
881 Set_Prefix
(Selector_Node
, Prefix_Node
);
882 Set_Selector_Name
(Selector_Node
, Designator_Node
);
883 return Selector_Node
;
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
;
905 Prefix_Node
:= Empty
;
907 -- Loop through prefixes
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
921 Scan
; -- past designator
923 if Token
/= Tok_Dot
then
924 Error_Msg_SP
("identifier expected");
929 -- Here at a dot, with token just before it in Designator_Node
931 if No
(Prefix_Node
) then
932 Prefix_Node
:= Designator_Node
;
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
;
940 Dot_Sloc
:= Token_Ptr
;
944 -- Fall out of the loop having just scanned an identifier
946 if No
(Prefix_Node
) then
947 return Designator_Node
;
949 Selector_Node
:= New_Node
(N_Selected_Component
, Dot_Sloc
);
950 Set_Prefix
(Selector_Node
, Prefix_Node
);
951 Set_Selector_Name
(Selector_Node
, Designator_Node
);
952 return Selector_Node
;
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
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)
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
)
1044 Attr_Node
: Node_Id
;
1047 Attr_Node
:= New_Node
(N_Attribute_Reference
, Token_Ptr
);
1048 Set_Prefix
(Attr_Node
, Prefix_Node
);
1049 Scan
; -- past apostrophe
1052 Style
.Check_Attribute_Name
(True);
1055 Set_Attribute_Name
(Attr_Node
, Name_Range
);
1058 if Token
= Tok_Left_Paren
then
1059 Scan
; -- past left paren
1060 Set_Expressions
(Attr_Node
, New_List
(P_Expression
));
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 --------------------
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
;
1091 if Nkind
(Aggr_Node
) /= N_Aggregate
1093 Nkind
(Aggr_Node
) /= N_Extension_Aggregate
1096 ("aggregate may not have single positional component", Aggr_Sloc
);
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).
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}
1121 -- RECORD_COMPONENT_ASSOCIATION ::=
1122 -- [COMPONENT_CHOICE_LIST =>] EXPRESSION
1124 -- COMPONENT_CHOICE_LIST ::=
1125 -- component_SELECTOR_NAME {| component_SELECTOR_NAME}
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
;
1160 Lparen_Sloc
:= Token_Ptr
;
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
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
1182 return Aggregate_Node
;
1184 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
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");
1198 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1199 return Aggregate_Node
;
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
1211 Bad_Range_Attribute
(Sloc
(Expr_Node
));
1215 if Ada_Version
= Ada_83
then
1216 Error_Msg_SC
("(Ada 83) extension aggregate not allowed");
1219 Aggregate_Node
:= New_Node
(N_Extension_Aggregate
, Lparen_Sloc
);
1220 Set_Ancestor_Part
(Aggregate_Node
, Expr_Node
);
1223 -- Deal with WITH NULL RECORD case
1225 if Token
= Tok_Null
then
1226 Save_Scan_State
(Scan_State
); -- at NULL
1229 if Token
= Tok_Record
then
1230 Scan
; -- past RECORD
1231 Set_Null_Record_Present
(Aggregate_Node
, True);
1233 return Aggregate_Node
;
1236 Restore_Scan_State
(Scan_State
); -- to NULL that must be expr
1240 if Token
/= Tok_Others
then
1241 Save_Scan_State
(Scan_State
);
1242 Expr_Node
:= P_Expression
;
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
1254 ("|parentheses not allowed for range attribute", Lparen_Sloc
);
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);
1269 T_Right_Paren
; -- past right paren (error message if none)
1272 -- Normal aggregate case
1275 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
1281 Aggregate_Node
:= New_Node
(N_Aggregate
, Lparen_Sloc
);
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.
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
;
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");
1312 -- A range attribute can only appear as part of a discrete choice
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
1320 Bad_Range_Attribute
(Sloc
(Expr_Node
));
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
1334 if Present
(Assoc_List
) then
1336 ("""='>"" expected (positional association cannot follow " &
1337 "named association)");
1340 if No
(Expr_List
) then
1341 Expr_List
:= New_List
;
1344 Append
(Expr_Node
, Expr_List
);
1346 -- Anything else is assumed to be a named association
1349 Restore_Scan_State
(Scan_State
); -- to start of expression
1351 if No
(Assoc_List
) then
1352 Assoc_List
:= New_List
;
1355 Append
(P_Record_Or_Array_Component_Association
, Assoc_List
);
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");
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
1375 Save_Scan_State
(Scan_State
); -- at start of expression
1376 Expr_Node
:= P_Expression_Or_Range_Attribute
;
1381 -- All component associations (positional and named) have been scanned
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}
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
;
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
);
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
1431 ("limited aggregate is an Ada 2005 extension");
1432 Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
1435 Set_Box_Present
(Assoc_Node
);
1438 Set_Expression
(Assoc_Node
, P_Expression
);
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 ---------------------
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
;
1522 Node1
:= P_Relation
;
1524 if Token
in Token_Class_Logop
then
1525 Prev_Logical_Op
:= N_Empty
;
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
1535 ("mixed logical operators in expression", Op_Location
);
1536 Prev_Logical_Op
:= N_Empty
;
1538 Prev_Logical_Op
:= Logical_Op
;
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
;
1549 Expr_Form
:= EF_Non_Simple
;
1552 if Token
= Tok_Apostrophe
then
1553 Bad_Range_Attribute
(Token_Ptr
);
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
1570 return No_Right_Paren
(P_Expression
);
1571 end P_Expression_No_Right_Paren
;
1573 ----------------------------------------
1574 -- 4.4 Expression_Or_Range_Attribute --
1575 ----------------------------------------
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
;
1604 Attr_Node
: Node_Id
;
1607 Node1
:= P_Relation
;
1609 if Token
= Tok_Apostrophe
then
1610 Attr_Node
:= P_Range_Attribute_Reference
(Node1
);
1611 Expr_Form
:= EF_Range_Attr
;
1614 elsif Token
in Token_Class_Logop
then
1615 Prev_Logical_Op
:= N_Empty
;
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
1625 ("mixed logical operators in expression", Op_Location
);
1626 Prev_Logical_Op
:= N_Empty
;
1628 Prev_Logical_Op
:= Logical_Op
;
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
;
1639 Expr_Form
:= EF_Non_Simple
;
1642 if Token
= Tok_Apostrophe
then
1643 Bad_Range_Attribute
(Token_Ptr
);
1648 end P_Expression_Or_Range_Attribute
;
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
;
1673 Node1
:= P_Simple_Expression
;
1675 if Token
not in Token_Class_Relop
then
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.
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 (= /= < <= > >=)
1697 Set_Right_Opnd
(Node2
, P_Simple_Expression
);
1700 Expr_Form
:= EF_Non_Simple
;
1702 if Token
in Token_Class_Relop
then
1703 Error_Msg_SC
("unexpected relational operator");
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.
1715 when Error_Resync
=>
1717 Expr_Form
:= EF_Simple
;
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
;
1747 Tokptr
: Source_Ptr
;
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
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
;
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
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.
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
);
1797 Set_Left_Opnd
(Node2
, Node1
);
1798 Set_Right_Opnd
(Node2
, P_Primary
);
1799 Set_Op_Name
(Node2
);
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
);
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
);
1827 Expr_Form
:= EF_Simple
;
1830 -- Cases where simple expression does not start with a name
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
);
1846 -- Scan out sequence of terms separated by binary adding operators
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
);
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
;
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");
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 ...
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
1904 Error_Msg_AP
("binary operator expected");
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.
1915 when Error_Resync
=>
1917 Expr_Form
:= EF_Simple
;
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
1937 Attr_Node
: Node_Id
;
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
;
1950 end P_Simple_Expression_Or_Range_Attribute
;
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
;
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
);
1985 -- FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
1987 -- Error recovery: can raise Error_Resync
1989 function P_Factor
return Node_Id
is
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;
1998 Set_Right_Opnd
(Node1
, P_Primary
);
1999 Set_Op_Name
(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;
2006 Set_Right_Opnd
(Node1
, P_Primary
);
2007 Set_Op_Name
(Node1
);
2013 if Token
= Tok_Double_Asterisk
then
2014 Node2
:= New_Node
(N_Op_Expon
, Token_Ptr
);
2016 Set_Left_Opnd
(Node2
, Node1
);
2017 Set_Right_Opnd
(Node2
, P_Primary
);
2018 Set_Op_Name
(Node2
);
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
;
2043 -- The loop runs more than once only if misplaced pragmas are found
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
=>
2056 -- All done unless apostrophe follows
2058 if Token
/= Tok_Apostrophe
then
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
);
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
);
2092 -- Numeric or string literal
2094 when Tok_Integer_Literal |
2096 Tok_String_Literal
=>
2098 Node1
:= Token_Node
;
2099 Scan
; -- past number
2102 -- Left paren, starts aggregate or parenthesized expression
2104 when Tok_Left_Paren
=>
2105 return P_Aggregate_Or_Paren_Expr
;
2116 return New_Node
(N_Null
, Prev_Token_Ptr
);
2118 -- Pragma, not allowed here, so just skip past it
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
2127 if Is_Reserved_Identifier
then
2128 return P_Identifier
;
2130 elsif Prev_Token
= Tok_Comma
then
2131 Error_Msg_SP
("extra "","" ignored");
2135 Error_Msg_AP
("missing operand");
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
2162 if Token
= Tok_And
then
2163 if Style_Check
then Style
.Check_Binary_Operator
; end if;
2166 if Token
= Tok_Then
then
2173 elsif Token
= Tok_Or
then
2174 if Style_Check
then Style
.Check_Binary_Operator
; end if;
2177 if Token
= Tok_Else
then
2184 else -- Token = Tok_Xor
2185 if Style_Check
then Style
.Check_Binary_Operator
; 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
,
2215 Tok_Not
=> N_Not_In
,
2216 Tok_Box
=> N_Op_Ne
);
2219 if Token
= Tok_Box
then
2220 Error_Msg_SC
("""'<'>"" should be ""/=""");
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
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
);
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
);
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
);
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
;
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
);
2338 end P_Qualified_Expression
;
2340 --------------------
2342 --------------------
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;
2357 Alloc_Node
:= New_Node
(N_Allocator
, Token_Ptr
);
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
));
2372 P_Subtype_Indication
(Type_Node
, Null_Exclusion_Present
));