1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 pragma Style_Checks
(All_Checks
);
29 -- Turn off subprogram body ordering check. Subprograms are in order
30 -- by RM section rather than alphabetical
35 -- Local functions, used only in this chapter
37 function P_Formal_Derived_Type_Definition
return Node_Id
;
38 function P_Formal_Discrete_Type_Definition
return Node_Id
;
39 function P_Formal_Fixed_Point_Definition
return Node_Id
;
40 function P_Formal_Floating_Point_Definition
return Node_Id
;
41 function P_Formal_Modular_Type_Definition
return Node_Id
;
42 function P_Formal_Package_Declaration
return Node_Id
;
43 function P_Formal_Private_Type_Definition
return Node_Id
;
44 function P_Formal_Signed_Integer_Type_Definition
return Node_Id
;
45 function P_Formal_Subprogram_Declaration
return Node_Id
;
46 function P_Formal_Type_Declaration
return Node_Id
;
47 function P_Formal_Type_Definition
return Node_Id
;
48 function P_Generic_Association
return Node_Id
;
50 procedure P_Formal_Object_Declarations
(Decls
: List_Id
);
51 -- Scans one or more formal object declarations and appends them to
52 -- Decls. Scans more than one declaration only in the case where the
53 -- source has a declaration with multiple defining identifiers.
55 --------------------------------
56 -- 12.1 Generic (also 8.5.5) --
57 --------------------------------
59 -- This routine parses either one of the forms of a generic declaration
60 -- or a generic renaming declaration.
62 -- GENERIC_DECLARATION ::=
63 -- GENERIC_SUBPROGRAM_DECLARATION | GENERIC_PACKAGE_DECLARATION
65 -- GENERIC_SUBPROGRAM_DECLARATION ::=
66 -- GENERIC_FORMAL_PART SUBPROGRAM_SPECIFICATION;
68 -- GENERIC_PACKAGE_DECLARATION ::=
69 -- GENERIC_FORMAL_PART PACKAGE_SPECIFICATION;
71 -- GENERIC_FORMAL_PART ::=
72 -- generic {GENERIC_FORMAL_PARAMETER_DECLARATION | USE_CLAUSE}
74 -- GENERIC_RENAMING_DECLARATION ::=
75 -- generic package DEFINING_PROGRAM_UNIT_NAME
76 -- renames generic_package_NAME
77 -- | generic procedure DEFINING_PROGRAM_UNIT_NAME
78 -- renames generic_procedure_NAME
79 -- | generic function DEFINING_PROGRAM_UNIT_NAME
80 -- renames generic_function_NAME
82 -- GENERIC_FORMAL_PARAMETER_DECLARATION ::=
83 -- FORMAL_OBJECT_DECLARATION
84 -- | FORMAL_TYPE_DECLARATION
85 -- | FORMAL_SUBPROGRAM_DECLARATION
86 -- | FORMAL_PACKAGE_DECLARATION
88 -- The caller has checked that the initial token is GENERIC
90 -- Error recovery: can raise Error_Resync
92 function P_Generic
return Node_Id
is
93 Gen_Sloc
: constant Source_Ptr
:= Token_Ptr
;
98 Ren_Token
: Token_Type
;
99 Scan_State
: Saved_Scan_State
;
102 Scan
; -- past GENERIC
104 if Token
= Tok_Private
then
105 Error_Msg_SC
("PRIVATE goes before GENERIC, not after");
106 Scan
; -- past junk PRIVATE token
109 Save_Scan_State
(Scan_State
); -- at token past GENERIC
111 -- Check for generic renaming declaration case
113 if Token
= Tok_Package
114 or else Token
= Tok_Function
115 or else Token
= Tok_Procedure
118 Scan
; -- scan past PACKAGE, FUNCTION or PROCEDURE
120 if Token
= Tok_Identifier
then
121 Def_Unit
:= P_Defining_Program_Unit_Name
;
123 Check_Misspelling_Of
(Tok_Renames
);
125 if Token
= Tok_Renames
then
126 if Ren_Token
= Tok_Package
then
127 Decl_Node
:= New_Node
128 (N_Generic_Package_Renaming_Declaration
, Gen_Sloc
);
130 elsif Ren_Token
= Tok_Procedure
then
131 Decl_Node
:= New_Node
132 (N_Generic_Procedure_Renaming_Declaration
, Gen_Sloc
);
134 else -- Ren_Token = Tok_Function then
135 Decl_Node
:= New_Node
136 (N_Generic_Function_Renaming_Declaration
, Gen_Sloc
);
139 Scan
; -- past RENAMES
140 Set_Defining_Unit_Name
(Decl_Node
, Def_Unit
);
141 Set_Name
(Decl_Node
, P_Name
);
148 -- Fall through if this is *not* a generic renaming declaration
150 Restore_Scan_State
(Scan_State
);
153 -- Loop through generic parameter declarations and use clauses
156 P_Pragmas_Opt
(Decls
);
157 Ignore
(Tok_Private
);
159 if Token
= Tok_Use
then
160 Append
(P_Use_Clause
, Decls
);
162 -- Parse a generic parameter declaration
164 if Token
= Tok_Identifier
then
165 P_Formal_Object_Declarations
(Decls
);
167 elsif Token
= Tok_Type
then
168 Append
(P_Formal_Type_Declaration
, Decls
);
170 elsif Token
= Tok_With
then
173 if Token
= Tok_Package
then
174 Append
(P_Formal_Package_Declaration
, Decls
);
176 elsif Token
= Tok_Procedure
or Token
= Tok_Function
then
177 Append
(P_Formal_Subprogram_Declaration
, Decls
);
181 ("FUNCTION, PROCEDURE or PACKAGE expected here");
182 Resync_Past_Semicolon
;
185 elsif Token
= Tok_Subtype
then
186 Error_Msg_SC
("subtype declaration not allowed " &
187 "as generic parameter declaration!");
188 Resync_Past_Semicolon
;
197 -- Generic formal part is scanned, scan out subprogram or package spec
199 if Token
= Tok_Package
then
200 Gen_Decl
:= New_Node
(N_Generic_Package_Declaration
, Gen_Sloc
);
201 Set_Specification
(Gen_Decl
, P_Package
(Pf_Spcn
));
203 Gen_Decl
:= New_Node
(N_Generic_Subprogram_Declaration
, Gen_Sloc
);
204 Set_Specification
(Gen_Decl
, P_Subprogram_Specification
);
208 Set_Generic_Formal_Declarations
(Gen_Decl
, Decls
);
212 -------------------------------
213 -- 12.1 Generic Declaration --
214 -------------------------------
216 -- Parsed by P_Generic (12.1)
218 ------------------------------------------
219 -- 12.1 Generic Subprogram Declaration --
220 ------------------------------------------
222 -- Parsed by P_Generic (12.1)
224 ---------------------------------------
225 -- 12.1 Generic Package Declaration --
226 ---------------------------------------
228 -- Parsed by P_Generic (12.1)
230 -------------------------------
231 -- 12.1 Generic Formal Part --
232 -------------------------------
234 -- Parsed by P_Generic (12.1)
236 -------------------------------------------------
237 -- 12.1 Generic Formal Parameter Declaration --
238 -------------------------------------------------
240 -- Parsed by P_Generic (12.1)
242 ---------------------------------
243 -- 12.3 Generic Instantiation --
244 ---------------------------------
246 -- Generic package instantiation parsed by P_Package (7.1)
247 -- Generic procedure instantiation parsed by P_Subprogram (6.1)
248 -- Generic function instantiation parsed by P_Subprogram (6.1)
250 -------------------------------
251 -- 12.3 Generic Actual Part --
252 -------------------------------
254 -- GENERIC_ACTUAL_PART ::=
255 -- (GENERIC_ASSOCIATION {, GENERIC_ASSOCIATION})
257 -- Returns a list of generic associations, or Empty if none are present
259 -- Error recovery: cannot raise Error_Resync
261 function P_Generic_Actual_Part_Opt
return List_Id
is
262 Association_List
: List_Id
;
265 -- Figure out if a generic actual part operation is present. Clearly
266 -- there is no generic actual part if the current token is semicolon
268 if Token
= Tok_Semicolon
then
271 -- If we don't have a left paren, then we have an error, and the job
272 -- is to figure out whether a left paren or semicolon was intended.
273 -- We assume a missing left paren (and hence a generic actual part
274 -- present) if the current token is not on a new line, or if it is
275 -- indented from the subprogram token. Otherwise assume missing
276 -- semicolon (which will be diagnosed by caller) and no generic part
278 elsif Token
/= Tok_Left_Paren
279 and then Token_Is_At_Start_Of_Line
280 and then Start_Column
<= Scope
.Table
(Scope
.Last
).Ecol
284 -- Otherwise we have a generic actual part (either a left paren is
285 -- present, or we have decided that there must be a missing left paren)
288 Association_List
:= New_List
;
292 Append
(P_Generic_Association
, Association_List
);
293 exit when not Comma_Present
;
297 return Association_List
;
300 end P_Generic_Actual_Part_Opt
;
302 -------------------------------
303 -- 12.3 Generic Association --
304 -------------------------------
306 -- GENERIC_ASSOCIATION ::=
307 -- [generic_formal_parameter_SELECTOR_NAME =>]
308 -- EXPLICIT_GENERIC_ACTUAL_PARAMETER
310 -- EXPLICIT_GENERIC_ACTUAL_PARAMETER ::=
311 -- EXPRESSION | variable_NAME | subprogram_NAME
312 -- | entry_NAME | SUBTYPE_MARK | package_instance_NAME
314 -- Error recovery: cannot raise Error_Resync
316 function P_Generic_Association
return Node_Id
is
317 Scan_State
: Saved_Scan_State
;
318 Param_Name_Node
: Node_Id
;
319 Generic_Assoc_Node
: Node_Id
;
322 Generic_Assoc_Node
:= New_Node
(N_Generic_Association
, Token_Ptr
);
324 if Token
in Token_Class_Desig
then
325 Param_Name_Node
:= Token_Node
;
326 Save_Scan_State
(Scan_State
); -- at designator
327 Scan
; -- past simple name or operator symbol
329 if Token
= Tok_Arrow
then
331 Set_Selector_Name
(Generic_Assoc_Node
, Param_Name_Node
);
333 Restore_Scan_State
(Scan_State
); -- to designator
337 Set_Explicit_Generic_Actual_Parameter
(Generic_Assoc_Node
, P_Expression
);
338 return Generic_Assoc_Node
;
339 end P_Generic_Association
;
341 ---------------------------------------------
342 -- 12.3 Explicit Generic Actual Parameter --
343 ---------------------------------------------
345 -- Parsed by P_Generic_Association (12.3)
347 --------------------------------------
348 -- 12.4 Formal Object Declarations --
349 --------------------------------------
351 -- FORMAL_OBJECT_DECLARATION ::=
352 -- DEFINING_IDENTIFIER_LIST :
353 -- MODE SUBTYPE_MARK [:= DEFAULT_EXPRESSION];
355 -- The caller has checked that the initial token is an identifier
357 -- Error recovery: cannot raise Error_Resync
359 procedure P_Formal_Object_Declarations
(Decls
: List_Id
) is
361 Scan_State
: Saved_Scan_State
;
365 Idents
: array (Int
range 1 .. 4096) of Entity_Id
;
366 -- This array holds the list of defining identifiers. The upper bound
367 -- of 4096 is intended to be essentially infinite, and we do not even
368 -- bother to check for it being exceeded.
371 Idents
(1) := P_Defining_Identifier
;
374 while Comma_Present
loop
375 Num_Idents
:= Num_Idents
+ 1;
376 Idents
(Num_Idents
) := P_Defining_Identifier
;
381 -- If there are multiple identifiers, we repeatedly scan the
382 -- type and initialization expression information by resetting
383 -- the scan pointer (so that we get completely separate trees
384 -- for each occurrence).
386 if Num_Idents
> 1 then
387 Save_Scan_State
(Scan_State
);
390 -- Loop through defining identifiers in list
394 Decl_Node
:= New_Node
(N_Formal_Object_Declaration
, Token_Ptr
);
395 Set_Defining_Identifier
(Decl_Node
, Idents
(Ident
));
397 Set_Subtype_Mark
(Decl_Node
, P_Subtype_Mark_Resync
);
399 Set_Expression
(Decl_Node
, Init_Expr_Opt
);
402 Set_Prev_Ids
(Decl_Node
, True);
405 if Ident
< Num_Idents
then
406 Set_More_Ids
(Decl_Node
, True);
409 Append
(Decl_Node
, Decls
);
411 exit Ident_Loop
when Ident
= Num_Idents
;
413 Restore_Scan_State
(Scan_State
);
417 end P_Formal_Object_Declarations
;
419 -----------------------------------
420 -- 12.5 Formal Type Declaration --
421 -----------------------------------
423 -- FORMAL_TYPE_DECLARATION ::=
424 -- type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
425 -- is FORMAL_TYPE_DEFINITION;
427 -- The caller has checked that the initial token is TYPE
429 -- Error recovery: cannot raise Error_Resync
431 function P_Formal_Type_Declaration
return Node_Id
is
436 Decl_Node
:= New_Node
(N_Formal_Type_Declaration
, Token_Ptr
);
438 Set_Defining_Identifier
(Decl_Node
, P_Defining_Identifier
);
440 if P_Unknown_Discriminant_Part_Opt
then
441 Set_Unknown_Discriminants_Present
(Decl_Node
, True);
443 Set_Discriminant_Specifications
444 (Decl_Node
, P_Known_Discriminant_Part_Opt
);
449 Def_Node
:= P_Formal_Type_Definition
;
451 if Def_Node
/= Error
then
452 Set_Formal_Type_Definition
(Decl_Node
, Def_Node
);
458 -- If we have semicolon, skip it to avoid cascaded errors
460 if Token
= Tok_Semicolon
then
466 end P_Formal_Type_Declaration
;
468 ----------------------------------
469 -- 12.5 Formal Type Definition --
470 ----------------------------------
472 -- FORMAL_TYPE_DEFINITION ::=
473 -- FORMAL_PRIVATE_TYPE_DEFINITION
474 -- | FORMAL_DERIVED_TYPE_DEFINITION
475 -- | FORMAL_DISCRETE_TYPE_DEFINITION
476 -- | FORMAL_SIGNED_INTEGER_TYPE_DEFINITION
477 -- | FORMAL_MODULAR_TYPE_DEFINITION
478 -- | FORMAL_FLOATING_POINT_DEFINITION
479 -- | FORMAL_ORDINARY_FIXED_POINT_DEFINITION
480 -- | FORMAL_DECIMAL_FIXED_POINT_DEFINITION
481 -- | FORMAL_ARRAY_TYPE_DEFINITION
482 -- | FORMAL_ACCESS_TYPE_DEFINITION
484 -- FORMAL_ARRAY_TYPE_DEFINITION ::= ARRAY_TYPE_DEFINITION
486 -- FORMAL_ACCESS_TYPE_DEFINITION ::= ACCESS_TYPE_DEFINITION
488 function P_Formal_Type_Definition
return Node_Id
is
489 Scan_State
: Saved_Scan_State
;
492 if Token_Name
= Name_Abstract
then
493 Check_95_Keyword
(Tok_Abstract
, Tok_Tagged
);
496 if Token_Name
= Name_Tagged
then
497 Check_95_Keyword
(Tok_Tagged
, Tok_Private
);
498 Check_95_Keyword
(Tok_Tagged
, Tok_Limited
);
503 -- Mostly we can tell what we have from the initial token. The one
504 -- exception is ABSTRACT, where we have to scan ahead to see if we
505 -- have a formal derived type or a formal private type definition.
508 Save_Scan_State
(Scan_State
);
509 Scan
; -- past ABSTRACT
511 if Token
= Tok_New
then
512 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
513 return P_Formal_Derived_Type_Definition
;
516 Restore_Scan_State
(Scan_State
); -- to ABSTRACT
517 return P_Formal_Private_Type_Definition
;
520 when Tok_Private | Tok_Limited | Tok_Tagged
=>
521 return P_Formal_Private_Type_Definition
;
524 return P_Formal_Derived_Type_Definition
;
526 when Tok_Left_Paren
=>
527 return P_Formal_Discrete_Type_Definition
;
530 return P_Formal_Signed_Integer_Type_Definition
;
533 return P_Formal_Modular_Type_Definition
;
536 return P_Formal_Floating_Point_Definition
;
539 return P_Formal_Fixed_Point_Definition
;
542 return P_Array_Type_Definition
;
545 return P_Access_Type_Definition
;
548 Error_Msg_SC
("record not allowed in generic type definition!");
549 Discard_Junk_Node
(P_Record_Definition
);
553 Error_Msg_BC
("expecting generic type definition here");
554 Resync_Past_Semicolon
;
558 end P_Formal_Type_Definition
;
560 --------------------------------------------
561 -- 12.5.1 Formal Private Type Definition --
562 --------------------------------------------
564 -- FORMAL_PRIVATE_TYPE_DEFINITION ::=
565 -- [[abstract] tagged] [limited] private
567 -- The caller has checked the initial token is PRIVATE, ABSTRACT,
570 -- Error recovery: cannot raise Error_Resync
572 function P_Formal_Private_Type_Definition
return Node_Id
is
576 Def_Node
:= New_Node
(N_Formal_Private_Type_Definition
, Token_Ptr
);
578 if Token
= Tok_Abstract
then
579 Scan
; -- past ABSTRACT
581 if Token_Name
= Name_Tagged
then
582 Check_95_Keyword
(Tok_Tagged
, Tok_Private
);
583 Check_95_Keyword
(Tok_Tagged
, Tok_Limited
);
586 if Token
/= Tok_Tagged
then
587 Error_Msg_SP
("ABSTRACT must be followed by TAGGED");
589 Set_Abstract_Present
(Def_Node
, True);
593 if Token
= Tok_Tagged
then
594 Set_Tagged_Present
(Def_Node
, True);
598 if Token
= Tok_Limited
then
599 Set_Limited_Present
(Def_Node
, True);
600 Scan
; -- past LIMITED
603 Set_Sloc
(Def_Node
, Token_Ptr
);
606 end P_Formal_Private_Type_Definition
;
608 --------------------------------------------
609 -- 12.5.1 Formal Derived Type Definition --
610 --------------------------------------------
612 -- FORMAL_DERIVED_TYPE_DEFINITION ::=
613 -- [abstract] new SUBTYPE_MARK [with private]
615 -- The caller has checked the initial token(s) is/are NEW or ASTRACT NEW
617 -- Error recovery: cannot raise Error_Resync
619 function P_Formal_Derived_Type_Definition
return Node_Id
is
623 Def_Node
:= New_Node
(N_Formal_Derived_Type_Definition
, Token_Ptr
);
625 if Token
= Tok_Abstract
then
626 Set_Abstract_Present
(Def_Node
);
627 Scan
; -- past ABSTRACT
631 Set_Subtype_Mark
(Def_Node
, P_Subtype_Mark
);
634 if Token
= Tok_With
then
636 Set_Private_Present
(Def_Node
, True);
639 elsif Token
= Tok_Tagged
then
642 if Token
= Tok_Private
then
643 Error_Msg_SC
("TAGGED should be WITH");
644 Set_Private_Present
(Def_Node
, True);
652 end P_Formal_Derived_Type_Definition
;
654 ---------------------------------------------
655 -- 12.5.2 Formal Discrete Type Definition --
656 ---------------------------------------------
658 -- FORMAL_DISCRETE_TYPE_DEFINITION ::= (<>)
660 -- The caller has checked the initial token is left paren
662 -- Error recovery: cannot raise Error_Resync
664 function P_Formal_Discrete_Type_Definition
return Node_Id
is
668 Def_Node
:= New_Node
(N_Formal_Discrete_Type_Definition
, Token_Ptr
);
669 Scan
; -- past left paren
673 end P_Formal_Discrete_Type_Definition
;
675 ---------------------------------------------------
676 -- 12.5.2 Formal Signed Integer Type Definition --
677 ---------------------------------------------------
679 -- FORMAL_SIGNED_INTEGER_TYPE_DEFINITION ::= range <>
681 -- The caller has checked the initial token is RANGE
683 -- Error recovery: cannot raise Error_Resync
685 function P_Formal_Signed_Integer_Type_Definition
return Node_Id
is
690 New_Node
(N_Formal_Signed_Integer_Type_Definition
, Token_Ptr
);
694 end P_Formal_Signed_Integer_Type_Definition
;
696 --------------------------------------------
697 -- 12.5.2 Formal Modular Type Definition --
698 --------------------------------------------
700 -- FORMAL_MODULAR_TYPE_DEFINITION ::= mod <>
702 -- The caller has checked the initial token is MOD
704 -- Error recovery: cannot raise Error_Resync
706 function P_Formal_Modular_Type_Definition
return Node_Id
is
711 New_Node
(N_Formal_Modular_Type_Definition
, Token_Ptr
);
715 end P_Formal_Modular_Type_Definition
;
717 ----------------------------------------------
718 -- 12.5.2 Formal Floating Point Definition --
719 ----------------------------------------------
721 -- FORMAL_FLOATING_POINT_DEFINITION ::= digits <>
723 -- The caller has checked the initial token is DIGITS
725 -- Error recovery: cannot raise Error_Resync
727 function P_Formal_Floating_Point_Definition
return Node_Id
is
732 New_Node
(N_Formal_Floating_Point_Definition
, Token_Ptr
);
736 end P_Formal_Floating_Point_Definition
;
738 -------------------------------------------
739 -- 12.5.2 Formal Fixed Point Definition --
740 -------------------------------------------
742 -- This routine parses either a formal ordinary fixed point definition
743 -- or a formal decimal fixed point definition:
745 -- FORMAL_ORDINARY_FIXED_POINT_DEFINITION ::= delta <>
747 -- FORMAL_DECIMAL_FIXED_POINT_DEFINITION ::= delta <> digits <>
749 -- The caller has checked the initial token is DELTA
751 -- Error recovery: cannot raise Error_Resync
753 function P_Formal_Fixed_Point_Definition
return Node_Id
is
755 Delta_Sloc
: Source_Ptr
;
758 Delta_Sloc
:= Token_Ptr
;
762 if Token
= Tok_Digits
then
764 New_Node
(N_Formal_Decimal_Fixed_Point_Definition
, Delta_Sloc
);
769 New_Node
(N_Formal_Ordinary_Fixed_Point_Definition
, Delta_Sloc
);
773 end P_Formal_Fixed_Point_Definition
;
775 ----------------------------------------------------
776 -- 12.5.2 Formal Ordinary Fixed Point Definition --
777 ----------------------------------------------------
779 -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2)
781 ---------------------------------------------------
782 -- 12.5.2 Formal Decimal Fixed Point Definition --
783 ---------------------------------------------------
785 -- Parsed by P_Formal_Fixed_Point_Definition (12.5.2)
787 ------------------------------------------
788 -- 12.5.3 Formal Array Type Definition --
789 ------------------------------------------
791 -- Parsed by P_Formal_Type_Definition (12.5)
793 -------------------------------------------
794 -- 12.5.4 Formal Access Type Definition --
795 -------------------------------------------
797 -- Parsed by P_Formal_Type_Definition (12.5)
799 -----------------------------------------
800 -- 12.6 Formal Subprogram Declaration --
801 -----------------------------------------
803 -- FORMAL_SUBPROGRAM_DECLARATION ::=
804 -- with SUBPROGRAM_SPECIFICATION [is SUBPROGRAM_DEFAULT];
806 -- SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <>
808 -- DEFAULT_NAME ::= NAME
810 -- The caller has checked that the initial tokens are WITH FUNCTION or
811 -- WITH PROCEDURE, and the initial WITH has been scanned out.
813 -- Note: we separate this into two procedures because the name is allowed
814 -- to be an operator symbol for a function, but not for a procedure.
816 -- Error recovery: cannot raise Error_Resync
818 function P_Formal_Subprogram_Declaration
return Node_Id
is
822 Def_Node
:= New_Node
(N_Formal_Subprogram_Declaration
, Prev_Token_Ptr
);
823 Set_Specification
(Def_Node
, P_Subprogram_Specification
);
825 if Token
= Tok_Is
then
826 T_Is
; -- past IS, skip extra IS or ";"
828 if Token
= Tok_Box
then
829 Set_Box_Present
(Def_Node
, True);
833 Set_Default_Name
(Def_Node
, P_Name
);
840 end P_Formal_Subprogram_Declaration
;
842 ------------------------------
843 -- 12.6 Subprogram Default --
844 ------------------------------
846 -- Parsed by P_Formal_Procedure_Declaration (12.6)
848 ------------------------
849 -- 12.6 Default Name --
850 ------------------------
852 -- Parsed by P_Formal_Procedure_Declaration (12.6)
854 --------------------------------------
855 -- 12.7 Formal Package Declaration --
856 --------------------------------------
858 -- FORMAL_PACKAGE_DECLARATION ::=
859 -- with package DEFINING_IDENTIFIER
860 -- is new generic_package_NAME FORMAL_PACKAGE_ACTUAL_PART;
862 -- FORMAL_PACKAGE_ACTUAL_PART ::=
863 -- (<>) | [GENERIC_ACTUAL_PART]
865 -- The caller has checked that the initial tokens are WITH PACKAGE,
866 -- and the initial WITH has been scanned out (so Token = Tok_Package).
868 -- Error recovery: cannot raise Error_Resync
870 function P_Formal_Package_Declaration
return Node_Id
is
872 Scan_State
: Saved_Scan_State
;
875 Def_Node
:= New_Node
(N_Formal_Package_Declaration
, Prev_Token_Ptr
);
876 Scan
; -- past PACKAGE
877 Set_Defining_Identifier
(Def_Node
, P_Defining_Identifier
);
880 Set_Name
(Def_Node
, P_Qualified_Simple_Name
);
882 if Token
= Tok_Left_Paren
then
883 Save_Scan_State
(Scan_State
); -- at the left paren
884 Scan
; -- past the left paren
886 if Token
= Tok_Box
then
887 Set_Box_Present
(Def_Node
, True);
892 Restore_Scan_State
(Scan_State
); -- to the left paren
893 Set_Generic_Associations
(Def_Node
, P_Generic_Actual_Part_Opt
);
899 end P_Formal_Package_Declaration
;
901 --------------------------------------
902 -- 12.7 Formal Package Actual Part --
903 --------------------------------------
905 -- Parsed by P_Formal_Package_Declaration (12.7)