]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P A R . C H 1 2 -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
82c80734 | 9 | -- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- |
19235870 RK |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
13 | -- ware Foundation; either version 2, or (at your option) any later ver- -- | |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
27 | pragma Style_Checks (All_Checks); | |
28 | -- Turn off subprogram body ordering check. Subprograms are in order | |
29 | -- by RM section rather than alphabetical | |
30 | ||
31 | separate (Par) | |
32 | package body Ch12 is | |
33 | ||
34 | -- Local functions, used only in this chapter | |
35 | ||
36 | function P_Formal_Derived_Type_Definition return Node_Id; | |
37 | function P_Formal_Discrete_Type_Definition return Node_Id; | |
38 | function P_Formal_Fixed_Point_Definition return Node_Id; | |
39 | function P_Formal_Floating_Point_Definition return Node_Id; | |
40 | function P_Formal_Modular_Type_Definition return Node_Id; | |
41 | function P_Formal_Package_Declaration return Node_Id; | |
42 | function P_Formal_Private_Type_Definition return Node_Id; | |
43 | function P_Formal_Signed_Integer_Type_Definition return Node_Id; | |
44 | function P_Formal_Subprogram_Declaration return Node_Id; | |
45 | function P_Formal_Type_Declaration return Node_Id; | |
46 | function P_Formal_Type_Definition return Node_Id; | |
47 | function P_Generic_Association return Node_Id; | |
48 | ||
49 | procedure P_Formal_Object_Declarations (Decls : List_Id); | |
50 | -- Scans one or more formal object declarations and appends them to | |
51 | -- Decls. Scans more than one declaration only in the case where the | |
52 | -- source has a declaration with multiple defining identifiers. | |
53 | ||
54 | -------------------------------- | |
55 | -- 12.1 Generic (also 8.5.5) -- | |
56 | -------------------------------- | |
57 | ||
58 | -- This routine parses either one of the forms of a generic declaration | |
59 | -- or a generic renaming declaration. | |
60 | ||
61 | -- GENERIC_DECLARATION ::= | |
62 | -- GENERIC_SUBPROGRAM_DECLARATION | GENERIC_PACKAGE_DECLARATION | |
63 | ||
64 | -- GENERIC_SUBPROGRAM_DECLARATION ::= | |
65 | -- GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION; | |
66 | ||
67 | -- GENERIC_PACKAGE_DECLARATION ::= | |
68 | -- GENERIC_FORMAL_PART PACKAGE_SPECIFICATION; | |
69 | ||
70 | -- GENERIC_FORMAL_PART ::= | |
71 | -- generic {GENERIC_FORMAL_PARAMETER_DECLARATION | USE_CLAUSE} | |
72 | ||
73 | -- GENERIC_RENAMING_DECLARATION ::= | |
74 | -- generic package DEFINING_PROGRAM_UNIT_NAME | |
75 | -- renames generic_package_NAME | |
76 | -- | generic procedure DEFINING_PROGRAM_UNIT_NAME | |
77 | -- renames generic_procedure_NAME | |
78 | -- | generic function DEFINING_PROGRAM_UNIT_NAME | |
79 | -- renames generic_function_NAME | |
80 | ||
81 | -- GENERIC_FORMAL_PARAMETER_DECLARATION ::= | |
82 | -- FORMAL_OBJECT_DECLARATION | |
83 | -- | FORMAL_TYPE_DECLARATION | |
84 | -- | FORMAL_SUBPROGRAM_DECLARATION | |
85 | -- | FORMAL_PACKAGE_DECLARATION | |
86 | ||
87 | -- The caller has checked that the initial token is GENERIC | |
88 | ||
89 | -- Error recovery: can raise Error_Resync | |
90 | ||
91 | function P_Generic return Node_Id is | |
92 | Gen_Sloc : constant Source_Ptr := Token_Ptr; | |
93 | Gen_Decl : Node_Id; | |
94 | Decl_Node : Node_Id; | |
95 | Decls : List_Id; | |
96 | Def_Unit : Node_Id; | |
97 | Ren_Token : Token_Type; | |
98 | Scan_State : Saved_Scan_State; | |
99 | ||
100 | begin | |
101 | Scan; -- past GENERIC | |
102 | ||
103 | if Token = Tok_Private then | |
104 | Error_Msg_SC ("PRIVATE goes before GENERIC, not after"); | |
105 | Scan; -- past junk PRIVATE token | |
106 | end if; | |
107 | ||
108 | Save_Scan_State (Scan_State); -- at token past GENERIC | |
109 | ||
110 | -- Check for generic renaming declaration case | |
111 | ||
112 | if Token = Tok_Package | |
113 | or else Token = Tok_Function | |
114 | or else Token = Tok_Procedure | |
115 | then | |
116 | Ren_Token := Token; | |
117 | Scan; -- scan past PACKAGE, FUNCTION or PROCEDURE | |
118 | ||
119 | if Token = Tok_Identifier then | |
120 | Def_Unit := P_Defining_Program_Unit_Name; | |
121 | ||
122 | Check_Misspelling_Of (Tok_Renames); | |
123 | ||
124 | if Token = Tok_Renames then | |
125 | if Ren_Token = Tok_Package then | |
126 | Decl_Node := New_Node | |
127 | (N_Generic_Package_Renaming_Declaration, Gen_Sloc); | |
128 | ||
129 | elsif Ren_Token = Tok_Procedure then | |
130 | Decl_Node := New_Node | |
131 | (N_Generic_Procedure_Renaming_Declaration, Gen_Sloc); | |
132 | ||
133 | else -- Ren_Token = Tok_Function then | |
134 | Decl_Node := New_Node | |
135 | (N_Generic_Function_Renaming_Declaration, Gen_Sloc); | |
136 | end if; | |
137 | ||
138 | Scan; -- past RENAMES | |
139 | Set_Defining_Unit_Name (Decl_Node, Def_Unit); | |
140 | Set_Name (Decl_Node, P_Name); | |
141 | TF_Semicolon; | |
142 | return Decl_Node; | |
143 | end if; | |
144 | end if; | |
145 | end if; | |
146 | ||
147 | -- Fall through if this is *not* a generic renaming declaration | |
148 | ||
149 | Restore_Scan_State (Scan_State); | |
150 | Decls := New_List; | |
151 | ||
152 | -- Loop through generic parameter declarations and use clauses | |
153 | ||
154 | Decl_Loop : loop | |
155 | P_Pragmas_Opt (Decls); | |
a276fddf RD |
156 | |
157 | if Token = Tok_Private then | |
158 | Error_Msg_S ("generic private child packages not permitted"); | |
159 | Scan; -- past PRIVATE | |
160 | end if; | |
19235870 RK |
161 | |
162 | if Token = Tok_Use then | |
163 | Append (P_Use_Clause, Decls); | |
164 | else | |
165 | -- Parse a generic parameter declaration | |
166 | ||
167 | if Token = Tok_Identifier then | |
168 | P_Formal_Object_Declarations (Decls); | |
169 | ||
170 | elsif Token = Tok_Type then | |
171 | Append (P_Formal_Type_Declaration, Decls); | |
172 | ||
173 | elsif Token = Tok_With then | |
174 | Scan; -- past WITH | |
175 | ||
176 | if Token = Tok_Package then | |
177 | Append (P_Formal_Package_Declaration, Decls); | |
178 | ||
179 | elsif Token = Tok_Procedure or Token = Tok_Function then | |
180 | Append (P_Formal_Subprogram_Declaration, Decls); | |
181 | ||
182 | else | |
183 | Error_Msg_BC | |
184 | ("FUNCTION, PROCEDURE or PACKAGE expected here"); | |
185 | Resync_Past_Semicolon; | |
186 | end if; | |
187 | ||
188 | elsif Token = Tok_Subtype then | |
189 | Error_Msg_SC ("subtype declaration not allowed " & | |
190 | "as generic parameter declaration!"); | |
191 | Resync_Past_Semicolon; | |
192 | ||
193 | else | |
194 | exit Decl_Loop; | |
195 | end if; | |
196 | end if; | |
197 | ||
198 | end loop Decl_Loop; | |
199 | ||
200 | -- Generic formal part is scanned, scan out subprogram or package spec | |
201 | ||
202 | if Token = Tok_Package then | |
203 | Gen_Decl := New_Node (N_Generic_Package_Declaration, Gen_Sloc); | |
204 | Set_Specification (Gen_Decl, P_Package (Pf_Spcn)); | |
205 | else | |
206 | Gen_Decl := New_Node (N_Generic_Subprogram_Declaration, Gen_Sloc); | |
5453d5bd | 207 | |
19235870 | 208 | Set_Specification (Gen_Decl, P_Subprogram_Specification); |
5453d5bd | 209 | |
cc335f43 AC |
210 | if Nkind (Defining_Unit_Name (Specification (Gen_Decl))) = |
211 | N_Defining_Program_Unit_Name | |
5453d5bd AC |
212 | and then Scope.Last > 0 |
213 | then | |
214 | Error_Msg_SP ("child unit allowed only at library level"); | |
215 | end if; | |
19235870 RK |
216 | TF_Semicolon; |
217 | end if; | |
218 | ||
219 | Set_Generic_Formal_Declarations (Gen_Decl, Decls); | |
220 | return Gen_Decl; | |
221 | end P_Generic; | |
222 | ||
223 | ------------------------------- | |
224 | -- 12.1 Generic Declaration -- | |
225 | ------------------------------- | |
226 | ||
227 | -- Parsed by P_Generic (12.1) | |
228 | ||
229 | ------------------------------------------ | |
230 | -- 12.1 Generic Subprogram Declaration -- | |
231 | ------------------------------------------ | |
232 | ||
233 | -- Parsed by P_Generic (12.1) | |
234 | ||
235 | --------------------------------------- | |
236 | -- 12.1 Generic Package Declaration -- | |
237 | --------------------------------------- | |
238 | ||
239 | -- Parsed by P_Generic (12.1) | |
240 | ||
241 | ------------------------------- | |
242 | -- 12.1 Generic Formal Part -- | |
243 | ------------------------------- | |
244 | ||
245 | -- Parsed by P_Generic (12.1) | |
246 | ||
247 | ------------------------------------------------- | |
248 | -- 12.1 Generic Formal Parameter Declaration -- | |
249 | ------------------------------------------------- | |
250 | ||
251 | -- Parsed by P_Generic (12.1) | |
252 | ||
253 | --------------------------------- | |
254 | -- 12.3 Generic Instantiation -- | |
255 | --------------------------------- | |
256 | ||
257 | -- Generic package instantiation parsed by P_Package (7.1) | |
258 | -- Generic procedure instantiation parsed by P_Subprogram (6.1) | |
259 | -- Generic function instantiation parsed by P_Subprogram (6.1) | |
260 | ||
261 | ------------------------------- | |
262 | -- 12.3 Generic Actual Part -- | |
263 | ------------------------------- | |
264 | ||
265 | -- GENERIC_ACTUAL_PART ::= | |
266 | -- (GENERIC_ASSOCIATION {, GENERIC_ASSOCIATION}) | |
267 | ||
268 | -- Returns a list of generic associations, or Empty if none are present | |
269 | ||
270 | -- Error recovery: cannot raise Error_Resync | |
271 | ||
272 | function P_Generic_Actual_Part_Opt return List_Id is | |
273 | Association_List : List_Id; | |
274 | ||
275 | begin | |
276 | -- Figure out if a generic actual part operation is present. Clearly | |
277 | -- there is no generic actual part if the current token is semicolon | |
278 | ||
279 | if Token = Tok_Semicolon then | |
280 | return No_List; | |
281 | ||
282 | -- If we don't have a left paren, then we have an error, and the job | |
283 | -- is to figure out whether a left paren or semicolon was intended. | |
284 | -- We assume a missing left paren (and hence a generic actual part | |
285 | -- present) if the current token is not on a new line, or if it is | |
286 | -- indented from the subprogram token. Otherwise assume missing | |
287 | -- semicolon (which will be diagnosed by caller) and no generic part | |
288 | ||
289 | elsif Token /= Tok_Left_Paren | |
290 | and then Token_Is_At_Start_Of_Line | |
291 | and then Start_Column <= Scope.Table (Scope.Last).Ecol | |
292 | then | |
293 | return No_List; | |
294 | ||
295 | -- Otherwise we have a generic actual part (either a left paren is | |
296 | -- present, or we have decided that there must be a missing left paren) | |
297 | ||
298 | else | |
299 | Association_List := New_List; | |
300 | T_Left_Paren; | |
301 | ||
302 | loop | |
303 | Append (P_Generic_Association, Association_List); | |
304 | exit when not Comma_Present; | |
305 | end loop; | |
306 | ||
307 | T_Right_Paren; | |
308 | return Association_List; | |
309 | end if; | |
310 | ||
311 | end P_Generic_Actual_Part_Opt; | |
312 | ||
313 | ------------------------------- | |
314 | -- 12.3 Generic Association -- | |
315 | ------------------------------- | |
316 | ||
317 | -- GENERIC_ASSOCIATION ::= | |
318 | -- [generic_formal_parameter_SELECTOR_NAME =>] | |
319 | -- EXPLICIT_GENERIC_ACTUAL_PARAMETER | |
320 | ||
321 | -- EXPLICIT_GENERIC_ACTUAL_PARAMETER ::= | |
322 | -- EXPRESSION | variable_NAME | subprogram_NAME | |
323 | -- | entry_NAME | SUBTYPE_MARK | package_instance_NAME | |
324 | ||
325 | -- Error recovery: cannot raise Error_Resync | |
326 | ||
327 | function P_Generic_Association return Node_Id is | |
328 | Scan_State : Saved_Scan_State; | |
329 | Param_Name_Node : Node_Id; | |
330 | Generic_Assoc_Node : Node_Id; | |
331 | ||
332 | begin | |
333 | Generic_Assoc_Node := New_Node (N_Generic_Association, Token_Ptr); | |
334 | ||
335 | if Token in Token_Class_Desig then | |
336 | Param_Name_Node := Token_Node; | |
337 | Save_Scan_State (Scan_State); -- at designator | |
338 | Scan; -- past simple name or operator symbol | |
339 | ||
340 | if Token = Tok_Arrow then | |
341 | Scan; -- past arrow | |
342 | Set_Selector_Name (Generic_Assoc_Node, Param_Name_Node); | |
343 | else | |
344 | Restore_Scan_State (Scan_State); -- to designator | |
345 | end if; | |
346 | end if; | |
347 | ||
348 | Set_Explicit_Generic_Actual_Parameter (Generic_Assoc_Node, P_Expression); | |
349 | return Generic_Assoc_Node; | |
350 | end P_Generic_Association; | |
351 | ||
352 | --------------------------------------------- | |
353 | -- 12.3 Explicit Generic Actual Parameter -- | |
354 | --------------------------------------------- | |
355 | ||
356 | -- Parsed by P_Generic_Association (12.3) | |
357 | ||
358 | -------------------------------------- | |
359 | -- 12.4 Formal Object Declarations -- | |
360 | -------------------------------------- | |
361 | ||
362 | -- FORMAL_OBJECT_DECLARATION ::= | |
363 | -- DEFINING_IDENTIFIER_LIST : | |
364 | -- MODE SUBTYPE_MARK [:= DEFAULT_EXPRESSION]; | |
365 | ||
366 | -- The caller has checked that the initial token is an identifier | |
367 | ||
368 | -- Error recovery: cannot raise Error_Resync | |
369 | ||
370 | procedure P_Formal_Object_Declarations (Decls : List_Id) is | |
371 | Decl_Node : Node_Id; | |
372 | Scan_State : Saved_Scan_State; | |
373 | Num_Idents : Nat; | |
374 | Ident : Nat; | |
375 | ||
376 | Idents : array (Int range 1 .. 4096) of Entity_Id; | |
377 | -- This array holds the list of defining identifiers. The upper bound | |
378 | -- of 4096 is intended to be essentially infinite, and we do not even | |
379 | -- bother to check for it being exceeded. | |
380 | ||
381 | begin | |
bde58e32 | 382 | Idents (1) := P_Defining_Identifier (C_Comma_Colon); |
19235870 RK |
383 | Num_Idents := 1; |
384 | ||
385 | while Comma_Present loop | |
386 | Num_Idents := Num_Idents + 1; | |
bde58e32 | 387 | Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); |
19235870 RK |
388 | end loop; |
389 | ||
390 | T_Colon; | |
391 | ||
392 | -- If there are multiple identifiers, we repeatedly scan the | |
393 | -- type and initialization expression information by resetting | |
394 | -- the scan pointer (so that we get completely separate trees | |
395 | -- for each occurrence). | |
396 | ||
397 | if Num_Idents > 1 then | |
398 | Save_Scan_State (Scan_State); | |
399 | end if; | |
400 | ||
401 | -- Loop through defining identifiers in list | |
402 | ||
403 | Ident := 1; | |
404 | Ident_Loop : loop | |
405 | Decl_Node := New_Node (N_Formal_Object_Declaration, Token_Ptr); | |
406 | Set_Defining_Identifier (Decl_Node, Idents (Ident)); | |
407 | P_Mode (Decl_Node); | |
408 | Set_Subtype_Mark (Decl_Node, P_Subtype_Mark_Resync); | |
409 | No_Constraint; | |
410 | Set_Expression (Decl_Node, Init_Expr_Opt); | |
411 | ||
412 | if Ident > 1 then | |
413 | Set_Prev_Ids (Decl_Node, True); | |
414 | end if; | |
415 | ||
416 | if Ident < Num_Idents then | |
417 | Set_More_Ids (Decl_Node, True); | |
418 | end if; | |
419 | ||
420 | Append (Decl_Node, Decls); | |
421 | ||
422 | exit Ident_Loop when Ident = Num_Idents; | |
423 | Ident := Ident + 1; | |
424 | Restore_Scan_State (Scan_State); | |
425 | end loop Ident_Loop; | |
426 | ||
427 | TF_Semicolon; | |
428 | end P_Formal_Object_Declarations; | |
429 | ||
430 | ----------------------------------- | |
431 | -- 12.5 Formal Type Declaration -- | |
432 | ----------------------------------- | |
433 | ||
434 | -- FORMAL_TYPE_DECLARATION ::= | |
435 | -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART] | |
436 | -- is FORMAL_TYPE_DEFINITION; | |
437 | ||
438 | -- The caller has checked that the initial token is TYPE | |
439 | ||
440 | -- Error recovery: cannot raise Error_Resync | |
441 | ||
442 | function P_Formal_Type_Declaration return Node_Id is | |
443 | Decl_Node : Node_Id; | |
dd5875a6 | 444 | Def_Node : Node_Id; |
19235870 RK |
445 | |
446 | begin | |
447 | Decl_Node := New_Node (N_Formal_Type_Declaration, Token_Ptr); | |
448 | Scan; -- past TYPE | |
449 | Set_Defining_Identifier (Decl_Node, P_Defining_Identifier); | |
450 | ||
451 | if P_Unknown_Discriminant_Part_Opt then | |
452 | Set_Unknown_Discriminants_Present (Decl_Node, True); | |
453 | else | |
454 | Set_Discriminant_Specifications | |
455 | (Decl_Node, P_Known_Discriminant_Part_Opt); | |
456 | end if; | |
457 | ||
458 | T_Is; | |
459 | ||
dd5875a6 ES |
460 | Def_Node := P_Formal_Type_Definition; |
461 | ||
462 | if Def_Node /= Error then | |
463 | Set_Formal_Type_Definition (Decl_Node, Def_Node); | |
464 | TF_Semicolon; | |
de76a39c | 465 | |
dd5875a6 ES |
466 | else |
467 | Decl_Node := Error; | |
f311e166 | 468 | |
de76a39c GB |
469 | -- If we have semicolon, skip it to avoid cascaded errors |
470 | ||
f311e166 | 471 | if Token = Tok_Semicolon then |
f311e166 RD |
472 | Scan; |
473 | end if; | |
dd5875a6 ES |
474 | end if; |
475 | ||
19235870 RK |
476 | return Decl_Node; |
477 | end P_Formal_Type_Declaration; | |
478 | ||
479 | ---------------------------------- | |
480 | -- 12.5 Formal Type Definition -- | |
481 | ---------------------------------- | |
482 | ||
483 | -- FORMAL_TYPE_DEFINITION ::= | |
484 | -- FORMAL_PRIVATE_TYPE_DEFINITION | |
485 | -- | FORMAL_DERIVED_TYPE_DEFINITION | |
486 | -- | FORMAL_DISCRETE_TYPE_DEFINITION | |
487 | -- | FORMAL_SIGNED_INTEGER_TYPE_DEFINITION | |
488 | -- | FORMAL_MODULAR_TYPE_DEFINITION | |
489 | -- | FORMAL_FLOATING_POINT_DEFINITION | |
490 | -- | FORMAL_ORDINARY_FIXED_POINT_DEFINITION | |
491 | -- | FORMAL_DECIMAL_FIXED_POINT_DEFINITION | |
492 | -- | FORMAL_ARRAY_TYPE_DEFINITION | |
493 | -- | FORMAL_ACCESS_TYPE_DEFINITION | |
a9d8907c | 494 | -- | FORMAL_INTERFACE_TYPE_DEFINITION |
19235870 RK |
495 | |
496 | -- FORMAL_ARRAY_TYPE_DEFINITION ::= ARRAY_TYPE_DEFINITION | |
497 | ||
498 | -- FORMAL_ACCESS_TYPE_DEFINITION ::= ACCESS_TYPE_DEFINITION | |
499 | ||
a9d8907c JM |
500 | -- FORMAL_INTERFACE_TYPE_DEFINITION ::= INTERFACE_TYPE_DEFINITION |
501 | ||
19235870 | 502 | function P_Formal_Type_Definition return Node_Id is |
a9d8907c JM |
503 | Scan_State : Saved_Scan_State; |
504 | Typedef_Node : Node_Id; | |
19235870 RK |
505 | |
506 | begin | |
507 | if Token_Name = Name_Abstract then | |
508 | Check_95_Keyword (Tok_Abstract, Tok_Tagged); | |
509 | end if; | |
510 | ||
511 | if Token_Name = Name_Tagged then | |
512 | Check_95_Keyword (Tok_Tagged, Tok_Private); | |
513 | Check_95_Keyword (Tok_Tagged, Tok_Limited); | |
514 | end if; | |
515 | ||
516 | case Token is | |
517 | ||
518 | -- Mostly we can tell what we have from the initial token. The one | |
519 | -- exception is ABSTRACT, where we have to scan ahead to see if we | |
520 | -- have a formal derived type or a formal private type definition. | |
521 | ||
522 | when Tok_Abstract => | |
523 | Save_Scan_State (Scan_State); | |
524 | Scan; -- past ABSTRACT | |
525 | ||
526 | if Token = Tok_New then | |
527 | Restore_Scan_State (Scan_State); -- to ABSTRACT | |
528 | return P_Formal_Derived_Type_Definition; | |
529 | ||
530 | else | |
531 | Restore_Scan_State (Scan_State); -- to ABSTRACT | |
532 | return P_Formal_Private_Type_Definition; | |
533 | end if; | |
534 | ||
a9d8907c JM |
535 | when Tok_Access => |
536 | return P_Access_Type_Definition; | |
19235870 | 537 | |
a9d8907c JM |
538 | when Tok_Array => |
539 | return P_Array_Type_Definition; | |
540 | ||
541 | when Tok_Delta => | |
542 | return P_Formal_Fixed_Point_Definition; | |
543 | ||
544 | when Tok_Digits => | |
545 | return P_Formal_Floating_Point_Definition; | |
546 | ||
547 | when Tok_Interface => -- Ada 2005 (AI-251) | |
548 | return P_Interface_Type_Definition (Is_Synchronized => False); | |
19235870 RK |
549 | |
550 | when Tok_Left_Paren => | |
551 | return P_Formal_Discrete_Type_Definition; | |
552 | ||
a9d8907c JM |
553 | when Tok_Limited => |
554 | Save_Scan_State (Scan_State); | |
555 | Scan; -- past LIMITED | |
556 | ||
557 | if Token = Tok_Interface then | |
558 | Typedef_Node := P_Interface_Type_Definition | |
559 | (Is_Synchronized => False); | |
560 | Set_Limited_Present (Typedef_Node); | |
561 | return Typedef_Node; | |
562 | ||
563 | else | |
564 | Restore_Scan_State (Scan_State); | |
565 | return P_Formal_Private_Type_Definition; | |
566 | end if; | |
19235870 RK |
567 | |
568 | when Tok_Mod => | |
569 | return P_Formal_Modular_Type_Definition; | |
570 | ||
a9d8907c JM |
571 | when Tok_New => |
572 | return P_Formal_Derived_Type_Definition; | |
19235870 | 573 | |
a9d8907c JM |
574 | when Tok_Private | |
575 | Tok_Tagged => | |
576 | return P_Formal_Private_Type_Definition; | |
19235870 | 577 | |
a9d8907c JM |
578 | when Tok_Range => |
579 | return P_Formal_Signed_Integer_Type_Definition; | |
19235870 RK |
580 | |
581 | when Tok_Record => | |
582 | Error_Msg_SC ("record not allowed in generic type definition!"); | |
583 | Discard_Junk_Node (P_Record_Definition); | |
584 | return Error; | |
585 | ||
a9d8907c JM |
586 | -- Ada 2005 (AI-345) |
587 | ||
588 | when Tok_Protected | | |
589 | Tok_Synchronized | | |
590 | Tok_Task => | |
591 | ||
592 | Scan; -- past TASK, PROTECTED or SYNCHRONIZED | |
593 | ||
594 | declare | |
595 | Saved_Token : constant Token_Type := Token; | |
596 | ||
597 | begin | |
598 | Typedef_Node := P_Interface_Type_Definition | |
599 | (Is_Synchronized => True); | |
600 | ||
601 | case Saved_Token is | |
602 | when Tok_Task => | |
603 | Set_Task_Present (Typedef_Node); | |
604 | ||
605 | when Tok_Protected => | |
606 | Set_Protected_Present (Typedef_Node); | |
607 | ||
608 | when Tok_Synchronized => | |
609 | Set_Synchronized_Present (Typedef_Node); | |
610 | ||
611 | when others => | |
612 | null; | |
613 | end case; | |
614 | ||
615 | return Typedef_Node; | |
616 | end; | |
617 | ||
19235870 RK |
618 | when others => |
619 | Error_Msg_BC ("expecting generic type definition here"); | |
620 | Resync_Past_Semicolon; | |
621 | return Error; | |
622 | ||
623 | end case; | |
624 | end P_Formal_Type_Definition; | |
625 | ||
626 | -------------------------------------------- | |
627 | -- 12.5.1 Formal Private Type Definition -- | |
628 | -------------------------------------------- | |
629 | ||
630 | -- FORMAL_PRIVATE_TYPE_DEFINITION ::= | |
631 | -- [[abstract] tagged] [limited] private | |
632 | ||
633 | -- The caller has checked the initial token is PRIVATE, ABSTRACT, | |
634 | -- TAGGED or LIMITED | |
635 | ||
636 | -- Error recovery: cannot raise Error_Resync | |
637 | ||
638 | function P_Formal_Private_Type_Definition return Node_Id is | |
639 | Def_Node : Node_Id; | |
640 | ||
641 | begin | |
642 | Def_Node := New_Node (N_Formal_Private_Type_Definition, Token_Ptr); | |
643 | ||
644 | if Token = Tok_Abstract then | |
645 | Scan; -- past ABSTRACT | |
646 | ||
647 | if Token_Name = Name_Tagged then | |
648 | Check_95_Keyword (Tok_Tagged, Tok_Private); | |
649 | Check_95_Keyword (Tok_Tagged, Tok_Limited); | |
650 | end if; | |
651 | ||
652 | if Token /= Tok_Tagged then | |
653 | Error_Msg_SP ("ABSTRACT must be followed by TAGGED"); | |
654 | else | |
655 | Set_Abstract_Present (Def_Node, True); | |
656 | end if; | |
657 | end if; | |
658 | ||
659 | if Token = Tok_Tagged then | |
660 | Set_Tagged_Present (Def_Node, True); | |
661 | Scan; -- past TAGGED | |
662 | end if; | |
663 | ||
664 | if Token = Tok_Limited then | |
665 | Set_Limited_Present (Def_Node, True); | |
666 | Scan; -- past LIMITED | |
667 | end if; | |
668 | ||
669 | Set_Sloc (Def_Node, Token_Ptr); | |
670 | T_Private; | |
671 | return Def_Node; | |
672 | end P_Formal_Private_Type_Definition; | |
673 | ||
674 | -------------------------------------------- | |
675 | -- 12.5.1 Formal Derived Type Definition -- | |
676 | -------------------------------------------- | |
677 | ||
678 | -- FORMAL_DERIVED_TYPE_DEFINITION ::= | |
a9d8907c | 679 | -- [abstract] new SUBTYPE_MARK [[AND interface_list] with private] |
19235870 RK |
680 | |
681 | -- The caller has checked the initial token(s) is/are NEW or ASTRACT NEW | |
682 | ||
683 | -- Error recovery: cannot raise Error_Resync | |
684 | ||
685 | function P_Formal_Derived_Type_Definition return Node_Id is | |
686 | Def_Node : Node_Id; | |
687 | ||
688 | begin | |
689 | Def_Node := New_Node (N_Formal_Derived_Type_Definition, Token_Ptr); | |
690 | ||
691 | if Token = Tok_Abstract then | |
692 | Set_Abstract_Present (Def_Node); | |
693 | Scan; -- past ABSTRACT | |
694 | end if; | |
695 | ||
696 | Scan; -- past NEW; | |
697 | Set_Subtype_Mark (Def_Node, P_Subtype_Mark); | |
698 | No_Constraint; | |
699 | ||
a9d8907c JM |
700 | -- Ada 2005 (AI-251): Deal with interfaces |
701 | ||
702 | if Token = Tok_And then | |
703 | Scan; -- past AND | |
704 | ||
705 | if Ada_Version < Ada_05 then | |
706 | Error_Msg_SP | |
707 | ("abstract interface is an Ada 2005 extension"); | |
708 | Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); | |
709 | end if; | |
710 | ||
711 | Set_Interface_List (Def_Node, New_List); | |
712 | ||
713 | loop | |
714 | Append (P_Qualified_Simple_Name, Interface_List (Def_Node)); | |
715 | exit when Token /= Tok_And; | |
716 | Scan; -- past AND | |
717 | end loop; | |
718 | end if; | |
719 | ||
19235870 RK |
720 | if Token = Tok_With then |
721 | Scan; -- past WITH | |
722 | Set_Private_Present (Def_Node, True); | |
723 | T_Private; | |
dd5875a6 ES |
724 | |
725 | elsif Token = Tok_Tagged then | |
726 | Scan; | |
727 | ||
728 | if Token = Tok_Private then | |
729 | Error_Msg_SC ("TAGGED should be WITH"); | |
730 | Set_Private_Present (Def_Node, True); | |
731 | T_Private; | |
732 | else | |
733 | Ignore (Tok_Tagged); | |
734 | end if; | |
19235870 RK |
735 | end if; |
736 | ||
737 | return Def_Node; | |
738 | end P_Formal_Derived_Type_Definition; | |
739 | ||
740 | --------------------------------------------- | |
741 | -- 12.5.2 Formal Discrete Type Definition -- | |
742 | --------------------------------------------- | |
743 | ||
744 | -- FORMAL_DISCRETE_TYPE_DEFINITION ::= (<>) | |
745 | ||
746 | -- The caller has checked the initial token is left paren | |
747 | ||
748 | -- Error recovery: cannot raise Error_Resync | |
749 | ||
750 | function P_Formal_Discrete_Type_Definition return Node_Id is | |
751 | Def_Node : Node_Id; | |
752 | ||
753 | begin | |
754 | Def_Node := New_Node (N_Formal_Discrete_Type_Definition, Token_Ptr); | |
755 | Scan; -- past left paren | |
756 | T_Box; | |
757 | T_Right_Paren; | |
758 | return Def_Node; | |
759 | end P_Formal_Discrete_Type_Definition; | |
760 | ||
761 | --------------------------------------------------- | |
762 | -- 12.5.2 Formal Signed Integer Type Definition -- | |
763 | --------------------------------------------------- | |
764 | ||
765 | -- FORMAL_SIGNED_INTEGER_TYPE_DEFINITION ::= range <> | |
766 | ||
767 | -- The caller has checked the initial token is RANGE | |
768 | ||
769 | -- Error recovery: cannot raise Error_Resync | |
770 | ||
771 | function P_Formal_Signed_Integer_Type_Definition return Node_Id is | |
772 | Def_Node : Node_Id; | |
773 | ||
774 | begin | |
775 | Def_Node := | |
776 | New_Node (N_Formal_Signed_Integer_Type_Definition, Token_Ptr); | |
777 | Scan; -- past RANGE | |
778 | T_Box; | |
779 | return Def_Node; | |
780 | end P_Formal_Signed_Integer_Type_Definition; | |
781 | ||
782 | -------------------------------------------- | |
783 | -- 12.5.2 Formal Modular Type Definition -- | |
784 | -------------------------------------------- | |
785 | ||
786 | -- FORMAL_MODULAR_TYPE_DEFINITION ::= mod <> | |
787 | ||
788 | -- The caller has checked the initial token is MOD | |
789 | ||
790 | -- Error recovery: cannot raise Error_Resync | |
791 | ||
792 | function P_Formal_Modular_Type_Definition return Node_Id is | |
793 | Def_Node : Node_Id; | |
794 | ||
795 | begin | |
796 | Def_Node := | |
797 | New_Node (N_Formal_Modular_Type_Definition, Token_Ptr); | |
798 | Scan; -- past MOD | |
799 | T_Box; | |
800 | return Def_Node; | |
801 | end P_Formal_Modular_Type_Definition; | |
802 | ||
803 | ---------------------------------------------- | |
804 | -- 12.5.2 Formal Floating Point Definition -- | |
805 | ---------------------------------------------- | |
806 | ||
807 | -- FORMAL_FLOATING_POINT_DEFINITION ::= digits <> | |
808 | ||
809 | -- The caller has checked the initial token is DIGITS | |
810 | ||
811 | -- Error recovery: cannot raise Error_Resync | |
812 | ||
813 | function P_Formal_Floating_Point_Definition return Node_Id is | |
814 | Def_Node : Node_Id; | |
815 | ||
816 | begin | |
817 | Def_Node := | |
818 | New_Node (N_Formal_Floating_Point_Definition, Token_Ptr); | |
819 | Scan; -- past DIGITS | |
820 | T_Box; | |
821 | return Def_Node; | |
822 | end P_Formal_Floating_Point_Definition; | |
823 | ||
824 | ------------------------------------------- | |
825 | -- 12.5.2 Formal Fixed Point Definition -- | |
826 | ------------------------------------------- | |
827 | ||
828 | -- This routine parses either a formal ordinary fixed point definition | |
829 | -- or a formal decimal fixed point definition: | |
830 | ||
831 | -- FORMAL_ORDINARY_FIXED_POINT_DEFINITION ::= delta <> | |
832 | ||
833 | -- FORMAL_DECIMAL_FIXED_POINT_DEFINITION ::= delta <> digits <> | |
834 | ||
835 | -- The caller has checked the initial token is DELTA | |
836 | ||
837 | -- Error recovery: cannot raise Error_Resync | |
838 | ||
839 | function P_Formal_Fixed_Point_Definition return Node_Id is | |
840 | Def_Node : Node_Id; | |
841 | Delta_Sloc : Source_Ptr; | |
842 | ||
843 | begin | |
844 | Delta_Sloc := Token_Ptr; | |
845 | Scan; -- past DELTA | |
846 | T_Box; | |
847 | ||
848 | if Token = Tok_Digits then | |
849 | Def_Node := | |
850 | New_Node (N_Formal_Decimal_Fixed_Point_Definition, Delta_Sloc); | |
851 | Scan; -- past DIGITS | |
852 | T_Box; | |
853 | else | |
854 | Def_Node := | |
855 | New_Node (N_Formal_Ordinary_Fixed_Point_Definition, Delta_Sloc); | |
856 | end if; | |
857 | ||
858 | return Def_Node; | |
859 | end P_Formal_Fixed_Point_Definition; | |
860 | ||
861 | ---------------------------------------------------- | |
862 | -- 12.5.2 Formal Ordinary Fixed Point Definition -- | |
863 | ---------------------------------------------------- | |
864 | ||
865 | -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2) | |
866 | ||
867 | --------------------------------------------------- | |
868 | -- 12.5.2 Formal Decimal Fixed Point Definition -- | |
869 | --------------------------------------------------- | |
870 | ||
871 | -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2) | |
872 | ||
873 | ------------------------------------------ | |
874 | -- 12.5.3 Formal Array Type Definition -- | |
875 | ------------------------------------------ | |
876 | ||
877 | -- Parsed by P_Formal_Type_Definition (12.5) | |
878 | ||
879 | ------------------------------------------- | |
880 | -- 12.5.4 Formal Access Type Definition -- | |
881 | ------------------------------------------- | |
882 | ||
883 | -- Parsed by P_Formal_Type_Definition (12.5) | |
884 | ||
885 | ----------------------------------------- | |
886 | -- 12.6 Formal Subprogram Declaration -- | |
887 | ----------------------------------------- | |
888 | ||
889 | -- FORMAL_SUBPROGRAM_DECLARATION ::= | |
82c80734 RD |
890 | -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION |
891 | -- | FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION | |
892 | ||
893 | -- FORMAL_CONCRETE_SUBPROGRAM_DECLARATION ::= | |
19235870 RK |
894 | -- with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT]; |
895 | ||
82c80734 RD |
896 | -- FORMAL_ABSTRACT_SUBPROGRAM_DECLARATION ::= |
897 | -- with SUBPROGRAM_SPECIFICATION is abstract [SUBPROGRAM_DEFAULT]; | |
898 | ||
19235870 RK |
899 | -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <> |
900 | ||
901 | -- DEFAULT_NAME ::= NAME | |
902 | ||
903 | -- The caller has checked that the initial tokens are WITH FUNCTION or | |
904 | -- WITH PROCEDURE, and the initial WITH has been scanned out. | |
905 | ||
19235870 RK |
906 | -- Error recovery: cannot raise Error_Resync |
907 | ||
908 | function P_Formal_Subprogram_Declaration return Node_Id is | |
82c80734 RD |
909 | Prev_Sloc : constant Source_Ptr := Prev_Token_Ptr; |
910 | Spec_Node : constant Node_Id := P_Subprogram_Specification; | |
911 | Def_Node : Node_Id; | |
19235870 RK |
912 | |
913 | begin | |
19235870 RK |
914 | if Token = Tok_Is then |
915 | T_Is; -- past IS, skip extra IS or ";" | |
916 | ||
82c80734 RD |
917 | if Token = Tok_Abstract then |
918 | Def_Node := | |
919 | New_Node (N_Formal_Abstract_Subprogram_Declaration, Prev_Sloc); | |
920 | Scan; -- past ABSTRACT | |
921 | ||
922 | if Ada_Version < Ada_05 then | |
923 | Error_Msg_SP | |
924 | ("formal abstract subprograms are an Ada 2005 extension"); | |
925 | Error_Msg_SP ("\unit must be compiled with -gnat05 switch"); | |
926 | end if; | |
927 | ||
928 | else | |
929 | Def_Node := | |
930 | New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc); | |
931 | end if; | |
932 | ||
933 | Set_Specification (Def_Node, Spec_Node); | |
934 | ||
935 | if Token = Tok_Semicolon then | |
936 | Scan; -- past ";" | |
937 | ||
938 | elsif Token = Tok_Box then | |
19235870 RK |
939 | Set_Box_Present (Def_Node, True); |
940 | Scan; -- past <> | |
82c80734 | 941 | T_Semicolon; |
19235870 RK |
942 | |
943 | else | |
944 | Set_Default_Name (Def_Node, P_Name); | |
82c80734 | 945 | T_Semicolon; |
19235870 RK |
946 | end if; |
947 | ||
82c80734 RD |
948 | else |
949 | Def_Node := | |
950 | New_Node (N_Formal_Concrete_Subprogram_Declaration, Prev_Sloc); | |
951 | Set_Specification (Def_Node, Spec_Node); | |
952 | T_Semicolon; | |
19235870 RK |
953 | end if; |
954 | ||
19235870 RK |
955 | return Def_Node; |
956 | end P_Formal_Subprogram_Declaration; | |
957 | ||
958 | ------------------------------ | |
959 | -- 12.6 Subprogram Default -- | |
960 | ------------------------------ | |
961 | ||
962 | -- Parsed by P_Formal_Procedure_Declaration (12.6) | |
963 | ||
964 | ------------------------ | |
965 | -- 12.6 Default Name -- | |
966 | ------------------------ | |
967 | ||
968 | -- Parsed by P_Formal_Procedure_Declaration (12.6) | |
969 | ||
970 | -------------------------------------- | |
971 | -- 12.7 Formal Package Declaration -- | |
972 | -------------------------------------- | |
973 | ||
974 | -- FORMAL_PACKAGE_DECLARATION ::= | |
975 | -- with package DEFINING_IDENTIFIER | |
976 | -- is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART; | |
977 | ||
978 | -- FORMAL_PACKAGE_ACTUAL_PART ::= | |
979 | -- (<>) | [GENERIC_ACTUAL_PART] | |
980 | ||
981 | -- The caller has checked that the initial tokens are WITH PACKAGE, | |
982 | -- and the initial WITH has been scanned out (so Token = Tok_Package). | |
983 | ||
984 | -- Error recovery: cannot raise Error_Resync | |
985 | ||
986 | function P_Formal_Package_Declaration return Node_Id is | |
987 | Def_Node : Node_Id; | |
988 | Scan_State : Saved_Scan_State; | |
989 | ||
990 | begin | |
991 | Def_Node := New_Node (N_Formal_Package_Declaration, Prev_Token_Ptr); | |
992 | Scan; -- past PACKAGE | |
bde58e32 | 993 | Set_Defining_Identifier (Def_Node, P_Defining_Identifier (C_Is)); |
19235870 RK |
994 | T_Is; |
995 | T_New; | |
996 | Set_Name (Def_Node, P_Qualified_Simple_Name); | |
997 | ||
998 | if Token = Tok_Left_Paren then | |
999 | Save_Scan_State (Scan_State); -- at the left paren | |
1000 | Scan; -- past the left paren | |
1001 | ||
1002 | if Token = Tok_Box then | |
1003 | Set_Box_Present (Def_Node, True); | |
1004 | Scan; -- past box | |
1005 | T_Right_Paren; | |
1006 | ||
1007 | else | |
1008 | Restore_Scan_State (Scan_State); -- to the left paren | |
1009 | Set_Generic_Associations (Def_Node, P_Generic_Actual_Part_Opt); | |
1010 | end if; | |
1011 | end if; | |
1012 | ||
1013 | T_Semicolon; | |
1014 | return Def_Node; | |
1015 | end P_Formal_Package_Declaration; | |
1016 | ||
1017 | -------------------------------------- | |
1018 | -- 12.7 Formal Package Actual Part -- | |
1019 | -------------------------------------- | |
1020 | ||
1021 | -- Parsed by P_Formal_Package_Declaration (12.7) | |
1022 | ||
1023 | end Ch12; |