OSDN Git Service

89f3345e8879e4df8736cac94c6f013ab0414ff8
[pf3gnuchains/gcc-fork.git] / gcc / ada / par-ch4.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                              P A R . C H 4                               --
6 --                                                                          --
7 --                                 B o d y                                  --
8 --                                                                          --
9 --          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
10 --                                                                          --
11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
12 -- terms of the  GNU General Public License as published  by the Free Soft- --
13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17 -- for  more details.  You should have  received  a copy of the GNU General --
18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
20 --                                                                          --
21 -- GNAT was originally developed  by the GNAT team at  New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
23 --                                                                          --
24 ------------------------------------------------------------------------------
25
26 pragma Style_Checks (All_Checks);
27 --  Turn off subprogram body ordering check. Subprograms are in order
28 --  by RM section rather than alphabetical
29
30 with Stringt; use Stringt;
31
32 separate (Par)
33 package body Ch4 is
34
35    -----------------------
36    -- Local Subprograms --
37    -----------------------
38
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;
46
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;
52
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.
56
57    function P_Range_Attribute_Reference
58      (Prefix_Node : Node_Id)
59       return        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.
63
64    procedure Set_Op_Name (Node : Node_Id);
65    --  Procedure to set name field (Chars) in operator node
66
67    -------------------------
68    -- Bad_Range_Attribute --
69    -------------------------
70
71    procedure Bad_Range_Attribute (Loc : Source_Ptr) is
72    begin
73       Error_Msg ("range attribute cannot be used in expression!", Loc);
74       Resync_Expression;
75    end Bad_Range_Attribute;
76
77    ------------------
78    -- Set_Op_Name --
79    ------------------
80
81    procedure Set_Op_Name (Node : Node_Id) is
82       type Name_Of_Type is array (N_Op) of Name_Id;
83       Name_Of : constant 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,
105
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)
109
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);
115
116    begin
117       if Nkind (Node) in N_Op then
118          Set_Chars (Node, Name_Of (Nkind (Node)));
119       end if;
120    end Set_Op_Name;
121
122    --------------------------
123    -- 4.1  Name (also 6.4) --
124    --------------------------
125
126    --  NAME ::=
127    --    DIRECT_NAME        | EXPLICIT_DEREFERENCE
128    --  | INDEXED_COMPONENT  | SLICE
129    --  | SELECTED_COMPONENT | ATTRIBUTE
130    --  | TYPE_CONVERSION    | FUNCTION_CALL
131    --  | CHARACTER_LITERAL
132
133    --  DIRECT_NAME ::= IDENTIFIER | OPERATOR_SYMBOL
134
135    --  PREFIX ::= NAME | IMPLICIT_DEREFERENCE
136
137    --  EXPLICIT_DEREFERENCE ::= NAME . all
138
139    --  IMPLICIT_DEREFERENCE ::= NAME
140
141    --  INDEXED_COMPONENT ::= PREFIX (EXPRESSION {, EXPRESSION})
142
143    --  SLICE ::= PREFIX (DISCRETE_RANGE)
144
145    --  SELECTED_COMPONENT ::= PREFIX . SELECTOR_NAME
146
147    --  SELECTOR_NAME ::= IDENTIFIER | CHARACTER_LITERAL | OPERATOR_SYMBOL
148
149    --  ATTRIBUTE_REFERENCE ::= PREFIX ' ATTRIBUTE_DESIGNATOR
150
151    --  ATTRIBUTE_DESIGNATOR ::=
152    --    IDENTIFIER [(static_EXPRESSION)]
153    --  | access | delta | digits
154
155    --  FUNCTION_CALL ::=
156    --    function_NAME
157    --  | function_PREFIX ACTUAL_PARAMETER_PART
158
159    --  ACTUAL_PARAMETER_PART ::=
160    --    (PARAMETER_ASSOCIATION {,PARAMETER_ASSOCIATION})
161
162    --  PARAMETER_ASSOCIATION ::=
163    --    [formal_parameter_SELECTOR_NAME =>] EXPLICIT_ACTUAL_PARAMETER
164
165    --  EXPLICIT_ACTUAL_PARAMETER ::= EXPRESSION | variable_NAME
166
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.
169
170    --  On return, Expr_Form is set to either EF_Name or EF_Simple_Name
171
172    --  Error recovery: can raise Error_Resync
173
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.
178
179    --  Error recovery: can raise Error_Resync
180
181    function P_Name return Node_Id is
182       Scan_State  : Saved_Scan_State;
183       Name_Node   : Node_Id;
184       Prefix_Node : Node_Id;
185       Ident_Node  : Node_Id;
186       Expr_Node   : Node_Id;
187       Range_Node  : Node_Id;
188       Arg_Node    : Node_Id;
189
190       Arg_List  : List_Id := No_List; -- kill junk warning
191       Attr_Name : Name_Id := No_Name; -- kill junk warning
192
193    begin
194       --  Case of not a name
195
196       if Token not in Token_Class_Name then
197
198          --  If it looks like start of expression, complain and scan expression
199
200          if Token in Token_Class_Literal
201            or else Token = Tok_Left_Paren
202          then
203             Error_Msg_SC ("name expected");
204             return P_Expression;
205
206          --  Otherwise some other junk, not much we can do
207
208          else
209             Error_Msg_AP ("name expected");
210             raise Error_Resync;
211          end if;
212       end if;
213
214       --  Loop through designators in qualified name
215
216       Name_Node := Token_Node;
217
218       loop
219          Scan; -- past designator
220          exit when Token /= Tok_Dot;
221          Save_Scan_State (Scan_State); -- at dot
222          Scan; -- past dot
223
224          --  If we do not have another designator after the dot, then join
225          --  the normal circuit to handle a dot extension (may be .all or
226          --  character literal case). Otherwise loop back to scan the next
227          --  designator.
228
229          if Token not in Token_Class_Desig then
230             goto Scan_Name_Extension_Dot;
231          else
232             Prefix_Node := Name_Node;
233             Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
234             Set_Prefix (Name_Node, Prefix_Node);
235             Set_Selector_Name (Name_Node, Token_Node);
236          end if;
237       end loop;
238
239       --  We have now scanned out a qualified designator. If the last token is
240       --  an operator symbol, then we certainly do not have the Snam case, so
241       --  we can just use the normal name extension check circuit
242
243       if Prev_Token = Tok_Operator_Symbol then
244          goto Scan_Name_Extension;
245       end if;
246
247       --  We have scanned out a qualified simple name, check for name extension
248       --  Note that we know there is no dot here at this stage, so the only
249       --  possible cases of name extension are apostrophe and left paren.
250
251       if Token = Tok_Apostrophe then
252          Save_Scan_State (Scan_State); -- at apostrophe
253          Scan; -- past apostrophe
254
255          --  If left paren, then this might be a qualified expression, but we
256          --  are only in the business of scanning out names, so return with
257          --  Token backed up to point to the apostrophe. The treatment for
258          --  the range attribute is similar (we do not consider x'range to
259          --  be a name in this grammar).
260
261          if Token = Tok_Left_Paren or else Token = Tok_Range then
262             Restore_Scan_State (Scan_State); -- to apostrophe
263             Expr_Form := EF_Simple_Name;
264             return Name_Node;
265
266          --  Otherwise we have the case of a name extended by an attribute
267
268          else
269             goto Scan_Name_Extension_Apostrophe;
270          end if;
271
272       --  Check case of qualified simple name extended by a left parenthesis
273
274       elsif Token = Tok_Left_Paren then
275          Scan; -- past left paren
276          goto Scan_Name_Extension_Left_Paren;
277
278       --  Otherwise the qualified simple name is not extended, so return
279
280       else
281          Expr_Form := EF_Simple_Name;
282          return Name_Node;
283       end if;
284
285       --  Loop scanning past name extensions. A label is used for control
286       --  transfer for this loop for ease of interfacing with the finite state
287       --  machine in the parenthesis scanning circuit, and also to allow for
288       --  passing in control to the appropriate point from the above code.
289
290       <<Scan_Name_Extension>>
291
292          --  Character literal used as name cannot be extended. Also this
293          --  cannot be a call, since the name for a call must be a designator.
294          --  Return in these cases, or if there is no name extension
295
296          if Token not in Token_Class_Namext
297            or else Prev_Token = Tok_Char_Literal
298          then
299             Expr_Form := EF_Name;
300             return Name_Node;
301          end if;
302
303       --  Merge here when we know there is a name extension
304
305       <<Scan_Name_Extension_OK>>
306
307          if Token = Tok_Left_Paren then
308             Scan; -- past left paren
309             goto Scan_Name_Extension_Left_Paren;
310
311          elsif Token = Tok_Apostrophe then
312             Save_Scan_State (Scan_State); -- at apostrophe
313             Scan; -- past apostrophe
314             goto Scan_Name_Extension_Apostrophe;
315
316          else -- Token = Tok_Dot
317             Save_Scan_State (Scan_State); -- at dot
318             Scan; -- past dot
319             goto Scan_Name_Extension_Dot;
320          end if;
321
322       --  Case of name extended by dot (selection), dot is already skipped
323       --  and the scan state at the point of the dot is saved in Scan_State.
324
325       <<Scan_Name_Extension_Dot>>
326
327          --  Explicit dereference case
328
329          if Token = Tok_All then
330             Prefix_Node := Name_Node;
331             Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
332             Set_Prefix (Name_Node, Prefix_Node);
333             Scan; -- past ALL
334             goto Scan_Name_Extension;
335
336          --  Selected component case
337
338          elsif Token in Token_Class_Name then
339             Prefix_Node := Name_Node;
340             Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
341             Set_Prefix (Name_Node, Prefix_Node);
342             Set_Selector_Name (Name_Node, Token_Node);
343             Scan; -- past selector
344             goto Scan_Name_Extension;
345
346          --  Reserved identifier as selector
347
348          elsif Is_Reserved_Identifier then
349             Scan_Reserved_Identifier (Force_Msg => False);
350             Prefix_Node := Name_Node;
351             Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
352             Set_Prefix (Name_Node, Prefix_Node);
353             Set_Selector_Name (Name_Node, Token_Node);
354             Scan; -- past identifier used as selector
355             goto Scan_Name_Extension;
356
357          --  If dot is at end of line and followed by nothing legal,
358          --  then assume end of name and quit (dot will be taken as
359          --  an erroneous form of some other punctuation by our caller).
360
361          elsif Token_Is_At_Start_Of_Line then
362             Restore_Scan_State (Scan_State);
363             return Name_Node;
364
365          --  Here if nothing legal after the dot
366
367          else
368             Error_Msg_AP ("selector expected");
369             raise Error_Resync;
370          end if;
371
372       --  Here for an apostrophe as name extension. The scan position at the
373       --  apostrophe has already been saved, and the apostrophe scanned out.
374
375       <<Scan_Name_Extension_Apostrophe>>
376
377          Scan_Apostrophe : declare
378             function Apostrophe_Should_Be_Semicolon return Boolean;
379             --  Checks for case where apostrophe should probably be
380             --  a semicolon, and if so, gives appropriate message,
381             --  resets the scan pointer to the apostrophe, changes
382             --  the current token to Tok_Semicolon, and returns True.
383             --  Otherwise returns False.
384
385             function Apostrophe_Should_Be_Semicolon return Boolean is
386             begin
387                if Token_Is_At_Start_Of_Line then
388                   Restore_Scan_State (Scan_State); -- to apostrophe
389                   Error_Msg_SC ("""''"" should be "";""");
390                   Token := Tok_Semicolon;
391                   return True;
392                else
393                   return False;
394                end if;
395             end Apostrophe_Should_Be_Semicolon;
396
397          --  Start of processing for Scan_Apostrophe
398
399          begin
400             --  If range attribute after apostrophe, then return with Token
401             --  pointing to the apostrophe. Note that in this case the prefix
402             --  need not be a simple name (cases like A.all'range). Similarly
403             --  if there is a left paren after the apostrophe, then we also
404             --  return with Token pointing to the apostrophe (this is the
405             --  qualified expression case).
406
407             if Token = Tok_Range or else Token = Tok_Left_Paren then
408                Restore_Scan_State (Scan_State); -- to apostrophe
409                Expr_Form := EF_Name;
410                return Name_Node;
411
412             --  Here for cases where attribute designator is an identifier
413
414             elsif Token = Tok_Identifier then
415                Attr_Name := Token_Name;
416
417                if not Is_Attribute_Name (Attr_Name) then
418                   if Apostrophe_Should_Be_Semicolon then
419                      Expr_Form := EF_Name;
420                      return Name_Node;
421
422                   --  Here for a bad attribute name
423
424                   else
425                      Signal_Bad_Attribute;
426                      Scan; -- past bad identifier
427
428                      if Token = Tok_Left_Paren then
429                         Scan; -- past left paren
430
431                         loop
432                            Discard_Junk_Node (P_Expression);
433                            exit when not Comma_Present;
434                         end loop;
435
436                         T_Right_Paren;
437                      end if;
438
439                      return Error;
440                   end if;
441                end if;
442
443                if Style_Check then
444                   Style.Check_Attribute_Name (False);
445                end if;
446
447                Delete_Node (Token_Node);
448
449             --  Here for case of attribute designator is not an identifier
450
451             else
452                if Token = Tok_Delta then
453                   Attr_Name := Name_Delta;
454
455                elsif Token = Tok_Digits then
456                   Attr_Name := Name_Digits;
457
458                elsif Token = Tok_Access then
459                   Attr_Name := Name_Access;
460
461                elsif Token = Tok_Mod and then Ada_Version = Ada_05 then
462                   Attr_Name := Name_Mod;
463
464                elsif Apostrophe_Should_Be_Semicolon then
465                   Expr_Form := EF_Name;
466                   return Name_Node;
467
468                else
469                   Error_Msg_AP ("attribute designator expected");
470                   raise Error_Resync;
471                end if;
472
473                if Style_Check then
474                   Style.Check_Attribute_Name (True);
475                end if;
476             end if;
477
478             --  We come here with an OK attribute scanned, and the
479             --  corresponding Attribute identifier node stored in Ident_Node.
480
481             Prefix_Node := Name_Node;
482             Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
483             Scan; -- past attribute designator
484             Set_Prefix (Name_Node, Prefix_Node);
485             Set_Attribute_Name (Name_Node, Attr_Name);
486
487             --  Scan attribute arguments/designator
488
489             if Token = Tok_Left_Paren then
490                Set_Expressions (Name_Node, New_List);
491                Scan; -- past left paren
492
493                loop
494                   declare
495                      Expr : constant Node_Id := P_Expression;
496
497                   begin
498                      if Token = Tok_Arrow then
499                         Error_Msg_SC
500                           ("named parameters not permitted for attributes");
501                         Scan; -- past junk arrow
502
503                      else
504                         Append (Expr, Expressions (Name_Node));
505                         exit when not Comma_Present;
506                      end if;
507                   end;
508                end loop;
509
510                T_Right_Paren;
511             end if;
512
513             goto Scan_Name_Extension;
514          end Scan_Apostrophe;
515
516       --  Here for left parenthesis extending name (left paren skipped)
517
518       <<Scan_Name_Extension_Left_Paren>>
519
520          --  We now have to scan through a list of items, terminated by a
521          --  right parenthesis. The scan is handled by a finite state
522          --  machine. The possibilities are:
523
524          --   (discrete_range)
525
526          --      This is a slice. This case is handled in LP_State_Init
527
528          --   (expression, expression, ..)
529
530          --      This is interpreted as an indexed component, i.e. as a
531          --      case of a name which can be extended in the normal manner.
532          --      This case is handled by LP_State_Name or LP_State_Expr.
533
534          --   (..., identifier => expression , ...)
535
536          --      If there is at least one occurrence of identifier => (but
537          --      none of the other cases apply), then we have a call.
538
539          --  Test for Id => case
540
541          if Token = Tok_Identifier then
542             Save_Scan_State (Scan_State); -- at Id
543             Scan; -- past Id
544
545             --  Test for => (allow := as an error substitute)
546
547             if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
548                Restore_Scan_State (Scan_State); -- to Id
549                Arg_List := New_List;
550                goto LP_State_Call;
551
552             else
553                Restore_Scan_State (Scan_State); -- to Id
554             end if;
555          end if;
556
557          --  Here we have an expression after all
558
559          Expr_Node := P_Expression_Or_Range_Attribute;
560
561          --  Check cases of discrete range for a slice
562
563          --  First possibility: Range_Attribute_Reference
564
565          if Expr_Form = EF_Range_Attr then
566             Range_Node := Expr_Node;
567
568          --  Second possibility: Simple_expression .. Simple_expression
569
570          elsif Token = Tok_Dot_Dot then
571             Check_Simple_Expression (Expr_Node);
572             Range_Node := New_Node (N_Range, Token_Ptr);
573             Set_Low_Bound (Range_Node, Expr_Node);
574             Scan; -- past ..
575             Expr_Node := P_Expression;
576             Check_Simple_Expression (Expr_Node);
577             Set_High_Bound (Range_Node, Expr_Node);
578
579          --  Third possibility: Type_name range Range
580
581          elsif Token = Tok_Range then
582             if Expr_Form /= EF_Simple_Name then
583                Error_Msg_SC ("subtype mark must precede RANGE");
584                raise Error_Resync;
585             end if;
586
587             Range_Node := P_Subtype_Indication (Expr_Node);
588
589          --  Otherwise we just have an expression. It is true that we might
590          --  have a subtype mark without a range constraint but this case
591          --  is syntactically indistinguishable from the expression case.
592
593          else
594             Arg_List := New_List;
595             goto LP_State_Expr;
596          end if;
597
598          --  Fall through here with unmistakable Discrete range scanned,
599          --  which means that we definitely have the case of a slice. The
600          --  Discrete range is in Range_Node.
601
602          if Token = Tok_Comma then
603             Error_Msg_SC ("slice cannot have more than one dimension");
604             raise Error_Resync;
605
606          elsif Token /= Tok_Right_Paren then
607             T_Right_Paren;
608             raise Error_Resync;
609
610          else
611             Scan; -- past right paren
612             Prefix_Node := Name_Node;
613             Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
614             Set_Prefix (Name_Node, Prefix_Node);
615             Set_Discrete_Range (Name_Node, Range_Node);
616
617             --  An operator node is legal as a prefix to other names,
618             --  but not for a slice.
619
620             if Nkind (Prefix_Node) = N_Operator_Symbol then
621                Error_Msg_N ("illegal prefix for slice", Prefix_Node);
622             end if;
623
624             --  If we have a name extension, go scan it
625
626             if Token in Token_Class_Namext then
627                goto Scan_Name_Extension_OK;
628
629             --  Otherwise return (a slice is a name, but is not a call)
630
631             else
632                Expr_Form := EF_Name;
633                return Name_Node;
634             end if;
635          end if;
636
637       --  In LP_State_Expr, we have scanned one or more expressions, and
638       --  so we have a call or an indexed component which is a name. On
639       --  entry we have the expression just scanned in Expr_Node and
640       --  Arg_List contains the list of expressions encountered so far
641
642       <<LP_State_Expr>>
643          Append (Expr_Node, Arg_List);
644
645          if Token = Tok_Arrow then
646             Error_Msg
647               ("expect identifier in parameter association",
648                 Sloc (Expr_Node));
649             Scan;  --   past arrow.
650
651          elsif not Comma_Present then
652             T_Right_Paren;
653             Prefix_Node := Name_Node;
654             Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
655             Set_Prefix (Name_Node, Prefix_Node);
656             Set_Expressions (Name_Node, Arg_List);
657             goto Scan_Name_Extension;
658          end if;
659
660          --  Comma present (and scanned out), test for identifier => case
661          --  Test for identifier => case
662
663          if Token = Tok_Identifier then
664             Save_Scan_State (Scan_State); -- at Id
665             Scan; -- past Id
666
667             --  Test for => (allow := as error substitute)
668
669             if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
670                Restore_Scan_State (Scan_State); -- to Id
671                goto LP_State_Call;
672
673             --  Otherwise it's just an expression after all, so backup
674
675             else
676                Restore_Scan_State (Scan_State); -- to Id
677             end if;
678          end if;
679
680          --  Here we have an expression after all, so stay in this state
681
682          Expr_Node := P_Expression;
683          goto LP_State_Expr;
684
685       --  LP_State_Call corresponds to the situation in which at least
686       --  one instance of Id => Expression has been encountered, so we
687       --  know that we do not have a name, but rather a call. We enter
688       --  it with the scan pointer pointing to the next argument to scan,
689       --  and Arg_List containing the list of arguments scanned so far.
690
691       <<LP_State_Call>>
692
693          --  Test for case of Id => Expression (named parameter)
694
695          if Token = Tok_Identifier then
696             Save_Scan_State (Scan_State); -- at Id
697             Ident_Node := Token_Node;
698             Scan; -- past Id
699
700             --  Deal with => (allow := as erroneous substitute)
701
702             if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
703                Arg_Node :=
704                  New_Node (N_Parameter_Association, Prev_Token_Ptr);
705                Set_Selector_Name (Arg_Node, Ident_Node);
706                T_Arrow;
707                Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
708                Append (Arg_Node, Arg_List);
709
710                --  If a comma follows, go back and scan next entry
711
712                if Comma_Present then
713                   goto LP_State_Call;
714
715                --  Otherwise we have the end of a call
716
717                else
718                   Prefix_Node := Name_Node;
719                   Name_Node :=
720                     New_Node (N_Function_Call, Sloc (Prefix_Node));
721                   Set_Name (Name_Node, Prefix_Node);
722                   Set_Parameter_Associations (Name_Node, Arg_List);
723                   T_Right_Paren;
724
725                   if Token in Token_Class_Namext then
726                      goto Scan_Name_Extension_OK;
727
728                   --  This is a case of a call which cannot be a name
729
730                   else
731                      Expr_Form := EF_Name;
732                      return Name_Node;
733                   end if;
734                end if;
735
736             --  Not named parameter: Id started an expression after all
737
738             else
739                Restore_Scan_State (Scan_State); -- to Id
740             end if;
741          end if;
742
743          --  Here if entry did not start with Id => which means that it
744          --  is a positional parameter, which is not allowed, since we
745          --  have seen at least one named parameter already.
746
747          Error_Msg_SC
748             ("positional parameter association " &
749               "not allowed after named one");
750
751          Expr_Node := P_Expression;
752
753          --  Leaving the '>' in an association is not unusual, so suggest
754          --  a possible fix.
755
756          if Nkind (Expr_Node) = N_Op_Eq then
757             Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
758          end if;
759
760          --  We go back to scanning out expressions, so that we do not get
761          --  multiple error messages when several positional parameters
762          --  follow a named parameter.
763
764          goto LP_State_Expr;
765
766          --  End of treatment for name extensions starting with left paren
767
768       --  End of loop through name extensions
769
770    end P_Name;
771
772    --  This function parses a restricted form of Names which are either
773    --  designators, or designators preceded by a sequence of prefixes
774    --  that are direct names.
775
776    --  Error recovery: cannot raise Error_Resync
777
778    function P_Function_Name return Node_Id is
779       Designator_Node : Node_Id;
780       Prefix_Node     : Node_Id;
781       Selector_Node   : Node_Id;
782       Dot_Sloc        : Source_Ptr := No_Location;
783
784    begin
785       --  Prefix_Node is set to the gathered prefix so far, Empty means that
786       --  no prefix has been scanned. This allows us to build up the result
787       --  in the required right recursive manner.
788
789       Prefix_Node := Empty;
790
791       --  Loop through prefixes
792
793       loop
794          Designator_Node := Token_Node;
795
796          if Token not in Token_Class_Desig then
797             return P_Identifier; -- let P_Identifier issue the error message
798
799          else -- Token in Token_Class_Desig
800             Scan; -- past designator
801             exit when Token /= Tok_Dot;
802          end if;
803
804          --  Here at a dot, with token just before it in Designator_Node
805
806          if No (Prefix_Node) then
807             Prefix_Node := Designator_Node;
808          else
809             Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
810             Set_Prefix (Selector_Node, Prefix_Node);
811             Set_Selector_Name (Selector_Node, Designator_Node);
812             Prefix_Node := Selector_Node;
813          end if;
814
815          Dot_Sloc := Token_Ptr;
816          Scan; -- past dot
817       end loop;
818
819       --  Fall out of the loop having just scanned a designator
820
821       if No (Prefix_Node) then
822          return Designator_Node;
823       else
824          Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
825          Set_Prefix (Selector_Node, Prefix_Node);
826          Set_Selector_Name (Selector_Node, Designator_Node);
827          return Selector_Node;
828       end if;
829
830    exception
831       when Error_Resync =>
832          return Error;
833
834    end P_Function_Name;
835
836    --  This function parses a restricted form of Names which are either
837    --  identifiers, or identifiers preceded by a sequence of prefixes
838    --  that are direct names.
839
840    --  Error recovery: cannot raise Error_Resync
841
842    function P_Qualified_Simple_Name return Node_Id is
843       Designator_Node : Node_Id;
844       Prefix_Node     : Node_Id;
845       Selector_Node   : Node_Id;
846       Dot_Sloc        : Source_Ptr := No_Location;
847
848    begin
849       --  Prefix node is set to the gathered prefix so far, Empty means that
850       --  no prefix has been scanned. This allows us to build up the result
851       --  in the required right recursive manner.
852
853       Prefix_Node := Empty;
854
855       --  Loop through prefixes
856
857       loop
858          Designator_Node := Token_Node;
859
860          if Token = Tok_Identifier then
861             Scan; -- past identifier
862             exit when Token /= Tok_Dot;
863
864          elsif Token not in Token_Class_Desig then
865             return P_Identifier; -- let P_Identifier issue the error message
866
867          else
868             Scan; -- past designator
869
870             if Token /= Tok_Dot then
871                Error_Msg_SP ("identifier expected");
872                return Error;
873             end if;
874          end if;
875
876          --  Here at a dot, with token just before it in Designator_Node
877
878          if No (Prefix_Node) then
879             Prefix_Node := Designator_Node;
880          else
881             Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
882             Set_Prefix (Selector_Node, Prefix_Node);
883             Set_Selector_Name (Selector_Node, Designator_Node);
884             Prefix_Node := Selector_Node;
885          end if;
886
887          Dot_Sloc := Token_Ptr;
888          Scan; -- past dot
889       end loop;
890
891       --  Fall out of the loop having just scanned an identifier
892
893       if No (Prefix_Node) then
894          return Designator_Node;
895       else
896          Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
897          Set_Prefix (Selector_Node, Prefix_Node);
898          Set_Selector_Name (Selector_Node, Designator_Node);
899          return Selector_Node;
900       end if;
901
902    exception
903       when Error_Resync =>
904          return Error;
905
906    end P_Qualified_Simple_Name;
907
908    --  This procedure differs from P_Qualified_Simple_Name only in that it
909    --  raises Error_Resync if any error is encountered. It only returns after
910    --  scanning a valid qualified simple name.
911
912    --  Error recovery: can raise Error_Resync
913
914    function P_Qualified_Simple_Name_Resync return Node_Id is
915       Designator_Node : Node_Id;
916       Prefix_Node     : Node_Id;
917       Selector_Node   : Node_Id;
918       Dot_Sloc        : Source_Ptr := No_Location;
919
920    begin
921       Prefix_Node := Empty;
922
923       --  Loop through prefixes
924
925       loop
926          Designator_Node := Token_Node;
927
928          if Token = Tok_Identifier then
929             Scan; -- past identifier
930             exit when Token /= Tok_Dot;
931
932          elsif Token not in Token_Class_Desig then
933             Discard_Junk_Node (P_Identifier); -- to issue the error message
934             raise Error_Resync;
935
936          else
937             Scan; -- past designator
938
939             if Token /= Tok_Dot then
940                Error_Msg_SP ("identifier expected");
941                raise Error_Resync;
942             end if;
943          end if;
944
945          --  Here at a dot, with token just before it in Designator_Node
946
947          if No (Prefix_Node) then
948             Prefix_Node := Designator_Node;
949          else
950             Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
951             Set_Prefix (Selector_Node, Prefix_Node);
952             Set_Selector_Name (Selector_Node, Designator_Node);
953             Prefix_Node := Selector_Node;
954          end if;
955
956          Dot_Sloc := Token_Ptr;
957          Scan; -- past period
958       end loop;
959
960       --  Fall out of the loop having just scanned an identifier
961
962       if No (Prefix_Node) then
963          return Designator_Node;
964       else
965          Selector_Node := New_Node (N_Selected_Component, Dot_Sloc);
966          Set_Prefix (Selector_Node, Prefix_Node);
967          Set_Selector_Name (Selector_Node, Designator_Node);
968          return Selector_Node;
969       end if;
970
971    end P_Qualified_Simple_Name_Resync;
972
973    ----------------------
974    -- 4.1  Direct_Name --
975    ----------------------
976
977    --  Parsed by P_Name and other functions in section 4.1
978
979    -----------------
980    -- 4.1  Prefix --
981    -----------------
982
983    --  Parsed by P_Name (4.1)
984
985    -------------------------------
986    -- 4.1  Explicit Dereference --
987    -------------------------------
988
989    --  Parsed by P_Name (4.1)
990
991    -------------------------------
992    -- 4.1  Implicit_Dereference --
993    -------------------------------
994
995    --  Parsed by P_Name (4.1)
996
997    ----------------------------
998    -- 4.1  Indexed Component --
999    ----------------------------
1000
1001    --  Parsed by P_Name (4.1)
1002
1003    ----------------
1004    -- 4.1  Slice --
1005    ----------------
1006
1007    --  Parsed by P_Name (4.1)
1008
1009    -----------------------------
1010    -- 4.1  Selected_Component --
1011    -----------------------------
1012
1013    --  Parsed by P_Name (4.1)
1014
1015    ------------------------
1016    -- 4.1  Selector Name --
1017    ------------------------
1018
1019    --  Parsed by P_Name (4.1)
1020
1021    ------------------------------
1022    -- 4.1  Attribute Reference --
1023    ------------------------------
1024
1025    --  Parsed by P_Name (4.1)
1026
1027    -------------------------------
1028    -- 4.1  Attribute Designator --
1029    -------------------------------
1030
1031    --  Parsed by P_Name (4.1)
1032
1033    --------------------------------------
1034    -- 4.1.4  Range Attribute Reference --
1035    --------------------------------------
1036
1037    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1038
1039    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1040
1041    --  In the grammar, a RANGE attribute is simply a name, but its use is
1042    --  highly restricted, so in the parser, we do not regard it as a name.
1043    --  Instead, P_Name returns without scanning the 'RANGE part of the
1044    --  attribute, and the caller uses the following function to construct
1045    --  a range attribute in places where it is appropriate.
1046
1047    --  Note that RANGE here is treated essentially as an identifier,
1048    --  rather than a reserved word.
1049
1050    --  The caller has parsed the prefix, i.e. a name, and Token points to
1051    --  the apostrophe. The token after the apostrophe is known to be RANGE
1052    --  at this point. The prefix node becomes the prefix of the attribute.
1053
1054    --  Error_Recovery: Cannot raise Error_Resync
1055
1056    function P_Range_Attribute_Reference
1057      (Prefix_Node : Node_Id)
1058       return        Node_Id
1059    is
1060       Attr_Node  : Node_Id;
1061
1062    begin
1063       Attr_Node := New_Node (N_Attribute_Reference, Token_Ptr);
1064       Set_Prefix (Attr_Node, Prefix_Node);
1065       Scan; -- past apostrophe
1066
1067       if Style_Check then
1068          Style.Check_Attribute_Name (True);
1069       end if;
1070
1071       Set_Attribute_Name (Attr_Node, Name_Range);
1072       Scan; -- past RANGE
1073
1074       if Token = Tok_Left_Paren then
1075          Scan; -- past left paren
1076          Set_Expressions (Attr_Node, New_List (P_Expression));
1077          T_Right_Paren;
1078       end if;
1079
1080       return Attr_Node;
1081    end P_Range_Attribute_Reference;
1082
1083    ---------------------------------------
1084    -- 4.1.4  Range Attribute Designator --
1085    ---------------------------------------
1086
1087    --  Parsed by P_Range_Attribute_Reference (4.4)
1088
1089    --------------------
1090    -- 4.3  Aggregate --
1091    --------------------
1092
1093    --  AGGREGATE ::= RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1094
1095    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3), except in the case where
1096    --  an aggregate is known to be required (code statement, extension
1097    --  aggregate), in which cases this routine performs the necessary check
1098    --  that we have an aggregate rather than a parenthesized expression
1099
1100    --  Error recovery: can raise Error_Resync
1101
1102    function P_Aggregate return Node_Id is
1103       Aggr_Sloc : constant Source_Ptr := Token_Ptr;
1104       Aggr_Node : constant Node_Id    := P_Aggregate_Or_Paren_Expr;
1105
1106    begin
1107       if Nkind (Aggr_Node) /= N_Aggregate
1108            and then
1109          Nkind (Aggr_Node) /= N_Extension_Aggregate
1110       then
1111          Error_Msg
1112            ("aggregate may not have single positional component", Aggr_Sloc);
1113          return Error;
1114       else
1115          return Aggr_Node;
1116       end if;
1117    end P_Aggregate;
1118
1119    -------------------------------------------------
1120    -- 4.3  Aggregate or Parenthesized Expresssion --
1121    -------------------------------------------------
1122
1123    --  This procedure parses out either an aggregate or a parenthesized
1124    --  expression (these two constructs are closely related, since a
1125    --  parenthesized expression looks like an aggregate with a single
1126    --  positional component).
1127
1128    --  AGGREGATE ::=
1129    --    RECORD_AGGREGATE | EXTENSION_AGGREGATE | ARRAY_AGGREGATE
1130
1131    --  RECORD_AGGREGATE ::= (RECORD_COMPONENT_ASSOCIATION_LIST)
1132
1133    --  RECORD_COMPONENT_ASSOCIATION_LIST ::=
1134    --     RECORD_COMPONENT_ASSOCIATION {, RECORD_COMPONENT_ASSOCIATION}
1135    --   | null record
1136
1137    --  RECORD_COMPONENT_ASSOCIATION ::=
1138    --    [COMPONENT_CHOICE_LIST =>] EXPRESSION
1139
1140    --  COMPONENT_CHOICE_LIST ::=
1141    --    component_SELECTOR_NAME {| component_SELECTOR_NAME}
1142    --  | others
1143
1144    --  EXTENSION_AGGREGATE ::=
1145    --    (ANCESTOR_PART with RECORD_COMPONENT_ASSOCIATION_LIST)
1146
1147    --  ANCESTOR_PART ::= EXPRESSION | SUBTYPE_MARK
1148
1149    --  ARRAY_AGGREGATE ::=
1150    --    POSITIONAL_ARRAY_AGGREGATE | NAMED_ARRAY_AGGREGATE
1151
1152    --  POSITIONAL_ARRAY_AGGREGATE ::=
1153    --    (EXPRESSION, EXPRESSION {, EXPRESSION})
1154    --  | (EXPRESSION {, EXPRESSION}, others => EXPRESSION)
1155    --  | (EXPRESSION {, EXPRESSION}, others => <>)
1156
1157    --  NAMED_ARRAY_AGGREGATE ::=
1158    --    (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION})
1159
1160    --  PRIMARY ::= (EXPRESSION);
1161
1162    --  Error recovery: can raise Error_Resync
1163
1164    --  Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
1165    --        to Ada 2005 limited aggregates (AI-287)
1166
1167    function P_Aggregate_Or_Paren_Expr return Node_Id is
1168       Aggregate_Node : Node_Id;
1169       Expr_List      : List_Id;
1170       Assoc_List     : List_Id;
1171       Expr_Node      : Node_Id;
1172       Lparen_Sloc    : Source_Ptr;
1173       Scan_State     : Saved_Scan_State;
1174
1175    begin
1176       Lparen_Sloc := Token_Ptr;
1177       T_Left_Paren;
1178
1179       --  Note: the mechanism used here of rescanning the initial expression
1180       --  is distinctly unpleasant, but it saves a lot of fiddling in scanning
1181       --  out the discrete choice list.
1182
1183       --  Deal with expression and extension aggregate cases first
1184
1185       if Token /= Tok_Others then
1186          Save_Scan_State (Scan_State); -- at start of expression
1187
1188          --  Deal with (NULL RECORD) case
1189
1190          if Token = Tok_Null then
1191             Scan; -- past NULL
1192
1193             if Token = Tok_Record then
1194                Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1195                Set_Null_Record_Present (Aggregate_Node, True);
1196                Scan; -- past RECORD
1197                T_Right_Paren;
1198                return Aggregate_Node;
1199             else
1200                Restore_Scan_State (Scan_State); -- to NULL that must be expr
1201             end if;
1202          end if;
1203
1204          --  Ada 2005 (AI-287): The box notation is allowed only with named
1205          --  notation because positional notation might be error prone. For
1206          --  example, in "(X, <>, Y, <>)", there is no type associated with
1207          --  the boxes, so you might not be leaving out the components you
1208          --  thought you were leaving out.
1209
1210          if Ada_Version >= Ada_05 and then Token = Tok_Box then
1211             Error_Msg_SC ("(Ada 2005) box notation only allowed with "
1212                           & "named notation");
1213             Scan; --  past BOX
1214             Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1215             return Aggregate_Node;
1216          end if;
1217
1218          Expr_Node := P_Expression_Or_Range_Attribute;
1219
1220          --  Extension aggregate case
1221
1222          if Token = Tok_With then
1223
1224             if Nkind (Expr_Node) = N_Attribute_Reference
1225               and then Attribute_Name (Expr_Node) = Name_Range
1226             then
1227                Bad_Range_Attribute (Sloc (Expr_Node));
1228                return Error;
1229             end if;
1230
1231             if Ada_Version = Ada_83 then
1232                Error_Msg_SC ("(Ada 83) extension aggregate not allowed");
1233             end if;
1234
1235             Aggregate_Node := New_Node (N_Extension_Aggregate, Lparen_Sloc);
1236             Set_Ancestor_Part (Aggregate_Node, Expr_Node);
1237             Scan; -- past WITH
1238
1239             --  Deal with WITH NULL RECORD case
1240
1241             if Token = Tok_Null then
1242                Save_Scan_State (Scan_State); -- at NULL
1243                Scan; -- past NULL
1244
1245                if Token = Tok_Record then
1246                   Scan; -- past RECORD
1247                   Set_Null_Record_Present (Aggregate_Node, True);
1248                   T_Right_Paren;
1249                   return Aggregate_Node;
1250
1251                else
1252                   Restore_Scan_State (Scan_State); -- to NULL that must be expr
1253                end if;
1254             end if;
1255
1256             if Token /= Tok_Others then
1257                Save_Scan_State (Scan_State);
1258                Expr_Node := P_Expression;
1259             else
1260                Expr_Node := Empty;
1261             end if;
1262
1263          --  Expression case
1264
1265          elsif Token = Tok_Right_Paren or else Token in Token_Class_Eterm then
1266             if Nkind (Expr_Node) = N_Attribute_Reference
1267               and then Attribute_Name (Expr_Node) = Name_Range
1268             then
1269                Error_Msg
1270                  ("|parentheses not allowed for range attribute", Lparen_Sloc);
1271                Scan; -- past right paren
1272                return Expr_Node;
1273             end if;
1274
1275             --  Bump paren count of expression
1276
1277             if Expr_Node /= Error then
1278                Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
1279             end if;
1280
1281             T_Right_Paren; -- past right paren (error message if none)
1282             return Expr_Node;
1283
1284          --  Normal aggregate case
1285
1286          else
1287             Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1288          end if;
1289
1290       --  Others case
1291
1292       else
1293          Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc);
1294          Expr_Node := Empty;
1295       end if;
1296
1297       --  Prepare to scan list of component associations
1298
1299       Expr_List  := No_List; -- don't set yet, maybe all named entries
1300       Assoc_List := No_List; -- don't set yet, maybe all positional entries
1301
1302       --  This loop scans through component associations. On entry to the
1303       --  loop, an expression has been scanned at the start of the current
1304       --  association unless initial token was OTHERS, in which case
1305       --  Expr_Node is set to Empty.
1306
1307       loop
1308          --  Deal with others association first. This is a named association
1309
1310          if No (Expr_Node) then
1311             if No (Assoc_List) then
1312                Assoc_List := New_List;
1313             end if;
1314
1315             Append (P_Record_Or_Array_Component_Association, Assoc_List);
1316
1317          --  Improper use of WITH
1318
1319          elsif Token = Tok_With then
1320             Error_Msg_SC ("WITH must be preceded by single expression in " &
1321                              "extension aggregate");
1322             raise Error_Resync;
1323
1324          --  A range attribute can only appear as part of a discrete choice
1325          --  list.
1326
1327          elsif Nkind (Expr_Node) = N_Attribute_Reference
1328            and then Attribute_Name (Expr_Node) = Name_Range
1329            and then Token /= Tok_Arrow
1330            and then Token /= Tok_Vertical_Bar
1331          then
1332             Bad_Range_Attribute (Sloc (Expr_Node));
1333             return Error;
1334
1335          --  Assume positional case if comma, right paren, or literal or
1336          --  identifier or OTHERS follows (the latter cases are missing
1337          --  comma cases). Also assume positional if a semicolon follows,
1338          --  which can happen if there are missing parens
1339
1340          elsif Token = Tok_Comma
1341            or else Token = Tok_Right_Paren
1342            or else Token = Tok_Others
1343            or else Token in Token_Class_Lit_Or_Name
1344            or else Token = Tok_Semicolon
1345          then
1346             if Present (Assoc_List) then
1347                Error_Msg_BC
1348                   ("""='>"" expected (positional association cannot follow " &
1349                    "named association)");
1350             end if;
1351
1352             if No (Expr_List) then
1353                Expr_List := New_List;
1354             end if;
1355
1356             Append (Expr_Node, Expr_List);
1357
1358          --  Anything else is assumed to be a named association
1359
1360          else
1361             Restore_Scan_State (Scan_State); -- to start of expression
1362
1363             if No (Assoc_List) then
1364                Assoc_List := New_List;
1365             end if;
1366
1367             Append (P_Record_Or_Array_Component_Association, Assoc_List);
1368          end if;
1369
1370          exit when not Comma_Present;
1371
1372          --  If we are at an expression terminator, something is seriously
1373          --  wrong, so let's get out now, before we start eating up stuff
1374          --  that doesn't belong to us!
1375
1376          if Token in Token_Class_Eterm then
1377             Error_Msg_AP ("expecting expression or component association");
1378             exit;
1379          end if;
1380
1381          --  Otherwise initiate for reentry to top of loop by scanning an
1382          --  initial expression, unless the first token is OTHERS.
1383
1384          if Token = Tok_Others then
1385             Expr_Node := Empty;
1386          else
1387             Save_Scan_State (Scan_State); -- at start of expression
1388             Expr_Node := P_Expression_Or_Range_Attribute;
1389
1390          end if;
1391       end loop;
1392
1393       --  All component associations (positional and named) have been scanned
1394
1395       T_Right_Paren;
1396       Set_Expressions (Aggregate_Node, Expr_List);
1397       Set_Component_Associations (Aggregate_Node, Assoc_List);
1398       return Aggregate_Node;
1399    end P_Aggregate_Or_Paren_Expr;
1400
1401    ------------------------------------------------
1402    -- 4.3  Record or Array Component Association --
1403    ------------------------------------------------
1404
1405    --  RECORD_COMPONENT_ASSOCIATION ::=
1406    --    [COMPONENT_CHOICE_LIST =>] EXPRESSION
1407    --  | COMPONENT_CHOICE_LIST => <>
1408
1409    --  COMPONENT_CHOICE_LIST =>
1410    --    component_SELECTOR_NAME {| component_SELECTOR_NAME}
1411    --  | others
1412
1413    --  ARRAY_COMPONENT_ASSOCIATION ::=
1414    --    DISCRETE_CHOICE_LIST => EXPRESSION
1415    --  | DISCRETE_CHOICE_LIST => <>
1416
1417    --  Note: this routine only handles the named cases, including others.
1418    --  Cases where the component choice list is not present have already
1419    --  been handled directly.
1420
1421    --  Error recovery: can raise Error_Resync
1422
1423    --  Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
1424    --        rules have been extended to give support to Ada 2005 limited
1425    --        aggregates (AI-287)
1426
1427    function P_Record_Or_Array_Component_Association return Node_Id is
1428       Assoc_Node : Node_Id;
1429
1430    begin
1431       Assoc_Node := New_Node (N_Component_Association, Token_Ptr);
1432       Set_Choices (Assoc_Node, P_Discrete_Choice_List);
1433       Set_Sloc (Assoc_Node, Token_Ptr);
1434       TF_Arrow;
1435
1436       if Token = Tok_Box then
1437
1438          --  Ada 2005(AI-287): The box notation is used to indicate the
1439          --  default initialization of aggregate components
1440
1441          if Ada_Version < Ada_05 then
1442             Error_Msg_SP
1443               ("component association with '<'> is an Ada 2005 extension");
1444             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
1445          end if;
1446
1447          Set_Box_Present (Assoc_Node);
1448          Scan; -- Past box
1449       else
1450          Set_Expression (Assoc_Node, P_Expression);
1451       end if;
1452
1453       return Assoc_Node;
1454    end P_Record_Or_Array_Component_Association;
1455
1456    -----------------------------
1457    -- 4.3.1  Record Aggregate --
1458    -----------------------------
1459
1460    --  Case of enumeration aggregate is parsed by P_Aggregate (4.3)
1461    --  All other cases are parsed by P_Aggregate_Or_Paren_Expr (4.3)
1462
1463    ----------------------------------------------
1464    -- 4.3.1  Record Component Association List --
1465    ----------------------------------------------
1466
1467    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1468
1469    ----------------------------------
1470    -- 4.3.1  Component Choice List --
1471    ----------------------------------
1472
1473    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1474
1475    --------------------------------
1476    -- 4.3.1  Extension Aggregate --
1477    --------------------------------
1478
1479    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1480
1481    --------------------------
1482    -- 4.3.1  Ancestor Part --
1483    --------------------------
1484
1485    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1486
1487    ----------------------------
1488    -- 4.3.1  Array Aggregate --
1489    ----------------------------
1490
1491    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1492
1493    ---------------------------------------
1494    -- 4.3.1  Positional Array Aggregate --
1495    ---------------------------------------
1496
1497    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1498
1499    ----------------------------------
1500    -- 4.3.1  Named Array Aggregate --
1501    ----------------------------------
1502
1503    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1504
1505    ----------------------------------------
1506    -- 4.3.1  Array Component Association --
1507    ----------------------------------------
1508
1509    --  Parsed by P_Aggregate_Or_Paren_Expr (4.3)
1510
1511    ---------------------
1512    -- 4.4  Expression --
1513    ---------------------
1514
1515    --  EXPRESSION ::=
1516    --    RELATION {and RELATION} | RELATION {and then RELATION}
1517    --  | RELATION {or RELATION}  | RELATION {or else RELATION}
1518    --  | RELATION {xor RELATION}
1519
1520    --  On return, Expr_Form indicates the categorization of the expression
1521    --  EF_Range_Attr is not a possible value (if a range attribute is found,
1522    --  an error message is given, and Error is returned).
1523
1524    --  Error recovery: cannot raise Error_Resync
1525
1526    function P_Expression return Node_Id is
1527       Logical_Op      : Node_Kind;
1528       Prev_Logical_Op : Node_Kind;
1529       Op_Location     : Source_Ptr;
1530       Node1           : Node_Id;
1531       Node2           : Node_Id;
1532
1533    begin
1534       Node1 := P_Relation;
1535
1536       if Token in Token_Class_Logop then
1537          Prev_Logical_Op := N_Empty;
1538
1539          loop
1540             Op_Location := Token_Ptr;
1541             Logical_Op := P_Logical_Operator;
1542
1543             if Prev_Logical_Op /= N_Empty and then
1544                Logical_Op /= Prev_Logical_Op
1545             then
1546                Error_Msg
1547                  ("mixed logical operators in expression", Op_Location);
1548                Prev_Logical_Op := N_Empty;
1549             else
1550                Prev_Logical_Op := Logical_Op;
1551             end if;
1552
1553             Node2 := Node1;
1554             Node1 := New_Node (Logical_Op, Op_Location);
1555             Set_Left_Opnd (Node1, Node2);
1556             Set_Right_Opnd (Node1, P_Relation);
1557             Set_Op_Name (Node1);
1558             exit when Token not in Token_Class_Logop;
1559          end loop;
1560
1561          Expr_Form := EF_Non_Simple;
1562       end if;
1563
1564       if Token = Tok_Apostrophe then
1565          Bad_Range_Attribute (Token_Ptr);
1566          return Error;
1567       else
1568          return Node1;
1569       end if;
1570    end P_Expression;
1571
1572    --  This function is identical to the normal P_Expression, except that it
1573    --  checks that the expression scan did not stop on a right paren. It is
1574    --  called in all contexts where a right parenthesis cannot legitimately
1575    --  follow an expression.
1576
1577    --  Error recovery: can not raise Error_Resync
1578
1579    function P_Expression_No_Right_Paren return Node_Id is
1580       Expr : constant Node_Id := P_Expression;
1581    begin
1582       Check_No_Right_Paren;
1583       return Expr;
1584    end P_Expression_No_Right_Paren;
1585
1586    ----------------------------------------
1587    -- 4.4  Expression_Or_Range_Attribute --
1588    ----------------------------------------
1589
1590    --  EXPRESSION ::=
1591    --    RELATION {and RELATION} | RELATION {and then RELATION}
1592    --  | RELATION {or RELATION}  | RELATION {or else RELATION}
1593    --  | RELATION {xor RELATION}
1594
1595    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
1596
1597    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
1598
1599    --  On return, Expr_Form indicates the categorization of the expression
1600    --  and EF_Range_Attr is one of the possibilities.
1601
1602    --  Error recovery: cannot raise Error_Resync
1603
1604    --  In the grammar, a RANGE attribute is simply a name, but its use is
1605    --  highly restricted, so in the parser, we do not regard it as a name.
1606    --  Instead, P_Name returns without scanning the 'RANGE part of the
1607    --  attribute, and P_Expression_Or_Range_Attribute handles the range
1608    --  attribute reference. In the normal case where a range attribute is
1609    --  not allowed, an error message is issued by P_Expression.
1610
1611    function P_Expression_Or_Range_Attribute return Node_Id is
1612       Logical_Op      : Node_Kind;
1613       Prev_Logical_Op : Node_Kind;
1614       Op_Location     : Source_Ptr;
1615       Node1           : Node_Id;
1616       Node2           : Node_Id;
1617       Attr_Node       : Node_Id;
1618
1619    begin
1620       Node1 := P_Relation;
1621
1622       if Token = Tok_Apostrophe then
1623          Attr_Node := P_Range_Attribute_Reference (Node1);
1624          Expr_Form := EF_Range_Attr;
1625          return Attr_Node;
1626
1627       elsif Token in Token_Class_Logop then
1628          Prev_Logical_Op := N_Empty;
1629
1630          loop
1631             Op_Location := Token_Ptr;
1632             Logical_Op := P_Logical_Operator;
1633
1634             if Prev_Logical_Op /= N_Empty and then
1635                Logical_Op /= Prev_Logical_Op
1636             then
1637                Error_Msg
1638                  ("mixed logical operators in expression", Op_Location);
1639                Prev_Logical_Op := N_Empty;
1640             else
1641                Prev_Logical_Op := Logical_Op;
1642             end if;
1643
1644             Node2 := Node1;
1645             Node1 := New_Node (Logical_Op, Op_Location);
1646             Set_Left_Opnd (Node1, Node2);
1647             Set_Right_Opnd (Node1, P_Relation);
1648             Set_Op_Name (Node1);
1649             exit when Token not in Token_Class_Logop;
1650          end loop;
1651
1652          Expr_Form := EF_Non_Simple;
1653       end if;
1654
1655       if Token = Tok_Apostrophe then
1656          Bad_Range_Attribute (Token_Ptr);
1657          return Error;
1658       else
1659          return Node1;
1660       end if;
1661    end P_Expression_Or_Range_Attribute;
1662
1663    -------------------
1664    -- 4.4  Relation --
1665    -------------------
1666
1667    --  RELATION ::=
1668    --    SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
1669    --  | SIMPLE_EXPRESSION [not] in RANGE
1670    --  | SIMPLE_EXPRESSION [not] in SUBTYPE_MARK
1671
1672    --  On return, Expr_Form indicates the categorization of the expression
1673
1674    --  Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1675    --  EF_Simple_Name and the following token is RANGE (range attribute case).
1676
1677    --  Error recovery: cannot raise Error_Resync. If an error occurs within an
1678    --  expression, then tokens are scanned until either a non-expression token,
1679    --  a right paren (not matched by a left paren) or a comma, is encountered.
1680
1681    function P_Relation return Node_Id is
1682       Node1, Node2 : Node_Id;
1683       Optok        : Source_Ptr;
1684
1685    begin
1686       Node1 := P_Simple_Expression;
1687
1688       if Token not in Token_Class_Relop then
1689          return Node1;
1690
1691       else
1692          --  Here we have a relational operator following. If so then scan it
1693          --  out. Note that the assignment symbol := is treated as a relational
1694          --  operator to improve the error recovery when it is misused for =.
1695          --  P_Relational_Operator also parses the IN and NOT IN operations.
1696
1697          Optok := Token_Ptr;
1698          Node2 := New_Node (P_Relational_Operator, Optok);
1699          Set_Left_Opnd (Node2, Node1);
1700          Set_Op_Name (Node2);
1701
1702          --  Case of IN or NOT IN
1703
1704          if Prev_Token = Tok_In then
1705             Set_Right_Opnd (Node2, P_Range_Or_Subtype_Mark);
1706
1707          --  Case of relational operator (= /= < <= > >=)
1708
1709          else
1710             Set_Right_Opnd (Node2, P_Simple_Expression);
1711          end if;
1712
1713          Expr_Form := EF_Non_Simple;
1714
1715          if Token in Token_Class_Relop then
1716             Error_Msg_SC ("unexpected relational operator");
1717             raise Error_Resync;
1718          end if;
1719
1720          return Node2;
1721       end if;
1722
1723    --  If any error occurs, then scan to the next expression terminator symbol
1724    --  or comma or right paren at the outer (i.e. current) parentheses level.
1725    --  The flags are set to indicate a normal simple expression.
1726
1727    exception
1728       when Error_Resync =>
1729          Resync_Expression;
1730          Expr_Form := EF_Simple;
1731          return Error;
1732    end P_Relation;
1733
1734    ----------------------------
1735    -- 4.4  Simple Expression --
1736    ----------------------------
1737
1738    --  SIMPLE_EXPRESSION ::=
1739    --    [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
1740
1741    --  On return, Expr_Form indicates the categorization of the expression
1742
1743    --  Note: if Token = Tok_Apostrophe on return, then Expr_Form is set to
1744    --  EF_Simple_Name and the following token is RANGE (range attribute case).
1745
1746    --  Error recovery: cannot raise Error_Resync. If an error occurs within an
1747    --  expression, then tokens are scanned until either a non-expression token,
1748    --  a right paren (not matched by a left paren) or a comma, is encountered.
1749
1750    --  Note: P_Simple_Expression is called only internally by higher level
1751    --  expression routines. In cases in the grammar where a simple expression
1752    --  is required, the approach is to scan an expression, and then post an
1753    --  appropriate error message if the expression obtained is not simple. This
1754    --  gives better error recovery and treatment.
1755
1756    function P_Simple_Expression return Node_Id is
1757       Scan_State : Saved_Scan_State;
1758       Node1      : Node_Id;
1759       Node2      : Node_Id;
1760       Tokptr     : Source_Ptr;
1761
1762    begin
1763       --  Check for cases starting with a name. There are two reasons for
1764       --  special casing. First speed things up by catching a common case
1765       --  without going through several routine layers. Second the caller must
1766       --  be informed via Expr_Form when the simple expression is a name.
1767
1768       if Token in Token_Class_Name then
1769          Node1 := P_Name;
1770
1771          --  Deal with apostrophe cases
1772
1773          if Token = Tok_Apostrophe then
1774             Save_Scan_State (Scan_State); -- at apostrophe
1775             Scan; -- past apostrophe
1776
1777             --  If qualified expression, scan it out and fall through
1778
1779             if Token = Tok_Left_Paren then
1780                Node1 := P_Qualified_Expression (Node1);
1781                Expr_Form := EF_Simple;
1782
1783             --  If range attribute, then we return with Token pointing to the
1784             --  apostrophe. Note: avoid the normal error check on exit. We
1785             --  know that the expression really is complete in this case!
1786
1787             else -- Token = Tok_Range then
1788                Restore_Scan_State (Scan_State); -- to apostrophe
1789                Expr_Form := EF_Simple_Name;
1790                return Node1;
1791             end if;
1792          end if;
1793
1794          --  If an expression terminator follows, the previous processing
1795          --  completely scanned out the expression (a common case), and
1796          --  left Expr_Form set appropriately for returning to our caller.
1797
1798          if Token in Token_Class_Sterm then
1799             null;
1800
1801          --  If we do not have an expression terminator, then complete the
1802          --  scan of a simple expression. This code duplicates the code
1803          --  found in P_Term and P_Factor.
1804
1805          else
1806             if Token = Tok_Double_Asterisk then
1807                if Style_Check then
1808                   Style.Check_Exponentiation_Operator;
1809                end if;
1810
1811                Node2 := New_Node (N_Op_Expon, Token_Ptr);
1812                Scan; -- past **
1813                Set_Left_Opnd (Node2, Node1);
1814                Set_Right_Opnd (Node2, P_Primary);
1815                Set_Op_Name (Node2);
1816                Node1 := Node2;
1817             end if;
1818
1819             loop
1820                exit when Token not in Token_Class_Mulop;
1821                Tokptr := Token_Ptr;
1822                Node2 := New_Node (P_Multiplying_Operator, Tokptr);
1823
1824                if Style_Check then
1825                   Style.Check_Binary_Operator;
1826                end if;
1827
1828                Scan; -- past operator
1829                Set_Left_Opnd (Node2, Node1);
1830                Set_Right_Opnd (Node2, P_Factor);
1831                Set_Op_Name (Node2);
1832                Node1 := Node2;
1833             end loop;
1834
1835             loop
1836                exit when Token not in Token_Class_Binary_Addop;
1837                Tokptr := Token_Ptr;
1838                Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1839
1840                if Style_Check then
1841                   Style.Check_Binary_Operator;
1842                end if;
1843
1844                Scan; -- past operator
1845                Set_Left_Opnd (Node2, Node1);
1846                Set_Right_Opnd (Node2, P_Term);
1847                Set_Op_Name (Node2);
1848                Node1 := Node2;
1849             end loop;
1850
1851             Expr_Form := EF_Simple;
1852          end if;
1853
1854       --  Cases where simple expression does not start with a name
1855
1856       else
1857          --  Scan initial sign and initial Term
1858
1859          if Token in Token_Class_Unary_Addop then
1860             Tokptr := Token_Ptr;
1861             Node1 := New_Node (P_Unary_Adding_Operator, Tokptr);
1862
1863             if Style_Check then
1864                Style.Check_Unary_Plus_Or_Minus;
1865             end if;
1866
1867             Scan; -- past operator
1868             Set_Right_Opnd (Node1, P_Term);
1869             Set_Op_Name (Node1);
1870          else
1871             Node1 := P_Term;
1872          end if;
1873
1874          --  In the following, we special-case a sequence of concatentations of
1875          --  string literals, such as "aaa" & "bbb" & ... & "ccc", with nothing
1876          --  else mixed in. For such a sequence, we return a tree representing
1877          --  "" & "aaabbb...ccc" (a single concatenation). This is done only if
1878          --  the number of concatenations is large. If semantic analysis
1879          --  resolves the "&" to a predefined one, then this folding gives the
1880          --  right answer. Otherwise, semantic analysis will complain about a
1881          --  capacity-exceeded error. The purpose of this trick is to avoid
1882          --  creating a deeply nested tree, which would cause deep recursion
1883          --  during semantics, causing stack overflow. This way, we can handle
1884          --  enormous concatenations in the normal case of predefined "&".  We
1885          --  first build up the normal tree, and then rewrite it if
1886          --  appropriate.
1887
1888          declare
1889             Num_Concats_Threshold : constant Positive := 1000;
1890             --  Arbitrary threshold value to enable optimization
1891
1892             First_Node : constant Node_Id := Node1;
1893             Is_Strlit_Concat : Boolean;
1894             --  True iff we've parsed a sequence of concatenations of string
1895             --  literals, with nothing else mixed in.
1896
1897             Num_Concats : Natural;
1898             --  Number of "&" operators if Is_Strlit_Concat is True
1899
1900          begin
1901             Is_Strlit_Concat :=
1902               Nkind (Node1) = N_String_Literal
1903                 and then Token = Tok_Ampersand;
1904             Num_Concats := 0;
1905
1906             --  Scan out sequence of terms separated by binary adding operators
1907
1908             loop
1909                exit when Token not in Token_Class_Binary_Addop;
1910                Tokptr := Token_Ptr;
1911                Node2 := New_Node (P_Binary_Adding_Operator, Tokptr);
1912                Scan; -- past operator
1913                Set_Left_Opnd (Node2, Node1);
1914                Node1 := P_Term;
1915                Set_Right_Opnd (Node2, Node1);
1916                Set_Op_Name (Node2);
1917
1918                --  Check if we're still concatenating string literals
1919
1920                Is_Strlit_Concat :=
1921                  Is_Strlit_Concat
1922                    and then Nkind (Node2) = N_Op_Concat
1923                  and then Nkind (Node1) = N_String_Literal;
1924
1925                if Is_Strlit_Concat then
1926                   Num_Concats := Num_Concats + 1;
1927                end if;
1928
1929                Node1 := Node2;
1930             end loop;
1931
1932             --  If we have an enormous series of concatenations of string
1933             --  literals, rewrite as explained above. The Is_Folded_In_Parser
1934             --  flag tells semantic analysis that if the "&" is not predefined,
1935             --  the folded value is wrong.
1936
1937             if Is_Strlit_Concat
1938               and then Num_Concats >= Num_Concats_Threshold
1939             then
1940                declare
1941                   Empty_String_Val : String_Id;
1942                   --  String_Id for ""
1943
1944                   Strlit_Concat_Val : String_Id;
1945                   --  Contains the folded value (which will be correct if the
1946                   --  "&" operators are the predefined ones).
1947
1948                   Cur_Node : Node_Id;
1949                   --  For walking up the tree
1950
1951                   New_Node : Node_Id;
1952                   --  Folded node to replace Node1
1953
1954                   Loc : constant Source_Ptr := Sloc (First_Node);
1955
1956                begin
1957                   --  Walk up the tree starting at the leftmost string literal
1958                   --  (First_Node), building up the Strlit_Concat_Val as we
1959                   --  go. Note that we do not use recursion here -- the whole
1960                   --  point is to avoid recursively walking that enormous tree.
1961
1962                   Start_String;
1963                   Store_String_Chars (Strval (First_Node));
1964
1965                   Cur_Node := Parent (First_Node);
1966                   while Present (Cur_Node) loop
1967                      pragma Assert (Nkind (Cur_Node) = N_Op_Concat and then
1968                         Nkind (Right_Opnd (Cur_Node)) = N_String_Literal);
1969
1970                      Store_String_Chars (Strval (Right_Opnd (Cur_Node)));
1971                      Cur_Node := Parent (Cur_Node);
1972                   end loop;
1973
1974                   Strlit_Concat_Val := End_String;
1975
1976                   --  Create new folded node, and rewrite result with a concat-
1977                   --  enation of an empty string literal and the folded node.
1978
1979                   Start_String;
1980                   Empty_String_Val := End_String;
1981                   New_Node :=
1982                     Make_Op_Concat (Loc,
1983                       Make_String_Literal (Loc, Empty_String_Val),
1984                       Make_String_Literal (Loc, Strlit_Concat_Val,
1985                         Is_Folded_In_Parser => True));
1986                   Rewrite (Node1, New_Node);
1987                end;
1988             end if;
1989          end;
1990
1991          --  All done, we clearly do not have name or numeric literal so this
1992          --  is a case of a simple expression which is some other possibility.
1993
1994          Expr_Form := EF_Simple;
1995       end if;
1996
1997       --  Come here at end of simple expression, where we do a couple of
1998       --  special checks to improve error recovery.
1999
2000       --  Special test to improve error recovery. If the current token
2001       --  is a period, then someone is trying to do selection on something
2002       --  that is not a name, e.g. a qualified expression.
2003
2004       if Token = Tok_Dot then
2005          Error_Msg_SC ("prefix for selection is not a name");
2006          raise Error_Resync;
2007       end if;
2008
2009       --  Special test to improve error recovery: If the current token is
2010       --  not the first token on a line (as determined by checking the
2011       --  previous token position with the start of the current line),
2012       --  then we insist that we have an appropriate terminating token.
2013       --  Consider the following two examples:
2014
2015       --   1)  if A nad B then ...
2016
2017       --   2)  A := B
2018       --       C := D
2019
2020       --  In the first example, we would like to issue a binary operator
2021       --  expected message and resynchronize to the then. In the second
2022       --  example, we do not want to issue a binary operator message, so
2023       --  that instead we will get the missing semicolon message. This
2024       --  distinction is of course a heuristic which does not always work,
2025       --  but in practice it is quite effective.
2026
2027       --  Note: the one case in which we do not go through this circuit is
2028       --  when we have scanned a range attribute and want to return with
2029       --  Token pointing to the apostrophe. The apostrophe is not normally
2030       --  an expression terminator, and is not in Token_Class_Sterm, but
2031       --  in this special case we know that the expression is complete.
2032
2033       if not Token_Is_At_Start_Of_Line
2034          and then Token not in Token_Class_Sterm
2035       then
2036          Error_Msg_AP ("binary operator expected");
2037          raise Error_Resync;
2038       else
2039          return Node1;
2040       end if;
2041
2042    --  If any error occurs, then scan to next expression terminator symbol
2043    --  or comma, right paren or vertical bar at the outer (i.e. current) paren
2044    --  level. Expr_Form is set to indicate a normal simple expression.
2045
2046    exception
2047       when Error_Resync =>
2048          Resync_Expression;
2049          Expr_Form := EF_Simple;
2050          return Error;
2051
2052    end P_Simple_Expression;
2053
2054    -----------------------------------------------
2055    -- 4.4  Simple Expression or Range Attribute --
2056    -----------------------------------------------
2057
2058    --  SIMPLE_EXPRESSION ::=
2059    --    [UNARY_ADDING_OPERATOR] TERM {BINARY_ADDING_OPERATOR TERM}
2060
2061    --  RANGE_ATTRIBUTE_REFERENCE ::= PREFIX ' RANGE_ATTRIBUTE_DESIGNATOR
2062
2063    --  RANGE_ATTRIBUTE_DESIGNATOR ::= range [(static_EXPRESSION)]
2064
2065    --  Error recovery: cannot raise Error_Resync
2066
2067    function P_Simple_Expression_Or_Range_Attribute return Node_Id is
2068       Sexpr     : Node_Id;
2069       Attr_Node : Node_Id;
2070
2071    begin
2072       --  We don't just want to roar ahead and call P_Simple_Expression
2073       --  here, since we want to handle the case of a parenthesized range
2074       --  attribute cleanly.
2075
2076       if Token = Tok_Left_Paren then
2077          declare
2078             Lptr       : constant Source_Ptr := Token_Ptr;
2079             Scan_State : Saved_Scan_State;
2080
2081          begin
2082             Save_Scan_State (Scan_State);
2083             Scan; -- past left paren
2084             Sexpr := P_Simple_Expression;
2085
2086             if Token = Tok_Apostrophe then
2087                Attr_Node := P_Range_Attribute_Reference (Sexpr);
2088                Expr_Form := EF_Range_Attr;
2089
2090                if Token = Tok_Right_Paren then
2091                   Scan; -- scan past right paren if present
2092                end if;
2093
2094                Error_Msg ("parentheses not allowed for range attribute", Lptr);
2095
2096                return Attr_Node;
2097             end if;
2098
2099             Restore_Scan_State (Scan_State);
2100          end;
2101       end if;
2102
2103       --  Here after dealing with parenthesized range attribute
2104
2105       Sexpr := P_Simple_Expression;
2106
2107       if Token = Tok_Apostrophe then
2108          Attr_Node := P_Range_Attribute_Reference (Sexpr);
2109          Expr_Form := EF_Range_Attr;
2110          return Attr_Node;
2111
2112       else
2113          return Sexpr;
2114       end if;
2115    end P_Simple_Expression_Or_Range_Attribute;
2116
2117    ---------------
2118    -- 4.4  Term --
2119    ---------------
2120
2121    --  TERM ::= FACTOR {MULTIPLYING_OPERATOR FACTOR}
2122
2123    --  Error recovery: can raise Error_Resync
2124
2125    function P_Term return Node_Id is
2126       Node1, Node2 : Node_Id;
2127       Tokptr       : Source_Ptr;
2128
2129    begin
2130       Node1 := P_Factor;
2131
2132       loop
2133          exit when Token not in Token_Class_Mulop;
2134          Tokptr := Token_Ptr;
2135          Node2 := New_Node (P_Multiplying_Operator, Tokptr);
2136          Scan; -- past operator
2137          Set_Left_Opnd (Node2, Node1);
2138          Set_Right_Opnd (Node2, P_Factor);
2139          Set_Op_Name (Node2);
2140          Node1 := Node2;
2141       end loop;
2142
2143       return Node1;
2144    end P_Term;
2145
2146    -----------------
2147    -- 4.4  Factor --
2148    -----------------
2149
2150    --  FACTOR ::= PRIMARY [** PRIMARY] | abs PRIMARY | not PRIMARY
2151
2152    --  Error recovery: can raise Error_Resync
2153
2154    function P_Factor return Node_Id is
2155       Node1 : Node_Id;
2156       Node2 : Node_Id;
2157
2158    begin
2159       if Token = Tok_Abs then
2160          Node1 := New_Node (N_Op_Abs, Token_Ptr);
2161
2162          if Style_Check then
2163             Style.Check_Abs_Not;
2164          end if;
2165
2166          Scan; -- past ABS
2167          Set_Right_Opnd (Node1, P_Primary);
2168          Set_Op_Name (Node1);
2169          return Node1;
2170
2171       elsif Token = Tok_Not then
2172          Node1 := New_Node (N_Op_Not, Token_Ptr);
2173
2174          if Style_Check then
2175             Style.Check_Abs_Not;
2176          end if;
2177
2178          Scan; -- past NOT
2179          Set_Right_Opnd (Node1, P_Primary);
2180          Set_Op_Name (Node1);
2181          return Node1;
2182
2183       else
2184          Node1 := P_Primary;
2185
2186          if Token = Tok_Double_Asterisk then
2187             Node2 := New_Node (N_Op_Expon, Token_Ptr);
2188             Scan; -- past **
2189             Set_Left_Opnd (Node2, Node1);
2190             Set_Right_Opnd (Node2, P_Primary);
2191             Set_Op_Name (Node2);
2192             return Node2;
2193          else
2194             return Node1;
2195          end if;
2196       end if;
2197    end P_Factor;
2198
2199    ------------------
2200    -- 4.4  Primary --
2201    ------------------
2202
2203    --  PRIMARY ::=
2204    --    NUMERIC_LITERAL  | null
2205    --  | STRING_LITERAL   | AGGREGATE
2206    --  | NAME             | QUALIFIED_EXPRESSION
2207    --  | ALLOCATOR        | (EXPRESSION)
2208
2209    --  Error recovery: can raise Error_Resync
2210
2211    function P_Primary return Node_Id is
2212       Scan_State : Saved_Scan_State;
2213       Node1      : Node_Id;
2214
2215    begin
2216       --  The loop runs more than once only if misplaced pragmas are found
2217
2218       loop
2219          case Token is
2220
2221             --  Name token can start a name, call or qualified expression, all
2222             --  of which are acceptable possibilities for primary. Note also
2223             --  that string literal is included in name (as operator symbol)
2224             --  and type conversion is included in name (as indexed component).
2225
2226             when Tok_Char_Literal | Tok_Operator_Symbol | Tok_Identifier =>
2227                Node1 := P_Name;
2228
2229                --  All done unless apostrophe follows
2230
2231                if Token /= Tok_Apostrophe then
2232                   return Node1;
2233
2234                --  Apostrophe following means that we have either just parsed
2235                --  the subtype mark of a qualified expression, or the prefix
2236                --  or a range attribute.
2237
2238                else -- Token = Tok_Apostrophe
2239                   Save_Scan_State (Scan_State); -- at apostrophe
2240                   Scan; -- past apostrophe
2241
2242                   --  If range attribute, then this is always an error, since
2243                   --  the only legitimate case (where the scanned expression is
2244                   --  a qualified simple name) is handled at the level of the
2245                   --  Simple_Expression processing. This case corresponds to a
2246                   --  usage such as 3 + A'Range, which is always illegal.
2247
2248                   if Token = Tok_Range then
2249                      Restore_Scan_State (Scan_State); -- to apostrophe
2250                      Bad_Range_Attribute (Token_Ptr);
2251                      return Error;
2252
2253                   --  If left paren, then we have a qualified expression.
2254                   --  Note that P_Name guarantees that in this case, where
2255                   --  Token = Tok_Apostrophe on return, the only two possible
2256                   --  tokens following the apostrophe are left paren and
2257                   --  RANGE, so we know we have a left paren here.
2258
2259                   else -- Token = Tok_Left_Paren
2260                      return P_Qualified_Expression (Node1);
2261
2262                   end if;
2263                end if;
2264
2265             --  Numeric or string literal
2266
2267             when Tok_Integer_Literal |
2268                  Tok_Real_Literal    |
2269                  Tok_String_Literal  =>
2270
2271                Node1 := Token_Node;
2272                Scan; -- past number
2273                return Node1;
2274
2275             --  Left paren, starts aggregate or parenthesized expression
2276
2277             when Tok_Left_Paren =>
2278                declare
2279                   Expr : constant Node_Id := P_Aggregate_Or_Paren_Expr;
2280
2281                begin
2282                   if Nkind (Expr) = N_Attribute_Reference
2283                     and then Attribute_Name (Expr) = Name_Range
2284                   then
2285                      Bad_Range_Attribute (Sloc (Expr));
2286                   end if;
2287
2288                   return Expr;
2289                end;
2290
2291             --  Allocator
2292
2293             when Tok_New =>
2294                return P_Allocator;
2295
2296             --  Null
2297
2298             when Tok_Null =>
2299                Scan; -- past NULL
2300                return New_Node (N_Null, Prev_Token_Ptr);
2301
2302             --  Pragma, not allowed here, so just skip past it
2303
2304             when Tok_Pragma =>
2305                P_Pragmas_Misplaced;
2306
2307             --  Anything else is illegal as the first token of a primary, but
2308             --  we test for a reserved identifier so that it is treated nicely
2309
2310             when others =>
2311                if Is_Reserved_Identifier then
2312                   return P_Identifier;
2313
2314                elsif Prev_Token = Tok_Comma then
2315                   Error_Msg_SP ("extra "","" ignored");
2316                   raise Error_Resync;
2317
2318                else
2319                   Error_Msg_AP ("missing operand");
2320                   raise Error_Resync;
2321                end if;
2322
2323          end case;
2324       end loop;
2325    end P_Primary;
2326
2327    ---------------------------
2328    -- 4.5  Logical Operator --
2329    ---------------------------
2330
2331    --  LOGICAL_OPERATOR  ::=  and | or | xor
2332
2333    --  Note: AND THEN and OR ELSE are also treated as logical operators
2334    --  by the parser (even though they are not operators semantically)
2335
2336    --  The value returned is the appropriate Node_Kind code for the operator
2337    --  On return, Token points to the token following the scanned operator.
2338
2339    --  The caller has checked that the first token is a legitimate logical
2340    --  operator token (i.e. is either XOR, AND, OR).
2341
2342    --  Error recovery: cannot raise Error_Resync
2343
2344    function P_Logical_Operator return Node_Kind is
2345    begin
2346       if Token = Tok_And then
2347          if Style_Check then
2348             Style.Check_Binary_Operator;
2349          end if;
2350
2351          Scan; -- past AND
2352
2353          if Token = Tok_Then then
2354             Scan; -- past THEN
2355             return N_And_Then;
2356          else
2357             return N_Op_And;
2358          end if;
2359
2360       elsif Token = Tok_Or then
2361          if Style_Check then
2362             Style.Check_Binary_Operator;
2363          end if;
2364
2365          Scan; -- past OR
2366
2367          if Token = Tok_Else then
2368             Scan; -- past ELSE
2369             return N_Or_Else;
2370          else
2371             return N_Op_Or;
2372          end if;
2373
2374       else -- Token = Tok_Xor
2375          if Style_Check then
2376             Style.Check_Binary_Operator;
2377          end if;
2378
2379          Scan; -- past XOR
2380          return N_Op_Xor;
2381       end if;
2382    end P_Logical_Operator;
2383
2384    ------------------------------
2385    -- 4.5  Relational Operator --
2386    ------------------------------
2387
2388    --  RELATIONAL_OPERATOR ::= = | /= | < | <= | > | >=
2389
2390    --  The value returned is the appropriate Node_Kind code for the operator.
2391    --  On return, Token points to the operator token, NOT past it.
2392
2393    --  The caller has checked that the first token is a legitimate relational
2394    --  operator token (i.e. is one of the operator tokens listed above).
2395
2396    --  Error recovery: cannot raise Error_Resync
2397
2398    function P_Relational_Operator return Node_Kind is
2399       Op_Kind : Node_Kind;
2400       Relop_Node : constant array (Token_Class_Relop) of Node_Kind :=
2401         (Tok_Less           => N_Op_Lt,
2402          Tok_Equal          => N_Op_Eq,
2403          Tok_Greater        => N_Op_Gt,
2404          Tok_Not_Equal      => N_Op_Ne,
2405          Tok_Greater_Equal  => N_Op_Ge,
2406          Tok_Less_Equal     => N_Op_Le,
2407          Tok_In             => N_In,
2408          Tok_Not            => N_Not_In,
2409          Tok_Box            => N_Op_Ne);
2410
2411    begin
2412       if Token = Tok_Box then
2413          Error_Msg_SC ("""'<'>"" should be ""/=""");
2414       end if;
2415
2416       Op_Kind := Relop_Node (Token);
2417
2418       if Style_Check then
2419          Style.Check_Binary_Operator;
2420       end if;
2421
2422       Scan; -- past operator token
2423
2424       if Prev_Token = Tok_Not then
2425          T_In;
2426       end if;
2427
2428       return Op_Kind;
2429    end P_Relational_Operator;
2430
2431    ---------------------------------
2432    -- 4.5  Binary Adding Operator --
2433    ---------------------------------
2434
2435    --  BINARY_ADDING_OPERATOR ::= + | - | &
2436
2437    --  The value returned is the appropriate Node_Kind code for the operator.
2438    --  On return, Token points to the operator token (NOT past it).
2439
2440    --  The caller has checked that the first token is a legitimate adding
2441    --  operator token (i.e. is one of the operator tokens listed above).
2442
2443    --  Error recovery: cannot raise Error_Resync
2444
2445    function P_Binary_Adding_Operator return Node_Kind is
2446       Addop_Node : constant array (Token_Class_Binary_Addop) of Node_Kind :=
2447         (Tok_Ampersand      => N_Op_Concat,
2448          Tok_Minus          => N_Op_Subtract,
2449          Tok_Plus           => N_Op_Add);
2450    begin
2451       return Addop_Node (Token);
2452    end P_Binary_Adding_Operator;
2453
2454    --------------------------------
2455    -- 4.5  Unary Adding Operator --
2456    --------------------------------
2457
2458    --  UNARY_ADDING_OPERATOR ::= + | -
2459
2460    --  The value returned is the appropriate Node_Kind code for the operator.
2461    --  On return, Token points to the operator token (NOT past it).
2462
2463    --  The caller has checked that the first token is a legitimate adding
2464    --  operator token (i.e. is one of the operator tokens listed above).
2465
2466    --  Error recovery: cannot raise Error_Resync
2467
2468    function P_Unary_Adding_Operator return Node_Kind is
2469       Addop_Node : constant array (Token_Class_Unary_Addop) of Node_Kind :=
2470         (Tok_Minus          => N_Op_Minus,
2471          Tok_Plus           => N_Op_Plus);
2472    begin
2473       return Addop_Node (Token);
2474    end P_Unary_Adding_Operator;
2475
2476    -------------------------------
2477    -- 4.5  Multiplying Operator --
2478    -------------------------------
2479
2480    --  MULTIPLYING_OPERATOR ::= * | / | mod | rem
2481
2482    --  The value returned is the appropriate Node_Kind code for the operator.
2483    --  On return, Token points to the operator token (NOT past it).
2484
2485    --  The caller has checked that the first token is a legitimate multiplying
2486    --  operator token (i.e. is one of the operator tokens listed above).
2487
2488    --  Error recovery: cannot raise Error_Resync
2489
2490    function P_Multiplying_Operator return Node_Kind is
2491       Mulop_Node : constant array (Token_Class_Mulop) of Node_Kind :=
2492         (Tok_Asterisk       => N_Op_Multiply,
2493          Tok_Mod            => N_Op_Mod,
2494          Tok_Rem            => N_Op_Rem,
2495          Tok_Slash          => N_Op_Divide);
2496    begin
2497       return Mulop_Node (Token);
2498    end P_Multiplying_Operator;
2499
2500    --------------------------------------
2501    -- 4.5  Highest Precedence Operator --
2502    --------------------------------------
2503
2504    --  Parsed by P_Factor (4.4)
2505
2506    --  Note: this rule is not in fact used by the grammar at any point!
2507
2508    --------------------------
2509    -- 4.6  Type Conversion --
2510    --------------------------
2511
2512    --  Parsed by P_Primary as a Name (4.1)
2513
2514    -------------------------------
2515    -- 4.7  Qualified Expression --
2516    -------------------------------
2517
2518    --  QUALIFIED_EXPRESSION ::=
2519    --    SUBTYPE_MARK ' (EXPRESSION) | SUBTYPE_MARK ' AGGREGATE
2520
2521    --  The caller has scanned the name which is the Subtype_Mark parameter
2522    --  and scanned past the single quote following the subtype mark. The
2523    --  caller has not checked that this name is in fact appropriate for
2524    --  a subtype mark name (i.e. it is a selected component or identifier).
2525
2526    --  Error_Recovery: cannot raise Error_Resync
2527
2528    function  P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id is
2529       Qual_Node : Node_Id;
2530    begin
2531       Qual_Node := New_Node (N_Qualified_Expression, Prev_Token_Ptr);
2532       Set_Subtype_Mark (Qual_Node, Check_Subtype_Mark (Subtype_Mark));
2533       Set_Expression (Qual_Node, P_Aggregate_Or_Paren_Expr);
2534       return Qual_Node;
2535    end P_Qualified_Expression;
2536
2537    --------------------
2538    -- 4.8  Allocator --
2539    --------------------
2540
2541    --  ALLOCATOR ::=
2542    --    new [NULL_EXCLUSION] SUBTYPE_INDICATION | new QUALIFIED_EXPRESSION
2543
2544    --  The caller has checked that the initial token is NEW
2545
2546    --  Error recovery: can raise Error_Resync
2547
2548    function P_Allocator return Node_Id is
2549       Alloc_Node             : Node_Id;
2550       Type_Node              : Node_Id;
2551       Null_Exclusion_Present : Boolean;
2552
2553    begin
2554       Alloc_Node := New_Node (N_Allocator, Token_Ptr);
2555       T_New;
2556
2557       --  Scan Null_Exclusion if present (Ada 2005 (AI-231))
2558
2559       Null_Exclusion_Present := P_Null_Exclusion;
2560       Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present);
2561       Type_Node := P_Subtype_Mark_Resync;
2562
2563       if Token = Tok_Apostrophe then
2564          Scan; -- past apostrophe
2565          Set_Expression (Alloc_Node, P_Qualified_Expression (Type_Node));
2566       else
2567          Set_Expression
2568            (Alloc_Node,
2569             P_Subtype_Indication (Type_Node, Null_Exclusion_Present));
2570       end if;
2571
2572       return Alloc_Node;
2573    end P_Allocator;
2574
2575 end Ch4;