[NDS32] new attribute no_prologue and new option -mret-in-naked-func.
[official-gcc.git] / gcc / ada / einfo.adb
blobcdfd44d1ee1f514333a9362907fedc96bdcc9802
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E I N F O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2018, 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. --
17 -- --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
32 pragma Style_Checks (All_Checks);
33 -- Turn off subprogram ordering, not used for this unit
35 with Atree; use Atree;
36 with Elists; use Elists;
37 with Namet; use Namet;
38 with Nlists; use Nlists;
39 with Output; use Output;
40 with Sinfo; use Sinfo;
41 with Stand; use Stand;
43 package body Einfo is
45 use Atree.Unchecked_Access;
46 -- This is one of the packages that is allowed direct untyped access to
47 -- the fields in a node, since it provides the next level abstraction
48 -- which incorporates appropriate checks.
50 ----------------------------------------------
51 -- Usage of Fields in Defining Entity Nodes --
52 ----------------------------------------------
54 -- Four of these fields are defined in Sinfo, since they in are the base
55 -- part of the node. The access routines for these four fields and the
56 -- corresponding set procedures are defined in Sinfo. These fields are
57 -- present in all entities. Note that Homonym is also in the base part of
58 -- the node, but has access routines that are more properly part of Einfo,
59 -- which is why they are defined here.
61 -- Chars Name1
62 -- Next_Entity Node2
63 -- Scope Node3
64 -- Etype Node5
66 -- Remaining fields are present only in extended nodes (i.e. entities).
68 -- The following fields are present in all entities
70 -- Homonym Node4
71 -- First_Rep_Item Node6
72 -- Freeze_Node Node7
73 -- Prev_Entity Node36
74 -- Associated_Entity Node37
76 -- The usage of other fields (and the entity kinds to which it applies)
77 -- depends on the particular field (see Einfo spec for details).
79 -- Associated_Node_For_Itype Node8
80 -- Dependent_Instances Elist8
81 -- Hiding_Loop_Variable Node8
82 -- Mechanism Uint8 (but returns Mechanism_Type)
83 -- Normalized_First_Bit Uint8
84 -- Refinement_Constituents Elist8
85 -- Return_Applies_To Node8
86 -- First_Exit_Statement Node8
88 -- Class_Wide_Type Node9
89 -- Current_Value Node9
90 -- Renaming_Map Uint9
92 -- Direct_Primitive_Operations Elist10
93 -- Discriminal_Link Node10
94 -- Float_Rep Uint10 (but returns Float_Rep_Kind)
95 -- Handler_Records List10
96 -- Normalized_Position_Max Uint10
97 -- Part_Of_Constituents Elist10
99 -- Block_Node Node11
100 -- Component_Bit_Offset Uint11
101 -- Full_View Node11
102 -- Entry_Component Node11
103 -- Enumeration_Pos Uint11
104 -- Generic_Homonym Node11
105 -- Part_Of_References Elist11
106 -- Protected_Body_Subprogram Node11
108 -- Barrier_Function Node12
109 -- Enumeration_Rep Uint12
110 -- Esize Uint12
111 -- Next_Inlined_Subprogram Node12
113 -- Component_Clause Node13
114 -- Elaboration_Entity Node13
115 -- Extra_Accessibility Node13
116 -- RM_Size Uint13
118 -- Alignment Uint14
119 -- Normalized_Position Uint14
120 -- Postconditions_Proc Node14
121 -- Shadow_Entities List14
123 -- Discriminant_Number Uint15
124 -- DT_Position Uint15
125 -- DT_Entry_Count Uint15
126 -- Entry_Parameters_Type Node15
127 -- Extra_Formal Node15
128 -- Pending_Access_Types Elist15
129 -- Related_Instance Node15
130 -- Status_Flag_Or_Transient_Decl Node15
132 -- Access_Disp_Table Elist16
133 -- Body_References Elist16
134 -- Cloned_Subtype Node16
135 -- DTC_Entity Node16
136 -- Entry_Formal Node16
137 -- First_Private_Entity Node16
138 -- Lit_Strings Node16
139 -- Scale_Value Uint16
140 -- String_Literal_Length Uint16
141 -- Unset_Reference Node16
143 -- Actual_Subtype Node17
144 -- Digits_Value Uint17
145 -- Discriminal Node17
146 -- First_Entity Node17
147 -- First_Index Node17
148 -- First_Literal Node17
149 -- Master_Id Node17
150 -- Modulus Uint17
151 -- Prival Node17
153 -- Alias Node18
154 -- Corresponding_Concurrent_Type Node18
155 -- Corresponding_Protected_Entry Node18
156 -- Corresponding_Record_Type Node18
157 -- Delta_Value Ureal18
158 -- Enclosing_Scope Node18
159 -- Equivalent_Type Node18
160 -- Lit_Indexes Node18
161 -- Private_Dependents Elist18
162 -- Renamed_Entity Node18
163 -- Renamed_Object Node18
164 -- String_Literal_Low_Bound Node18
166 -- Body_Entity Node19
167 -- Corresponding_Discriminant Node19
168 -- Default_Aspect_Component_Value Node19
169 -- Default_Aspect_Value Node19
170 -- Entry_Bodies_Array Node19
171 -- Extra_Accessibility_Of_Result Node19
172 -- Non_Limited_View Node19
173 -- Parent_Subtype Node19
174 -- Receiving_Entry Node19
175 -- Size_Check_Code Node19
176 -- Spec_Entity Node19
177 -- Underlying_Full_View Node19
179 -- Component_Type Node20
180 -- Default_Value Node20
181 -- Directly_Designated_Type Node20
182 -- Discriminant_Checking_Func Node20
183 -- Discriminant_Default_Value Node20
184 -- Last_Entity Node20
185 -- Prival_Link Node20
186 -- Register_Exception_Call Node20
187 -- Scalar_Range Node20
189 -- Accept_Address Elist21
190 -- Corresponding_Record_Component Node21
191 -- Default_Expr_Function Node21
192 -- Discriminant_Constraint Elist21
193 -- Interface_Name Node21
194 -- Original_Array_Type Node21
195 -- Small_Value Ureal21
197 -- Associated_Storage_Pool Node22
198 -- Component_Size Uint22
199 -- Corresponding_Remote_Type Node22
200 -- Enumeration_Rep_Expr Node22
201 -- Original_Record_Component Node22
202 -- Private_View Node22
203 -- Protected_Formal Node22
204 -- Scope_Depth_Value Uint22
205 -- Shared_Var_Procs_Instance Node22
207 -- CR_Discriminant Node23
208 -- Entry_Cancel_Parameter Node23
209 -- Enum_Pos_To_Rep Node23
210 -- Extra_Constrained Node23
211 -- Finalization_Master Node23
212 -- Generic_Renamings Elist23
213 -- Inner_Instances Elist23
214 -- Limited_View Node23
215 -- Packed_Array_Impl_Type Node23
216 -- Protection_Object Node23
217 -- Stored_Constraint Elist23
219 -- Incomplete_Actuals Elist24
220 -- Related_Expression Node24
221 -- Subps_Index Uint24
223 -- Contract_Wrapper Node25
224 -- Debug_Renaming_Link Node25
225 -- DT_Offset_To_Top_Func Node25
226 -- Interface_Alias Node25
227 -- Interfaces Elist25
228 -- Related_Array_Object Node25
229 -- Static_Discrete_Predicate List25
230 -- Static_Real_Or_String_Predicate Node25
231 -- Task_Body_Procedure Node25
233 -- Dispatch_Table_Wrappers Elist26
234 -- Last_Assignment Node26
235 -- Overridden_Operation Node26
236 -- Package_Instantiation Node26
237 -- Storage_Size_Variable Node26
239 -- Current_Use_Clause Node27
240 -- Related_Type Node27
241 -- Wrapped_Entity Node27
243 -- Extra_Formals Node28
244 -- Finalizer Node28
245 -- Initialization_Statements Node28
246 -- Original_Access_Type Node28
247 -- Relative_Deadline_Variable Node28
248 -- Underlying_Record_View Node28
250 -- Anonymous_Masters Elist29
251 -- BIP_Initialization_Call Node29
252 -- Subprograms_For_Type Elist29
254 -- Access_Disp_Table_Elab_Flag Node30
255 -- Anonymous_Object Node30
256 -- Corresponding_Equality Node30
257 -- Hidden_In_Formal_Instance Elist30
258 -- Last_Aggregate_Assignment Node30
259 -- Static_Initialization Node30
261 -- Activation_Record_Component Node31
262 -- Derived_Type_Link Node31
263 -- Thunk_Entity Node31
265 -- Corresponding_Function Node32
266 -- Corresponding_Procedure Node32
267 -- Encapsulating_State Node32
268 -- No_Tagged_Streams_Pragma Node32
270 -- Linker_Section_Pragma Node33
272 -- Contract Node34
274 -- Anonymous_Designated_Type Node35
275 -- Entry_Max_Queue_Lengths_Array Node35
276 -- Import_Pragma Node35
278 -- Validated_Object Node38
279 -- Predicated_Parent Node38
280 -- Class_Wide_Clone Node38
282 -- Protected_Subprogram Node39
284 -- SPARK_Pragma Node40
286 -- Original_Protected_Subprogram Node41
287 -- SPARK_Aux_Pragma Node41
289 ---------------------------------------------
290 -- Usage of Flags in Defining Entity Nodes --
291 ---------------------------------------------
293 -- All flags are unique, there is no overlaying, so each flag is physically
294 -- present in every entity. However, for many of the flags, it only makes
295 -- sense for them to be set true for certain subsets of entity kinds. See
296 -- the spec of Einfo for further details.
298 -- Is_Inlined_Always Flag1
299 -- Is_Hidden_Non_Overridden_Subpgm Flag2
300 -- Has_Own_DIC Flag3
301 -- Is_Frozen Flag4
302 -- Has_Discriminants Flag5
303 -- Is_Dispatching_Operation Flag6
304 -- Is_Immediately_Visible Flag7
305 -- In_Use Flag8
306 -- Is_Potentially_Use_Visible Flag9
307 -- Is_Public Flag10
309 -- Is_Inlined Flag11
310 -- Is_Constrained Flag12
311 -- Is_Generic_Type Flag13
312 -- Depends_On_Private Flag14
313 -- Is_Aliased Flag15
314 -- Is_Volatile Flag16
315 -- Is_Internal Flag17
316 -- Has_Delayed_Freeze Flag18
317 -- Is_Abstract_Subprogram Flag19
318 -- Is_Concurrent_Record_Type Flag20
320 -- Has_Master_Entity Flag21
321 -- Needs_No_Actuals Flag22
322 -- Has_Storage_Size_Clause Flag23
323 -- Is_Imported Flag24
324 -- Is_Limited_Record Flag25
325 -- Has_Completion Flag26
326 -- Has_Pragma_Controlled Flag27
327 -- Is_Statically_Allocated Flag28
328 -- Has_Size_Clause Flag29
329 -- Has_Task Flag30
331 -- Checks_May_Be_Suppressed Flag31
332 -- Kill_Elaboration_Checks Flag32
333 -- Kill_Range_Checks Flag33
334 -- Has_Independent_Components Flag34
335 -- Is_Class_Wide_Equivalent_Type Flag35
336 -- Referenced_As_LHS Flag36
337 -- Is_Known_Non_Null Flag37
338 -- Can_Never_Be_Null Flag38
339 -- Has_Default_Aspect Flag39
340 -- Body_Needed_For_SAL Flag40
342 -- Treat_As_Volatile Flag41
343 -- Is_Controlled_Active Flag42
344 -- Has_Controlled_Component Flag43
345 -- Is_Pure Flag44
346 -- In_Private_Part Flag45
347 -- Has_Alignment_Clause Flag46
348 -- Has_Exit Flag47
349 -- In_Package_Body Flag48
350 -- Reachable Flag49
351 -- Delay_Subprogram_Descriptors Flag50
353 -- Is_Packed Flag51
354 -- Is_Entry_Formal Flag52
355 -- Is_Private_Descendant Flag53
356 -- Return_Present Flag54
357 -- Is_Tagged_Type Flag55
358 -- Has_Homonym Flag56
359 -- Is_Hidden Flag57
360 -- Non_Binary_Modulus Flag58
361 -- Is_Preelaborated Flag59
362 -- Is_Shared_Passive Flag60
364 -- Is_Remote_Types Flag61
365 -- Is_Remote_Call_Interface Flag62
366 -- Is_Character_Type Flag63
367 -- Is_Intrinsic_Subprogram Flag64
368 -- Has_Record_Rep_Clause Flag65
369 -- Has_Enumeration_Rep_Clause Flag66
370 -- Has_Small_Clause Flag67
371 -- Has_Component_Size_Clause Flag68
372 -- Is_Access_Constant Flag69
373 -- Is_First_Subtype Flag70
375 -- Has_Completion_In_Body Flag71
376 -- Has_Unknown_Discriminants Flag72
377 -- Is_Child_Unit Flag73
378 -- Is_CPP_Class Flag74
379 -- Has_Non_Standard_Rep Flag75
380 -- Is_Constructor Flag76
381 -- Static_Elaboration_Desired Flag77
382 -- Is_Tag Flag78
383 -- Has_All_Calls_Remote Flag79
384 -- Is_Constr_Subt_For_U_Nominal Flag80
386 -- Is_Asynchronous Flag81
387 -- Has_Gigi_Rep_Item Flag82
388 -- Has_Machine_Radix_Clause Flag83
389 -- Machine_Radix_10 Flag84
390 -- Is_Atomic Flag85
391 -- Has_Atomic_Components Flag86
392 -- Has_Volatile_Components Flag87
393 -- Discard_Names Flag88
394 -- Is_Interrupt_Handler Flag89
395 -- Returns_By_Ref Flag90
397 -- Is_Itype Flag91
398 -- Size_Known_At_Compile_Time Flag92
399 -- Reverse_Storage_Order Flag93
400 -- Is_Generic_Actual_Type Flag94
401 -- Uses_Sec_Stack Flag95
402 -- Warnings_Off Flag96
403 -- Is_Controlling_Formal Flag97
404 -- Has_Controlling_Result Flag98
405 -- Is_Exported Flag99
406 -- Has_Specified_Layout Flag100
408 -- Has_Nested_Block_With_Handler Flag101
409 -- Is_Called Flag102
410 -- Is_Completely_Hidden Flag103
411 -- Address_Taken Flag104
412 -- Suppress_Initialization Flag105
413 -- Is_Limited_Composite Flag106
414 -- Is_Private_Composite Flag107
415 -- Default_Expressions_Processed Flag108
416 -- Is_Non_Static_Subtype Flag109
417 -- Has_Out_Or_In_Out_Parameter Flag110
419 -- Is_Formal_Subprogram Flag111
420 -- Is_Renaming_Of_Object Flag112
421 -- No_Return Flag113
422 -- Delay_Cleanups Flag114
423 -- Never_Set_In_Source Flag115
424 -- Is_Visible_Lib_Unit Flag116
425 -- Is_Unchecked_Union Flag117
426 -- Is_For_Access_Subtype Flag118
427 -- Has_Convention_Pragma Flag119
428 -- Has_Primitive_Operations Flag120
430 -- Has_Pragma_Pack Flag121
431 -- Is_Bit_Packed_Array Flag122
432 -- Has_Unchecked_Union Flag123
433 -- Is_Eliminated Flag124
434 -- C_Pass_By_Copy Flag125
435 -- Is_Instantiated Flag126
436 -- Is_Valued_Procedure Flag127
437 -- (used for Component_Alignment) Flag128
438 -- (used for Component_Alignment) Flag129
439 -- Is_Generic_Instance Flag130
441 -- No_Pool_Assigned Flag131
442 -- Is_DIC_Procedure Flag132
443 -- Has_Inherited_DIC Flag133
444 -- Has_Aliased_Components Flag135
445 -- No_Strict_Aliasing Flag136
446 -- Is_Machine_Code_Subprogram Flag137
447 -- Is_Packed_Array_Impl_Type Flag138
448 -- Has_Biased_Representation Flag139
449 -- Has_Complex_Representation Flag140
451 -- Is_Constr_Subt_For_UN_Aliased Flag141
452 -- Has_Missing_Return Flag142
453 -- Has_Recursive_Call Flag143
454 -- Is_Unsigned_Type Flag144
455 -- Strict_Alignment Flag145
456 -- Is_Abstract_Type Flag146
457 -- Needs_Debug_Info Flag147
458 -- Is_Elaboration_Checks_OK_Id Flag148
459 -- Is_Compilation_Unit Flag149
460 -- Has_Pragma_Elaborate_Body Flag150
462 -- Has_Private_Ancestor Flag151
463 -- Entry_Accepted Flag152
464 -- Is_Obsolescent Flag153
465 -- Has_Per_Object_Constraint Flag154
466 -- Has_Private_Declaration Flag155
467 -- Referenced Flag156
468 -- Has_Pragma_Inline Flag157
469 -- Finalize_Storage_Only Flag158
470 -- From_Limited_With Flag159
471 -- Is_Package_Body_Entity Flag160
473 -- Has_Qualified_Name Flag161
474 -- Nonzero_Is_True Flag162
475 -- Is_True_Constant Flag163
476 -- Reverse_Bit_Order Flag164
477 -- Suppress_Style_Checks Flag165
478 -- Debug_Info_Off Flag166
479 -- Sec_Stack_Needed_For_Return Flag167
480 -- Materialize_Entity Flag168
481 -- Has_Pragma_Thread_Local_Storage Flag169
482 -- Is_Known_Valid Flag170
484 -- Is_Hidden_Open_Scope Flag171
485 -- Has_Object_Size_Clause Flag172
486 -- Has_Fully_Qualified_Name Flag173
487 -- Elaboration_Entity_Required Flag174
488 -- Has_Forward_Instantiation Flag175
489 -- Is_Discrim_SO_Function Flag176
490 -- Size_Depends_On_Discriminant Flag177
491 -- Is_Null_Init_Proc Flag178
492 -- Has_Pragma_Pure_Function Flag179
493 -- Has_Pragma_Unreferenced Flag180
495 -- Has_Contiguous_Rep Flag181
496 -- Has_Xref_Entry Flag182
497 -- Must_Be_On_Byte_Boundary Flag183
498 -- Has_Stream_Size_Clause Flag184
499 -- Is_Ada_2005_Only Flag185
500 -- Is_Interface Flag186
501 -- Has_Constrained_Partial_View Flag187
502 -- Uses_Lock_Free Flag188
503 -- Is_Pure_Unit_Access_Type Flag189
504 -- Has_Specified_Stream_Input Flag190
506 -- Has_Specified_Stream_Output Flag191
507 -- Has_Specified_Stream_Read Flag192
508 -- Has_Specified_Stream_Write Flag193
509 -- Is_Local_Anonymous_Access Flag194
510 -- Is_Primitive_Wrapper Flag195
511 -- Was_Hidden Flag196
512 -- Is_Limited_Interface Flag197
513 -- Has_Pragma_Ordered Flag198
514 -- Is_Ada_2012_Only Flag199
516 -- Has_Delayed_Aspects Flag200
517 -- Has_Pragma_No_Inline Flag201
518 -- Itype_Printed Flag202
519 -- Has_Pragma_Pure Flag203
520 -- Is_Known_Null Flag204
521 -- Low_Bound_Tested Flag205
522 -- Is_Visible_Formal Flag206
523 -- Known_To_Have_Preelab_Init Flag207
524 -- Must_Have_Preelab_Init Flag208
525 -- Is_Return_Object Flag209
526 -- Elaborate_Body_Desirable Flag210
528 -- Has_Static_Discriminants Flag211
529 -- Has_Pragma_Unreferenced_Objects Flag212
530 -- Requires_Overriding Flag213
531 -- Has_RACW Flag214
532 -- Is_Param_Block_Component_Type Flag215
533 -- Universal_Aliasing Flag216
534 -- Suppress_Value_Tracking_On_Call Flag217
535 -- Is_Primitive Flag218
536 -- Has_Initial_Value Flag219
537 -- Has_Dispatch_Table Flag220
539 -- Has_Pragma_Preelab_Init Flag221
540 -- Used_As_Generic_Actual Flag222
541 -- Is_Descendant_Of_Address Flag223
542 -- Is_Raised Flag224
543 -- Is_Thunk Flag225
544 -- Is_Only_Out_Parameter Flag226
545 -- Referenced_As_Out_Parameter Flag227
546 -- Has_Thunks Flag228
547 -- Can_Use_Internal_Rep Flag229
548 -- Has_Pragma_Inline_Always Flag230
550 -- Renamed_In_Spec Flag231
551 -- Has_Own_Invariants Flag232
552 -- Has_Pragma_Unmodified Flag233
553 -- Is_Dispatch_Table_Entity Flag234
554 -- Is_Trivial_Subprogram Flag235
555 -- Warnings_Off_Used Flag236
556 -- Warnings_Off_Used_Unmodified Flag237
557 -- Warnings_Off_Used_Unreferenced Flag238
558 -- No_Reordering Flag239
559 -- Has_Expanded_Contract Flag240
561 -- Optimize_Alignment_Space Flag241
562 -- Optimize_Alignment_Time Flag242
563 -- Overlays_Constant Flag243
564 -- Is_RACW_Stub_Type Flag244
565 -- Is_Private_Primitive Flag245
566 -- Is_Underlying_Record_View Flag246
567 -- OK_To_Rename Flag247
568 -- Has_Inheritable_Invariants Flag248
569 -- Is_Safe_To_Reevaluate Flag249
570 -- Has_Predicates Flag250
572 -- Has_Implicit_Dereference Flag251
573 -- Is_Finalized_Transient Flag252
574 -- Disable_Controlled Flag253
575 -- Is_Implementation_Defined Flag254
576 -- Is_Predicate_Function Flag255
577 -- Is_Predicate_Function_M Flag256
578 -- Is_Invariant_Procedure Flag257
579 -- Has_Dynamic_Predicate_Aspect Flag258
580 -- Has_Static_Predicate_Aspect Flag259
581 -- Has_Loop_Entry_Attributes Flag260
583 -- Has_Delayed_Rep_Aspects Flag261
584 -- May_Inherit_Delayed_Rep_Aspects Flag262
585 -- Has_Visible_Refinement Flag263
586 -- Is_Discriminant_Check_Function Flag264
587 -- SPARK_Pragma_Inherited Flag265
588 -- SPARK_Aux_Pragma_Inherited Flag266
589 -- Has_Shift_Operator Flag267
590 -- Is_Independent Flag268
591 -- Has_Static_Predicate Flag269
592 -- Stores_Attribute_Old_Prefix Flag270
594 -- Has_Protected Flag271
595 -- SSO_Set_Low_By_Default Flag272
596 -- SSO_Set_High_By_Default Flag273
597 -- Is_Generic_Actual_Subprogram Flag274
598 -- No_Predicate_On_Actual Flag275
599 -- No_Dynamic_Predicate_On_Actual Flag276
600 -- Is_Checked_Ghost_Entity Flag277
601 -- Is_Ignored_Ghost_Entity Flag278
602 -- Contains_Ignored_Ghost_Code Flag279
603 -- Partial_View_Has_Unknown_Discr Flag280
605 -- Is_Static_Type Flag281
606 -- Has_Nested_Subprogram Flag282
607 -- Is_Uplevel_Referenced_Entity Flag283
608 -- Is_Unimplemented Flag284
609 -- Is_Volatile_Full_Access Flag285
610 -- Is_Exception_Handler Flag286
611 -- Rewritten_For_C Flag287
612 -- Predicates_Ignored Flag288
613 -- Has_Timing_Event Flag289
614 -- Is_Class_Wide_Clone Flag290
616 -- Has_Inherited_Invariants Flag291
617 -- Is_Partial_Invariant_Procedure Flag292
618 -- Is_Actual_Subtype Flag293
619 -- Has_Pragma_Unused Flag294
620 -- Is_Ignored_Transient Flag295
621 -- Has_Partial_Visible_Refinement Flag296
622 -- Is_Entry_Wrapper Flag297
623 -- Is_Underlying_Full_View Flag298
624 -- Body_Needed_For_Inlining Flag299
625 -- Has_Private_Extension Flag300
627 -- Ignore_SPARK_Mode_Pragmas Flag301
628 -- Is_Initial_Condition_Procedure Flag302
629 -- Suppress_Elaboration_Warnings Flag303
630 -- Is_Elaboration_Warnings_OK_Id Flag304
631 -- Is_Activation_Record Flag305
633 -- (unused) Flag306
634 -- (unused) Flag307
635 -- (unused) Flag308
636 -- (unused) Flag309
638 -- Note: Flag310-317 are defined in atree.ads/adb, but not yet in atree.h
640 -----------------------
641 -- Local subprograms --
642 -----------------------
644 function Has_Option
645 (State_Id : Entity_Id;
646 Option_Nam : Name_Id) return Boolean;
647 -- Determine whether abstract state State_Id has particular option denoted
648 -- by the name Option_Nam.
650 ---------------
651 -- Float_Rep --
652 ---------------
654 function Float_Rep (Id : E) return F is
655 pragma Assert (Is_Floating_Point_Type (Id));
656 begin
657 return F'Val (UI_To_Int (Uint10 (Base_Type (Id))));
658 end Float_Rep;
660 ----------------
661 -- Has_Option --
662 ----------------
664 function Has_Option
665 (State_Id : Entity_Id;
666 Option_Nam : Name_Id) return Boolean
668 Decl : constant Node_Id := Parent (State_Id);
669 Opt : Node_Id;
670 Opt_Nam : Node_Id;
672 begin
673 pragma Assert (Ekind (State_Id) = E_Abstract_State);
675 -- The declaration of abstract states with options appear as an
676 -- extension aggregate. If this is not the case, the option is not
677 -- available.
679 if Nkind (Decl) /= N_Extension_Aggregate then
680 return False;
681 end if;
683 -- Simple options
685 Opt := First (Expressions (Decl));
686 while Present (Opt) loop
687 if Nkind (Opt) = N_Identifier and then Chars (Opt) = Option_Nam then
688 return True;
689 end if;
691 Next (Opt);
692 end loop;
694 -- Complex options with various specifiers
696 Opt := First (Component_Associations (Decl));
697 while Present (Opt) loop
698 Opt_Nam := First (Choices (Opt));
700 if Nkind (Opt_Nam) = N_Identifier
701 and then Chars (Opt_Nam) = Option_Nam
702 then
703 return True;
704 end if;
706 Next (Opt);
707 end loop;
709 return False;
710 end Has_Option;
712 --------------------------------
713 -- Attribute Access Functions --
714 --------------------------------
716 function Abstract_States (Id : E) return L is
717 begin
718 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
719 return Elist25 (Id);
720 end Abstract_States;
722 function Accept_Address (Id : E) return L is
723 begin
724 return Elist21 (Id);
725 end Accept_Address;
727 function Access_Disp_Table (Id : E) return L is
728 begin
729 pragma Assert (Ekind_In (Id, E_Record_Subtype,
730 E_Record_Type,
731 E_Record_Type_With_Private));
732 return Elist16 (Implementation_Base_Type (Id));
733 end Access_Disp_Table;
735 function Access_Disp_Table_Elab_Flag (Id : E) return E is
736 begin
737 pragma Assert (Ekind_In (Id, E_Record_Subtype,
738 E_Record_Type,
739 E_Record_Type_With_Private));
740 return Node30 (Implementation_Base_Type (Id));
741 end Access_Disp_Table_Elab_Flag;
743 function Activation_Record_Component (Id : E) return E is
744 begin
745 pragma Assert (Ekind_In (Id, E_Constant,
746 E_Discriminant,
747 E_In_Parameter,
748 E_In_Out_Parameter,
749 E_Loop_Parameter,
750 E_Out_Parameter,
751 E_Variable));
752 return Node31 (Id);
753 end Activation_Record_Component;
755 function Actual_Subtype (Id : E) return E is
756 begin
757 pragma Assert
758 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
759 or else Is_Formal (Id));
760 return Node17 (Id);
761 end Actual_Subtype;
763 function Address_Taken (Id : E) return B is
764 begin
765 return Flag104 (Id);
766 end Address_Taken;
768 function Alias (Id : E) return E is
769 begin
770 pragma Assert
771 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
772 return Node18 (Id);
773 end Alias;
775 function Alignment (Id : E) return U is
776 begin
777 pragma Assert (Is_Type (Id)
778 or else Is_Formal (Id)
779 or else Ekind_In (Id, E_Loop_Parameter,
780 E_Constant,
781 E_Exception,
782 E_Variable));
783 return Uint14 (Id);
784 end Alignment;
786 function Anonymous_Designated_Type (Id : E) return E is
787 begin
788 pragma Assert (Ekind (Id) = E_Variable);
789 return Node35 (Id);
790 end Anonymous_Designated_Type;
792 function Anonymous_Masters (Id : E) return L is
793 begin
794 pragma Assert (Ekind_In (Id, E_Function,
795 E_Package,
796 E_Procedure,
797 E_Subprogram_Body));
798 return Elist29 (Id);
799 end Anonymous_Masters;
801 function Anonymous_Object (Id : E) return E is
802 begin
803 pragma Assert (Ekind_In (Id, E_Protected_Type, E_Task_Type));
804 return Node30 (Id);
805 end Anonymous_Object;
807 function Associated_Entity (Id : E) return E is
808 begin
809 return Node37 (Id);
810 end Associated_Entity;
812 function Associated_Formal_Package (Id : E) return E is
813 begin
814 pragma Assert (Ekind (Id) = E_Package);
815 return Node12 (Id);
816 end Associated_Formal_Package;
818 function Associated_Node_For_Itype (Id : E) return N is
819 begin
820 return Node8 (Id);
821 end Associated_Node_For_Itype;
823 function Associated_Storage_Pool (Id : E) return E is
824 begin
825 pragma Assert (Is_Access_Type (Id));
826 return Node22 (Root_Type (Id));
827 end Associated_Storage_Pool;
829 function Barrier_Function (Id : E) return N is
830 begin
831 pragma Assert (Is_Entry (Id));
832 return Node12 (Id);
833 end Barrier_Function;
835 function Block_Node (Id : E) return N is
836 begin
837 pragma Assert (Ekind (Id) = E_Block);
838 return Node11 (Id);
839 end Block_Node;
841 function Body_Entity (Id : E) return E is
842 begin
843 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
844 return Node19 (Id);
845 end Body_Entity;
847 function Body_Needed_For_Inlining (Id : E) return B is
848 begin
849 pragma Assert (Ekind (Id) = E_Package);
850 return Flag299 (Id);
851 end Body_Needed_For_Inlining;
853 function Body_Needed_For_SAL (Id : E) return B is
854 begin
855 pragma Assert
856 (Ekind (Id) = E_Package
857 or else Is_Subprogram (Id)
858 or else Is_Generic_Unit (Id));
859 return Flag40 (Id);
860 end Body_Needed_For_SAL;
862 function Body_References (Id : E) return L is
863 begin
864 pragma Assert (Ekind (Id) = E_Abstract_State);
865 return Elist16 (Id);
866 end Body_References;
868 function BIP_Initialization_Call (Id : E) return N is
869 begin
870 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
871 return Node29 (Id);
872 end BIP_Initialization_Call;
874 function C_Pass_By_Copy (Id : E) return B is
875 begin
876 pragma Assert (Is_Record_Type (Id));
877 return Flag125 (Implementation_Base_Type (Id));
878 end C_Pass_By_Copy;
880 function Can_Never_Be_Null (Id : E) return B is
881 begin
882 return Flag38 (Id);
883 end Can_Never_Be_Null;
885 function Checks_May_Be_Suppressed (Id : E) return B is
886 begin
887 return Flag31 (Id);
888 end Checks_May_Be_Suppressed;
890 function Class_Wide_Clone (Id : E) return E is
891 begin
892 pragma Assert (Is_Subprogram (Id));
893 return Node38 (Id);
894 end Class_Wide_Clone;
896 function Class_Wide_Type (Id : E) return E is
897 begin
898 pragma Assert (Is_Type (Id));
899 return Node9 (Id);
900 end Class_Wide_Type;
902 function Cloned_Subtype (Id : E) return E is
903 begin
904 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
905 return Node16 (Id);
906 end Cloned_Subtype;
908 function Component_Bit_Offset (Id : E) return U is
909 begin
910 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
911 return Uint11 (Id);
912 end Component_Bit_Offset;
914 function Component_Clause (Id : E) return N is
915 begin
916 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
917 return Node13 (Id);
918 end Component_Clause;
920 function Component_Size (Id : E) return U is
921 begin
922 pragma Assert (Is_Array_Type (Id));
923 return Uint22 (Implementation_Base_Type (Id));
924 end Component_Size;
926 function Component_Type (Id : E) return E is
927 begin
928 pragma Assert (Is_Array_Type (Id));
929 return Node20 (Implementation_Base_Type (Id));
930 end Component_Type;
932 function Corresponding_Concurrent_Type (Id : E) return E is
933 begin
934 pragma Assert (Ekind (Id) = E_Record_Type);
935 return Node18 (Id);
936 end Corresponding_Concurrent_Type;
938 function Corresponding_Discriminant (Id : E) return E is
939 begin
940 pragma Assert (Ekind (Id) = E_Discriminant);
941 return Node19 (Id);
942 end Corresponding_Discriminant;
944 function Corresponding_Equality (Id : E) return E is
945 begin
946 pragma Assert
947 (Ekind (Id) = E_Function
948 and then not Comes_From_Source (Id)
949 and then Chars (Id) = Name_Op_Ne);
950 return Node30 (Id);
951 end Corresponding_Equality;
953 function Corresponding_Function (Id : E) return E is
954 begin
955 pragma Assert (Ekind (Id) = E_Procedure);
956 return Node32 (Id);
957 end Corresponding_Function;
959 function Corresponding_Procedure (Id : E) return E is
960 begin
961 pragma Assert (Ekind (Id) = E_Function);
962 return Node32 (Id);
963 end Corresponding_Procedure;
965 function Corresponding_Protected_Entry (Id : E) return E is
966 begin
967 pragma Assert (Ekind (Id) = E_Subprogram_Body);
968 return Node18 (Id);
969 end Corresponding_Protected_Entry;
971 function Corresponding_Record_Component (Id : E) return E is
972 begin
973 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
974 return Node21 (Id);
975 end Corresponding_Record_Component;
977 function Corresponding_Record_Type (Id : E) return E is
978 begin
979 pragma Assert (Is_Concurrent_Type (Id));
980 return Node18 (Id);
981 end Corresponding_Record_Type;
983 function Corresponding_Remote_Type (Id : E) return E is
984 begin
985 return Node22 (Id);
986 end Corresponding_Remote_Type;
988 function Current_Use_Clause (Id : E) return E is
989 begin
990 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
991 return Node27 (Id);
992 end Current_Use_Clause;
994 function Current_Value (Id : E) return N is
995 begin
996 pragma Assert (Ekind (Id) in Object_Kind);
997 return Node9 (Id);
998 end Current_Value;
1000 function CR_Discriminant (Id : E) return E is
1001 begin
1002 return Node23 (Id);
1003 end CR_Discriminant;
1005 function Debug_Info_Off (Id : E) return B is
1006 begin
1007 return Flag166 (Id);
1008 end Debug_Info_Off;
1010 function Debug_Renaming_Link (Id : E) return E is
1011 begin
1012 return Node25 (Id);
1013 end Debug_Renaming_Link;
1015 function Default_Aspect_Component_Value (Id : E) return N is
1016 begin
1017 pragma Assert (Is_Array_Type (Id));
1018 return Node19 (Base_Type (Id));
1019 end Default_Aspect_Component_Value;
1021 function Default_Aspect_Value (Id : E) return N is
1022 begin
1023 pragma Assert (Is_Scalar_Type (Id));
1024 return Node19 (Base_Type (Id));
1025 end Default_Aspect_Value;
1027 function Default_Expr_Function (Id : E) return E is
1028 begin
1029 pragma Assert (Is_Formal (Id));
1030 return Node21 (Id);
1031 end Default_Expr_Function;
1033 function Default_Expressions_Processed (Id : E) return B is
1034 begin
1035 return Flag108 (Id);
1036 end Default_Expressions_Processed;
1038 function Default_Value (Id : E) return N is
1039 begin
1040 pragma Assert (Is_Formal (Id));
1041 return Node20 (Id);
1042 end Default_Value;
1044 function Delay_Cleanups (Id : E) return B is
1045 begin
1046 return Flag114 (Id);
1047 end Delay_Cleanups;
1049 function Delay_Subprogram_Descriptors (Id : E) return B is
1050 begin
1051 return Flag50 (Id);
1052 end Delay_Subprogram_Descriptors;
1054 function Delta_Value (Id : E) return R is
1055 begin
1056 pragma Assert (Is_Fixed_Point_Type (Id));
1057 return Ureal18 (Id);
1058 end Delta_Value;
1060 function Dependent_Instances (Id : E) return L is
1061 begin
1062 pragma Assert (Is_Generic_Instance (Id));
1063 return Elist8 (Id);
1064 end Dependent_Instances;
1066 function Depends_On_Private (Id : E) return B is
1067 begin
1068 pragma Assert (Nkind (Id) in N_Entity);
1069 return Flag14 (Id);
1070 end Depends_On_Private;
1072 function Derived_Type_Link (Id : E) return E is
1073 begin
1074 pragma Assert (Is_Type (Id));
1075 return Node31 (Base_Type (Id));
1076 end Derived_Type_Link;
1078 function Digits_Value (Id : E) return U is
1079 begin
1080 pragma Assert
1081 (Is_Floating_Point_Type (Id)
1082 or else Is_Decimal_Fixed_Point_Type (Id));
1083 return Uint17 (Id);
1084 end Digits_Value;
1086 function Direct_Primitive_Operations (Id : E) return L is
1087 begin
1088 pragma Assert (Is_Tagged_Type (Id));
1089 return Elist10 (Id);
1090 end Direct_Primitive_Operations;
1092 function Directly_Designated_Type (Id : E) return E is
1093 begin
1094 pragma Assert (Is_Access_Type (Id));
1095 return Node20 (Id);
1096 end Directly_Designated_Type;
1098 function Disable_Controlled (Id : E) return B is
1099 begin
1100 return Flag253 (Base_Type (Id));
1101 end Disable_Controlled;
1103 function Discard_Names (Id : E) return B is
1104 begin
1105 return Flag88 (Id);
1106 end Discard_Names;
1108 function Discriminal (Id : E) return E is
1109 begin
1110 pragma Assert (Ekind (Id) = E_Discriminant);
1111 return Node17 (Id);
1112 end Discriminal;
1114 function Discriminal_Link (Id : E) return N is
1115 begin
1116 return Node10 (Id);
1117 end Discriminal_Link;
1119 function Discriminant_Checking_Func (Id : E) return E is
1120 begin
1121 pragma Assert (Ekind (Id) = E_Component);
1122 return Node20 (Id);
1123 end Discriminant_Checking_Func;
1125 function Discriminant_Constraint (Id : E) return L is
1126 begin
1127 pragma Assert (Is_Composite_Type (Id) and then Has_Discriminants (Id));
1128 return Elist21 (Id);
1129 end Discriminant_Constraint;
1131 function Discriminant_Default_Value (Id : E) return N is
1132 begin
1133 pragma Assert (Ekind (Id) = E_Discriminant);
1134 return Node20 (Id);
1135 end Discriminant_Default_Value;
1137 function Discriminant_Number (Id : E) return U is
1138 begin
1139 pragma Assert (Ekind (Id) = E_Discriminant);
1140 return Uint15 (Id);
1141 end Discriminant_Number;
1143 function Dispatch_Table_Wrappers (Id : E) return L is
1144 begin
1145 pragma Assert (Ekind_In (Id, E_Record_Type,
1146 E_Record_Subtype));
1147 return Elist26 (Implementation_Base_Type (Id));
1148 end Dispatch_Table_Wrappers;
1150 function DT_Entry_Count (Id : E) return U is
1151 begin
1152 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
1153 return Uint15 (Id);
1154 end DT_Entry_Count;
1156 function DT_Offset_To_Top_Func (Id : E) return E is
1157 begin
1158 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
1159 return Node25 (Id);
1160 end DT_Offset_To_Top_Func;
1162 function DT_Position (Id : E) return U is
1163 begin
1164 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
1165 and then Present (DTC_Entity (Id)));
1166 return Uint15 (Id);
1167 end DT_Position;
1169 function DTC_Entity (Id : E) return E is
1170 begin
1171 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
1172 return Node16 (Id);
1173 end DTC_Entity;
1175 function Elaborate_Body_Desirable (Id : E) return B is
1176 begin
1177 pragma Assert (Ekind (Id) = E_Package);
1178 return Flag210 (Id);
1179 end Elaborate_Body_Desirable;
1181 function Elaboration_Entity (Id : E) return E is
1182 begin
1183 pragma Assert
1184 (Is_Subprogram (Id)
1185 or else
1186 Ekind (Id) = E_Package
1187 or else
1188 Is_Generic_Unit (Id));
1189 return Node13 (Id);
1190 end Elaboration_Entity;
1192 function Elaboration_Entity_Required (Id : E) return B is
1193 begin
1194 pragma Assert
1195 (Is_Subprogram (Id)
1196 or else
1197 Ekind (Id) = E_Package
1198 or else
1199 Is_Generic_Unit (Id));
1200 return Flag174 (Id);
1201 end Elaboration_Entity_Required;
1203 function Encapsulating_State (Id : E) return N is
1204 begin
1205 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Constant, E_Variable));
1206 return Node32 (Id);
1207 end Encapsulating_State;
1209 function Enclosing_Scope (Id : E) return E is
1210 begin
1211 return Node18 (Id);
1212 end Enclosing_Scope;
1214 function Entry_Accepted (Id : E) return B is
1215 begin
1216 pragma Assert (Is_Entry (Id));
1217 return Flag152 (Id);
1218 end Entry_Accepted;
1220 function Entry_Bodies_Array (Id : E) return E is
1221 begin
1222 return Node19 (Id);
1223 end Entry_Bodies_Array;
1225 function Entry_Cancel_Parameter (Id : E) return E is
1226 begin
1227 return Node23 (Id);
1228 end Entry_Cancel_Parameter;
1230 function Entry_Component (Id : E) return E is
1231 begin
1232 return Node11 (Id);
1233 end Entry_Component;
1235 function Entry_Formal (Id : E) return E is
1236 begin
1237 return Node16 (Id);
1238 end Entry_Formal;
1240 function Entry_Index_Constant (Id : E) return N is
1241 begin
1242 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
1243 return Node18 (Id);
1244 end Entry_Index_Constant;
1246 function Entry_Max_Queue_Lengths_Array (Id : E) return N is
1247 begin
1248 pragma Assert (Ekind (Id) = E_Protected_Type);
1249 return Node35 (Id);
1250 end Entry_Max_Queue_Lengths_Array;
1252 function Contains_Ignored_Ghost_Code (Id : E) return B is
1253 begin
1254 pragma Assert
1255 (Ekind_In (Id, E_Block,
1256 E_Function,
1257 E_Generic_Function,
1258 E_Generic_Package,
1259 E_Generic_Procedure,
1260 E_Package,
1261 E_Package_Body,
1262 E_Procedure,
1263 E_Subprogram_Body));
1264 return Flag279 (Id);
1265 end Contains_Ignored_Ghost_Code;
1267 function Contract (Id : E) return N is
1268 begin
1269 pragma Assert
1270 (Ekind_In (Id, E_Protected_Type, -- concurrent types
1271 E_Task_Body,
1272 E_Task_Type)
1273 or else
1274 Ekind_In (Id, E_Constant, -- objects
1275 E_Variable)
1276 or else
1277 Ekind_In (Id, E_Entry, -- overloadable
1278 E_Entry_Family,
1279 E_Function,
1280 E_Generic_Function,
1281 E_Generic_Procedure,
1282 E_Operator,
1283 E_Procedure,
1284 E_Subprogram_Body)
1285 or else
1286 Ekind_In (Id, E_Generic_Package, -- packages
1287 E_Package,
1288 E_Package_Body)
1289 or else
1290 Ekind (Id) = E_Void); -- special purpose
1291 return Node34 (Id);
1292 end Contract;
1294 function Contract_Wrapper (Id : E) return E is
1295 begin
1296 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
1297 return Node25 (Id);
1298 end Contract_Wrapper;
1300 function Entry_Parameters_Type (Id : E) return E is
1301 begin
1302 return Node15 (Id);
1303 end Entry_Parameters_Type;
1305 function Enum_Pos_To_Rep (Id : E) return E is
1306 begin
1307 pragma Assert (Ekind (Id) = E_Enumeration_Type);
1308 return Node23 (Id);
1309 end Enum_Pos_To_Rep;
1311 function Enumeration_Pos (Id : E) return Uint is
1312 begin
1313 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1314 return Uint11 (Id);
1315 end Enumeration_Pos;
1317 function Enumeration_Rep (Id : E) return U is
1318 begin
1319 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1320 return Uint12 (Id);
1321 end Enumeration_Rep;
1323 function Enumeration_Rep_Expr (Id : E) return N is
1324 begin
1325 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1326 return Node22 (Id);
1327 end Enumeration_Rep_Expr;
1329 function Equivalent_Type (Id : E) return E is
1330 begin
1331 pragma Assert
1332 (Ekind_In (Id, E_Class_Wide_Type,
1333 E_Class_Wide_Subtype,
1334 E_Access_Subprogram_Type,
1335 E_Access_Protected_Subprogram_Type,
1336 E_Anonymous_Access_Protected_Subprogram_Type,
1337 E_Access_Subprogram_Type,
1338 E_Exception_Type));
1339 return Node18 (Id);
1340 end Equivalent_Type;
1342 function Esize (Id : E) return Uint is
1343 begin
1344 return Uint12 (Id);
1345 end Esize;
1347 function Extra_Accessibility (Id : E) return E is
1348 begin
1349 pragma Assert
1350 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
1351 return Node13 (Id);
1352 end Extra_Accessibility;
1354 function Extra_Accessibility_Of_Result (Id : E) return E is
1355 begin
1356 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
1357 return Node19 (Id);
1358 end Extra_Accessibility_Of_Result;
1360 function Extra_Constrained (Id : E) return E is
1361 begin
1362 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
1363 return Node23 (Id);
1364 end Extra_Constrained;
1366 function Extra_Formal (Id : E) return E is
1367 begin
1368 return Node15 (Id);
1369 end Extra_Formal;
1371 function Extra_Formals (Id : E) return E is
1372 begin
1373 pragma Assert
1374 (Is_Overloadable (Id)
1375 or else Ekind_In (Id, E_Entry_Family,
1376 E_Subprogram_Body,
1377 E_Subprogram_Type));
1378 return Node28 (Id);
1379 end Extra_Formals;
1381 function Can_Use_Internal_Rep (Id : E) return B is
1382 begin
1383 pragma Assert (Is_Access_Subprogram_Type (Base_Type (Id)));
1384 return Flag229 (Base_Type (Id));
1385 end Can_Use_Internal_Rep;
1387 function Finalization_Master (Id : E) return E is
1388 begin
1389 pragma Assert (Is_Access_Type (Id));
1390 return Node23 (Root_Type (Id));
1391 end Finalization_Master;
1393 function Finalize_Storage_Only (Id : E) return B is
1394 begin
1395 pragma Assert (Is_Type (Id));
1396 return Flag158 (Base_Type (Id));
1397 end Finalize_Storage_Only;
1399 function Finalizer (Id : E) return E is
1400 begin
1401 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
1402 return Node28 (Id);
1403 end Finalizer;
1405 function First_Entity (Id : E) return E is
1406 begin
1407 return Node17 (Id);
1408 end First_Entity;
1410 function First_Exit_Statement (Id : E) return N is
1411 begin
1412 pragma Assert (Ekind (Id) = E_Loop);
1413 return Node8 (Id);
1414 end First_Exit_Statement;
1416 function First_Index (Id : E) return N is
1417 begin
1418 pragma Assert (Is_Array_Type (Id));
1419 return Node17 (Id);
1420 end First_Index;
1422 function First_Literal (Id : E) return E is
1423 begin
1424 pragma Assert (Is_Enumeration_Type (Id));
1425 return Node17 (Id);
1426 end First_Literal;
1428 function First_Private_Entity (Id : E) return E is
1429 begin
1430 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
1431 or else Ekind (Id) in Concurrent_Kind);
1432 return Node16 (Id);
1433 end First_Private_Entity;
1435 function First_Rep_Item (Id : E) return E is
1436 begin
1437 return Node6 (Id);
1438 end First_Rep_Item;
1440 function Freeze_Node (Id : E) return N is
1441 begin
1442 return Node7 (Id);
1443 end Freeze_Node;
1445 function From_Limited_With (Id : E) return B is
1446 begin
1447 return Flag159 (Id);
1448 end From_Limited_With;
1450 function Full_View (Id : E) return E is
1451 begin
1452 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
1453 return Node11 (Id);
1454 end Full_View;
1456 function Generic_Homonym (Id : E) return E is
1457 begin
1458 pragma Assert (Ekind (Id) = E_Generic_Package);
1459 return Node11 (Id);
1460 end Generic_Homonym;
1462 function Generic_Renamings (Id : E) return L is
1463 begin
1464 return Elist23 (Id);
1465 end Generic_Renamings;
1467 function Handler_Records (Id : E) return S is
1468 begin
1469 return List10 (Id);
1470 end Handler_Records;
1472 function Has_Aliased_Components (Id : E) return B is
1473 begin
1474 return Flag135 (Implementation_Base_Type (Id));
1475 end Has_Aliased_Components;
1477 function Has_Alignment_Clause (Id : E) return B is
1478 begin
1479 return Flag46 (Id);
1480 end Has_Alignment_Clause;
1482 function Has_All_Calls_Remote (Id : E) return B is
1483 begin
1484 return Flag79 (Id);
1485 end Has_All_Calls_Remote;
1487 function Has_Atomic_Components (Id : E) return B is
1488 begin
1489 return Flag86 (Implementation_Base_Type (Id));
1490 end Has_Atomic_Components;
1492 function Has_Biased_Representation (Id : E) return B is
1493 begin
1494 return Flag139 (Id);
1495 end Has_Biased_Representation;
1497 function Has_Completion (Id : E) return B is
1498 begin
1499 return Flag26 (Id);
1500 end Has_Completion;
1502 function Has_Completion_In_Body (Id : E) return B is
1503 begin
1504 pragma Assert (Is_Type (Id));
1505 return Flag71 (Id);
1506 end Has_Completion_In_Body;
1508 function Has_Complex_Representation (Id : E) return B is
1509 begin
1510 pragma Assert (Is_Record_Type (Id));
1511 return Flag140 (Implementation_Base_Type (Id));
1512 end Has_Complex_Representation;
1514 function Has_Component_Size_Clause (Id : E) return B is
1515 begin
1516 pragma Assert (Is_Array_Type (Id));
1517 return Flag68 (Implementation_Base_Type (Id));
1518 end Has_Component_Size_Clause;
1520 function Has_Constrained_Partial_View (Id : E) return B is
1521 begin
1522 pragma Assert (Is_Type (Id));
1523 return Flag187 (Id);
1524 end Has_Constrained_Partial_View;
1526 function Has_Controlled_Component (Id : E) return B is
1527 begin
1528 return Flag43 (Base_Type (Id));
1529 end Has_Controlled_Component;
1531 function Has_Contiguous_Rep (Id : E) return B is
1532 begin
1533 return Flag181 (Id);
1534 end Has_Contiguous_Rep;
1536 function Has_Controlling_Result (Id : E) return B is
1537 begin
1538 return Flag98 (Id);
1539 end Has_Controlling_Result;
1541 function Has_Convention_Pragma (Id : E) return B is
1542 begin
1543 return Flag119 (Id);
1544 end Has_Convention_Pragma;
1546 function Has_Default_Aspect (Id : E) return B is
1547 begin
1548 return Flag39 (Base_Type (Id));
1549 end Has_Default_Aspect;
1551 function Has_Delayed_Aspects (Id : E) return B is
1552 begin
1553 pragma Assert (Nkind (Id) in N_Entity);
1554 return Flag200 (Id);
1555 end Has_Delayed_Aspects;
1557 function Has_Delayed_Freeze (Id : E) return B is
1558 begin
1559 pragma Assert (Nkind (Id) in N_Entity);
1560 return Flag18 (Id);
1561 end Has_Delayed_Freeze;
1563 function Has_Delayed_Rep_Aspects (Id : E) return B is
1564 begin
1565 pragma Assert (Nkind (Id) in N_Entity);
1566 return Flag261 (Id);
1567 end Has_Delayed_Rep_Aspects;
1569 function Has_Discriminants (Id : E) return B is
1570 begin
1571 pragma Assert (Is_Type (Id));
1572 return Flag5 (Id);
1573 end Has_Discriminants;
1575 function Has_Dispatch_Table (Id : E) return B is
1576 begin
1577 pragma Assert (Is_Tagged_Type (Id));
1578 return Flag220 (Id);
1579 end Has_Dispatch_Table;
1581 function Has_Dynamic_Predicate_Aspect (Id : E) return B is
1582 begin
1583 pragma Assert (Is_Type (Id));
1584 return Flag258 (Id);
1585 end Has_Dynamic_Predicate_Aspect;
1587 function Has_Enumeration_Rep_Clause (Id : E) return B is
1588 begin
1589 pragma Assert (Is_Enumeration_Type (Id));
1590 return Flag66 (Id);
1591 end Has_Enumeration_Rep_Clause;
1593 function Has_Exit (Id : E) return B is
1594 begin
1595 return Flag47 (Id);
1596 end Has_Exit;
1598 function Has_Expanded_Contract (Id : E) return B is
1599 begin
1600 pragma Assert (Is_Subprogram (Id));
1601 return Flag240 (Id);
1602 end Has_Expanded_Contract;
1604 function Has_Forward_Instantiation (Id : E) return B is
1605 begin
1606 return Flag175 (Id);
1607 end Has_Forward_Instantiation;
1609 function Has_Fully_Qualified_Name (Id : E) return B is
1610 begin
1611 return Flag173 (Id);
1612 end Has_Fully_Qualified_Name;
1614 function Has_Gigi_Rep_Item (Id : E) return B is
1615 begin
1616 return Flag82 (Id);
1617 end Has_Gigi_Rep_Item;
1619 function Has_Homonym (Id : E) return B is
1620 begin
1621 return Flag56 (Id);
1622 end Has_Homonym;
1624 function Has_Implicit_Dereference (Id : E) return B is
1625 begin
1626 return Flag251 (Id);
1627 end Has_Implicit_Dereference;
1629 function Has_Independent_Components (Id : E) return B is
1630 begin
1631 return Flag34 (Implementation_Base_Type (Id));
1632 end Has_Independent_Components;
1634 function Has_Inheritable_Invariants (Id : E) return B is
1635 begin
1636 pragma Assert (Is_Type (Id));
1637 return Flag248 (Base_Type (Id));
1638 end Has_Inheritable_Invariants;
1640 function Has_Inherited_DIC (Id : E) return B is
1641 begin
1642 pragma Assert (Is_Type (Id));
1643 return Flag133 (Base_Type (Id));
1644 end Has_Inherited_DIC;
1646 function Has_Inherited_Invariants (Id : E) return B is
1647 begin
1648 pragma Assert (Is_Type (Id));
1649 return Flag291 (Base_Type (Id));
1650 end Has_Inherited_Invariants;
1652 function Has_Initial_Value (Id : E) return B is
1653 begin
1654 pragma Assert (Ekind (Id) = E_Variable or else Is_Formal (Id));
1655 return Flag219 (Id);
1656 end Has_Initial_Value;
1658 function Has_Loop_Entry_Attributes (Id : E) return B is
1659 begin
1660 pragma Assert (Ekind (Id) = E_Loop);
1661 return Flag260 (Id);
1662 end Has_Loop_Entry_Attributes;
1664 function Has_Machine_Radix_Clause (Id : E) return B is
1665 begin
1666 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
1667 return Flag83 (Id);
1668 end Has_Machine_Radix_Clause;
1670 function Has_Master_Entity (Id : E) return B is
1671 begin
1672 return Flag21 (Id);
1673 end Has_Master_Entity;
1675 function Has_Missing_Return (Id : E) return B is
1676 begin
1677 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
1678 return Flag142 (Id);
1679 end Has_Missing_Return;
1681 function Has_Nested_Block_With_Handler (Id : E) return B is
1682 begin
1683 return Flag101 (Id);
1684 end Has_Nested_Block_With_Handler;
1686 function Has_Nested_Subprogram (Id : E) return B is
1687 begin
1688 pragma Assert (Is_Subprogram (Id));
1689 return Flag282 (Id);
1690 end Has_Nested_Subprogram;
1692 function Has_Non_Standard_Rep (Id : E) return B is
1693 begin
1694 return Flag75 (Implementation_Base_Type (Id));
1695 end Has_Non_Standard_Rep;
1697 function Has_Object_Size_Clause (Id : E) return B is
1698 begin
1699 pragma Assert (Is_Type (Id));
1700 return Flag172 (Id);
1701 end Has_Object_Size_Clause;
1703 function Has_Out_Or_In_Out_Parameter (Id : E) return B is
1704 begin
1705 pragma Assert
1706 (Ekind_In (Id, E_Entry, E_Entry_Family)
1707 or else Is_Subprogram_Or_Generic_Subprogram (Id));
1708 return Flag110 (Id);
1709 end Has_Out_Or_In_Out_Parameter;
1711 function Has_Own_DIC (Id : E) return B is
1712 begin
1713 pragma Assert (Is_Type (Id));
1714 return Flag3 (Base_Type (Id));
1715 end Has_Own_DIC;
1717 function Has_Own_Invariants (Id : E) return B is
1718 begin
1719 pragma Assert (Is_Type (Id));
1720 return Flag232 (Base_Type (Id));
1721 end Has_Own_Invariants;
1723 function Has_Partial_Visible_Refinement (Id : E) return B is
1724 begin
1725 pragma Assert (Ekind (Id) = E_Abstract_State);
1726 return Flag296 (Id);
1727 end Has_Partial_Visible_Refinement;
1729 function Has_Per_Object_Constraint (Id : E) return B is
1730 begin
1731 return Flag154 (Id);
1732 end Has_Per_Object_Constraint;
1734 function Has_Pragma_Controlled (Id : E) return B is
1735 begin
1736 pragma Assert (Is_Access_Type (Id));
1737 return Flag27 (Implementation_Base_Type (Id));
1738 end Has_Pragma_Controlled;
1740 function Has_Pragma_Elaborate_Body (Id : E) return B is
1741 begin
1742 return Flag150 (Id);
1743 end Has_Pragma_Elaborate_Body;
1745 function Has_Pragma_Inline (Id : E) return B is
1746 begin
1747 return Flag157 (Id);
1748 end Has_Pragma_Inline;
1750 function Has_Pragma_Inline_Always (Id : E) return B is
1751 begin
1752 return Flag230 (Id);
1753 end Has_Pragma_Inline_Always;
1755 function Has_Pragma_No_Inline (Id : E) return B is
1756 begin
1757 return Flag201 (Id);
1758 end Has_Pragma_No_Inline;
1760 function Has_Pragma_Ordered (Id : E) return B is
1761 begin
1762 pragma Assert (Is_Enumeration_Type (Id));
1763 return Flag198 (Implementation_Base_Type (Id));
1764 end Has_Pragma_Ordered;
1766 function Has_Pragma_Pack (Id : E) return B is
1767 begin
1768 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
1769 return Flag121 (Implementation_Base_Type (Id));
1770 end Has_Pragma_Pack;
1772 function Has_Pragma_Preelab_Init (Id : E) return B is
1773 begin
1774 return Flag221 (Id);
1775 end Has_Pragma_Preelab_Init;
1777 function Has_Pragma_Pure (Id : E) return B is
1778 begin
1779 return Flag203 (Id);
1780 end Has_Pragma_Pure;
1782 function Has_Pragma_Pure_Function (Id : E) return B is
1783 begin
1784 return Flag179 (Id);
1785 end Has_Pragma_Pure_Function;
1787 function Has_Pragma_Thread_Local_Storage (Id : E) return B is
1788 begin
1789 return Flag169 (Id);
1790 end Has_Pragma_Thread_Local_Storage;
1792 function Has_Pragma_Unmodified (Id : E) return B is
1793 begin
1794 return Flag233 (Id);
1795 end Has_Pragma_Unmodified;
1797 function Has_Pragma_Unreferenced (Id : E) return B is
1798 begin
1799 return Flag180 (Id);
1800 end Has_Pragma_Unreferenced;
1802 function Has_Pragma_Unreferenced_Objects (Id : E) return B is
1803 begin
1804 pragma Assert (Is_Type (Id));
1805 return Flag212 (Id);
1806 end Has_Pragma_Unreferenced_Objects;
1808 function Has_Pragma_Unused (Id : E) return B is
1809 begin
1810 return Flag294 (Id);
1811 end Has_Pragma_Unused;
1813 function Has_Predicates (Id : E) return B is
1814 begin
1815 pragma Assert (Is_Type (Id));
1816 return Flag250 (Id);
1817 end Has_Predicates;
1819 function Has_Primitive_Operations (Id : E) return B is
1820 begin
1821 pragma Assert (Is_Type (Id));
1822 return Flag120 (Base_Type (Id));
1823 end Has_Primitive_Operations;
1825 function Has_Private_Ancestor (Id : E) return B is
1826 begin
1827 return Flag151 (Id);
1828 end Has_Private_Ancestor;
1830 function Has_Private_Declaration (Id : E) return B is
1831 begin
1832 return Flag155 (Id);
1833 end Has_Private_Declaration;
1835 function Has_Private_Extension (Id : E) return B is
1836 begin
1837 pragma Assert (Is_Tagged_Type (Id));
1838 return Flag300 (Id);
1839 end Has_Private_Extension;
1841 function Has_Protected (Id : E) return B is
1842 begin
1843 return Flag271 (Base_Type (Id));
1844 end Has_Protected;
1846 function Has_Qualified_Name (Id : E) return B is
1847 begin
1848 return Flag161 (Id);
1849 end Has_Qualified_Name;
1851 function Has_RACW (Id : E) return B is
1852 begin
1853 pragma Assert (Ekind (Id) = E_Package);
1854 return Flag214 (Id);
1855 end Has_RACW;
1857 function Has_Record_Rep_Clause (Id : E) return B is
1858 begin
1859 pragma Assert (Is_Record_Type (Id));
1860 return Flag65 (Implementation_Base_Type (Id));
1861 end Has_Record_Rep_Clause;
1863 function Has_Recursive_Call (Id : E) return B is
1864 begin
1865 pragma Assert (Is_Subprogram (Id));
1866 return Flag143 (Id);
1867 end Has_Recursive_Call;
1869 function Has_Shift_Operator (Id : E) return B is
1870 begin
1871 pragma Assert (Is_Integer_Type (Id));
1872 return Flag267 (Base_Type (Id));
1873 end Has_Shift_Operator;
1875 function Has_Size_Clause (Id : E) return B is
1876 begin
1877 return Flag29 (Id);
1878 end Has_Size_Clause;
1880 function Has_Small_Clause (Id : E) return B is
1881 begin
1882 pragma Assert (Is_Ordinary_Fixed_Point_Type (Id));
1883 return Flag67 (Id);
1884 end Has_Small_Clause;
1886 function Has_Specified_Layout (Id : E) return B is
1887 begin
1888 pragma Assert (Is_Type (Id));
1889 return Flag100 (Implementation_Base_Type (Id));
1890 end Has_Specified_Layout;
1892 function Has_Specified_Stream_Input (Id : E) return B is
1893 begin
1894 pragma Assert (Is_Type (Id));
1895 return Flag190 (Id);
1896 end Has_Specified_Stream_Input;
1898 function Has_Specified_Stream_Output (Id : E) return B is
1899 begin
1900 pragma Assert (Is_Type (Id));
1901 return Flag191 (Id);
1902 end Has_Specified_Stream_Output;
1904 function Has_Specified_Stream_Read (Id : E) return B is
1905 begin
1906 pragma Assert (Is_Type (Id));
1907 return Flag192 (Id);
1908 end Has_Specified_Stream_Read;
1910 function Has_Specified_Stream_Write (Id : E) return B is
1911 begin
1912 pragma Assert (Is_Type (Id));
1913 return Flag193 (Id);
1914 end Has_Specified_Stream_Write;
1916 function Has_Static_Discriminants (Id : E) return B is
1917 begin
1918 pragma Assert (Is_Type (Id));
1919 return Flag211 (Id);
1920 end Has_Static_Discriminants;
1922 function Has_Static_Predicate (Id : E) return B is
1923 begin
1924 pragma Assert (Is_Type (Id));
1925 return Flag269 (Id);
1926 end Has_Static_Predicate;
1928 function Has_Static_Predicate_Aspect (Id : E) return B is
1929 begin
1930 pragma Assert (Is_Type (Id));
1931 return Flag259 (Id);
1932 end Has_Static_Predicate_Aspect;
1934 function Has_Storage_Size_Clause (Id : E) return B is
1935 begin
1936 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
1937 return Flag23 (Implementation_Base_Type (Id));
1938 end Has_Storage_Size_Clause;
1940 function Has_Stream_Size_Clause (Id : E) return B is
1941 begin
1942 return Flag184 (Id);
1943 end Has_Stream_Size_Clause;
1945 function Has_Task (Id : E) return B is
1946 begin
1947 return Flag30 (Base_Type (Id));
1948 end Has_Task;
1950 function Has_Thunks (Id : E) return B is
1951 begin
1952 return Flag228 (Id);
1953 end Has_Thunks;
1955 function Has_Timing_Event (Id : E) return B is
1956 begin
1957 return Flag289 (Base_Type (Id));
1958 end Has_Timing_Event;
1960 function Has_Unchecked_Union (Id : E) return B is
1961 begin
1962 return Flag123 (Base_Type (Id));
1963 end Has_Unchecked_Union;
1965 function Has_Unknown_Discriminants (Id : E) return B is
1966 begin
1967 pragma Assert (Is_Type (Id));
1968 return Flag72 (Id);
1969 end Has_Unknown_Discriminants;
1971 function Has_Visible_Refinement (Id : E) return B is
1972 begin
1973 pragma Assert (Ekind (Id) = E_Abstract_State);
1974 return Flag263 (Id);
1975 end Has_Visible_Refinement;
1977 function Has_Volatile_Components (Id : E) return B is
1978 begin
1979 return Flag87 (Implementation_Base_Type (Id));
1980 end Has_Volatile_Components;
1982 function Has_Xref_Entry (Id : E) return B is
1983 begin
1984 return Flag182 (Id);
1985 end Has_Xref_Entry;
1987 function Hiding_Loop_Variable (Id : E) return E is
1988 begin
1989 pragma Assert (Ekind (Id) = E_Variable);
1990 return Node8 (Id);
1991 end Hiding_Loop_Variable;
1993 function Hidden_In_Formal_Instance (Id : E) return L is
1994 begin
1995 pragma Assert (Ekind (Id) = E_Package);
1996 return Elist30 (Id);
1997 end Hidden_In_Formal_Instance;
1999 function Homonym (Id : E) return E is
2000 begin
2001 return Node4 (Id);
2002 end Homonym;
2004 function Ignore_SPARK_Mode_Pragmas (Id : E) return B is
2005 begin
2006 pragma Assert
2007 (Ekind_In (Id, E_Protected_Body, -- concurrent types
2008 E_Protected_Type,
2009 E_Task_Body,
2010 E_Task_Type)
2011 or else
2012 Ekind_In (Id, E_Entry, -- overloadable
2013 E_Entry_Family,
2014 E_Function,
2015 E_Generic_Function,
2016 E_Generic_Procedure,
2017 E_Operator,
2018 E_Procedure,
2019 E_Subprogram_Body)
2020 or else
2021 Ekind_In (Id, E_Generic_Package, -- packages
2022 E_Package,
2023 E_Package_Body));
2024 return Flag301 (Id);
2025 end Ignore_SPARK_Mode_Pragmas;
2027 function Import_Pragma (Id : E) return E is
2028 begin
2029 pragma Assert (Is_Subprogram (Id));
2030 return Node35 (Id);
2031 end Import_Pragma;
2033 function Incomplete_Actuals (Id : E) return L is
2034 begin
2035 pragma Assert (Ekind (Id) = E_Package);
2036 return Elist24 (Id);
2037 end Incomplete_Actuals;
2039 function Interface_Alias (Id : E) return E is
2040 begin
2041 pragma Assert (Is_Subprogram (Id));
2042 return Node25 (Id);
2043 end Interface_Alias;
2045 function Interfaces (Id : E) return L is
2046 begin
2047 pragma Assert (Is_Record_Type (Id));
2048 return Elist25 (Id);
2049 end Interfaces;
2051 function In_Package_Body (Id : E) return B is
2052 begin
2053 return Flag48 (Id);
2054 end In_Package_Body;
2056 function In_Private_Part (Id : E) return B is
2057 begin
2058 return Flag45 (Id);
2059 end In_Private_Part;
2061 function In_Use (Id : E) return B is
2062 begin
2063 pragma Assert (Nkind (Id) in N_Entity);
2064 return Flag8 (Id);
2065 end In_Use;
2067 function Initialization_Statements (Id : E) return N is
2068 begin
2069 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2070 return Node28 (Id);
2071 end Initialization_Statements;
2073 function Inner_Instances (Id : E) return L is
2074 begin
2075 return Elist23 (Id);
2076 end Inner_Instances;
2078 function Interface_Name (Id : E) return N is
2079 begin
2080 return Node21 (Id);
2081 end Interface_Name;
2083 function Is_Abstract_Subprogram (Id : E) return B is
2084 begin
2085 pragma Assert (Is_Overloadable (Id));
2086 return Flag19 (Id);
2087 end Is_Abstract_Subprogram;
2089 function Is_Abstract_Type (Id : E) return B is
2090 begin
2091 pragma Assert (Is_Type (Id));
2092 return Flag146 (Id);
2093 end Is_Abstract_Type;
2095 function Is_Access_Constant (Id : E) return B is
2096 begin
2097 pragma Assert (Is_Access_Type (Id));
2098 return Flag69 (Id);
2099 end Is_Access_Constant;
2101 function Is_Activation_Record (Id : E) return B is
2102 begin
2103 pragma Assert (Ekind (Id) = E_In_Parameter);
2104 return Flag305 (Id);
2105 end Is_Activation_Record;
2107 function Is_Actual_Subtype (Id : E) return B is
2108 begin
2109 pragma Assert (Is_Type (Id));
2110 return Flag293 (Id);
2111 end Is_Actual_Subtype;
2113 function Is_Ada_2005_Only (Id : E) return B is
2114 begin
2115 return Flag185 (Id);
2116 end Is_Ada_2005_Only;
2118 function Is_Ada_2012_Only (Id : E) return B is
2119 begin
2120 return Flag199 (Id);
2121 end Is_Ada_2012_Only;
2123 function Is_Aliased (Id : E) return B is
2124 begin
2125 pragma Assert (Nkind (Id) in N_Entity);
2126 return Flag15 (Id);
2127 end Is_Aliased;
2129 function Is_Asynchronous (Id : E) return B is
2130 begin
2131 pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id));
2132 return Flag81 (Id);
2133 end Is_Asynchronous;
2135 function Is_Atomic (Id : E) return B is
2136 begin
2137 return Flag85 (Id);
2138 end Is_Atomic;
2140 function Is_Bit_Packed_Array (Id : E) return B is
2141 begin
2142 return Flag122 (Implementation_Base_Type (Id));
2143 end Is_Bit_Packed_Array;
2145 function Is_Called (Id : E) return B is
2146 begin
2147 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
2148 return Flag102 (Id);
2149 end Is_Called;
2151 function Is_Character_Type (Id : E) return B is
2152 begin
2153 return Flag63 (Id);
2154 end Is_Character_Type;
2156 function Is_Checked_Ghost_Entity (Id : E) return B is
2157 begin
2158 -- Allow this attribute to appear on unanalyzed entities
2160 pragma Assert (Nkind (Id) in N_Entity
2161 or else Ekind (Id) = E_Void);
2162 return Flag277 (Id);
2163 end Is_Checked_Ghost_Entity;
2165 function Is_Child_Unit (Id : E) return B is
2166 begin
2167 return Flag73 (Id);
2168 end Is_Child_Unit;
2170 function Is_Class_Wide_Clone (Id : E) return B is
2171 begin
2172 return Flag290 (Id);
2173 end Is_Class_Wide_Clone;
2175 function Is_Class_Wide_Equivalent_Type (Id : E) return B is
2176 begin
2177 return Flag35 (Id);
2178 end Is_Class_Wide_Equivalent_Type;
2180 function Is_Compilation_Unit (Id : E) return B is
2181 begin
2182 return Flag149 (Id);
2183 end Is_Compilation_Unit;
2185 function Is_Completely_Hidden (Id : E) return B is
2186 begin
2187 pragma Assert (Ekind (Id) = E_Discriminant);
2188 return Flag103 (Id);
2189 end Is_Completely_Hidden;
2191 function Is_Constr_Subt_For_U_Nominal (Id : E) return B is
2192 begin
2193 return Flag80 (Id);
2194 end Is_Constr_Subt_For_U_Nominal;
2196 function Is_Constr_Subt_For_UN_Aliased (Id : E) return B is
2197 begin
2198 return Flag141 (Id);
2199 end Is_Constr_Subt_For_UN_Aliased;
2201 function Is_Constrained (Id : E) return B is
2202 begin
2203 pragma Assert (Nkind (Id) in N_Entity);
2204 return Flag12 (Id);
2205 end Is_Constrained;
2207 function Is_Constructor (Id : E) return B is
2208 begin
2209 return Flag76 (Id);
2210 end Is_Constructor;
2212 function Is_Controlled_Active (Id : E) return B is
2213 begin
2214 return Flag42 (Base_Type (Id));
2215 end Is_Controlled_Active;
2217 function Is_Controlling_Formal (Id : E) return B is
2218 begin
2219 pragma Assert (Is_Formal (Id));
2220 return Flag97 (Id);
2221 end Is_Controlling_Formal;
2223 function Is_CPP_Class (Id : E) return B is
2224 begin
2225 return Flag74 (Id);
2226 end Is_CPP_Class;
2228 function Is_DIC_Procedure (Id : E) return B is
2229 begin
2230 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2231 return Flag132 (Id);
2232 end Is_DIC_Procedure;
2234 function Is_Descendant_Of_Address (Id : E) return B is
2235 begin
2236 return Flag223 (Id);
2237 end Is_Descendant_Of_Address;
2239 function Is_Discrim_SO_Function (Id : E) return B is
2240 begin
2241 return Flag176 (Id);
2242 end Is_Discrim_SO_Function;
2244 function Is_Discriminant_Check_Function (Id : E) return B is
2245 begin
2246 return Flag264 (Id);
2247 end Is_Discriminant_Check_Function;
2249 function Is_Dispatch_Table_Entity (Id : E) return B is
2250 begin
2251 return Flag234 (Id);
2252 end Is_Dispatch_Table_Entity;
2254 function Is_Dispatching_Operation (Id : E) return B is
2255 begin
2256 pragma Assert (Nkind (Id) in N_Entity);
2257 return Flag6 (Id);
2258 end Is_Dispatching_Operation;
2260 function Is_Elaboration_Checks_OK_Id (Id : E) return B is
2261 begin
2262 pragma Assert (Is_Elaboration_Target (Id));
2263 return Flag148 (Id);
2264 end Is_Elaboration_Checks_OK_Id;
2266 function Is_Elaboration_Warnings_OK_Id (Id : E) return B is
2267 begin
2268 pragma Assert (Is_Elaboration_Target (Id) or else Ekind (Id) = E_Void);
2269 return Flag304 (Id);
2270 end Is_Elaboration_Warnings_OK_Id;
2272 function Is_Eliminated (Id : E) return B is
2273 begin
2274 return Flag124 (Id);
2275 end Is_Eliminated;
2277 function Is_Entry_Formal (Id : E) return B is
2278 begin
2279 return Flag52 (Id);
2280 end Is_Entry_Formal;
2282 function Is_Entry_Wrapper (Id : E) return B is
2283 begin
2284 return Flag297 (Id);
2285 end Is_Entry_Wrapper;
2287 function Is_Exception_Handler (Id : E) return B is
2288 begin
2289 pragma Assert (Ekind (Id) = E_Block);
2290 return Flag286 (Id);
2291 end Is_Exception_Handler;
2293 function Is_Exported (Id : E) return B is
2294 begin
2295 return Flag99 (Id);
2296 end Is_Exported;
2298 function Is_Finalized_Transient (Id : E) return B is
2299 begin
2300 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
2301 return Flag252 (Id);
2302 end Is_Finalized_Transient;
2304 function Is_First_Subtype (Id : E) return B is
2305 begin
2306 return Flag70 (Id);
2307 end Is_First_Subtype;
2309 function Is_For_Access_Subtype (Id : E) return B is
2310 begin
2311 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
2312 return Flag118 (Id);
2313 end Is_For_Access_Subtype;
2315 function Is_Formal_Subprogram (Id : E) return B is
2316 begin
2317 return Flag111 (Id);
2318 end Is_Formal_Subprogram;
2320 function Is_Frozen (Id : E) return B is
2321 begin
2322 return Flag4 (Id);
2323 end Is_Frozen;
2325 function Is_Generic_Actual_Subprogram (Id : E) return B is
2326 begin
2327 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2328 return Flag274 (Id);
2329 end Is_Generic_Actual_Subprogram;
2331 function Is_Generic_Actual_Type (Id : E) return B is
2332 begin
2333 pragma Assert (Is_Type (Id));
2334 return Flag94 (Id);
2335 end Is_Generic_Actual_Type;
2337 function Is_Generic_Instance (Id : E) return B is
2338 begin
2339 return Flag130 (Id);
2340 end Is_Generic_Instance;
2342 function Is_Generic_Type (Id : E) return B is
2343 begin
2344 pragma Assert (Nkind (Id) in N_Entity);
2345 return Flag13 (Id);
2346 end Is_Generic_Type;
2348 function Is_Hidden (Id : E) return B is
2349 begin
2350 return Flag57 (Id);
2351 end Is_Hidden;
2353 function Is_Hidden_Non_Overridden_Subpgm (Id : E) return B is
2354 begin
2355 return Flag2 (Id);
2356 end Is_Hidden_Non_Overridden_Subpgm;
2358 function Is_Hidden_Open_Scope (Id : E) return B is
2359 begin
2360 return Flag171 (Id);
2361 end Is_Hidden_Open_Scope;
2363 function Is_Ignored_Ghost_Entity (Id : E) return B is
2364 begin
2365 -- Allow this attribute to appear on unanalyzed entities
2367 pragma Assert (Nkind (Id) in N_Entity
2368 or else Ekind (Id) = E_Void);
2369 return Flag278 (Id);
2370 end Is_Ignored_Ghost_Entity;
2372 function Is_Ignored_Transient (Id : E) return B is
2373 begin
2374 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
2375 return Flag295 (Id);
2376 end Is_Ignored_Transient;
2378 function Is_Immediately_Visible (Id : E) return B is
2379 begin
2380 pragma Assert (Nkind (Id) in N_Entity);
2381 return Flag7 (Id);
2382 end Is_Immediately_Visible;
2384 function Is_Implementation_Defined (Id : E) return B is
2385 begin
2386 return Flag254 (Id);
2387 end Is_Implementation_Defined;
2389 function Is_Imported (Id : E) return B is
2390 begin
2391 return Flag24 (Id);
2392 end Is_Imported;
2394 function Is_Independent (Id : E) return B is
2395 begin
2396 return Flag268 (Id);
2397 end Is_Independent;
2399 function Is_Initial_Condition_Procedure (Id : E) return B is
2400 begin
2401 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2402 return Flag302 (Id);
2403 end Is_Initial_Condition_Procedure;
2405 function Is_Inlined (Id : E) return B is
2406 begin
2407 return Flag11 (Id);
2408 end Is_Inlined;
2410 function Is_Inlined_Always (Id : E) return B is
2411 begin
2412 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2413 return Flag1 (Id);
2414 end Is_Inlined_Always;
2416 function Is_Interface (Id : E) return B is
2417 begin
2418 return Flag186 (Id);
2419 end Is_Interface;
2421 function Is_Instantiated (Id : E) return B is
2422 begin
2423 return Flag126 (Id);
2424 end Is_Instantiated;
2426 function Is_Internal (Id : E) return B is
2427 begin
2428 pragma Assert (Nkind (Id) in N_Entity);
2429 return Flag17 (Id);
2430 end Is_Internal;
2432 function Is_Interrupt_Handler (Id : E) return B is
2433 begin
2434 pragma Assert (Nkind (Id) in N_Entity);
2435 return Flag89 (Id);
2436 end Is_Interrupt_Handler;
2438 function Is_Intrinsic_Subprogram (Id : E) return B is
2439 begin
2440 return Flag64 (Id);
2441 end Is_Intrinsic_Subprogram;
2443 function Is_Invariant_Procedure (Id : E) return B is
2444 begin
2445 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2446 return Flag257 (Id);
2447 end Is_Invariant_Procedure;
2449 function Is_Itype (Id : E) return B is
2450 begin
2451 return Flag91 (Id);
2452 end Is_Itype;
2454 function Is_Known_Non_Null (Id : E) return B is
2455 begin
2456 return Flag37 (Id);
2457 end Is_Known_Non_Null;
2459 function Is_Known_Null (Id : E) return B is
2460 begin
2461 return Flag204 (Id);
2462 end Is_Known_Null;
2464 function Is_Known_Valid (Id : E) return B is
2465 begin
2466 return Flag170 (Id);
2467 end Is_Known_Valid;
2469 function Is_Limited_Composite (Id : E) return B is
2470 begin
2471 return Flag106 (Id);
2472 end Is_Limited_Composite;
2474 function Is_Limited_Interface (Id : E) return B is
2475 begin
2476 return Flag197 (Id);
2477 end Is_Limited_Interface;
2479 function Is_Limited_Record (Id : E) return B is
2480 begin
2481 return Flag25 (Id);
2482 end Is_Limited_Record;
2484 function Is_Local_Anonymous_Access (Id : E) return B is
2485 begin
2486 pragma Assert (Is_Access_Type (Id));
2487 return Flag194 (Id);
2488 end Is_Local_Anonymous_Access;
2490 function Is_Machine_Code_Subprogram (Id : E) return B is
2491 begin
2492 pragma Assert (Is_Subprogram (Id));
2493 return Flag137 (Id);
2494 end Is_Machine_Code_Subprogram;
2496 function Is_Non_Static_Subtype (Id : E) return B is
2497 begin
2498 pragma Assert (Is_Type (Id));
2499 return Flag109 (Id);
2500 end Is_Non_Static_Subtype;
2502 function Is_Null_Init_Proc (Id : E) return B is
2503 begin
2504 pragma Assert (Ekind (Id) = E_Procedure);
2505 return Flag178 (Id);
2506 end Is_Null_Init_Proc;
2508 function Is_Obsolescent (Id : E) return B is
2509 begin
2510 return Flag153 (Id);
2511 end Is_Obsolescent;
2513 function Is_Only_Out_Parameter (Id : E) return B is
2514 begin
2515 pragma Assert (Is_Formal (Id));
2516 return Flag226 (Id);
2517 end Is_Only_Out_Parameter;
2519 function Is_Package_Body_Entity (Id : E) return B is
2520 begin
2521 return Flag160 (Id);
2522 end Is_Package_Body_Entity;
2524 function Is_Packed (Id : E) return B is
2525 begin
2526 return Flag51 (Implementation_Base_Type (Id));
2527 end Is_Packed;
2529 function Is_Packed_Array_Impl_Type (Id : E) return B is
2530 begin
2531 return Flag138 (Id);
2532 end Is_Packed_Array_Impl_Type;
2534 function Is_Param_Block_Component_Type (Id : E) return B is
2535 begin
2536 pragma Assert (Is_Access_Type (Id));
2537 return Flag215 (Base_Type (Id));
2538 end Is_Param_Block_Component_Type;
2540 function Is_Partial_Invariant_Procedure (Id : E) return B is
2541 begin
2542 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2543 return Flag292 (Id);
2544 end Is_Partial_Invariant_Procedure;
2546 function Is_Potentially_Use_Visible (Id : E) return B is
2547 begin
2548 pragma Assert (Nkind (Id) in N_Entity);
2549 return Flag9 (Id);
2550 end Is_Potentially_Use_Visible;
2552 function Is_Predicate_Function (Id : E) return B is
2553 begin
2554 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2555 return Flag255 (Id);
2556 end Is_Predicate_Function;
2558 function Is_Predicate_Function_M (Id : E) return B is
2559 begin
2560 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2561 return Flag256 (Id);
2562 end Is_Predicate_Function_M;
2564 function Is_Preelaborated (Id : E) return B is
2565 begin
2566 return Flag59 (Id);
2567 end Is_Preelaborated;
2569 function Is_Primitive (Id : E) return B is
2570 begin
2571 pragma Assert
2572 (Is_Overloadable (Id)
2573 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
2574 return Flag218 (Id);
2575 end Is_Primitive;
2577 function Is_Primitive_Wrapper (Id : E) return B is
2578 begin
2579 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2580 return Flag195 (Id);
2581 end Is_Primitive_Wrapper;
2583 function Is_Private_Composite (Id : E) return B is
2584 begin
2585 pragma Assert (Is_Type (Id));
2586 return Flag107 (Id);
2587 end Is_Private_Composite;
2589 function Is_Private_Descendant (Id : E) return B is
2590 begin
2591 return Flag53 (Id);
2592 end Is_Private_Descendant;
2594 function Is_Private_Primitive (Id : E) return B is
2595 begin
2596 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2597 return Flag245 (Id);
2598 end Is_Private_Primitive;
2600 function Is_Public (Id : E) return B is
2601 begin
2602 pragma Assert (Nkind (Id) in N_Entity);
2603 return Flag10 (Id);
2604 end Is_Public;
2606 function Is_Pure (Id : E) return B is
2607 begin
2608 return Flag44 (Id);
2609 end Is_Pure;
2611 function Is_Pure_Unit_Access_Type (Id : E) return B is
2612 begin
2613 pragma Assert (Is_Access_Type (Id));
2614 return Flag189 (Id);
2615 end Is_Pure_Unit_Access_Type;
2617 function Is_RACW_Stub_Type (Id : E) return B is
2618 begin
2619 pragma Assert (Is_Type (Id));
2620 return Flag244 (Id);
2621 end Is_RACW_Stub_Type;
2623 function Is_Raised (Id : E) return B is
2624 begin
2625 pragma Assert (Ekind (Id) = E_Exception);
2626 return Flag224 (Id);
2627 end Is_Raised;
2629 function Is_Remote_Call_Interface (Id : E) return B is
2630 begin
2631 return Flag62 (Id);
2632 end Is_Remote_Call_Interface;
2634 function Is_Remote_Types (Id : E) return B is
2635 begin
2636 return Flag61 (Id);
2637 end Is_Remote_Types;
2639 function Is_Renaming_Of_Object (Id : E) return B is
2640 begin
2641 return Flag112 (Id);
2642 end Is_Renaming_Of_Object;
2644 function Is_Return_Object (Id : E) return B is
2645 begin
2646 return Flag209 (Id);
2647 end Is_Return_Object;
2649 function Is_Safe_To_Reevaluate (Id : E) return B is
2650 begin
2651 return Flag249 (Id);
2652 end Is_Safe_To_Reevaluate;
2654 function Is_Shared_Passive (Id : E) return B is
2655 begin
2656 return Flag60 (Id);
2657 end Is_Shared_Passive;
2659 function Is_Static_Type (Id : E) return B is
2660 begin
2661 return Flag281 (Id);
2662 end Is_Static_Type;
2664 function Is_Statically_Allocated (Id : E) return B is
2665 begin
2666 return Flag28 (Id);
2667 end Is_Statically_Allocated;
2669 function Is_Tag (Id : E) return B is
2670 begin
2671 pragma Assert (Nkind (Id) in N_Entity);
2672 return Flag78 (Id);
2673 end Is_Tag;
2675 function Is_Tagged_Type (Id : E) return B is
2676 begin
2677 return Flag55 (Id);
2678 end Is_Tagged_Type;
2680 function Is_Thunk (Id : E) return B is
2681 begin
2682 return Flag225 (Id);
2683 end Is_Thunk;
2685 function Is_Trivial_Subprogram (Id : E) return B is
2686 begin
2687 return Flag235 (Id);
2688 end Is_Trivial_Subprogram;
2690 function Is_True_Constant (Id : E) return B is
2691 begin
2692 return Flag163 (Id);
2693 end Is_True_Constant;
2695 function Is_Unchecked_Union (Id : E) return B is
2696 begin
2697 return Flag117 (Implementation_Base_Type (Id));
2698 end Is_Unchecked_Union;
2700 function Is_Underlying_Full_View (Id : E) return B is
2701 begin
2702 return Flag298 (Id);
2703 end Is_Underlying_Full_View;
2705 function Is_Underlying_Record_View (Id : E) return B is
2706 begin
2707 return Flag246 (Id);
2708 end Is_Underlying_Record_View;
2710 function Is_Unimplemented (Id : E) return B is
2711 begin
2712 return Flag284 (Id);
2713 end Is_Unimplemented;
2715 function Is_Unsigned_Type (Id : E) return B is
2716 begin
2717 pragma Assert (Is_Type (Id));
2718 return Flag144 (Id);
2719 end Is_Unsigned_Type;
2721 function Is_Uplevel_Referenced_Entity (Id : E) return B is
2722 begin
2723 return Flag283 (Id);
2724 end Is_Uplevel_Referenced_Entity;
2726 function Is_Valued_Procedure (Id : E) return B is
2727 begin
2728 pragma Assert (Ekind (Id) = E_Procedure);
2729 return Flag127 (Id);
2730 end Is_Valued_Procedure;
2732 function Is_Visible_Formal (Id : E) return B is
2733 begin
2734 return Flag206 (Id);
2735 end Is_Visible_Formal;
2737 function Is_Visible_Lib_Unit (Id : E) return B is
2738 begin
2739 return Flag116 (Id);
2740 end Is_Visible_Lib_Unit;
2742 function Is_Volatile (Id : E) return B is
2743 begin
2744 pragma Assert (Nkind (Id) in N_Entity);
2746 if Is_Type (Id) then
2747 return Flag16 (Base_Type (Id));
2748 else
2749 return Flag16 (Id);
2750 end if;
2751 end Is_Volatile;
2753 function Is_Volatile_Full_Access (Id : E) return B is
2754 begin
2755 return Flag285 (Id);
2756 end Is_Volatile_Full_Access;
2758 function Itype_Printed (Id : E) return B is
2759 begin
2760 pragma Assert (Is_Itype (Id));
2761 return Flag202 (Id);
2762 end Itype_Printed;
2764 function Kill_Elaboration_Checks (Id : E) return B is
2765 begin
2766 return Flag32 (Id);
2767 end Kill_Elaboration_Checks;
2769 function Kill_Range_Checks (Id : E) return B is
2770 begin
2771 return Flag33 (Id);
2772 end Kill_Range_Checks;
2774 function Known_To_Have_Preelab_Init (Id : E) return B is
2775 begin
2776 pragma Assert (Is_Type (Id));
2777 return Flag207 (Id);
2778 end Known_To_Have_Preelab_Init;
2780 function Last_Aggregate_Assignment (Id : E) return N is
2781 begin
2782 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2783 return Node30 (Id);
2784 end Last_Aggregate_Assignment;
2786 function Last_Assignment (Id : E) return N is
2787 begin
2788 pragma Assert (Is_Assignable (Id));
2789 return Node26 (Id);
2790 end Last_Assignment;
2792 function Last_Entity (Id : E) return E is
2793 begin
2794 return Node20 (Id);
2795 end Last_Entity;
2797 function Limited_View (Id : E) return E is
2798 begin
2799 pragma Assert (Ekind (Id) = E_Package);
2800 return Node23 (Id);
2801 end Limited_View;
2803 function Linker_Section_Pragma (Id : E) return N is
2804 begin
2805 pragma Assert
2806 (Is_Object (Id) or else Is_Subprogram (Id) or else Is_Type (Id));
2807 return Node33 (Id);
2808 end Linker_Section_Pragma;
2810 function Lit_Indexes (Id : E) return E is
2811 begin
2812 pragma Assert (Is_Enumeration_Type (Id));
2813 return Node18 (Id);
2814 end Lit_Indexes;
2816 function Lit_Strings (Id : E) return E is
2817 begin
2818 pragma Assert (Is_Enumeration_Type (Id));
2819 return Node16 (Id);
2820 end Lit_Strings;
2822 function Low_Bound_Tested (Id : E) return B is
2823 begin
2824 return Flag205 (Id);
2825 end Low_Bound_Tested;
2827 function Machine_Radix_10 (Id : E) return B is
2828 begin
2829 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
2830 return Flag84 (Id);
2831 end Machine_Radix_10;
2833 function Master_Id (Id : E) return E is
2834 begin
2835 pragma Assert (Is_Access_Type (Id));
2836 return Node17 (Id);
2837 end Master_Id;
2839 function Materialize_Entity (Id : E) return B is
2840 begin
2841 return Flag168 (Id);
2842 end Materialize_Entity;
2844 function May_Inherit_Delayed_Rep_Aspects (Id : E) return B is
2845 begin
2846 return Flag262 (Id);
2847 end May_Inherit_Delayed_Rep_Aspects;
2849 function Mechanism (Id : E) return M is
2850 begin
2851 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
2852 return UI_To_Int (Uint8 (Id));
2853 end Mechanism;
2855 function Modulus (Id : E) return Uint is
2856 begin
2857 pragma Assert (Is_Modular_Integer_Type (Id));
2858 return Uint17 (Base_Type (Id));
2859 end Modulus;
2861 function Must_Be_On_Byte_Boundary (Id : E) return B is
2862 begin
2863 pragma Assert (Is_Type (Id));
2864 return Flag183 (Id);
2865 end Must_Be_On_Byte_Boundary;
2867 function Must_Have_Preelab_Init (Id : E) return B is
2868 begin
2869 pragma Assert (Is_Type (Id));
2870 return Flag208 (Id);
2871 end Must_Have_Preelab_Init;
2873 function Needs_Debug_Info (Id : E) return B is
2874 begin
2875 return Flag147 (Id);
2876 end Needs_Debug_Info;
2878 function Needs_No_Actuals (Id : E) return B is
2879 begin
2880 pragma Assert
2881 (Is_Overloadable (Id)
2882 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
2883 return Flag22 (Id);
2884 end Needs_No_Actuals;
2886 function Never_Set_In_Source (Id : E) return B is
2887 begin
2888 return Flag115 (Id);
2889 end Never_Set_In_Source;
2891 function Next_Inlined_Subprogram (Id : E) return E is
2892 begin
2893 return Node12 (Id);
2894 end Next_Inlined_Subprogram;
2896 function No_Dynamic_Predicate_On_Actual (Id : E) return Boolean is
2897 begin
2898 pragma Assert (Is_Discrete_Type (Id));
2899 return Flag276 (Id);
2900 end No_Dynamic_Predicate_On_Actual;
2902 function No_Pool_Assigned (Id : E) return B is
2903 begin
2904 pragma Assert (Is_Access_Type (Id));
2905 return Flag131 (Root_Type (Id));
2906 end No_Pool_Assigned;
2908 function No_Predicate_On_Actual (Id : E) return Boolean is
2909 begin
2910 pragma Assert (Is_Discrete_Type (Id));
2911 return Flag275 (Id);
2912 end No_Predicate_On_Actual;
2914 function No_Reordering (Id : E) return B is
2915 begin
2916 pragma Assert (Is_Record_Type (Id));
2917 return Flag239 (Implementation_Base_Type (Id));
2918 end No_Reordering;
2920 function No_Return (Id : E) return B is
2921 begin
2922 return Flag113 (Id);
2923 end No_Return;
2925 function No_Strict_Aliasing (Id : E) return B is
2926 begin
2927 pragma Assert (Is_Access_Type (Id));
2928 return Flag136 (Base_Type (Id));
2929 end No_Strict_Aliasing;
2931 function No_Tagged_Streams_Pragma (Id : E) return N is
2932 begin
2933 pragma Assert (Is_Tagged_Type (Id));
2934 return Node32 (Id);
2935 end No_Tagged_Streams_Pragma;
2937 function Non_Binary_Modulus (Id : E) return B is
2938 begin
2939 pragma Assert (Is_Type (Id));
2940 return Flag58 (Base_Type (Id));
2941 end Non_Binary_Modulus;
2943 function Non_Limited_View (Id : E) return E is
2944 begin
2945 pragma Assert
2946 (Ekind (Id) in Incomplete_Kind
2947 or else
2948 Ekind (Id) in Class_Wide_Kind
2949 or else
2950 Ekind (Id) = E_Abstract_State);
2951 return Node19 (Id);
2952 end Non_Limited_View;
2954 function Nonzero_Is_True (Id : E) return B is
2955 begin
2956 pragma Assert (Root_Type (Id) = Standard_Boolean);
2957 return Flag162 (Base_Type (Id));
2958 end Nonzero_Is_True;
2960 function Normalized_First_Bit (Id : E) return U is
2961 begin
2962 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2963 return Uint8 (Id);
2964 end Normalized_First_Bit;
2966 function Normalized_Position (Id : E) return U is
2967 begin
2968 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2969 return Uint14 (Id);
2970 end Normalized_Position;
2972 function Normalized_Position_Max (Id : E) return U is
2973 begin
2974 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2975 return Uint10 (Id);
2976 end Normalized_Position_Max;
2978 function OK_To_Rename (Id : E) return B is
2979 begin
2980 pragma Assert (Ekind (Id) = E_Variable);
2981 return Flag247 (Id);
2982 end OK_To_Rename;
2984 function Optimize_Alignment_Space (Id : E) return B is
2985 begin
2986 pragma Assert
2987 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2988 return Flag241 (Id);
2989 end Optimize_Alignment_Space;
2991 function Optimize_Alignment_Time (Id : E) return B is
2992 begin
2993 pragma Assert
2994 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2995 return Flag242 (Id);
2996 end Optimize_Alignment_Time;
2998 function Original_Access_Type (Id : E) return E is
2999 begin
3000 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
3001 return Node28 (Id);
3002 end Original_Access_Type;
3004 function Original_Array_Type (Id : E) return E is
3005 begin
3006 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
3007 return Node21 (Id);
3008 end Original_Array_Type;
3010 function Original_Protected_Subprogram (Id : E) return N is
3011 begin
3012 return Node41 (Id);
3013 end Original_Protected_Subprogram;
3015 function Original_Record_Component (Id : E) return E is
3016 begin
3017 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
3018 return Node22 (Id);
3019 end Original_Record_Component;
3021 function Overlays_Constant (Id : E) return B is
3022 begin
3023 return Flag243 (Id);
3024 end Overlays_Constant;
3026 function Overridden_Operation (Id : E) return E is
3027 begin
3028 pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
3029 return Node26 (Id);
3030 end Overridden_Operation;
3032 function Package_Instantiation (Id : E) return N is
3033 begin
3034 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
3035 return Node26 (Id);
3036 end Package_Instantiation;
3038 function Packed_Array_Impl_Type (Id : E) return E is
3039 begin
3040 pragma Assert (Is_Array_Type (Id));
3041 return Node23 (Id);
3042 end Packed_Array_Impl_Type;
3044 function Parent_Subtype (Id : E) return E is
3045 begin
3046 pragma Assert (Is_Record_Type (Id));
3047 return Node19 (Base_Type (Id));
3048 end Parent_Subtype;
3050 function Part_Of_Constituents (Id : E) return L is
3051 begin
3052 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
3053 return Elist10 (Id);
3054 end Part_Of_Constituents;
3056 function Part_Of_References (Id : E) return L is
3057 begin
3058 pragma Assert (Ekind (Id) = E_Variable);
3059 return Elist11 (Id);
3060 end Part_Of_References;
3062 function Partial_View_Has_Unknown_Discr (Id : E) return B is
3063 begin
3064 pragma Assert (Is_Type (Id));
3065 return Flag280 (Id);
3066 end Partial_View_Has_Unknown_Discr;
3068 function Pending_Access_Types (Id : E) return L is
3069 begin
3070 pragma Assert (Is_Type (Id));
3071 return Elist15 (Id);
3072 end Pending_Access_Types;
3074 function Postconditions_Proc (Id : E) return E is
3075 begin
3076 pragma Assert (Ekind_In (Id, E_Entry,
3077 E_Entry_Family,
3078 E_Function,
3079 E_Procedure));
3080 return Node14 (Id);
3081 end Postconditions_Proc;
3083 function Predicated_Parent (Id : E) return E is
3084 begin
3085 pragma Assert (Ekind_In (Id, E_Array_Subtype,
3086 E_Record_Subtype,
3087 E_Record_Subtype_With_Private));
3088 return Node38 (Id);
3089 end Predicated_Parent;
3091 function Predicates_Ignored (Id : E) return B is
3092 begin
3093 pragma Assert (Is_Type (Id));
3094 return Flag288 (Id);
3095 end Predicates_Ignored;
3097 function Prev_Entity (Id : E) return E is
3098 begin
3099 return Node36 (Id);
3100 end Prev_Entity;
3102 function Prival (Id : E) return E is
3103 begin
3104 pragma Assert (Is_Protected_Component (Id));
3105 return Node17 (Id);
3106 end Prival;
3108 function Prival_Link (Id : E) return E is
3109 begin
3110 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
3111 return Node20 (Id);
3112 end Prival_Link;
3114 function Private_Dependents (Id : E) return L is
3115 begin
3116 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
3117 return Elist18 (Id);
3118 end Private_Dependents;
3120 function Private_View (Id : E) return N is
3121 begin
3122 pragma Assert (Is_Private_Type (Id));
3123 return Node22 (Id);
3124 end Private_View;
3126 function Protected_Body_Subprogram (Id : E) return E is
3127 begin
3128 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
3129 return Node11 (Id);
3130 end Protected_Body_Subprogram;
3132 function Protected_Formal (Id : E) return E is
3133 begin
3134 pragma Assert (Is_Formal (Id));
3135 return Node22 (Id);
3136 end Protected_Formal;
3138 function Protected_Subprogram (Id : E) return N is
3139 begin
3140 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
3141 return Node39 (Id);
3142 end Protected_Subprogram;
3144 function Protection_Object (Id : E) return E is
3145 begin
3146 pragma Assert (Ekind_In (Id, E_Entry,
3147 E_Entry_Family,
3148 E_Function,
3149 E_Procedure));
3150 return Node23 (Id);
3151 end Protection_Object;
3153 function Reachable (Id : E) return B is
3154 begin
3155 return Flag49 (Id);
3156 end Reachable;
3158 function Receiving_Entry (Id : E) return E is
3159 begin
3160 pragma Assert (Ekind (Id) = E_Procedure);
3161 return Node19 (Id);
3162 end Receiving_Entry;
3164 function Referenced (Id : E) return B is
3165 begin
3166 return Flag156 (Id);
3167 end Referenced;
3169 function Referenced_As_LHS (Id : E) return B is
3170 begin
3171 return Flag36 (Id);
3172 end Referenced_As_LHS;
3174 function Referenced_As_Out_Parameter (Id : E) return B is
3175 begin
3176 return Flag227 (Id);
3177 end Referenced_As_Out_Parameter;
3179 function Refinement_Constituents (Id : E) return L is
3180 begin
3181 pragma Assert (Ekind (Id) = E_Abstract_State);
3182 return Elist8 (Id);
3183 end Refinement_Constituents;
3185 function Register_Exception_Call (Id : E) return N is
3186 begin
3187 pragma Assert (Ekind (Id) = E_Exception);
3188 return Node20 (Id);
3189 end Register_Exception_Call;
3191 function Related_Array_Object (Id : E) return E is
3192 begin
3193 pragma Assert (Is_Array_Type (Id));
3194 return Node25 (Id);
3195 end Related_Array_Object;
3197 function Related_Expression (Id : E) return N is
3198 begin
3199 pragma Assert (Ekind (Id) in Type_Kind
3200 or else Ekind_In (Id, E_Constant, E_Variable));
3201 return Node24 (Id);
3202 end Related_Expression;
3204 function Related_Instance (Id : E) return E is
3205 begin
3206 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
3207 return Node15 (Id);
3208 end Related_Instance;
3210 function Related_Type (Id : E) return E is
3211 begin
3212 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
3213 return Node27 (Id);
3214 end Related_Type;
3216 function Relative_Deadline_Variable (Id : E) return E is
3217 begin
3218 pragma Assert (Is_Task_Type (Id));
3219 return Node28 (Implementation_Base_Type (Id));
3220 end Relative_Deadline_Variable;
3222 function Renamed_Entity (Id : E) return N is
3223 begin
3224 return Node18 (Id);
3225 end Renamed_Entity;
3227 function Renamed_In_Spec (Id : E) return B is
3228 begin
3229 pragma Assert (Ekind (Id) = E_Package);
3230 return Flag231 (Id);
3231 end Renamed_In_Spec;
3233 function Renamed_Object (Id : E) return N is
3234 begin
3235 return Node18 (Id);
3236 end Renamed_Object;
3238 function Renaming_Map (Id : E) return U is
3239 begin
3240 return Uint9 (Id);
3241 end Renaming_Map;
3243 function Requires_Overriding (Id : E) return B is
3244 begin
3245 pragma Assert (Is_Overloadable (Id));
3246 return Flag213 (Id);
3247 end Requires_Overriding;
3249 function Return_Present (Id : E) return B is
3250 begin
3251 return Flag54 (Id);
3252 end Return_Present;
3254 function Return_Applies_To (Id : E) return N is
3255 begin
3256 return Node8 (Id);
3257 end Return_Applies_To;
3259 function Returns_By_Ref (Id : E) return B is
3260 begin
3261 return Flag90 (Id);
3262 end Returns_By_Ref;
3264 function Reverse_Bit_Order (Id : E) return B is
3265 begin
3266 pragma Assert (Is_Record_Type (Id));
3267 return Flag164 (Base_Type (Id));
3268 end Reverse_Bit_Order;
3270 function Reverse_Storage_Order (Id : E) return B is
3271 begin
3272 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
3273 return Flag93 (Base_Type (Id));
3274 end Reverse_Storage_Order;
3276 function Rewritten_For_C (Id : E) return B is
3277 begin
3278 pragma Assert (Ekind (Id) = E_Function);
3279 return Flag287 (Id);
3280 end Rewritten_For_C;
3282 function RM_Size (Id : E) return U is
3283 begin
3284 pragma Assert (Is_Type (Id));
3285 return Uint13 (Id);
3286 end RM_Size;
3288 function Scalar_Range (Id : E) return N is
3289 begin
3290 return Node20 (Id);
3291 end Scalar_Range;
3293 function Scale_Value (Id : E) return U is
3294 begin
3295 return Uint16 (Id);
3296 end Scale_Value;
3298 function Scope_Depth_Value (Id : E) return U is
3299 begin
3300 return Uint22 (Id);
3301 end Scope_Depth_Value;
3303 function Sec_Stack_Needed_For_Return (Id : E) return B is
3304 begin
3305 return Flag167 (Id);
3306 end Sec_Stack_Needed_For_Return;
3308 function Shadow_Entities (Id : E) return S is
3309 begin
3310 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
3311 return List14 (Id);
3312 end Shadow_Entities;
3314 function Shared_Var_Procs_Instance (Id : E) return E is
3315 begin
3316 pragma Assert (Ekind (Id) = E_Variable);
3317 return Node22 (Id);
3318 end Shared_Var_Procs_Instance;
3320 function Size_Check_Code (Id : E) return N is
3321 begin
3322 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
3323 return Node19 (Id);
3324 end Size_Check_Code;
3326 function Size_Depends_On_Discriminant (Id : E) return B is
3327 begin
3328 return Flag177 (Id);
3329 end Size_Depends_On_Discriminant;
3331 function Size_Known_At_Compile_Time (Id : E) return B is
3332 begin
3333 return Flag92 (Id);
3334 end Size_Known_At_Compile_Time;
3336 function Small_Value (Id : E) return R is
3337 begin
3338 pragma Assert (Is_Fixed_Point_Type (Id));
3339 return Ureal21 (Id);
3340 end Small_Value;
3342 function SPARK_Aux_Pragma (Id : E) return N is
3343 begin
3344 pragma Assert
3345 (Ekind_In (Id, E_Protected_Type, -- concurrent types
3346 E_Task_Type)
3347 or else
3348 Ekind_In (Id, E_Generic_Package, -- packages
3349 E_Package,
3350 E_Package_Body));
3351 return Node41 (Id);
3352 end SPARK_Aux_Pragma;
3354 function SPARK_Aux_Pragma_Inherited (Id : E) return B is
3355 begin
3356 pragma Assert
3357 (Ekind_In (Id, E_Protected_Type, -- concurrent types
3358 E_Task_Type)
3359 or else
3360 Ekind_In (Id, E_Generic_Package, -- packages
3361 E_Package,
3362 E_Package_Body));
3363 return Flag266 (Id);
3364 end SPARK_Aux_Pragma_Inherited;
3366 function SPARK_Pragma (Id : E) return N is
3367 begin
3368 pragma Assert
3369 (Ekind_In (Id, E_Constant, -- objects
3370 E_Variable)
3371 or else
3372 Ekind_In (Id, E_Abstract_State, -- overloadable
3373 E_Entry,
3374 E_Entry_Family,
3375 E_Function,
3376 E_Generic_Function,
3377 E_Generic_Procedure,
3378 E_Operator,
3379 E_Procedure,
3380 E_Subprogram_Body)
3381 or else
3382 Ekind_In (Id, E_Generic_Package, -- packages
3383 E_Package,
3384 E_Package_Body)
3385 or else
3386 Ekind (Id) = E_Void -- special purpose
3387 or else
3388 Ekind_In (Id, E_Protected_Body, -- types
3389 E_Task_Body)
3390 or else
3391 Is_Type (Id));
3392 return Node40 (Id);
3393 end SPARK_Pragma;
3395 function SPARK_Pragma_Inherited (Id : E) return B is
3396 begin
3397 pragma Assert
3398 (Ekind_In (Id, E_Constant, -- objects
3399 E_Variable)
3400 or else
3401 Ekind_In (Id, E_Abstract_State, -- overloadable
3402 E_Entry,
3403 E_Entry_Family,
3404 E_Function,
3405 E_Generic_Function,
3406 E_Generic_Procedure,
3407 E_Operator,
3408 E_Procedure,
3409 E_Subprogram_Body)
3410 or else
3411 Ekind_In (Id, E_Generic_Package, -- packages
3412 E_Package,
3413 E_Package_Body)
3414 or else
3415 Ekind (Id) = E_Void -- special purpose
3416 or else
3417 Ekind_In (Id, E_Protected_Body, -- types
3418 E_Task_Body)
3419 or else
3420 Is_Type (Id));
3421 return Flag265 (Id);
3422 end SPARK_Pragma_Inherited;
3424 function Spec_Entity (Id : E) return E is
3425 begin
3426 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
3427 return Node19 (Id);
3428 end Spec_Entity;
3430 function SSO_Set_High_By_Default (Id : E) return B is
3431 begin
3432 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
3433 return Flag273 (Base_Type (Id));
3434 end SSO_Set_High_By_Default;
3436 function SSO_Set_Low_By_Default (Id : E) return B is
3437 begin
3438 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
3439 return Flag272 (Base_Type (Id));
3440 end SSO_Set_Low_By_Default;
3442 function Static_Discrete_Predicate (Id : E) return S is
3443 begin
3444 pragma Assert (Is_Discrete_Type (Id));
3445 return List25 (Id);
3446 end Static_Discrete_Predicate;
3448 function Static_Real_Or_String_Predicate (Id : E) return N is
3449 begin
3450 pragma Assert (Is_Real_Type (Id) or else Is_String_Type (Id));
3451 return Node25 (Id);
3452 end Static_Real_Or_String_Predicate;
3454 function Status_Flag_Or_Transient_Decl (Id : E) return N is
3455 begin
3456 pragma Assert (Ekind_In (Id, E_Constant,
3457 E_Loop_Parameter,
3458 E_Variable));
3459 return Node15 (Id);
3460 end Status_Flag_Or_Transient_Decl;
3462 function Storage_Size_Variable (Id : E) return E is
3463 begin
3464 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
3465 return Node26 (Implementation_Base_Type (Id));
3466 end Storage_Size_Variable;
3468 function Static_Elaboration_Desired (Id : E) return B is
3469 begin
3470 pragma Assert (Ekind (Id) = E_Package);
3471 return Flag77 (Id);
3472 end Static_Elaboration_Desired;
3474 function Static_Initialization (Id : E) return N is
3475 begin
3476 pragma Assert
3477 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
3478 return Node30 (Id);
3479 end Static_Initialization;
3481 function Stored_Constraint (Id : E) return L is
3482 begin
3483 pragma Assert
3484 (Is_Composite_Type (Id) and then not Is_Array_Type (Id));
3485 return Elist23 (Id);
3486 end Stored_Constraint;
3488 function Stores_Attribute_Old_Prefix (Id : E) return B is
3489 begin
3490 return Flag270 (Id);
3491 end Stores_Attribute_Old_Prefix;
3493 function Strict_Alignment (Id : E) return B is
3494 begin
3495 return Flag145 (Implementation_Base_Type (Id));
3496 end Strict_Alignment;
3498 function String_Literal_Length (Id : E) return U is
3499 begin
3500 return Uint16 (Id);
3501 end String_Literal_Length;
3503 function String_Literal_Low_Bound (Id : E) return N is
3504 begin
3505 return Node18 (Id);
3506 end String_Literal_Low_Bound;
3508 function Subprograms_For_Type (Id : E) return L is
3509 begin
3510 pragma Assert (Is_Type (Id));
3511 return Elist29 (Id);
3512 end Subprograms_For_Type;
3514 function Subps_Index (Id : E) return U is
3515 begin
3516 pragma Assert (Is_Subprogram (Id));
3517 return Uint24 (Id);
3518 end Subps_Index;
3520 function Suppress_Elaboration_Warnings (Id : E) return B is
3521 begin
3522 return Flag303 (Id);
3523 end Suppress_Elaboration_Warnings;
3525 function Suppress_Initialization (Id : E) return B is
3526 begin
3527 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
3528 return Flag105 (Id);
3529 end Suppress_Initialization;
3531 function Suppress_Style_Checks (Id : E) return B is
3532 begin
3533 return Flag165 (Id);
3534 end Suppress_Style_Checks;
3536 function Suppress_Value_Tracking_On_Call (Id : E) return B is
3537 begin
3538 return Flag217 (Id);
3539 end Suppress_Value_Tracking_On_Call;
3541 function Task_Body_Procedure (Id : E) return N is
3542 begin
3543 pragma Assert (Ekind (Id) in Task_Kind);
3544 return Node25 (Id);
3545 end Task_Body_Procedure;
3547 function Thunk_Entity (Id : E) return E is
3548 begin
3549 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
3550 and then Is_Thunk (Id));
3551 return Node31 (Id);
3552 end Thunk_Entity;
3554 function Treat_As_Volatile (Id : E) return B is
3555 begin
3556 return Flag41 (Id);
3557 end Treat_As_Volatile;
3559 function Underlying_Full_View (Id : E) return E is
3560 begin
3561 pragma Assert (Ekind (Id) in Private_Kind);
3562 return Node19 (Id);
3563 end Underlying_Full_View;
3565 function Underlying_Record_View (Id : E) return E is
3566 begin
3567 return Node28 (Id);
3568 end Underlying_Record_View;
3570 function Universal_Aliasing (Id : E) return B is
3571 begin
3572 pragma Assert (Is_Type (Id));
3573 return Flag216 (Implementation_Base_Type (Id));
3574 end Universal_Aliasing;
3576 function Unset_Reference (Id : E) return N is
3577 begin
3578 return Node16 (Id);
3579 end Unset_Reference;
3581 function Used_As_Generic_Actual (Id : E) return B is
3582 begin
3583 return Flag222 (Id);
3584 end Used_As_Generic_Actual;
3586 function Uses_Lock_Free (Id : E) return B is
3587 begin
3588 pragma Assert (Is_Protected_Type (Id));
3589 return Flag188 (Id);
3590 end Uses_Lock_Free;
3592 function Uses_Sec_Stack (Id : E) return B is
3593 begin
3594 return Flag95 (Id);
3595 end Uses_Sec_Stack;
3597 function Validated_Object (Id : E) return N is
3598 begin
3599 pragma Assert (Ekind (Id) = E_Variable);
3600 return Node38 (Id);
3601 end Validated_Object;
3603 function Warnings_Off (Id : E) return B is
3604 begin
3605 return Flag96 (Id);
3606 end Warnings_Off;
3608 function Warnings_Off_Used (Id : E) return B is
3609 begin
3610 return Flag236 (Id);
3611 end Warnings_Off_Used;
3613 function Warnings_Off_Used_Unmodified (Id : E) return B is
3614 begin
3615 return Flag237 (Id);
3616 end Warnings_Off_Used_Unmodified;
3618 function Warnings_Off_Used_Unreferenced (Id : E) return B is
3619 begin
3620 return Flag238 (Id);
3621 end Warnings_Off_Used_Unreferenced;
3623 function Wrapped_Entity (Id : E) return E is
3624 begin
3625 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
3626 and then Is_Primitive_Wrapper (Id));
3627 return Node27 (Id);
3628 end Wrapped_Entity;
3630 function Was_Hidden (Id : E) return B is
3631 begin
3632 return Flag196 (Id);
3633 end Was_Hidden;
3635 ------------------------------
3636 -- Classification Functions --
3637 ------------------------------
3639 function Is_Access_Type (Id : E) return B is
3640 begin
3641 return Ekind (Id) in Access_Kind;
3642 end Is_Access_Type;
3644 function Is_Access_Protected_Subprogram_Type (Id : E) return B is
3645 begin
3646 return Ekind (Id) in Access_Protected_Kind;
3647 end Is_Access_Protected_Subprogram_Type;
3649 function Is_Access_Subprogram_Type (Id : E) return B is
3650 begin
3651 return Ekind (Id) in Access_Subprogram_Kind;
3652 end Is_Access_Subprogram_Type;
3654 function Is_Aggregate_Type (Id : E) return B is
3655 begin
3656 return Ekind (Id) in Aggregate_Kind;
3657 end Is_Aggregate_Type;
3659 function Is_Anonymous_Access_Type (Id : E) return B is
3660 begin
3661 return Ekind (Id) in Anonymous_Access_Kind;
3662 end Is_Anonymous_Access_Type;
3664 function Is_Array_Type (Id : E) return B is
3665 begin
3666 return Ekind (Id) in Array_Kind;
3667 end Is_Array_Type;
3669 function Is_Assignable (Id : E) return B is
3670 begin
3671 return Ekind (Id) in Assignable_Kind;
3672 end Is_Assignable;
3674 function Is_Class_Wide_Type (Id : E) return B is
3675 begin
3676 return Ekind (Id) in Class_Wide_Kind;
3677 end Is_Class_Wide_Type;
3679 function Is_Composite_Type (Id : E) return B is
3680 begin
3681 return Ekind (Id) in Composite_Kind;
3682 end Is_Composite_Type;
3684 function Is_Concurrent_Body (Id : E) return B is
3685 begin
3686 return Ekind (Id) in Concurrent_Body_Kind;
3687 end Is_Concurrent_Body;
3689 function Is_Concurrent_Record_Type (Id : E) return B is
3690 begin
3691 return Flag20 (Id);
3692 end Is_Concurrent_Record_Type;
3694 function Is_Concurrent_Type (Id : E) return B is
3695 begin
3696 return Ekind (Id) in Concurrent_Kind;
3697 end Is_Concurrent_Type;
3699 function Is_Decimal_Fixed_Point_Type (Id : E) return B is
3700 begin
3701 return Ekind (Id) in Decimal_Fixed_Point_Kind;
3702 end Is_Decimal_Fixed_Point_Type;
3704 function Is_Digits_Type (Id : E) return B is
3705 begin
3706 return Ekind (Id) in Digits_Kind;
3707 end Is_Digits_Type;
3709 function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B is
3710 begin
3711 return Ekind (Id) in Discrete_Or_Fixed_Point_Kind;
3712 end Is_Discrete_Or_Fixed_Point_Type;
3714 function Is_Discrete_Type (Id : E) return B is
3715 begin
3716 return Ekind (Id) in Discrete_Kind;
3717 end Is_Discrete_Type;
3719 function Is_Elementary_Type (Id : E) return B is
3720 begin
3721 return Ekind (Id) in Elementary_Kind;
3722 end Is_Elementary_Type;
3724 function Is_Entry (Id : E) return B is
3725 begin
3726 return Ekind (Id) in Entry_Kind;
3727 end Is_Entry;
3729 function Is_Enumeration_Type (Id : E) return B is
3730 begin
3731 return Ekind (Id) in Enumeration_Kind;
3732 end Is_Enumeration_Type;
3734 function Is_Fixed_Point_Type (Id : E) return B is
3735 begin
3736 return Ekind (Id) in Fixed_Point_Kind;
3737 end Is_Fixed_Point_Type;
3739 function Is_Floating_Point_Type (Id : E) return B is
3740 begin
3741 return Ekind (Id) in Float_Kind;
3742 end Is_Floating_Point_Type;
3744 function Is_Formal (Id : E) return B is
3745 begin
3746 return Ekind (Id) in Formal_Kind;
3747 end Is_Formal;
3749 function Is_Formal_Object (Id : E) return B is
3750 begin
3751 return Ekind (Id) in Formal_Object_Kind;
3752 end Is_Formal_Object;
3754 function Is_Generic_Subprogram (Id : E) return B is
3755 begin
3756 return Ekind (Id) in Generic_Subprogram_Kind;
3757 end Is_Generic_Subprogram;
3759 function Is_Generic_Unit (Id : E) return B is
3760 begin
3761 return Ekind (Id) in Generic_Unit_Kind;
3762 end Is_Generic_Unit;
3764 function Is_Ghost_Entity (Id : Entity_Id) return Boolean is
3765 begin
3766 return Is_Checked_Ghost_Entity (Id) or else Is_Ignored_Ghost_Entity (Id);
3767 end Is_Ghost_Entity;
3769 function Is_Incomplete_Or_Private_Type (Id : E) return B is
3770 begin
3771 return Ekind (Id) in Incomplete_Or_Private_Kind;
3772 end Is_Incomplete_Or_Private_Type;
3774 function Is_Incomplete_Type (Id : E) return B is
3775 begin
3776 return Ekind (Id) in Incomplete_Kind;
3777 end Is_Incomplete_Type;
3779 function Is_Integer_Type (Id : E) return B is
3780 begin
3781 return Ekind (Id) in Integer_Kind;
3782 end Is_Integer_Type;
3784 function Is_Modular_Integer_Type (Id : E) return B is
3785 begin
3786 return Ekind (Id) in Modular_Integer_Kind;
3787 end Is_Modular_Integer_Type;
3789 function Is_Named_Number (Id : E) return B is
3790 begin
3791 return Ekind (Id) in Named_Kind;
3792 end Is_Named_Number;
3794 function Is_Numeric_Type (Id : E) return B is
3795 begin
3796 return Ekind (Id) in Numeric_Kind;
3797 end Is_Numeric_Type;
3799 function Is_Object (Id : E) return B is
3800 begin
3801 return Ekind (Id) in Object_Kind;
3802 end Is_Object;
3804 function Is_Ordinary_Fixed_Point_Type (Id : E) return B is
3805 begin
3806 return Ekind (Id) in Ordinary_Fixed_Point_Kind;
3807 end Is_Ordinary_Fixed_Point_Type;
3809 function Is_Overloadable (Id : E) return B is
3810 begin
3811 return Ekind (Id) in Overloadable_Kind;
3812 end Is_Overloadable;
3814 function Is_Private_Type (Id : E) return B is
3815 begin
3816 return Ekind (Id) in Private_Kind;
3817 end Is_Private_Type;
3819 function Is_Protected_Type (Id : E) return B is
3820 begin
3821 return Ekind (Id) in Protected_Kind;
3822 end Is_Protected_Type;
3824 function Is_Real_Type (Id : E) return B is
3825 begin
3826 return Ekind (Id) in Real_Kind;
3827 end Is_Real_Type;
3829 function Is_Record_Type (Id : E) return B is
3830 begin
3831 return Ekind (Id) in Record_Kind;
3832 end Is_Record_Type;
3834 function Is_Scalar_Type (Id : E) return B is
3835 begin
3836 return Ekind (Id) in Scalar_Kind;
3837 end Is_Scalar_Type;
3839 function Is_Signed_Integer_Type (Id : E) return B is
3840 begin
3841 return Ekind (Id) in Signed_Integer_Kind;
3842 end Is_Signed_Integer_Type;
3844 function Is_Subprogram (Id : E) return B is
3845 begin
3846 return Ekind (Id) in Subprogram_Kind;
3847 end Is_Subprogram;
3849 function Is_Subprogram_Or_Entry (Id : E) return B is
3850 begin
3851 return Ekind (Id) in Subprogram_Kind
3852 or else
3853 Ekind (Id) in Entry_Kind;
3854 end Is_Subprogram_Or_Entry;
3856 function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B is
3857 begin
3858 return Ekind (Id) in Subprogram_Kind
3859 or else
3860 Ekind (Id) in Generic_Subprogram_Kind;
3861 end Is_Subprogram_Or_Generic_Subprogram;
3863 function Is_Task_Type (Id : E) return B is
3864 begin
3865 return Ekind (Id) in Task_Kind;
3866 end Is_Task_Type;
3868 function Is_Type (Id : E) return B is
3869 begin
3870 return Ekind (Id) in Type_Kind;
3871 end Is_Type;
3873 ------------------------------
3874 -- Attribute Set Procedures --
3875 ------------------------------
3877 -- Note: in many of these set procedures an "obvious" assertion is missing.
3878 -- The reason for this is that in many cases, a field is set before the
3879 -- Ekind field is set, so that the field is set when Ekind = E_Void. It
3880 -- it is possible to add assertions that specifically include the E_Void
3881 -- possibility, but in some cases, we just omit the assertions.
3883 procedure Set_Abstract_States (Id : E; V : L) is
3884 begin
3885 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
3886 Set_Elist25 (Id, V);
3887 end Set_Abstract_States;
3889 procedure Set_Accept_Address (Id : E; V : L) is
3890 begin
3891 Set_Elist21 (Id, V);
3892 end Set_Accept_Address;
3894 procedure Set_Access_Disp_Table (Id : E; V : L) is
3895 begin
3896 pragma Assert (Ekind (Id) = E_Record_Type
3897 and then Id = Implementation_Base_Type (Id));
3898 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
3899 Set_Elist16 (Id, V);
3900 end Set_Access_Disp_Table;
3902 procedure Set_Access_Disp_Table_Elab_Flag (Id : E; V : E) is
3903 begin
3904 pragma Assert (Ekind (Id) = E_Record_Type
3905 and then Id = Implementation_Base_Type (Id));
3906 pragma Assert (Is_Tagged_Type (Id));
3907 Set_Node30 (Id, V);
3908 end Set_Access_Disp_Table_Elab_Flag;
3910 procedure Set_Anonymous_Designated_Type (Id : E; V : E) is
3911 begin
3912 pragma Assert (Ekind (Id) = E_Variable);
3913 Set_Node35 (Id, V);
3914 end Set_Anonymous_Designated_Type;
3916 procedure Set_Anonymous_Masters (Id : E; V : L) is
3917 begin
3918 pragma Assert (Ekind_In (Id, E_Function,
3919 E_Package,
3920 E_Procedure,
3921 E_Subprogram_Body));
3922 Set_Elist29 (Id, V);
3923 end Set_Anonymous_Masters;
3925 procedure Set_Anonymous_Object (Id : E; V : E) is
3926 begin
3927 pragma Assert (Ekind_In (Id, E_Protected_Type, E_Task_Type));
3928 Set_Node30 (Id, V);
3929 end Set_Anonymous_Object;
3931 procedure Set_Associated_Entity (Id : E; V : E) is
3932 begin
3933 Set_Node37 (Id, V);
3934 end Set_Associated_Entity;
3936 procedure Set_Associated_Formal_Package (Id : E; V : E) is
3937 begin
3938 Set_Node12 (Id, V);
3939 end Set_Associated_Formal_Package;
3941 procedure Set_Associated_Node_For_Itype (Id : E; V : E) is
3942 begin
3943 Set_Node8 (Id, V);
3944 end Set_Associated_Node_For_Itype;
3946 procedure Set_Associated_Storage_Pool (Id : E; V : E) is
3947 begin
3948 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
3949 Set_Node22 (Id, V);
3950 end Set_Associated_Storage_Pool;
3952 procedure Set_Activation_Record_Component (Id : E; V : E) is
3953 begin
3954 pragma Assert (Ekind_In (Id, E_Constant,
3955 E_Discriminant,
3956 E_In_Parameter,
3957 E_In_Out_Parameter,
3958 E_Loop_Parameter,
3959 E_Out_Parameter,
3960 E_Variable));
3961 Set_Node31 (Id, V);
3962 end Set_Activation_Record_Component;
3964 procedure Set_Actual_Subtype (Id : E; V : E) is
3965 begin
3966 pragma Assert
3967 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
3968 or else Is_Formal (Id));
3969 Set_Node17 (Id, V);
3970 end Set_Actual_Subtype;
3972 procedure Set_Address_Taken (Id : E; V : B := True) is
3973 begin
3974 Set_Flag104 (Id, V);
3975 end Set_Address_Taken;
3977 procedure Set_Alias (Id : E; V : E) is
3978 begin
3979 pragma Assert
3980 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
3981 Set_Node18 (Id, V);
3982 end Set_Alias;
3984 procedure Set_Alignment (Id : E; V : U) is
3985 begin
3986 pragma Assert (Is_Type (Id)
3987 or else Is_Formal (Id)
3988 or else Ekind_In (Id, E_Loop_Parameter,
3989 E_Constant,
3990 E_Exception,
3991 E_Variable));
3992 Set_Uint14 (Id, V);
3993 end Set_Alignment;
3995 procedure Set_Barrier_Function (Id : E; V : N) is
3996 begin
3997 pragma Assert (Is_Entry (Id));
3998 Set_Node12 (Id, V);
3999 end Set_Barrier_Function;
4001 procedure Set_Block_Node (Id : E; V : N) is
4002 begin
4003 pragma Assert (Ekind (Id) = E_Block);
4004 Set_Node11 (Id, V);
4005 end Set_Block_Node;
4007 procedure Set_Body_Entity (Id : E; V : E) is
4008 begin
4009 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
4010 Set_Node19 (Id, V);
4011 end Set_Body_Entity;
4013 procedure Set_Body_Needed_For_Inlining (Id : E; V : B := True) is
4014 begin
4015 pragma Assert (Ekind (Id) = E_Package);
4016 Set_Flag299 (Id, V);
4017 end Set_Body_Needed_For_Inlining;
4019 procedure Set_Body_Needed_For_SAL (Id : E; V : B := True) is
4020 begin
4021 pragma Assert
4022 (Ekind (Id) = E_Package
4023 or else Is_Subprogram (Id)
4024 or else Is_Generic_Unit (Id));
4025 Set_Flag40 (Id, V);
4026 end Set_Body_Needed_For_SAL;
4028 procedure Set_Body_References (Id : E; V : L) is
4029 begin
4030 pragma Assert (Ekind (Id) = E_Abstract_State);
4031 Set_Elist16 (Id, V);
4032 end Set_Body_References;
4034 procedure Set_BIP_Initialization_Call (Id : E; V : N) is
4035 begin
4036 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
4037 Set_Node29 (Id, V);
4038 end Set_BIP_Initialization_Call;
4040 procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is
4041 begin
4042 pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id));
4043 Set_Flag125 (Id, V);
4044 end Set_C_Pass_By_Copy;
4046 procedure Set_Can_Never_Be_Null (Id : E; V : B := True) is
4047 begin
4048 Set_Flag38 (Id, V);
4049 end Set_Can_Never_Be_Null;
4051 procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
4052 begin
4053 pragma Assert
4054 (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
4055 Set_Flag229 (Id, V);
4056 end Set_Can_Use_Internal_Rep;
4058 procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is
4059 begin
4060 Set_Flag31 (Id, V);
4061 end Set_Checks_May_Be_Suppressed;
4063 procedure Set_Class_Wide_Clone (Id : E; V : E) is
4064 begin
4065 pragma Assert (Is_Subprogram (Id));
4066 Set_Node38 (Id, V);
4067 end Set_Class_Wide_Clone;
4069 procedure Set_Class_Wide_Type (Id : E; V : E) is
4070 begin
4071 pragma Assert (Is_Type (Id));
4072 Set_Node9 (Id, V);
4073 end Set_Class_Wide_Type;
4075 procedure Set_Cloned_Subtype (Id : E; V : E) is
4076 begin
4077 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
4078 Set_Node16 (Id, V);
4079 end Set_Cloned_Subtype;
4081 procedure Set_Component_Bit_Offset (Id : E; V : U) is
4082 begin
4083 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
4084 Set_Uint11 (Id, V);
4085 end Set_Component_Bit_Offset;
4087 procedure Set_Component_Clause (Id : E; V : N) is
4088 begin
4089 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
4090 Set_Node13 (Id, V);
4091 end Set_Component_Clause;
4093 procedure Set_Component_Size (Id : E; V : U) is
4094 begin
4095 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
4096 Set_Uint22 (Id, V);
4097 end Set_Component_Size;
4099 procedure Set_Component_Type (Id : E; V : E) is
4100 begin
4101 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
4102 Set_Node20 (Id, V);
4103 end Set_Component_Type;
4105 procedure Set_Contains_Ignored_Ghost_Code (Id : E; V : B := True) is
4106 begin
4107 pragma Assert
4108 (Ekind_In (Id, E_Block,
4109 E_Function,
4110 E_Generic_Function,
4111 E_Generic_Package,
4112 E_Generic_Procedure,
4113 E_Package,
4114 E_Package_Body,
4115 E_Procedure,
4116 E_Subprogram_Body));
4117 Set_Flag279 (Id, V);
4118 end Set_Contains_Ignored_Ghost_Code;
4120 procedure Set_Contract (Id : E; V : N) is
4121 begin
4122 pragma Assert
4123 (Ekind_In (Id, E_Protected_Type, -- concurrent types
4124 E_Task_Body,
4125 E_Task_Type)
4126 or else
4127 Ekind_In (Id, E_Constant, -- objects
4128 E_Variable)
4129 or else
4130 Ekind_In (Id, E_Entry, -- overloadable
4131 E_Entry_Family,
4132 E_Function,
4133 E_Generic_Function,
4134 E_Generic_Procedure,
4135 E_Operator,
4136 E_Procedure,
4137 E_Subprogram_Body)
4138 or else
4139 Ekind_In (Id, E_Generic_Package, -- packages
4140 E_Package,
4141 E_Package_Body)
4142 or else
4143 Ekind (Id) = E_Void); -- special purpose
4144 Set_Node34 (Id, V);
4145 end Set_Contract;
4147 procedure Set_Contract_Wrapper (Id : E; V : E) is
4148 begin
4149 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
4150 Set_Node25 (Id, V);
4151 end Set_Contract_Wrapper;
4153 procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is
4154 begin
4155 pragma Assert
4156 (Ekind (Id) = E_Record_Type and then Is_Concurrent_Type (V));
4157 Set_Node18 (Id, V);
4158 end Set_Corresponding_Concurrent_Type;
4160 procedure Set_Corresponding_Discriminant (Id : E; V : E) is
4161 begin
4162 pragma Assert (Ekind (Id) = E_Discriminant);
4163 Set_Node19 (Id, V);
4164 end Set_Corresponding_Discriminant;
4166 procedure Set_Corresponding_Equality (Id : E; V : E) is
4167 begin
4168 pragma Assert
4169 (Ekind (Id) = E_Function
4170 and then not Comes_From_Source (Id)
4171 and then Chars (Id) = Name_Op_Ne);
4172 Set_Node30 (Id, V);
4173 end Set_Corresponding_Equality;
4175 procedure Set_Corresponding_Function (Id : E; V : E) is
4176 begin
4177 pragma Assert (Ekind (Id) = E_Procedure and then Rewritten_For_C (V));
4178 Set_Node32 (Id, V);
4179 end Set_Corresponding_Function;
4181 procedure Set_Corresponding_Procedure (Id : E; V : E) is
4182 begin
4183 pragma Assert (Ekind (Id) = E_Function and then Rewritten_For_C (Id));
4184 Set_Node32 (Id, V);
4185 end Set_Corresponding_Procedure;
4187 procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
4188 begin
4189 pragma Assert (Ekind_In (Id, E_Void, E_Subprogram_Body));
4190 Set_Node18 (Id, V);
4191 end Set_Corresponding_Protected_Entry;
4193 procedure Set_Corresponding_Record_Component (Id : E; V : E) is
4194 begin
4195 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
4196 Set_Node21 (Id, V);
4197 end Set_Corresponding_Record_Component;
4199 procedure Set_Corresponding_Record_Type (Id : E; V : E) is
4200 begin
4201 pragma Assert (Is_Concurrent_Type (Id));
4202 Set_Node18 (Id, V);
4203 end Set_Corresponding_Record_Type;
4205 procedure Set_Corresponding_Remote_Type (Id : E; V : E) is
4206 begin
4207 Set_Node22 (Id, V);
4208 end Set_Corresponding_Remote_Type;
4210 procedure Set_Current_Use_Clause (Id : E; V : E) is
4211 begin
4212 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
4213 Set_Node27 (Id, V);
4214 end Set_Current_Use_Clause;
4216 procedure Set_Current_Value (Id : E; V : N) is
4217 begin
4218 pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void);
4219 Set_Node9 (Id, V);
4220 end Set_Current_Value;
4222 procedure Set_CR_Discriminant (Id : E; V : E) is
4223 begin
4224 Set_Node23 (Id, V);
4225 end Set_CR_Discriminant;
4227 procedure Set_Debug_Info_Off (Id : E; V : B := True) is
4228 begin
4229 Set_Flag166 (Id, V);
4230 end Set_Debug_Info_Off;
4232 procedure Set_Debug_Renaming_Link (Id : E; V : E) is
4233 begin
4234 Set_Node25 (Id, V);
4235 end Set_Debug_Renaming_Link;
4237 procedure Set_Default_Aspect_Component_Value (Id : E; V : E) is
4238 begin
4239 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
4240 Set_Node19 (Id, V);
4241 end Set_Default_Aspect_Component_Value;
4243 procedure Set_Default_Aspect_Value (Id : E; V : E) is
4244 begin
4245 pragma Assert (Is_Scalar_Type (Id) and then Is_Base_Type (Id));
4246 Set_Node19 (Id, V);
4247 end Set_Default_Aspect_Value;
4249 procedure Set_Default_Expr_Function (Id : E; V : E) is
4250 begin
4251 pragma Assert (Is_Formal (Id));
4252 Set_Node21 (Id, V);
4253 end Set_Default_Expr_Function;
4255 procedure Set_Default_Expressions_Processed (Id : E; V : B := True) is
4256 begin
4257 Set_Flag108 (Id, V);
4258 end Set_Default_Expressions_Processed;
4260 procedure Set_Default_Value (Id : E; V : N) is
4261 begin
4262 pragma Assert (Is_Formal (Id));
4263 Set_Node20 (Id, V);
4264 end Set_Default_Value;
4266 procedure Set_Delay_Cleanups (Id : E; V : B := True) is
4267 begin
4268 pragma Assert
4269 (Is_Subprogram (Id)
4270 or else Is_Task_Type (Id)
4271 or else Ekind (Id) = E_Block);
4272 Set_Flag114 (Id, V);
4273 end Set_Delay_Cleanups;
4275 procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True) is
4276 begin
4277 pragma Assert
4278 (Is_Subprogram (Id) or else Ekind_In (Id, E_Package, E_Package_Body));
4280 Set_Flag50 (Id, V);
4281 end Set_Delay_Subprogram_Descriptors;
4283 procedure Set_Delta_Value (Id : E; V : R) is
4284 begin
4285 pragma Assert (Is_Fixed_Point_Type (Id));
4286 Set_Ureal18 (Id, V);
4287 end Set_Delta_Value;
4289 procedure Set_Dependent_Instances (Id : E; V : L) is
4290 begin
4291 pragma Assert (Is_Generic_Instance (Id));
4292 Set_Elist8 (Id, V);
4293 end Set_Dependent_Instances;
4295 procedure Set_Depends_On_Private (Id : E; V : B := True) is
4296 begin
4297 pragma Assert (Nkind (Id) in N_Entity);
4298 Set_Flag14 (Id, V);
4299 end Set_Depends_On_Private;
4301 procedure Set_Derived_Type_Link (Id : E; V : E) is
4302 begin
4303 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
4304 Set_Node31 (Id, V);
4305 end Set_Derived_Type_Link;
4307 procedure Set_Digits_Value (Id : E; V : U) is
4308 begin
4309 pragma Assert
4310 (Is_Floating_Point_Type (Id)
4311 or else Is_Decimal_Fixed_Point_Type (Id));
4312 Set_Uint17 (Id, V);
4313 end Set_Digits_Value;
4315 procedure Set_Directly_Designated_Type (Id : E; V : E) is
4316 begin
4317 Set_Node20 (Id, V);
4318 end Set_Directly_Designated_Type;
4320 procedure Set_Disable_Controlled (Id : E; V : B := True) is
4321 begin
4322 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
4323 Set_Flag253 (Id, V);
4324 end Set_Disable_Controlled;
4326 procedure Set_Discard_Names (Id : E; V : B := True) is
4327 begin
4328 Set_Flag88 (Id, V);
4329 end Set_Discard_Names;
4331 procedure Set_Discriminal (Id : E; V : E) is
4332 begin
4333 pragma Assert (Ekind (Id) = E_Discriminant);
4334 Set_Node17 (Id, V);
4335 end Set_Discriminal;
4337 procedure Set_Discriminal_Link (Id : E; V : E) is
4338 begin
4339 Set_Node10 (Id, V);
4340 end Set_Discriminal_Link;
4342 procedure Set_Discriminant_Checking_Func (Id : E; V : E) is
4343 begin
4344 pragma Assert (Ekind (Id) = E_Component);
4345 Set_Node20 (Id, V);
4346 end Set_Discriminant_Checking_Func;
4348 procedure Set_Discriminant_Constraint (Id : E; V : L) is
4349 begin
4350 pragma Assert (Nkind (Id) in N_Entity);
4351 Set_Elist21 (Id, V);
4352 end Set_Discriminant_Constraint;
4354 procedure Set_Discriminant_Default_Value (Id : E; V : N) is
4355 begin
4356 Set_Node20 (Id, V);
4357 end Set_Discriminant_Default_Value;
4359 procedure Set_Discriminant_Number (Id : E; V : U) is
4360 begin
4361 Set_Uint15 (Id, V);
4362 end Set_Discriminant_Number;
4364 procedure Set_Dispatch_Table_Wrappers (Id : E; V : L) is
4365 begin
4366 pragma Assert (Ekind (Id) = E_Record_Type
4367 and then Id = Implementation_Base_Type (Id));
4368 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
4369 Set_Elist26 (Id, V);
4370 end Set_Dispatch_Table_Wrappers;
4372 procedure Set_DT_Entry_Count (Id : E; V : U) is
4373 begin
4374 pragma Assert (Ekind (Id) = E_Component);
4375 Set_Uint15 (Id, V);
4376 end Set_DT_Entry_Count;
4378 procedure Set_DT_Offset_To_Top_Func (Id : E; V : E) is
4379 begin
4380 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
4381 Set_Node25 (Id, V);
4382 end Set_DT_Offset_To_Top_Func;
4384 procedure Set_DT_Position (Id : E; V : U) is
4385 begin
4386 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
4387 Set_Uint15 (Id, V);
4388 end Set_DT_Position;
4390 procedure Set_DTC_Entity (Id : E; V : E) is
4391 begin
4392 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
4393 Set_Node16 (Id, V);
4394 end Set_DTC_Entity;
4396 procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True) is
4397 begin
4398 pragma Assert (Ekind (Id) = E_Package);
4399 Set_Flag210 (Id, V);
4400 end Set_Elaborate_Body_Desirable;
4402 procedure Set_Elaboration_Entity (Id : E; V : E) is
4403 begin
4404 pragma Assert
4405 (Is_Subprogram (Id)
4406 or else
4407 Ekind (Id) = E_Package
4408 or else
4409 Is_Generic_Unit (Id));
4410 Set_Node13 (Id, V);
4411 end Set_Elaboration_Entity;
4413 procedure Set_Elaboration_Entity_Required (Id : E; V : B := True) is
4414 begin
4415 pragma Assert
4416 (Is_Subprogram (Id)
4417 or else
4418 Ekind (Id) = E_Package
4419 or else
4420 Is_Generic_Unit (Id));
4421 Set_Flag174 (Id, V);
4422 end Set_Elaboration_Entity_Required;
4424 procedure Set_Encapsulating_State (Id : E; V : E) is
4425 begin
4426 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Constant, E_Variable));
4427 Set_Node32 (Id, V);
4428 end Set_Encapsulating_State;
4430 procedure Set_Enclosing_Scope (Id : E; V : E) is
4431 begin
4432 Set_Node18 (Id, V);
4433 end Set_Enclosing_Scope;
4435 procedure Set_Entry_Accepted (Id : E; V : B := True) is
4436 begin
4437 pragma Assert (Is_Entry (Id));
4438 Set_Flag152 (Id, V);
4439 end Set_Entry_Accepted;
4441 procedure Set_Entry_Bodies_Array (Id : E; V : E) is
4442 begin
4443 Set_Node19 (Id, V);
4444 end Set_Entry_Bodies_Array;
4446 procedure Set_Entry_Cancel_Parameter (Id : E; V : E) is
4447 begin
4448 Set_Node23 (Id, V);
4449 end Set_Entry_Cancel_Parameter;
4451 procedure Set_Entry_Component (Id : E; V : E) is
4452 begin
4453 Set_Node11 (Id, V);
4454 end Set_Entry_Component;
4456 procedure Set_Entry_Formal (Id : E; V : E) is
4457 begin
4458 Set_Node16 (Id, V);
4459 end Set_Entry_Formal;
4461 procedure Set_Entry_Index_Constant (Id : E; V : E) is
4462 begin
4463 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
4464 Set_Node18 (Id, V);
4465 end Set_Entry_Index_Constant;
4467 procedure Set_Entry_Max_Queue_Lengths_Array (Id : E; V : E) is
4468 begin
4469 pragma Assert (Ekind (Id) = E_Protected_Type);
4470 Set_Node35 (Id, V);
4471 end Set_Entry_Max_Queue_Lengths_Array;
4473 procedure Set_Entry_Parameters_Type (Id : E; V : E) is
4474 begin
4475 Set_Node15 (Id, V);
4476 end Set_Entry_Parameters_Type;
4478 procedure Set_Enum_Pos_To_Rep (Id : E; V : E) is
4479 begin
4480 pragma Assert (Ekind (Id) = E_Enumeration_Type);
4481 Set_Node23 (Id, V);
4482 end Set_Enum_Pos_To_Rep;
4484 procedure Set_Enumeration_Pos (Id : E; V : U) is
4485 begin
4486 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
4487 Set_Uint11 (Id, V);
4488 end Set_Enumeration_Pos;
4490 procedure Set_Enumeration_Rep (Id : E; V : U) is
4491 begin
4492 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
4493 Set_Uint12 (Id, V);
4494 end Set_Enumeration_Rep;
4496 procedure Set_Enumeration_Rep_Expr (Id : E; V : N) is
4497 begin
4498 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
4499 Set_Node22 (Id, V);
4500 end Set_Enumeration_Rep_Expr;
4502 procedure Set_Equivalent_Type (Id : E; V : E) is
4503 begin
4504 pragma Assert
4505 (Ekind_In (Id, E_Class_Wide_Type,
4506 E_Class_Wide_Subtype,
4507 E_Access_Protected_Subprogram_Type,
4508 E_Anonymous_Access_Protected_Subprogram_Type,
4509 E_Access_Subprogram_Type,
4510 E_Exception_Type));
4511 Set_Node18 (Id, V);
4512 end Set_Equivalent_Type;
4514 procedure Set_Esize (Id : E; V : U) is
4515 begin
4516 Set_Uint12 (Id, V);
4517 end Set_Esize;
4519 procedure Set_Extra_Accessibility (Id : E; V : E) is
4520 begin
4521 pragma Assert
4522 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
4523 Set_Node13 (Id, V);
4524 end Set_Extra_Accessibility;
4526 procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E) is
4527 begin
4528 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
4529 Set_Node19 (Id, V);
4530 end Set_Extra_Accessibility_Of_Result;
4532 procedure Set_Extra_Constrained (Id : E; V : E) is
4533 begin
4534 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
4535 Set_Node23 (Id, V);
4536 end Set_Extra_Constrained;
4538 procedure Set_Extra_Formal (Id : E; V : E) is
4539 begin
4540 Set_Node15 (Id, V);
4541 end Set_Extra_Formal;
4543 procedure Set_Extra_Formals (Id : E; V : E) is
4544 begin
4545 pragma Assert
4546 (Is_Overloadable (Id)
4547 or else Ekind_In (Id, E_Entry_Family,
4548 E_Subprogram_Body,
4549 E_Subprogram_Type));
4550 Set_Node28 (Id, V);
4551 end Set_Extra_Formals;
4553 procedure Set_Finalization_Master (Id : E; V : E) is
4554 begin
4555 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
4556 Set_Node23 (Id, V);
4557 end Set_Finalization_Master;
4559 procedure Set_Finalize_Storage_Only (Id : E; V : B := True) is
4560 begin
4561 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
4562 Set_Flag158 (Id, V);
4563 end Set_Finalize_Storage_Only;
4565 procedure Set_Finalizer (Id : E; V : E) is
4566 begin
4567 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
4568 Set_Node28 (Id, V);
4569 end Set_Finalizer;
4571 procedure Set_First_Entity (Id : E; V : E) is
4572 begin
4573 Set_Node17 (Id, V);
4574 end Set_First_Entity;
4576 procedure Set_First_Exit_Statement (Id : E; V : N) is
4577 begin
4578 pragma Assert (Ekind (Id) = E_Loop);
4579 Set_Node8 (Id, V);
4580 end Set_First_Exit_Statement;
4582 procedure Set_First_Index (Id : E; V : N) is
4583 begin
4584 pragma Assert (Is_Array_Type (Id));
4585 Set_Node17 (Id, V);
4586 end Set_First_Index;
4588 procedure Set_First_Literal (Id : E; V : E) is
4589 begin
4590 pragma Assert (Is_Enumeration_Type (Id));
4591 Set_Node17 (Id, V);
4592 end Set_First_Literal;
4594 procedure Set_First_Private_Entity (Id : E; V : E) is
4595 begin
4596 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
4597 or else Ekind (Id) in Concurrent_Kind);
4598 Set_Node16 (Id, V);
4599 end Set_First_Private_Entity;
4601 procedure Set_First_Rep_Item (Id : E; V : N) is
4602 begin
4603 Set_Node6 (Id, V);
4604 end Set_First_Rep_Item;
4606 procedure Set_Float_Rep (Id : E; V : F) is
4607 pragma Assert (Ekind (Id) = E_Floating_Point_Type);
4608 begin
4609 Set_Uint10 (Id, UI_From_Int (F'Pos (V)));
4610 end Set_Float_Rep;
4612 procedure Set_Freeze_Node (Id : E; V : N) is
4613 begin
4614 Set_Node7 (Id, V);
4615 end Set_Freeze_Node;
4617 procedure Set_From_Limited_With (Id : E; V : B := True) is
4618 begin
4619 pragma Assert
4620 (Is_Type (Id) or else Ekind_In (Id, E_Abstract_State, E_Package));
4621 Set_Flag159 (Id, V);
4622 end Set_From_Limited_With;
4624 procedure Set_Full_View (Id : E; V : E) is
4625 begin
4626 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
4627 Set_Node11 (Id, V);
4628 end Set_Full_View;
4630 procedure Set_Generic_Homonym (Id : E; V : E) is
4631 begin
4632 Set_Node11 (Id, V);
4633 end Set_Generic_Homonym;
4635 procedure Set_Generic_Renamings (Id : E; V : L) is
4636 begin
4637 Set_Elist23 (Id, V);
4638 end Set_Generic_Renamings;
4640 procedure Set_Handler_Records (Id : E; V : S) is
4641 begin
4642 Set_List10 (Id, V);
4643 end Set_Handler_Records;
4645 procedure Set_Has_Aliased_Components (Id : E; V : B := True) is
4646 begin
4647 pragma Assert (Id = Base_Type (Id));
4648 Set_Flag135 (Id, V);
4649 end Set_Has_Aliased_Components;
4651 procedure Set_Has_Alignment_Clause (Id : E; V : B := True) is
4652 begin
4653 Set_Flag46 (Id, V);
4654 end Set_Has_Alignment_Clause;
4656 procedure Set_Has_All_Calls_Remote (Id : E; V : B := True) is
4657 begin
4658 Set_Flag79 (Id, V);
4659 end Set_Has_All_Calls_Remote;
4661 procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
4662 begin
4663 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
4664 Set_Flag86 (Id, V);
4665 end Set_Has_Atomic_Components;
4667 procedure Set_Has_Biased_Representation (Id : E; V : B := True) is
4668 begin
4669 pragma Assert
4670 ((V = False) or else (Is_Discrete_Type (Id) or else Is_Object (Id)));
4671 Set_Flag139 (Id, V);
4672 end Set_Has_Biased_Representation;
4674 procedure Set_Has_Completion (Id : E; V : B := True) is
4675 begin
4676 Set_Flag26 (Id, V);
4677 end Set_Has_Completion;
4679 procedure Set_Has_Completion_In_Body (Id : E; V : B := True) is
4680 begin
4681 pragma Assert (Is_Type (Id));
4682 Set_Flag71 (Id, V);
4683 end Set_Has_Completion_In_Body;
4685 procedure Set_Has_Complex_Representation (Id : E; V : B := True) is
4686 begin
4687 pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id));
4688 Set_Flag140 (Id, V);
4689 end Set_Has_Complex_Representation;
4691 procedure Set_Has_Component_Size_Clause (Id : E; V : B := True) is
4692 begin
4693 pragma Assert (Ekind (Id) = E_Array_Type);
4694 Set_Flag68 (Id, V);
4695 end Set_Has_Component_Size_Clause;
4697 procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True) is
4698 begin
4699 pragma Assert (Is_Type (Id));
4700 Set_Flag187 (Id, V);
4701 end Set_Has_Constrained_Partial_View;
4703 procedure Set_Has_Contiguous_Rep (Id : E; V : B := True) is
4704 begin
4705 Set_Flag181 (Id, V);
4706 end Set_Has_Contiguous_Rep;
4708 procedure Set_Has_Controlled_Component (Id : E; V : B := True) is
4709 begin
4710 pragma Assert (Id = Base_Type (Id));
4711 Set_Flag43 (Id, V);
4712 end Set_Has_Controlled_Component;
4714 procedure Set_Has_Controlling_Result (Id : E; V : B := True) is
4715 begin
4716 Set_Flag98 (Id, V);
4717 end Set_Has_Controlling_Result;
4719 procedure Set_Has_Convention_Pragma (Id : E; V : B := True) is
4720 begin
4721 Set_Flag119 (Id, V);
4722 end Set_Has_Convention_Pragma;
4724 procedure Set_Has_Default_Aspect (Id : E; V : B := True) is
4725 begin
4726 pragma Assert
4727 ((Is_Scalar_Type (Id) or else Is_Array_Type (Id))
4728 and then Is_Base_Type (Id));
4729 Set_Flag39 (Id, V);
4730 end Set_Has_Default_Aspect;
4732 procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is
4733 begin
4734 pragma Assert (Nkind (Id) in N_Entity);
4735 Set_Flag200 (Id, V);
4736 end Set_Has_Delayed_Aspects;
4738 procedure Set_Has_Delayed_Freeze (Id : E; V : B := True) is
4739 begin
4740 pragma Assert (Nkind (Id) in N_Entity);
4741 Set_Flag18 (Id, V);
4742 end Set_Has_Delayed_Freeze;
4744 procedure Set_Has_Delayed_Rep_Aspects (Id : E; V : B := True) is
4745 begin
4746 pragma Assert (Nkind (Id) in N_Entity);
4747 Set_Flag261 (Id, V);
4748 end Set_Has_Delayed_Rep_Aspects;
4750 procedure Set_Has_Discriminants (Id : E; V : B := True) is
4751 begin
4752 pragma Assert (Is_Type (Id));
4753 Set_Flag5 (Id, V);
4754 end Set_Has_Discriminants;
4756 procedure Set_Has_Dispatch_Table (Id : E; V : B := True) is
4757 begin
4758 pragma Assert (Ekind (Id) = E_Record_Type
4759 and then Is_Tagged_Type (Id));
4760 Set_Flag220 (Id, V);
4761 end Set_Has_Dispatch_Table;
4763 procedure Set_Has_Dynamic_Predicate_Aspect (Id : E; V : B := True) is
4764 begin
4765 pragma Assert (Is_Type (Id));
4766 Set_Flag258 (Id, V);
4767 end Set_Has_Dynamic_Predicate_Aspect;
4769 procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True) is
4770 begin
4771 pragma Assert (Is_Enumeration_Type (Id));
4772 Set_Flag66 (Id, V);
4773 end Set_Has_Enumeration_Rep_Clause;
4775 procedure Set_Has_Exit (Id : E; V : B := True) is
4776 begin
4777 Set_Flag47 (Id, V);
4778 end Set_Has_Exit;
4780 procedure Set_Has_Expanded_Contract (Id : E; V : B := True) is
4781 begin
4782 pragma Assert (Ekind_In (Id, E_Entry,
4783 E_Entry_Family,
4784 E_Function,
4785 E_Procedure));
4786 Set_Flag240 (Id, V);
4787 end Set_Has_Expanded_Contract;
4789 procedure Set_Has_Forward_Instantiation (Id : E; V : B := True) is
4790 begin
4791 Set_Flag175 (Id, V);
4792 end Set_Has_Forward_Instantiation;
4794 procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True) is
4795 begin
4796 Set_Flag173 (Id, V);
4797 end Set_Has_Fully_Qualified_Name;
4799 procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True) is
4800 begin
4801 Set_Flag82 (Id, V);
4802 end Set_Has_Gigi_Rep_Item;
4804 procedure Set_Has_Homonym (Id : E; V : B := True) is
4805 begin
4806 Set_Flag56 (Id, V);
4807 end Set_Has_Homonym;
4809 procedure Set_Has_Implicit_Dereference (Id : E; V : B := True) is
4810 begin
4811 Set_Flag251 (Id, V);
4812 end Set_Has_Implicit_Dereference;
4814 procedure Set_Has_Independent_Components (Id : E; V : B := True) is
4815 begin
4816 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
4817 Set_Flag34 (Id, V);
4818 end Set_Has_Independent_Components;
4820 procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True) is
4821 begin
4822 pragma Assert (Is_Type (Id));
4823 Set_Flag248 (Base_Type (Id), V);
4824 end Set_Has_Inheritable_Invariants;
4826 procedure Set_Has_Inherited_DIC (Id : E; V : B := True) is
4827 begin
4828 pragma Assert (Is_Type (Id));
4829 Set_Flag133 (Base_Type (Id), V);
4830 end Set_Has_Inherited_DIC;
4832 procedure Set_Has_Inherited_Invariants (Id : E; V : B := True) is
4833 begin
4834 pragma Assert (Is_Type (Id));
4835 Set_Flag291 (Base_Type (Id), V);
4836 end Set_Has_Inherited_Invariants;
4838 procedure Set_Has_Initial_Value (Id : E; V : B := True) is
4839 begin
4840 pragma Assert (Ekind_In (Id, E_Variable, E_Out_Parameter));
4841 Set_Flag219 (Id, V);
4842 end Set_Has_Initial_Value;
4844 procedure Set_Has_Loop_Entry_Attributes (Id : E; V : B := True) is
4845 begin
4846 pragma Assert (Ekind (Id) = E_Loop);
4847 Set_Flag260 (Id, V);
4848 end Set_Has_Loop_Entry_Attributes;
4850 procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True) is
4851 begin
4852 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
4853 Set_Flag83 (Id, V);
4854 end Set_Has_Machine_Radix_Clause;
4856 procedure Set_Has_Master_Entity (Id : E; V : B := True) is
4857 begin
4858 Set_Flag21 (Id, V);
4859 end Set_Has_Master_Entity;
4861 procedure Set_Has_Missing_Return (Id : E; V : B := True) is
4862 begin
4863 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
4864 Set_Flag142 (Id, V);
4865 end Set_Has_Missing_Return;
4867 procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True) is
4868 begin
4869 Set_Flag101 (Id, V);
4870 end Set_Has_Nested_Block_With_Handler;
4872 procedure Set_Has_Nested_Subprogram (Id : E; V : B := True) is
4873 begin
4874 pragma Assert (Is_Subprogram (Id));
4875 Set_Flag282 (Id, V);
4876 end Set_Has_Nested_Subprogram;
4878 procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
4879 begin
4880 pragma Assert (Id = Base_Type (Id));
4881 Set_Flag75 (Id, V);
4882 end Set_Has_Non_Standard_Rep;
4884 procedure Set_Has_Object_Size_Clause (Id : E; V : B := True) is
4885 begin
4886 pragma Assert (Is_Type (Id));
4887 Set_Flag172 (Id, V);
4888 end Set_Has_Object_Size_Clause;
4890 procedure Set_Has_Out_Or_In_Out_Parameter (Id : E; V : B := True) is
4891 begin
4892 pragma Assert
4893 (Ekind_In (Id, E_Entry, E_Entry_Family)
4894 or else Is_Subprogram_Or_Generic_Subprogram (Id));
4895 Set_Flag110 (Id, V);
4896 end Set_Has_Out_Or_In_Out_Parameter;
4898 procedure Set_Has_Own_DIC (Id : E; V : B := True) is
4899 begin
4900 pragma Assert (Is_Type (Id));
4901 Set_Flag3 (Base_Type (Id), V);
4902 end Set_Has_Own_DIC;
4904 procedure Set_Has_Own_Invariants (Id : E; V : B := True) is
4905 begin
4906 pragma Assert (Is_Type (Id));
4907 Set_Flag232 (Base_Type (Id), V);
4908 end Set_Has_Own_Invariants;
4910 procedure Set_Has_Partial_Visible_Refinement (Id : E; V : B := True) is
4911 begin
4912 pragma Assert (Ekind (Id) = E_Abstract_State);
4913 Set_Flag296 (Id, V);
4914 end Set_Has_Partial_Visible_Refinement;
4916 procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True) is
4917 begin
4918 Set_Flag154 (Id, V);
4919 end Set_Has_Per_Object_Constraint;
4921 procedure Set_Has_Pragma_Controlled (Id : E; V : B := True) is
4922 begin
4923 pragma Assert (Is_Access_Type (Id));
4924 Set_Flag27 (Base_Type (Id), V);
4925 end Set_Has_Pragma_Controlled;
4927 procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True) is
4928 begin
4929 Set_Flag150 (Id, V);
4930 end Set_Has_Pragma_Elaborate_Body;
4932 procedure Set_Has_Pragma_Inline (Id : E; V : B := True) is
4933 begin
4934 Set_Flag157 (Id, V);
4935 end Set_Has_Pragma_Inline;
4937 procedure Set_Has_Pragma_Inline_Always (Id : E; V : B := True) is
4938 begin
4939 Set_Flag230 (Id, V);
4940 end Set_Has_Pragma_Inline_Always;
4942 procedure Set_Has_Pragma_No_Inline (Id : E; V : B := True) is
4943 begin
4944 Set_Flag201 (Id, V);
4945 end Set_Has_Pragma_No_Inline;
4947 procedure Set_Has_Pragma_Ordered (Id : E; V : B := True) is
4948 begin
4949 pragma Assert (Is_Enumeration_Type (Id));
4950 pragma Assert (Id = Base_Type (Id));
4951 Set_Flag198 (Id, V);
4952 end Set_Has_Pragma_Ordered;
4954 procedure Set_Has_Pragma_Pack (Id : E; V : B := True) is
4955 begin
4956 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
4957 pragma Assert (Id = Base_Type (Id));
4958 Set_Flag121 (Id, V);
4959 end Set_Has_Pragma_Pack;
4961 procedure Set_Has_Pragma_Preelab_Init (Id : E; V : B := True) is
4962 begin
4963 Set_Flag221 (Id, V);
4964 end Set_Has_Pragma_Preelab_Init;
4966 procedure Set_Has_Pragma_Pure (Id : E; V : B := True) is
4967 begin
4968 Set_Flag203 (Id, V);
4969 end Set_Has_Pragma_Pure;
4971 procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True) is
4972 begin
4973 Set_Flag179 (Id, V);
4974 end Set_Has_Pragma_Pure_Function;
4976 procedure Set_Has_Pragma_Thread_Local_Storage (Id : E; V : B := True) is
4977 begin
4978 Set_Flag169 (Id, V);
4979 end Set_Has_Pragma_Thread_Local_Storage;
4981 procedure Set_Has_Pragma_Unmodified (Id : E; V : B := True) is
4982 begin
4983 Set_Flag233 (Id, V);
4984 end Set_Has_Pragma_Unmodified;
4986 procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True) is
4987 begin
4988 Set_Flag180 (Id, V);
4989 end Set_Has_Pragma_Unreferenced;
4991 procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True) is
4992 begin
4993 pragma Assert (Is_Type (Id));
4994 Set_Flag212 (Id, V);
4995 end Set_Has_Pragma_Unreferenced_Objects;
4997 procedure Set_Has_Pragma_Unused (Id : E; V : B := True) is
4998 begin
4999 Set_Flag294 (Id, V);
5000 end Set_Has_Pragma_Unused;
5002 procedure Set_Has_Predicates (Id : E; V : B := True) is
5003 begin
5004 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Void);
5005 Set_Flag250 (Id, V);
5006 end Set_Has_Predicates;
5008 procedure Set_Has_Primitive_Operations (Id : E; V : B := True) is
5009 begin
5010 pragma Assert (Id = Base_Type (Id));
5011 Set_Flag120 (Id, V);
5012 end Set_Has_Primitive_Operations;
5014 procedure Set_Has_Private_Ancestor (Id : E; V : B := True) is
5015 begin
5016 pragma Assert (Is_Type (Id));
5017 Set_Flag151 (Id, V);
5018 end Set_Has_Private_Ancestor;
5020 procedure Set_Has_Private_Declaration (Id : E; V : B := True) is
5021 begin
5022 Set_Flag155 (Id, V);
5023 end Set_Has_Private_Declaration;
5025 procedure Set_Has_Private_Extension (Id : E; V : B := True) is
5026 begin
5027 pragma Assert (Is_Tagged_Type (Id));
5028 Set_Flag300 (Id, V);
5029 end Set_Has_Private_Extension;
5031 procedure Set_Has_Protected (Id : E; V : B := True) is
5032 begin
5033 Set_Flag271 (Id, V);
5034 end Set_Has_Protected;
5036 procedure Set_Has_Qualified_Name (Id : E; V : B := True) is
5037 begin
5038 Set_Flag161 (Id, V);
5039 end Set_Has_Qualified_Name;
5041 procedure Set_Has_RACW (Id : E; V : B := True) is
5042 begin
5043 pragma Assert (Ekind (Id) = E_Package);
5044 Set_Flag214 (Id, V);
5045 end Set_Has_RACW;
5047 procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True) is
5048 begin
5049 pragma Assert (Id = Base_Type (Id));
5050 Set_Flag65 (Id, V);
5051 end Set_Has_Record_Rep_Clause;
5053 procedure Set_Has_Recursive_Call (Id : E; V : B := True) is
5054 begin
5055 pragma Assert (Is_Subprogram (Id));
5056 Set_Flag143 (Id, V);
5057 end Set_Has_Recursive_Call;
5059 procedure Set_Has_Shift_Operator (Id : E; V : B := True) is
5060 begin
5061 pragma Assert (Is_Integer_Type (Id) and then Is_Base_Type (Id));
5062 Set_Flag267 (Id, V);
5063 end Set_Has_Shift_Operator;
5065 procedure Set_Has_Size_Clause (Id : E; V : B := True) is
5066 begin
5067 Set_Flag29 (Id, V);
5068 end Set_Has_Size_Clause;
5070 procedure Set_Has_Small_Clause (Id : E; V : B := True) is
5071 begin
5072 pragma Assert (Is_Ordinary_Fixed_Point_Type (Id));
5073 Set_Flag67 (Id, V);
5074 end Set_Has_Small_Clause;
5076 procedure Set_Has_Specified_Layout (Id : E; V : B := True) is
5077 begin
5078 pragma Assert (Id = Base_Type (Id));
5079 Set_Flag100 (Id, V);
5080 end Set_Has_Specified_Layout;
5082 procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True) is
5083 begin
5084 pragma Assert (Is_Type (Id));
5085 Set_Flag190 (Id, V);
5086 end Set_Has_Specified_Stream_Input;
5088 procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True) is
5089 begin
5090 pragma Assert (Is_Type (Id));
5091 Set_Flag191 (Id, V);
5092 end Set_Has_Specified_Stream_Output;
5094 procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True) is
5095 begin
5096 pragma Assert (Is_Type (Id));
5097 Set_Flag192 (Id, V);
5098 end Set_Has_Specified_Stream_Read;
5100 procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True) is
5101 begin
5102 pragma Assert (Is_Type (Id));
5103 Set_Flag193 (Id, V);
5104 end Set_Has_Specified_Stream_Write;
5106 procedure Set_Has_Static_Discriminants (Id : E; V : B := True) is
5107 begin
5108 Set_Flag211 (Id, V);
5109 end Set_Has_Static_Discriminants;
5111 procedure Set_Has_Static_Predicate (Id : E; V : B := True) is
5112 begin
5113 pragma Assert (Is_Type (Id));
5114 Set_Flag269 (Id, V);
5115 end Set_Has_Static_Predicate;
5117 procedure Set_Has_Static_Predicate_Aspect (Id : E; V : B := True) is
5118 begin
5119 pragma Assert (Is_Type (Id));
5120 Set_Flag259 (Id, V);
5121 end Set_Has_Static_Predicate_Aspect;
5123 procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True) is
5124 begin
5125 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
5126 pragma Assert (Id = Base_Type (Id));
5127 Set_Flag23 (Id, V);
5128 end Set_Has_Storage_Size_Clause;
5130 procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True) is
5131 begin
5132 pragma Assert (Is_Elementary_Type (Id));
5133 Set_Flag184 (Id, V);
5134 end Set_Has_Stream_Size_Clause;
5136 procedure Set_Has_Task (Id : E; V : B := True) is
5137 begin
5138 pragma Assert (Id = Base_Type (Id));
5139 Set_Flag30 (Id, V);
5140 end Set_Has_Task;
5142 procedure Set_Has_Thunks (Id : E; V : B := True) is
5143 begin
5144 pragma Assert (Is_Tag (Id));
5145 Set_Flag228 (Id, V);
5146 end Set_Has_Thunks;
5148 procedure Set_Has_Timing_Event (Id : E; V : B := True) is
5149 begin
5150 pragma Assert (Id = Base_Type (Id));
5151 Set_Flag289 (Id, V);
5152 end Set_Has_Timing_Event;
5154 procedure Set_Has_Unchecked_Union (Id : E; V : B := True) is
5155 begin
5156 pragma Assert (Id = Base_Type (Id));
5157 Set_Flag123 (Id, V);
5158 end Set_Has_Unchecked_Union;
5160 procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True) is
5161 begin
5162 pragma Assert (Is_Type (Id));
5163 Set_Flag72 (Id, V);
5164 end Set_Has_Unknown_Discriminants;
5166 procedure Set_Has_Visible_Refinement (Id : E; V : B := True) is
5167 begin
5168 pragma Assert (Ekind (Id) = E_Abstract_State);
5169 Set_Flag263 (Id, V);
5170 end Set_Has_Visible_Refinement;
5172 procedure Set_Has_Volatile_Components (Id : E; V : B := True) is
5173 begin
5174 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
5175 Set_Flag87 (Id, V);
5176 end Set_Has_Volatile_Components;
5178 procedure Set_Has_Xref_Entry (Id : E; V : B := True) is
5179 begin
5180 Set_Flag182 (Id, V);
5181 end Set_Has_Xref_Entry;
5183 procedure Set_Hiding_Loop_Variable (Id : E; V : E) is
5184 begin
5185 pragma Assert (Ekind (Id) = E_Variable);
5186 Set_Node8 (Id, V);
5187 end Set_Hiding_Loop_Variable;
5189 procedure Set_Hidden_In_Formal_Instance (Id : E; V : L) is
5190 begin
5191 pragma Assert (Ekind (Id) = E_Package);
5192 Set_Elist30 (Id, V);
5193 end Set_Hidden_In_Formal_Instance;
5195 procedure Set_Homonym (Id : E; V : E) is
5196 begin
5197 pragma Assert (Id /= V);
5198 Set_Node4 (Id, V);
5199 end Set_Homonym;
5201 procedure Set_Incomplete_Actuals (Id : E; V : L) is
5202 begin
5203 pragma Assert (Ekind (Id) = E_Package);
5204 Set_Elist24 (Id, V);
5205 end Set_Incomplete_Actuals;
5207 procedure Set_Ignore_SPARK_Mode_Pragmas (Id : E; V : B := True) is
5208 begin
5209 pragma Assert
5210 (Ekind_In (Id, E_Protected_Body, -- concurrent types
5211 E_Protected_Type,
5212 E_Task_Body,
5213 E_Task_Type)
5214 or else
5215 Ekind_In (Id, E_Entry, -- overloadable
5216 E_Entry_Family,
5217 E_Function,
5218 E_Generic_Function,
5219 E_Generic_Procedure,
5220 E_Operator,
5221 E_Procedure,
5222 E_Subprogram_Body)
5223 or else
5224 Ekind_In (Id, E_Generic_Package, -- packages
5225 E_Package,
5226 E_Package_Body));
5227 Set_Flag301 (Id, V);
5228 end Set_Ignore_SPARK_Mode_Pragmas;
5230 procedure Set_Import_Pragma (Id : E; V : E) is
5231 begin
5232 pragma Assert (Is_Subprogram (Id));
5233 Set_Node35 (Id, V);
5234 end Set_Import_Pragma;
5236 procedure Set_Interface_Alias (Id : E; V : E) is
5237 begin
5238 pragma Assert
5239 (Is_Internal (Id)
5240 and then Is_Hidden (Id)
5241 and then (Ekind_In (Id, E_Procedure, E_Function)));
5242 Set_Node25 (Id, V);
5243 end Set_Interface_Alias;
5245 procedure Set_Interfaces (Id : E; V : L) is
5246 begin
5247 pragma Assert (Is_Record_Type (Id));
5248 Set_Elist25 (Id, V);
5249 end Set_Interfaces;
5251 procedure Set_In_Package_Body (Id : E; V : B := True) is
5252 begin
5253 Set_Flag48 (Id, V);
5254 end Set_In_Package_Body;
5256 procedure Set_In_Private_Part (Id : E; V : B := True) is
5257 begin
5258 Set_Flag45 (Id, V);
5259 end Set_In_Private_Part;
5261 procedure Set_In_Use (Id : E; V : B := True) is
5262 begin
5263 pragma Assert (Nkind (Id) in N_Entity);
5264 Set_Flag8 (Id, V);
5265 end Set_In_Use;
5267 procedure Set_Initialization_Statements (Id : E; V : N) is
5268 begin
5269 -- Tolerate an E_Void entity since this can be called while resolving
5270 -- an aggregate used as the initialization expression for an object
5271 -- declaration, and this occurs before the Ekind for the object is set.
5273 pragma Assert (Ekind_In (Id, E_Void, E_Constant, E_Variable));
5274 Set_Node28 (Id, V);
5275 end Set_Initialization_Statements;
5277 procedure Set_Inner_Instances (Id : E; V : L) is
5278 begin
5279 Set_Elist23 (Id, V);
5280 end Set_Inner_Instances;
5282 procedure Set_Interface_Name (Id : E; V : N) is
5283 begin
5284 Set_Node21 (Id, V);
5285 end Set_Interface_Name;
5287 procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True) is
5288 begin
5289 pragma Assert (Is_Overloadable (Id));
5290 Set_Flag19 (Id, V);
5291 end Set_Is_Abstract_Subprogram;
5293 procedure Set_Is_Abstract_Type (Id : E; V : B := True) is
5294 begin
5295 pragma Assert (Is_Type (Id));
5296 Set_Flag146 (Id, V);
5297 end Set_Is_Abstract_Type;
5299 procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
5300 begin
5301 pragma Assert (Is_Access_Type (Id));
5302 Set_Flag194 (Id, V);
5303 end Set_Is_Local_Anonymous_Access;
5305 procedure Set_Is_Access_Constant (Id : E; V : B := True) is
5306 begin
5307 pragma Assert (Is_Access_Type (Id));
5308 Set_Flag69 (Id, V);
5309 end Set_Is_Access_Constant;
5311 procedure Set_Is_Activation_Record (Id : E; V : B := True) is
5312 begin
5313 pragma Assert (Ekind (Id) = E_In_Parameter);
5314 Set_Flag305 (Id, V);
5315 end Set_Is_Activation_Record;
5317 procedure Set_Is_Actual_Subtype (Id : E; V : B := True) is
5318 begin
5319 pragma Assert (Is_Type (Id));
5320 Set_Flag293 (Id, V);
5321 end Set_Is_Actual_Subtype;
5323 procedure Set_Is_Ada_2005_Only (Id : E; V : B := True) is
5324 begin
5325 Set_Flag185 (Id, V);
5326 end Set_Is_Ada_2005_Only;
5328 procedure Set_Is_Ada_2012_Only (Id : E; V : B := True) is
5329 begin
5330 Set_Flag199 (Id, V);
5331 end Set_Is_Ada_2012_Only;
5333 procedure Set_Is_Aliased (Id : E; V : B := True) is
5334 begin
5335 pragma Assert (Nkind (Id) in N_Entity);
5336 Set_Flag15 (Id, V);
5337 end Set_Is_Aliased;
5339 procedure Set_Is_Asynchronous (Id : E; V : B := True) is
5340 begin
5341 pragma Assert
5342 (Ekind (Id) = E_Procedure or else Is_Type (Id));
5343 Set_Flag81 (Id, V);
5344 end Set_Is_Asynchronous;
5346 procedure Set_Is_Atomic (Id : E; V : B := True) is
5347 begin
5348 Set_Flag85 (Id, V);
5349 end Set_Is_Atomic;
5351 procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True) is
5352 begin
5353 pragma Assert ((not V)
5354 or else (Is_Array_Type (Id) and then Is_Base_Type (Id)));
5355 Set_Flag122 (Id, V);
5356 end Set_Is_Bit_Packed_Array;
5358 procedure Set_Is_Called (Id : E; V : B := True) is
5359 begin
5360 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
5361 Set_Flag102 (Id, V);
5362 end Set_Is_Called;
5364 procedure Set_Is_Character_Type (Id : E; V : B := True) is
5365 begin
5366 Set_Flag63 (Id, V);
5367 end Set_Is_Character_Type;
5369 procedure Set_Is_Checked_Ghost_Entity (Id : E; V : B := True) is
5370 begin
5371 -- Allow this attribute to appear on unanalyzed entities
5373 pragma Assert (Nkind (Id) in N_Entity
5374 or else Ekind (Id) = E_Void);
5375 Set_Flag277 (Id, V);
5376 end Set_Is_Checked_Ghost_Entity;
5378 procedure Set_Is_Child_Unit (Id : E; V : B := True) is
5379 begin
5380 Set_Flag73 (Id, V);
5381 end Set_Is_Child_Unit;
5383 procedure Set_Is_Class_Wide_Clone (Id : E; V : B := True) is
5384 begin
5385 Set_Flag290 (Id, V);
5386 end Set_Is_Class_Wide_Clone;
5388 procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True) is
5389 begin
5390 Set_Flag35 (Id, V);
5391 end Set_Is_Class_Wide_Equivalent_Type;
5393 procedure Set_Is_Compilation_Unit (Id : E; V : B := True) is
5394 begin
5395 Set_Flag149 (Id, V);
5396 end Set_Is_Compilation_Unit;
5398 procedure Set_Is_Completely_Hidden (Id : E; V : B := True) is
5399 begin
5400 pragma Assert (Ekind (Id) = E_Discriminant);
5401 Set_Flag103 (Id, V);
5402 end Set_Is_Completely_Hidden;
5404 procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True) is
5405 begin
5406 Set_Flag20 (Id, V);
5407 end Set_Is_Concurrent_Record_Type;
5409 procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True) is
5410 begin
5411 Set_Flag80 (Id, V);
5412 end Set_Is_Constr_Subt_For_U_Nominal;
5414 procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True) is
5415 begin
5416 Set_Flag141 (Id, V);
5417 end Set_Is_Constr_Subt_For_UN_Aliased;
5419 procedure Set_Is_Constrained (Id : E; V : B := True) is
5420 begin
5421 pragma Assert (Nkind (Id) in N_Entity);
5422 Set_Flag12 (Id, V);
5423 end Set_Is_Constrained;
5425 procedure Set_Is_Constructor (Id : E; V : B := True) is
5426 begin
5427 Set_Flag76 (Id, V);
5428 end Set_Is_Constructor;
5430 procedure Set_Is_Controlled_Active (Id : E; V : B := True) is
5431 begin
5432 pragma Assert (Id = Base_Type (Id));
5433 Set_Flag42 (Id, V);
5434 end Set_Is_Controlled_Active;
5436 procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is
5437 begin
5438 pragma Assert (Is_Formal (Id));
5439 Set_Flag97 (Id, V);
5440 end Set_Is_Controlling_Formal;
5442 procedure Set_Is_CPP_Class (Id : E; V : B := True) is
5443 begin
5444 Set_Flag74 (Id, V);
5445 end Set_Is_CPP_Class;
5447 procedure Set_Is_DIC_Procedure (Id : E; V : B := True) is
5448 begin
5449 pragma Assert (Ekind (Id) = E_Procedure);
5450 Set_Flag132 (Id, V);
5451 end Set_Is_DIC_Procedure;
5453 procedure Set_Is_Descendant_Of_Address (Id : E; V : B := True) is
5454 begin
5455 pragma Assert (Is_Type (Id));
5456 Set_Flag223 (Id, V);
5457 end Set_Is_Descendant_Of_Address;
5459 procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True) is
5460 begin
5461 Set_Flag176 (Id, V);
5462 end Set_Is_Discrim_SO_Function;
5464 procedure Set_Is_Discriminant_Check_Function (Id : E; V : B := True) is
5465 begin
5466 Set_Flag264 (Id, V);
5467 end Set_Is_Discriminant_Check_Function;
5469 procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True) is
5470 begin
5471 Set_Flag234 (Id, V);
5472 end Set_Is_Dispatch_Table_Entity;
5474 procedure Set_Is_Dispatching_Operation (Id : E; V : B := True) is
5475 begin
5476 pragma Assert
5477 (V = False
5478 or else
5479 Is_Overloadable (Id)
5480 or else
5481 Ekind (Id) = E_Subprogram_Type);
5483 Set_Flag6 (Id, V);
5484 end Set_Is_Dispatching_Operation;
5486 procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True) is
5487 begin
5488 pragma Assert (Is_Elaboration_Target (Id));
5489 Set_Flag148 (Id, V);
5490 end Set_Is_Elaboration_Checks_OK_Id;
5492 procedure Set_Is_Elaboration_Warnings_OK_Id (Id : E; V : B := True) is
5493 begin
5494 pragma Assert (Is_Elaboration_Target (Id));
5495 Set_Flag304 (Id, V);
5496 end Set_Is_Elaboration_Warnings_OK_Id;
5498 procedure Set_Is_Eliminated (Id : E; V : B := True) is
5499 begin
5500 Set_Flag124 (Id, V);
5501 end Set_Is_Eliminated;
5503 procedure Set_Is_Entry_Formal (Id : E; V : B := True) is
5504 begin
5505 Set_Flag52 (Id, V);
5506 end Set_Is_Entry_Formal;
5508 procedure Set_Is_Entry_Wrapper (Id : E; V : B := True) is
5509 begin
5510 Set_Flag297 (Id, V);
5511 end Set_Is_Entry_Wrapper;
5513 procedure Set_Is_Exception_Handler (Id : E; V : B := True) is
5514 begin
5515 pragma Assert (Ekind (Id) = E_Block);
5516 Set_Flag286 (Id, V);
5517 end Set_Is_Exception_Handler;
5519 procedure Set_Is_Exported (Id : E; V : B := True) is
5520 begin
5521 Set_Flag99 (Id, V);
5522 end Set_Is_Exported;
5524 procedure Set_Is_Finalized_Transient (Id : E; V : B := True) is
5525 begin
5526 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
5527 Set_Flag252 (Id, V);
5528 end Set_Is_Finalized_Transient;
5530 procedure Set_Is_First_Subtype (Id : E; V : B := True) is
5531 begin
5532 Set_Flag70 (Id, V);
5533 end Set_Is_First_Subtype;
5535 procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is
5536 begin
5537 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
5538 Set_Flag118 (Id, V);
5539 end Set_Is_For_Access_Subtype;
5541 procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is
5542 begin
5543 Set_Flag111 (Id, V);
5544 end Set_Is_Formal_Subprogram;
5546 procedure Set_Is_Frozen (Id : E; V : B := True) is
5547 begin
5548 pragma Assert (Nkind (Id) in N_Entity);
5549 Set_Flag4 (Id, V);
5550 end Set_Is_Frozen;
5552 procedure Set_Is_Generic_Actual_Subprogram (Id : E; V : B := True) is
5553 begin
5554 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5555 Set_Flag274 (Id, V);
5556 end Set_Is_Generic_Actual_Subprogram;
5558 procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True) is
5559 begin
5560 pragma Assert (Is_Type (Id));
5561 Set_Flag94 (Id, V);
5562 end Set_Is_Generic_Actual_Type;
5564 procedure Set_Is_Generic_Instance (Id : E; V : B := True) is
5565 begin
5566 Set_Flag130 (Id, V);
5567 end Set_Is_Generic_Instance;
5569 procedure Set_Is_Generic_Type (Id : E; V : B := True) is
5570 begin
5571 pragma Assert (Nkind (Id) in N_Entity);
5572 Set_Flag13 (Id, V);
5573 end Set_Is_Generic_Type;
5575 procedure Set_Is_Hidden (Id : E; V : B := True) is
5576 begin
5577 Set_Flag57 (Id, V);
5578 end Set_Is_Hidden;
5580 procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True) is
5581 begin
5582 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5583 Set_Flag2 (Id, V);
5584 end Set_Is_Hidden_Non_Overridden_Subpgm;
5586 procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True) is
5587 begin
5588 Set_Flag171 (Id, V);
5589 end Set_Is_Hidden_Open_Scope;
5591 procedure Set_Is_Ignored_Ghost_Entity (Id : E; V : B := True) is
5592 begin
5593 -- Allow this attribute to appear on unanalyzed entities
5595 pragma Assert (Nkind (Id) in N_Entity
5596 or else Ekind (Id) = E_Void);
5597 Set_Flag278 (Id, V);
5598 end Set_Is_Ignored_Ghost_Entity;
5600 procedure Set_Is_Ignored_Transient (Id : E; V : B := True) is
5601 begin
5602 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
5603 Set_Flag295 (Id, V);
5604 end Set_Is_Ignored_Transient;
5606 procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is
5607 begin
5608 pragma Assert (Nkind (Id) in N_Entity);
5609 Set_Flag7 (Id, V);
5610 end Set_Is_Immediately_Visible;
5612 procedure Set_Is_Implementation_Defined (Id : E; V : B := True) is
5613 begin
5614 Set_Flag254 (Id, V);
5615 end Set_Is_Implementation_Defined;
5617 procedure Set_Is_Imported (Id : E; V : B := True) is
5618 begin
5619 Set_Flag24 (Id, V);
5620 end Set_Is_Imported;
5622 procedure Set_Is_Independent (Id : E; V : B := True) is
5623 begin
5624 Set_Flag268 (Id, V);
5625 end Set_Is_Independent;
5627 procedure Set_Is_Initial_Condition_Procedure (Id : E; V : B := True) is
5628 begin
5629 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5630 Set_Flag302 (Id, V);
5631 end Set_Is_Initial_Condition_Procedure;
5633 procedure Set_Is_Inlined (Id : E; V : B := True) is
5634 begin
5635 Set_Flag11 (Id, V);
5636 end Set_Is_Inlined;
5638 procedure Set_Is_Inlined_Always (Id : E; V : B := True) is
5639 begin
5640 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5641 Set_Flag1 (Id, V);
5642 end Set_Is_Inlined_Always;
5644 procedure Set_Is_Interface (Id : E; V : B := True) is
5645 begin
5646 pragma Assert (Is_Record_Type (Id));
5647 Set_Flag186 (Id, V);
5648 end Set_Is_Interface;
5650 procedure Set_Is_Instantiated (Id : E; V : B := True) is
5651 begin
5652 Set_Flag126 (Id, V);
5653 end Set_Is_Instantiated;
5655 procedure Set_Is_Internal (Id : E; V : B := True) is
5656 begin
5657 pragma Assert (Nkind (Id) in N_Entity);
5658 Set_Flag17 (Id, V);
5659 end Set_Is_Internal;
5661 procedure Set_Is_Interrupt_Handler (Id : E; V : B := True) is
5662 begin
5663 pragma Assert (Nkind (Id) in N_Entity);
5664 Set_Flag89 (Id, V);
5665 end Set_Is_Interrupt_Handler;
5667 procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True) is
5668 begin
5669 Set_Flag64 (Id, V);
5670 end Set_Is_Intrinsic_Subprogram;
5672 procedure Set_Is_Invariant_Procedure (Id : E; V : B := True) is
5673 begin
5674 pragma Assert (Ekind (Id) = E_Procedure);
5675 Set_Flag257 (Id, V);
5676 end Set_Is_Invariant_Procedure;
5678 procedure Set_Is_Itype (Id : E; V : B := True) is
5679 begin
5680 Set_Flag91 (Id, V);
5681 end Set_Is_Itype;
5683 procedure Set_Is_Known_Non_Null (Id : E; V : B := True) is
5684 begin
5685 Set_Flag37 (Id, V);
5686 end Set_Is_Known_Non_Null;
5688 procedure Set_Is_Known_Null (Id : E; V : B := True) is
5689 begin
5690 Set_Flag204 (Id, V);
5691 end Set_Is_Known_Null;
5693 procedure Set_Is_Known_Valid (Id : E; V : B := True) is
5694 begin
5695 Set_Flag170 (Id, V);
5696 end Set_Is_Known_Valid;
5698 procedure Set_Is_Limited_Composite (Id : E; V : B := True) is
5699 begin
5700 pragma Assert (Is_Type (Id));
5701 Set_Flag106 (Id, V);
5702 end Set_Is_Limited_Composite;
5704 procedure Set_Is_Limited_Interface (Id : E; V : B := True) is
5705 begin
5706 pragma Assert (Is_Interface (Id));
5707 Set_Flag197 (Id, V);
5708 end Set_Is_Limited_Interface;
5710 procedure Set_Is_Limited_Record (Id : E; V : B := True) is
5711 begin
5712 Set_Flag25 (Id, V);
5713 end Set_Is_Limited_Record;
5715 procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is
5716 begin
5717 pragma Assert (Is_Subprogram (Id));
5718 Set_Flag137 (Id, V);
5719 end Set_Is_Machine_Code_Subprogram;
5721 procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True) is
5722 begin
5723 pragma Assert (Is_Type (Id));
5724 Set_Flag109 (Id, V);
5725 end Set_Is_Non_Static_Subtype;
5727 procedure Set_Is_Null_Init_Proc (Id : E; V : B := True) is
5728 begin
5729 pragma Assert (Ekind (Id) = E_Procedure);
5730 Set_Flag178 (Id, V);
5731 end Set_Is_Null_Init_Proc;
5733 procedure Set_Is_Obsolescent (Id : E; V : B := True) is
5734 begin
5735 Set_Flag153 (Id, V);
5736 end Set_Is_Obsolescent;
5738 procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True) is
5739 begin
5740 pragma Assert (Ekind (Id) = E_Out_Parameter);
5741 Set_Flag226 (Id, V);
5742 end Set_Is_Only_Out_Parameter;
5744 procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is
5745 begin
5746 Set_Flag160 (Id, V);
5747 end Set_Is_Package_Body_Entity;
5749 procedure Set_Is_Packed (Id : E; V : B := True) is
5750 begin
5751 pragma Assert (Id = Base_Type (Id));
5752 Set_Flag51 (Id, V);
5753 end Set_Is_Packed;
5755 procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True) is
5756 begin
5757 Set_Flag138 (Id, V);
5758 end Set_Is_Packed_Array_Impl_Type;
5760 procedure Set_Is_Param_Block_Component_Type (Id : E; V : B := True) is
5761 begin
5762 pragma Assert (Ekind_In (Id, E_Void, E_General_Access_Type));
5763 Set_Flag215 (Id, V);
5764 end Set_Is_Param_Block_Component_Type;
5766 procedure Set_Is_Partial_Invariant_Procedure (Id : E; V : B := True) is
5767 begin
5768 pragma Assert (Ekind (Id) = E_Procedure);
5769 Set_Flag292 (Id, V);
5770 end Set_Is_Partial_Invariant_Procedure;
5772 procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is
5773 begin
5774 pragma Assert (Nkind (Id) in N_Entity);
5775 Set_Flag9 (Id, V);
5776 end Set_Is_Potentially_Use_Visible;
5778 procedure Set_Is_Predicate_Function (Id : E; V : B := True) is
5779 begin
5780 pragma Assert (Ekind (Id) = E_Function);
5781 Set_Flag255 (Id, V);
5782 end Set_Is_Predicate_Function;
5784 procedure Set_Is_Predicate_Function_M (Id : E; V : B := True) is
5785 begin
5786 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5787 Set_Flag256 (Id, V);
5788 end Set_Is_Predicate_Function_M;
5790 procedure Set_Is_Preelaborated (Id : E; V : B := True) is
5791 begin
5792 Set_Flag59 (Id, V);
5793 end Set_Is_Preelaborated;
5795 procedure Set_Is_Primitive (Id : E; V : B := True) is
5796 begin
5797 pragma Assert
5798 (Is_Overloadable (Id)
5799 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
5800 Set_Flag218 (Id, V);
5801 end Set_Is_Primitive;
5803 procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is
5804 begin
5805 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5806 Set_Flag195 (Id, V);
5807 end Set_Is_Primitive_Wrapper;
5809 procedure Set_Is_Private_Composite (Id : E; V : B := True) is
5810 begin
5811 pragma Assert (Is_Type (Id));
5812 Set_Flag107 (Id, V);
5813 end Set_Is_Private_Composite;
5815 procedure Set_Is_Private_Descendant (Id : E; V : B := True) is
5816 begin
5817 Set_Flag53 (Id, V);
5818 end Set_Is_Private_Descendant;
5820 procedure Set_Is_Private_Primitive (Id : E; V : B := True) is
5821 begin
5822 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5823 Set_Flag245 (Id, V);
5824 end Set_Is_Private_Primitive;
5826 procedure Set_Is_Public (Id : E; V : B := True) is
5827 begin
5828 pragma Assert (Nkind (Id) in N_Entity);
5829 Set_Flag10 (Id, V);
5830 end Set_Is_Public;
5832 procedure Set_Is_Pure (Id : E; V : B := True) is
5833 begin
5834 Set_Flag44 (Id, V);
5835 end Set_Is_Pure;
5837 procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True) is
5838 begin
5839 pragma Assert (Is_Access_Type (Id));
5840 Set_Flag189 (Id, V);
5841 end Set_Is_Pure_Unit_Access_Type;
5843 procedure Set_Is_RACW_Stub_Type (Id : E; V : B := True) is
5844 begin
5845 pragma Assert (Is_Type (Id));
5846 Set_Flag244 (Id, V);
5847 end Set_Is_RACW_Stub_Type;
5849 procedure Set_Is_Raised (Id : E; V : B := True) is
5850 begin
5851 pragma Assert (Ekind (Id) = E_Exception);
5852 Set_Flag224 (Id, V);
5853 end Set_Is_Raised;
5855 procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True) is
5856 begin
5857 Set_Flag62 (Id, V);
5858 end Set_Is_Remote_Call_Interface;
5860 procedure Set_Is_Remote_Types (Id : E; V : B := True) is
5861 begin
5862 Set_Flag61 (Id, V);
5863 end Set_Is_Remote_Types;
5865 procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True) is
5866 begin
5867 Set_Flag112 (Id, V);
5868 end Set_Is_Renaming_Of_Object;
5870 procedure Set_Is_Return_Object (Id : E; V : B := True) is
5871 begin
5872 Set_Flag209 (Id, V);
5873 end Set_Is_Return_Object;
5875 procedure Set_Is_Safe_To_Reevaluate (Id : E; V : B := True) is
5876 begin
5877 pragma Assert (Ekind (Id) = E_Variable);
5878 Set_Flag249 (Id, V);
5879 end Set_Is_Safe_To_Reevaluate;
5881 procedure Set_Is_Shared_Passive (Id : E; V : B := True) is
5882 begin
5883 Set_Flag60 (Id, V);
5884 end Set_Is_Shared_Passive;
5886 procedure Set_Is_Static_Type (Id : E; V : B := True) is
5887 begin
5888 pragma Assert (Is_Type (Id));
5889 Set_Flag281 (Id, V);
5890 end Set_Is_Static_Type;
5892 procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is
5893 begin
5894 pragma Assert
5895 (Is_Type (Id)
5896 or else Ekind_In (Id, E_Exception,
5897 E_Variable,
5898 E_Constant,
5899 E_Void));
5900 Set_Flag28 (Id, V);
5901 end Set_Is_Statically_Allocated;
5903 procedure Set_Is_Tag (Id : E; V : B := True) is
5904 begin
5905 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
5906 Set_Flag78 (Id, V);
5907 end Set_Is_Tag;
5909 procedure Set_Is_Tagged_Type (Id : E; V : B := True) is
5910 begin
5911 Set_Flag55 (Id, V);
5912 end Set_Is_Tagged_Type;
5914 procedure Set_Is_Thunk (Id : E; V : B := True) is
5915 begin
5916 pragma Assert (Is_Subprogram (Id));
5917 Set_Flag225 (Id, V);
5918 end Set_Is_Thunk;
5920 procedure Set_Is_Trivial_Subprogram (Id : E; V : B := True) is
5921 begin
5922 Set_Flag235 (Id, V);
5923 end Set_Is_Trivial_Subprogram;
5925 procedure Set_Is_True_Constant (Id : E; V : B := True) is
5926 begin
5927 Set_Flag163 (Id, V);
5928 end Set_Is_True_Constant;
5930 procedure Set_Is_Unchecked_Union (Id : E; V : B := True) is
5931 begin
5932 pragma Assert (Id = Base_Type (Id));
5933 Set_Flag117 (Id, V);
5934 end Set_Is_Unchecked_Union;
5936 procedure Set_Is_Underlying_Full_View (Id : E; V : B := True) is
5937 begin
5938 pragma Assert (Is_Type (Id));
5939 Set_Flag298 (Id, V);
5940 end Set_Is_Underlying_Full_View;
5942 procedure Set_Is_Underlying_Record_View (Id : E; V : B := True) is
5943 begin
5944 pragma Assert (Ekind (Id) = E_Record_Type);
5945 Set_Flag246 (Id, V);
5946 end Set_Is_Underlying_Record_View;
5948 procedure Set_Is_Unimplemented (Id : E; V : B := True) is
5949 begin
5950 Set_Flag284 (Id, V);
5951 end Set_Is_Unimplemented;
5953 procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
5954 begin
5955 pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
5956 Set_Flag144 (Id, V);
5957 end Set_Is_Unsigned_Type;
5959 procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is
5960 begin
5961 pragma Assert
5962 (Ekind_In (Id, E_Constant, E_Variable, E_Discriminant)
5963 or else Is_Formal (Id)
5964 or else Is_Type (Id));
5965 Set_Flag283 (Id, V);
5966 end Set_Is_Uplevel_Referenced_Entity;
5968 procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
5969 begin
5970 pragma Assert (Ekind (Id) = E_Procedure);
5971 Set_Flag127 (Id, V);
5972 end Set_Is_Valued_Procedure;
5974 procedure Set_Is_Visible_Formal (Id : E; V : B := True) is
5975 begin
5976 Set_Flag206 (Id, V);
5977 end Set_Is_Visible_Formal;
5979 procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True) is
5980 begin
5981 Set_Flag116 (Id, V);
5982 end Set_Is_Visible_Lib_Unit;
5984 procedure Set_Is_Volatile (Id : E; V : B := True) is
5985 begin
5986 pragma Assert (Nkind (Id) in N_Entity);
5987 Set_Flag16 (Id, V);
5988 end Set_Is_Volatile;
5990 procedure Set_Is_Volatile_Full_Access (Id : E; V : B := True) is
5991 begin
5992 Set_Flag285 (Id, V);
5993 end Set_Is_Volatile_Full_Access;
5995 procedure Set_Itype_Printed (Id : E; V : B := True) is
5996 begin
5997 pragma Assert (Is_Itype (Id));
5998 Set_Flag202 (Id, V);
5999 end Set_Itype_Printed;
6001 procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is
6002 begin
6003 Set_Flag32 (Id, V);
6004 end Set_Kill_Elaboration_Checks;
6006 procedure Set_Kill_Range_Checks (Id : E; V : B := True) is
6007 begin
6008 Set_Flag33 (Id, V);
6009 end Set_Kill_Range_Checks;
6011 procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True) is
6012 begin
6013 pragma Assert (Is_Type (Id));
6014 Set_Flag207 (Id, V);
6015 end Set_Known_To_Have_Preelab_Init;
6017 procedure Set_Last_Aggregate_Assignment (Id : E; V : N) is
6018 begin
6019 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
6020 Set_Node30 (Id, V);
6021 end Set_Last_Aggregate_Assignment;
6023 procedure Set_Last_Assignment (Id : E; V : N) is
6024 begin
6025 pragma Assert (Is_Assignable (Id));
6026 Set_Node26 (Id, V);
6027 end Set_Last_Assignment;
6029 procedure Set_Last_Entity (Id : E; V : E) is
6030 begin
6031 Set_Node20 (Id, V);
6032 end Set_Last_Entity;
6034 procedure Set_Limited_View (Id : E; V : E) is
6035 begin
6036 pragma Assert (Ekind (Id) = E_Package);
6037 Set_Node23 (Id, V);
6038 end Set_Limited_View;
6040 procedure Set_Linker_Section_Pragma (Id : E; V : N) is
6041 begin
6042 pragma Assert
6043 (Is_Object (Id) or else Is_Subprogram (Id) or else Is_Type (Id));
6044 Set_Node33 (Id, V);
6045 end Set_Linker_Section_Pragma;
6047 procedure Set_Lit_Indexes (Id : E; V : E) is
6048 begin
6049 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
6050 Set_Node18 (Id, V);
6051 end Set_Lit_Indexes;
6053 procedure Set_Lit_Strings (Id : E; V : E) is
6054 begin
6055 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
6056 Set_Node16 (Id, V);
6057 end Set_Lit_Strings;
6059 procedure Set_Low_Bound_Tested (Id : E; V : B := True) is
6060 begin
6061 pragma Assert (Is_Formal (Id));
6062 Set_Flag205 (Id, V);
6063 end Set_Low_Bound_Tested;
6065 procedure Set_Machine_Radix_10 (Id : E; V : B := True) is
6066 begin
6067 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
6068 Set_Flag84 (Id, V);
6069 end Set_Machine_Radix_10;
6071 procedure Set_Master_Id (Id : E; V : E) is
6072 begin
6073 pragma Assert (Is_Access_Type (Id));
6074 Set_Node17 (Id, V);
6075 end Set_Master_Id;
6077 procedure Set_Materialize_Entity (Id : E; V : B := True) is
6078 begin
6079 Set_Flag168 (Id, V);
6080 end Set_Materialize_Entity;
6082 procedure Set_May_Inherit_Delayed_Rep_Aspects (Id : E; V : B := True) is
6083 begin
6084 Set_Flag262 (Id, V);
6085 end Set_May_Inherit_Delayed_Rep_Aspects;
6087 procedure Set_Mechanism (Id : E; V : M) is
6088 begin
6089 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
6090 Set_Uint8 (Id, UI_From_Int (V));
6091 end Set_Mechanism;
6093 procedure Set_Modulus (Id : E; V : U) is
6094 begin
6095 pragma Assert (Ekind (Id) = E_Modular_Integer_Type);
6096 Set_Uint17 (Id, V);
6097 end Set_Modulus;
6099 procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True) is
6100 begin
6101 pragma Assert (Is_Type (Id));
6102 Set_Flag183 (Id, V);
6103 end Set_Must_Be_On_Byte_Boundary;
6105 procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True) is
6106 begin
6107 pragma Assert (Is_Type (Id));
6108 Set_Flag208 (Id, V);
6109 end Set_Must_Have_Preelab_Init;
6111 procedure Set_Needs_Debug_Info (Id : E; V : B := True) is
6112 begin
6113 Set_Flag147 (Id, V);
6114 end Set_Needs_Debug_Info;
6116 procedure Set_Needs_No_Actuals (Id : E; V : B := True) is
6117 begin
6118 pragma Assert
6119 (Is_Overloadable (Id)
6120 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
6121 Set_Flag22 (Id, V);
6122 end Set_Needs_No_Actuals;
6124 procedure Set_Never_Set_In_Source (Id : E; V : B := True) is
6125 begin
6126 Set_Flag115 (Id, V);
6127 end Set_Never_Set_In_Source;
6129 procedure Set_Next_Inlined_Subprogram (Id : E; V : E) is
6130 begin
6131 Set_Node12 (Id, V);
6132 end Set_Next_Inlined_Subprogram;
6134 procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True) is
6135 begin
6136 pragma Assert (Is_Discrete_Type (Id));
6137 Set_Flag276 (Id, V);
6138 end Set_No_Dynamic_Predicate_On_Actual;
6140 procedure Set_No_Pool_Assigned (Id : E; V : B := True) is
6141 begin
6142 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
6143 Set_Flag131 (Id, V);
6144 end Set_No_Pool_Assigned;
6146 procedure Set_No_Predicate_On_Actual (Id : E; V : B := True) is
6147 begin
6148 pragma Assert (Is_Discrete_Type (Id));
6149 Set_Flag275 (Id, V);
6150 end Set_No_Predicate_On_Actual;
6152 procedure Set_No_Reordering (Id : E; V : B := True) is
6153 begin
6154 pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id));
6155 Set_Flag239 (Id, V);
6156 end Set_No_Reordering;
6158 procedure Set_No_Return (Id : E; V : B := True) is
6159 begin
6160 pragma Assert
6161 (V = False or else Ekind_In (Id, E_Procedure, E_Generic_Procedure));
6162 Set_Flag113 (Id, V);
6163 end Set_No_Return;
6165 procedure Set_No_Strict_Aliasing (Id : E; V : B := True) is
6166 begin
6167 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
6168 Set_Flag136 (Id, V);
6169 end Set_No_Strict_Aliasing;
6171 procedure Set_No_Tagged_Streams_Pragma (Id : E; V : E) is
6172 begin
6173 pragma Assert (Is_Tagged_Type (Id));
6174 Set_Node32 (Id, V);
6175 end Set_No_Tagged_Streams_Pragma;
6177 procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
6178 begin
6179 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
6180 Set_Flag58 (Id, V);
6181 end Set_Non_Binary_Modulus;
6183 procedure Set_Non_Limited_View (Id : E; V : E) is
6184 begin
6185 pragma Assert
6186 (Ekind (Id) in Incomplete_Kind
6187 or else Ekind_In (Id, E_Abstract_State, E_Class_Wide_Type));
6188 Set_Node19 (Id, V);
6189 end Set_Non_Limited_View;
6191 procedure Set_Nonzero_Is_True (Id : E; V : B := True) is
6192 begin
6193 pragma Assert
6194 (Root_Type (Id) = Standard_Boolean
6195 and then Ekind (Id) = E_Enumeration_Type);
6196 Set_Flag162 (Id, V);
6197 end Set_Nonzero_Is_True;
6199 procedure Set_Normalized_First_Bit (Id : E; V : U) is
6200 begin
6201 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
6202 Set_Uint8 (Id, V);
6203 end Set_Normalized_First_Bit;
6205 procedure Set_Normalized_Position (Id : E; V : U) is
6206 begin
6207 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
6208 Set_Uint14 (Id, V);
6209 end Set_Normalized_Position;
6211 procedure Set_Normalized_Position_Max (Id : E; V : U) is
6212 begin
6213 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
6214 Set_Uint10 (Id, V);
6215 end Set_Normalized_Position_Max;
6217 procedure Set_OK_To_Rename (Id : E; V : B := True) is
6218 begin
6219 pragma Assert (Ekind (Id) = E_Variable);
6220 Set_Flag247 (Id, V);
6221 end Set_OK_To_Rename;
6223 procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is
6224 begin
6225 pragma Assert
6226 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
6227 Set_Flag241 (Id, V);
6228 end Set_Optimize_Alignment_Space;
6230 procedure Set_Optimize_Alignment_Time (Id : E; V : B := True) is
6231 begin
6232 pragma Assert
6233 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
6234 Set_Flag242 (Id, V);
6235 end Set_Optimize_Alignment_Time;
6237 procedure Set_Original_Access_Type (Id : E; V : E) is
6238 begin
6239 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
6240 Set_Node28 (Id, V);
6241 end Set_Original_Access_Type;
6243 procedure Set_Original_Array_Type (Id : E; V : E) is
6244 begin
6245 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
6246 Set_Node21 (Id, V);
6247 end Set_Original_Array_Type;
6249 procedure Set_Original_Protected_Subprogram (Id : E; V : N) is
6250 begin
6251 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
6252 Set_Node41 (Id, V);
6253 end Set_Original_Protected_Subprogram;
6255 procedure Set_Original_Record_Component (Id : E; V : E) is
6256 begin
6257 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
6258 Set_Node22 (Id, V);
6259 end Set_Original_Record_Component;
6261 procedure Set_Overlays_Constant (Id : E; V : B := True) is
6262 begin
6263 Set_Flag243 (Id, V);
6264 end Set_Overlays_Constant;
6266 procedure Set_Overridden_Operation (Id : E; V : E) is
6267 begin
6268 pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
6269 Set_Node26 (Id, V);
6270 end Set_Overridden_Operation;
6272 procedure Set_Package_Instantiation (Id : E; V : N) is
6273 begin
6274 pragma Assert (Ekind_In (Id, E_Void, E_Generic_Package, E_Package));
6275 Set_Node26 (Id, V);
6276 end Set_Package_Instantiation;
6278 procedure Set_Packed_Array_Impl_Type (Id : E; V : E) is
6279 begin
6280 pragma Assert (Is_Array_Type (Id));
6281 Set_Node23 (Id, V);
6282 end Set_Packed_Array_Impl_Type;
6284 procedure Set_Parent_Subtype (Id : E; V : E) is
6285 begin
6286 pragma Assert (Ekind (Id) = E_Record_Type);
6287 Set_Node19 (Id, V);
6288 end Set_Parent_Subtype;
6290 procedure Set_Part_Of_Constituents (Id : E; V : L) is
6291 begin
6292 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
6293 Set_Elist10 (Id, V);
6294 end Set_Part_Of_Constituents;
6296 procedure Set_Part_Of_References (Id : E; V : L) is
6297 begin
6298 pragma Assert (Ekind (Id) = E_Variable);
6299 Set_Elist11 (Id, V);
6300 end Set_Part_Of_References;
6302 procedure Set_Partial_View_Has_Unknown_Discr (Id : E; V : B := True) is
6303 begin
6304 pragma Assert (Is_Type (Id));
6305 Set_Flag280 (Id, V);
6306 end Set_Partial_View_Has_Unknown_Discr;
6308 procedure Set_Pending_Access_Types (Id : E; V : L) is
6309 begin
6310 pragma Assert (Is_Type (Id));
6311 Set_Elist15 (Id, V);
6312 end Set_Pending_Access_Types;
6314 procedure Set_Postconditions_Proc (Id : E; V : E) is
6315 begin
6316 pragma Assert (Ekind_In (Id, E_Entry,
6317 E_Entry_Family,
6318 E_Function,
6319 E_Procedure));
6320 Set_Node14 (Id, V);
6321 end Set_Postconditions_Proc;
6323 procedure Set_Predicated_Parent (Id : E; V : E) is
6324 begin
6325 pragma Assert (Ekind_In (Id, E_Array_Subtype,
6326 E_Record_Subtype,
6327 E_Record_Subtype_With_Private));
6328 Set_Node38 (Id, V);
6329 end Set_Predicated_Parent;
6331 procedure Set_Predicates_Ignored (Id : E; V : B) is
6332 begin
6333 pragma Assert (Is_Type (Id));
6334 Set_Flag288 (Id, V);
6335 end Set_Predicates_Ignored;
6337 procedure Set_Direct_Primitive_Operations (Id : E; V : L) is
6338 begin
6339 pragma Assert (Is_Tagged_Type (Id));
6340 Set_Elist10 (Id, V);
6341 end Set_Direct_Primitive_Operations;
6343 procedure Set_Prival (Id : E; V : E) is
6344 begin
6345 pragma Assert (Is_Protected_Component (Id));
6346 Set_Node17 (Id, V);
6347 end Set_Prival;
6349 procedure Set_Prival_Link (Id : E; V : E) is
6350 begin
6351 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
6352 Set_Node20 (Id, V);
6353 end Set_Prival_Link;
6355 procedure Set_Private_Dependents (Id : E; V : L) is
6356 begin
6357 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
6358 Set_Elist18 (Id, V);
6359 end Set_Private_Dependents;
6361 procedure Set_Private_View (Id : E; V : N) is
6362 begin
6363 pragma Assert (Is_Private_Type (Id));
6364 Set_Node22 (Id, V);
6365 end Set_Private_View;
6367 procedure Set_Prev_Entity (Id : E; V : E) is
6368 begin
6369 Set_Node36 (Id, V);
6370 end Set_Prev_Entity;
6372 procedure Set_Protected_Body_Subprogram (Id : E; V : E) is
6373 begin
6374 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
6375 Set_Node11 (Id, V);
6376 end Set_Protected_Body_Subprogram;
6378 procedure Set_Protected_Formal (Id : E; V : E) is
6379 begin
6380 pragma Assert (Is_Formal (Id));
6381 Set_Node22 (Id, V);
6382 end Set_Protected_Formal;
6384 procedure Set_Protected_Subprogram (Id : E; V : E) is
6385 begin
6386 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
6387 Set_Node39 (Id, V);
6388 end Set_Protected_Subprogram;
6390 procedure Set_Protection_Object (Id : E; V : E) is
6391 begin
6392 pragma Assert (Ekind_In (Id, E_Entry,
6393 E_Entry_Family,
6394 E_Function,
6395 E_Procedure));
6396 Set_Node23 (Id, V);
6397 end Set_Protection_Object;
6399 procedure Set_Reachable (Id : E; V : B := True) is
6400 begin
6401 Set_Flag49 (Id, V);
6402 end Set_Reachable;
6404 procedure Set_Receiving_Entry (Id : E; V : E) is
6405 begin
6406 pragma Assert (Ekind (Id) = E_Procedure);
6407 Set_Node19 (Id, V);
6408 end Set_Receiving_Entry;
6410 procedure Set_Referenced (Id : E; V : B := True) is
6411 begin
6412 Set_Flag156 (Id, V);
6413 end Set_Referenced;
6415 procedure Set_Referenced_As_LHS (Id : E; V : B := True) is
6416 begin
6417 Set_Flag36 (Id, V);
6418 end Set_Referenced_As_LHS;
6420 procedure Set_Referenced_As_Out_Parameter (Id : E; V : B := True) is
6421 begin
6422 Set_Flag227 (Id, V);
6423 end Set_Referenced_As_Out_Parameter;
6425 procedure Set_Refinement_Constituents (Id : E; V : L) is
6426 begin
6427 pragma Assert (Ekind (Id) = E_Abstract_State);
6428 Set_Elist8 (Id, V);
6429 end Set_Refinement_Constituents;
6431 procedure Set_Register_Exception_Call (Id : E; V : N) is
6432 begin
6433 pragma Assert (Ekind (Id) = E_Exception);
6434 Set_Node20 (Id, V);
6435 end Set_Register_Exception_Call;
6437 procedure Set_Related_Array_Object (Id : E; V : E) is
6438 begin
6439 pragma Assert (Is_Array_Type (Id));
6440 Set_Node25 (Id, V);
6441 end Set_Related_Array_Object;
6443 procedure Set_Related_Expression (Id : E; V : N) is
6444 begin
6445 pragma Assert (Ekind (Id) in Type_Kind
6446 or else Ekind_In (Id, E_Constant, E_Variable, E_Void));
6447 Set_Node24 (Id, V);
6448 end Set_Related_Expression;
6450 procedure Set_Related_Instance (Id : E; V : E) is
6451 begin
6452 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
6453 Set_Node15 (Id, V);
6454 end Set_Related_Instance;
6456 procedure Set_Related_Type (Id : E; V : E) is
6457 begin
6458 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
6459 Set_Node27 (Id, V);
6460 end Set_Related_Type;
6462 procedure Set_Relative_Deadline_Variable (Id : E; V : E) is
6463 begin
6464 pragma Assert (Is_Task_Type (Id) and then Is_Base_Type (Id));
6465 Set_Node28 (Id, V);
6466 end Set_Relative_Deadline_Variable;
6468 procedure Set_Renamed_Entity (Id : E; V : N) is
6469 begin
6470 Set_Node18 (Id, V);
6471 end Set_Renamed_Entity;
6473 procedure Set_Renamed_In_Spec (Id : E; V : B := True) is
6474 begin
6475 pragma Assert (Ekind (Id) = E_Package);
6476 Set_Flag231 (Id, V);
6477 end Set_Renamed_In_Spec;
6479 procedure Set_Renamed_Object (Id : E; V : N) is
6480 begin
6481 Set_Node18 (Id, V);
6482 end Set_Renamed_Object;
6484 procedure Set_Renaming_Map (Id : E; V : U) is
6485 begin
6486 Set_Uint9 (Id, V);
6487 end Set_Renaming_Map;
6489 procedure Set_Requires_Overriding (Id : E; V : B := True) is
6490 begin
6491 pragma Assert (Is_Overloadable (Id));
6492 Set_Flag213 (Id, V);
6493 end Set_Requires_Overriding;
6495 procedure Set_Return_Present (Id : E; V : B := True) is
6496 begin
6497 Set_Flag54 (Id, V);
6498 end Set_Return_Present;
6500 procedure Set_Return_Applies_To (Id : E; V : N) is
6501 begin
6502 Set_Node8 (Id, V);
6503 end Set_Return_Applies_To;
6505 procedure Set_Returns_By_Ref (Id : E; V : B := True) is
6506 begin
6507 Set_Flag90 (Id, V);
6508 end Set_Returns_By_Ref;
6510 procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
6511 begin
6512 pragma Assert
6513 (Is_Record_Type (Id) and then Is_Base_Type (Id));
6514 Set_Flag164 (Id, V);
6515 end Set_Reverse_Bit_Order;
6517 procedure Set_Reverse_Storage_Order (Id : E; V : B := True) is
6518 begin
6519 pragma Assert
6520 (Is_Base_Type (Id)
6521 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
6522 Set_Flag93 (Id, V);
6523 end Set_Reverse_Storage_Order;
6525 procedure Set_Rewritten_For_C (Id : E; V : B := True) is
6526 begin
6527 pragma Assert (Ekind (Id) = E_Function);
6528 Set_Flag287 (Id, V);
6529 end Set_Rewritten_For_C;
6531 procedure Set_RM_Size (Id : E; V : U) is
6532 begin
6533 pragma Assert (Is_Type (Id));
6534 Set_Uint13 (Id, V);
6535 end Set_RM_Size;
6537 procedure Set_Scalar_Range (Id : E; V : N) is
6538 begin
6539 Set_Node20 (Id, V);
6540 end Set_Scalar_Range;
6542 procedure Set_Scale_Value (Id : E; V : U) is
6543 begin
6544 Set_Uint16 (Id, V);
6545 end Set_Scale_Value;
6547 procedure Set_Scope_Depth_Value (Id : E; V : U) is
6548 begin
6549 pragma Assert (not Is_Record_Type (Id));
6550 Set_Uint22 (Id, V);
6551 end Set_Scope_Depth_Value;
6553 procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True) is
6554 begin
6555 Set_Flag167 (Id, V);
6556 end Set_Sec_Stack_Needed_For_Return;
6558 procedure Set_Shadow_Entities (Id : E; V : S) is
6559 begin
6560 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
6561 Set_List14 (Id, V);
6562 end Set_Shadow_Entities;
6564 procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is
6565 begin
6566 pragma Assert (Ekind (Id) = E_Variable);
6567 Set_Node22 (Id, V);
6568 end Set_Shared_Var_Procs_Instance;
6570 procedure Set_Size_Check_Code (Id : E; V : N) is
6571 begin
6572 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
6573 Set_Node19 (Id, V);
6574 end Set_Size_Check_Code;
6576 procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True) is
6577 begin
6578 Set_Flag177 (Id, V);
6579 end Set_Size_Depends_On_Discriminant;
6581 procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True) is
6582 begin
6583 Set_Flag92 (Id, V);
6584 end Set_Size_Known_At_Compile_Time;
6586 procedure Set_Small_Value (Id : E; V : R) is
6587 begin
6588 pragma Assert (Is_Fixed_Point_Type (Id));
6589 Set_Ureal21 (Id, V);
6590 end Set_Small_Value;
6592 procedure Set_SPARK_Aux_Pragma (Id : E; V : N) is
6593 begin
6594 pragma Assert
6595 (Ekind_In (Id, E_Protected_Type, -- concurrent types
6596 E_Task_Type)
6597 or else
6598 Ekind_In (Id, E_Generic_Package, -- packages
6599 E_Package,
6600 E_Package_Body));
6601 Set_Node41 (Id, V);
6602 end Set_SPARK_Aux_Pragma;
6604 procedure Set_SPARK_Aux_Pragma_Inherited (Id : E; V : B := True) is
6605 begin
6606 pragma Assert
6607 (Ekind_In (Id, E_Protected_Type, -- concurrent types
6608 E_Task_Type)
6609 or else
6610 Ekind_In (Id, E_Generic_Package, -- packages
6611 E_Package,
6612 E_Package_Body));
6613 Set_Flag266 (Id, V);
6614 end Set_SPARK_Aux_Pragma_Inherited;
6616 procedure Set_SPARK_Pragma (Id : E; V : N) is
6617 begin
6618 pragma Assert
6619 (Ekind_In (Id, E_Constant, -- objects
6620 E_Variable)
6621 or else
6622 Ekind_In (Id, E_Abstract_State, -- overloadable
6623 E_Entry,
6624 E_Entry_Family,
6625 E_Function,
6626 E_Generic_Function,
6627 E_Generic_Procedure,
6628 E_Operator,
6629 E_Procedure,
6630 E_Subprogram_Body)
6631 or else
6632 Ekind_In (Id, E_Generic_Package, -- packages
6633 E_Package,
6634 E_Package_Body)
6635 or else
6636 Ekind (Id) = E_Void -- special purpose
6637 or else
6638 Ekind_In (Id, E_Protected_Body, -- types
6639 E_Task_Body)
6640 or else
6641 Is_Type (Id));
6642 Set_Node40 (Id, V);
6643 end Set_SPARK_Pragma;
6645 procedure Set_SPARK_Pragma_Inherited (Id : E; V : B := True) is
6646 begin
6647 pragma Assert
6648 (Ekind_In (Id, E_Constant, -- objects
6649 E_Variable)
6650 or else
6651 Ekind_In (Id, E_Abstract_State, -- overloadable
6652 E_Entry,
6653 E_Entry_Family,
6654 E_Function,
6655 E_Generic_Function,
6656 E_Generic_Procedure,
6657 E_Operator,
6658 E_Procedure,
6659 E_Subprogram_Body)
6660 or else
6661 Ekind_In (Id, E_Generic_Package, -- packages
6662 E_Package,
6663 E_Package_Body)
6664 or else
6665 Ekind (Id) = E_Void -- special purpose
6666 or else
6667 Ekind_In (Id, E_Protected_Body, -- types
6668 E_Task_Body)
6669 or else
6670 Is_Type (Id));
6671 Set_Flag265 (Id, V);
6672 end Set_SPARK_Pragma_Inherited;
6674 procedure Set_Spec_Entity (Id : E; V : E) is
6675 begin
6676 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
6677 Set_Node19 (Id, V);
6678 end Set_Spec_Entity;
6680 procedure Set_SSO_Set_High_By_Default (Id : E; V : B := True) is
6681 begin
6682 pragma Assert
6683 (Is_Base_Type (Id)
6684 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
6685 Set_Flag273 (Id, V);
6686 end Set_SSO_Set_High_By_Default;
6688 procedure Set_SSO_Set_Low_By_Default (Id : E; V : B := True) is
6689 begin
6690 pragma Assert
6691 (Is_Base_Type (Id)
6692 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
6693 Set_Flag272 (Id, V);
6694 end Set_SSO_Set_Low_By_Default;
6696 procedure Set_Static_Discrete_Predicate (Id : E; V : S) is
6697 begin
6698 pragma Assert (Is_Discrete_Type (Id) and then Has_Predicates (Id));
6699 Set_List25 (Id, V);
6700 end Set_Static_Discrete_Predicate;
6702 procedure Set_Static_Real_Or_String_Predicate (Id : E; V : N) is
6703 begin
6704 pragma Assert ((Is_Real_Type (Id) or else Is_String_Type (Id))
6705 and then Has_Predicates (Id));
6706 Set_Node25 (Id, V);
6707 end Set_Static_Real_Or_String_Predicate;
6709 procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E) is
6710 begin
6711 pragma Assert (Ekind_In (Id, E_Constant,
6712 E_Loop_Parameter,
6713 E_Variable));
6714 Set_Node15 (Id, V);
6715 end Set_Status_Flag_Or_Transient_Decl;
6717 procedure Set_Storage_Size_Variable (Id : E; V : E) is
6718 begin
6719 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
6720 pragma Assert (Id = Base_Type (Id));
6721 Set_Node26 (Id, V);
6722 end Set_Storage_Size_Variable;
6724 procedure Set_Static_Elaboration_Desired (Id : E; V : B) is
6725 begin
6726 pragma Assert (Ekind (Id) = E_Package);
6727 Set_Flag77 (Id, V);
6728 end Set_Static_Elaboration_Desired;
6730 procedure Set_Static_Initialization (Id : E; V : N) is
6731 begin
6732 pragma Assert
6733 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
6734 Set_Node30 (Id, V);
6735 end Set_Static_Initialization;
6737 procedure Set_Stored_Constraint (Id : E; V : L) is
6738 begin
6739 pragma Assert (Nkind (Id) in N_Entity);
6740 Set_Elist23 (Id, V);
6741 end Set_Stored_Constraint;
6743 procedure Set_Stores_Attribute_Old_Prefix (Id : E; V : B := True) is
6744 begin
6745 pragma Assert (Ekind (Id) = E_Constant);
6746 Set_Flag270 (Id, V);
6747 end Set_Stores_Attribute_Old_Prefix;
6749 procedure Set_Strict_Alignment (Id : E; V : B := True) is
6750 begin
6751 pragma Assert (Id = Base_Type (Id));
6752 Set_Flag145 (Id, V);
6753 end Set_Strict_Alignment;
6755 procedure Set_String_Literal_Length (Id : E; V : U) is
6756 begin
6757 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
6758 Set_Uint16 (Id, V);
6759 end Set_String_Literal_Length;
6761 procedure Set_String_Literal_Low_Bound (Id : E; V : N) is
6762 begin
6763 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
6764 Set_Node18 (Id, V);
6765 end Set_String_Literal_Low_Bound;
6767 procedure Set_Subprograms_For_Type (Id : E; V : L) is
6768 begin
6769 pragma Assert (Is_Type (Id));
6770 Set_Elist29 (Id, V);
6771 end Set_Subprograms_For_Type;
6773 procedure Set_Subps_Index (Id : E; V : U) is
6774 begin
6775 pragma Assert (Is_Subprogram (Id));
6776 Set_Uint24 (Id, V);
6777 end Set_Subps_Index;
6779 procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is
6780 begin
6781 Set_Flag303 (Id, V);
6782 end Set_Suppress_Elaboration_Warnings;
6784 procedure Set_Suppress_Initialization (Id : E; V : B := True) is
6785 begin
6786 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
6787 Set_Flag105 (Id, V);
6788 end Set_Suppress_Initialization;
6790 procedure Set_Suppress_Style_Checks (Id : E; V : B := True) is
6791 begin
6792 Set_Flag165 (Id, V);
6793 end Set_Suppress_Style_Checks;
6795 procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True) is
6796 begin
6797 Set_Flag217 (Id, V);
6798 end Set_Suppress_Value_Tracking_On_Call;
6800 procedure Set_Task_Body_Procedure (Id : E; V : N) is
6801 begin
6802 pragma Assert (Ekind (Id) in Task_Kind);
6803 Set_Node25 (Id, V);
6804 end Set_Task_Body_Procedure;
6806 procedure Set_Thunk_Entity (Id : E; V : E) is
6807 begin
6808 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
6809 and then Is_Thunk (Id));
6810 Set_Node31 (Id, V);
6811 end Set_Thunk_Entity;
6813 procedure Set_Treat_As_Volatile (Id : E; V : B := True) is
6814 begin
6815 Set_Flag41 (Id, V);
6816 end Set_Treat_As_Volatile;
6818 procedure Set_Underlying_Full_View (Id : E; V : E) is
6819 begin
6820 pragma Assert (Ekind (Id) in Private_Kind);
6821 Set_Node19 (Id, V);
6822 end Set_Underlying_Full_View;
6824 procedure Set_Underlying_Record_View (Id : E; V : E) is
6825 begin
6826 pragma Assert (Ekind (Id) = E_Record_Type);
6827 Set_Node28 (Id, V);
6828 end Set_Underlying_Record_View;
6830 procedure Set_Universal_Aliasing (Id : E; V : B := True) is
6831 begin
6832 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
6833 Set_Flag216 (Id, V);
6834 end Set_Universal_Aliasing;
6836 procedure Set_Unset_Reference (Id : E; V : N) is
6837 begin
6838 Set_Node16 (Id, V);
6839 end Set_Unset_Reference;
6841 procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
6842 begin
6843 Set_Flag222 (Id, V);
6844 end Set_Used_As_Generic_Actual;
6846 procedure Set_Uses_Lock_Free (Id : E; V : B := True) is
6847 begin
6848 pragma Assert (Ekind (Id) = E_Protected_Type);
6849 Set_Flag188 (Id, V);
6850 end Set_Uses_Lock_Free;
6852 procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
6853 begin
6854 Set_Flag95 (Id, V);
6855 end Set_Uses_Sec_Stack;
6857 procedure Set_Validated_Object (Id : E; V : N) is
6858 begin
6859 pragma Assert (Ekind (Id) = E_Variable);
6860 Set_Node38 (Id, V);
6861 end Set_Validated_Object;
6863 procedure Set_Warnings_Off (Id : E; V : B := True) is
6864 begin
6865 Set_Flag96 (Id, V);
6866 end Set_Warnings_Off;
6868 procedure Set_Warnings_Off_Used (Id : E; V : B := True) is
6869 begin
6870 Set_Flag236 (Id, V);
6871 end Set_Warnings_Off_Used;
6873 procedure Set_Warnings_Off_Used_Unmodified (Id : E; V : B := True) is
6874 begin
6875 Set_Flag237 (Id, V);
6876 end Set_Warnings_Off_Used_Unmodified;
6878 procedure Set_Warnings_Off_Used_Unreferenced (Id : E; V : B := True) is
6879 begin
6880 Set_Flag238 (Id, V);
6881 end Set_Warnings_Off_Used_Unreferenced;
6883 procedure Set_Was_Hidden (Id : E; V : B := True) is
6884 begin
6885 Set_Flag196 (Id, V);
6886 end Set_Was_Hidden;
6888 procedure Set_Wrapped_Entity (Id : E; V : E) is
6889 begin
6890 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
6891 and then Is_Primitive_Wrapper (Id));
6892 Set_Node27 (Id, V);
6893 end Set_Wrapped_Entity;
6895 -----------------------------------
6896 -- Field Initialization Routines --
6897 -----------------------------------
6899 procedure Init_Alignment (Id : E) is
6900 begin
6901 Set_Uint14 (Id, Uint_0);
6902 end Init_Alignment;
6904 procedure Init_Alignment (Id : E; V : Int) is
6905 begin
6906 Set_Uint14 (Id, UI_From_Int (V));
6907 end Init_Alignment;
6909 procedure Init_Component_Bit_Offset (Id : E) is
6910 begin
6911 Set_Uint11 (Id, No_Uint);
6912 end Init_Component_Bit_Offset;
6914 procedure Init_Component_Bit_Offset (Id : E; V : Int) is
6915 begin
6916 Set_Uint11 (Id, UI_From_Int (V));
6917 end Init_Component_Bit_Offset;
6919 procedure Init_Component_Size (Id : E) is
6920 begin
6921 Set_Uint22 (Id, Uint_0);
6922 end Init_Component_Size;
6924 procedure Init_Component_Size (Id : E; V : Int) is
6925 begin
6926 Set_Uint22 (Id, UI_From_Int (V));
6927 end Init_Component_Size;
6929 procedure Init_Digits_Value (Id : E) is
6930 begin
6931 Set_Uint17 (Id, Uint_0);
6932 end Init_Digits_Value;
6934 procedure Init_Digits_Value (Id : E; V : Int) is
6935 begin
6936 Set_Uint17 (Id, UI_From_Int (V));
6937 end Init_Digits_Value;
6939 procedure Init_Esize (Id : E) is
6940 begin
6941 Set_Uint12 (Id, Uint_0);
6942 end Init_Esize;
6944 procedure Init_Esize (Id : E; V : Int) is
6945 begin
6946 Set_Uint12 (Id, UI_From_Int (V));
6947 end Init_Esize;
6949 procedure Init_Normalized_First_Bit (Id : E) is
6950 begin
6951 Set_Uint8 (Id, No_Uint);
6952 end Init_Normalized_First_Bit;
6954 procedure Init_Normalized_First_Bit (Id : E; V : Int) is
6955 begin
6956 Set_Uint8 (Id, UI_From_Int (V));
6957 end Init_Normalized_First_Bit;
6959 procedure Init_Normalized_Position (Id : E) is
6960 begin
6961 Set_Uint14 (Id, No_Uint);
6962 end Init_Normalized_Position;
6964 procedure Init_Normalized_Position (Id : E; V : Int) is
6965 begin
6966 Set_Uint14 (Id, UI_From_Int (V));
6967 end Init_Normalized_Position;
6969 procedure Init_Normalized_Position_Max (Id : E) is
6970 begin
6971 Set_Uint10 (Id, No_Uint);
6972 end Init_Normalized_Position_Max;
6974 procedure Init_Normalized_Position_Max (Id : E; V : Int) is
6975 begin
6976 Set_Uint10 (Id, UI_From_Int (V));
6977 end Init_Normalized_Position_Max;
6979 procedure Init_RM_Size (Id : E) is
6980 begin
6981 Set_Uint13 (Id, Uint_0);
6982 end Init_RM_Size;
6984 procedure Init_RM_Size (Id : E; V : Int) is
6985 begin
6986 Set_Uint13 (Id, UI_From_Int (V));
6987 end Init_RM_Size;
6989 -----------------------------
6990 -- Init_Component_Location --
6991 -----------------------------
6993 procedure Init_Component_Location (Id : E) is
6994 begin
6995 Set_Uint8 (Id, No_Uint); -- Normalized_First_Bit
6996 Set_Uint10 (Id, No_Uint); -- Normalized_Position_Max
6997 Set_Uint11 (Id, No_Uint); -- Component_Bit_Offset
6998 Set_Uint12 (Id, Uint_0); -- Esize
6999 Set_Uint14 (Id, No_Uint); -- Normalized_Position
7000 end Init_Component_Location;
7002 ----------------------------
7003 -- Init_Object_Size_Align --
7004 ----------------------------
7006 procedure Init_Object_Size_Align (Id : E) is
7007 begin
7008 Set_Uint12 (Id, Uint_0); -- Esize
7009 Set_Uint14 (Id, Uint_0); -- Alignment
7010 end Init_Object_Size_Align;
7012 ---------------
7013 -- Init_Size --
7014 ---------------
7016 procedure Init_Size (Id : E; V : Int) is
7017 begin
7018 pragma Assert (not Is_Object (Id));
7019 Set_Uint12 (Id, UI_From_Int (V)); -- Esize
7020 Set_Uint13 (Id, UI_From_Int (V)); -- RM_Size
7021 end Init_Size;
7023 ---------------------
7024 -- Init_Size_Align --
7025 ---------------------
7027 procedure Init_Size_Align (Id : E) is
7028 begin
7029 pragma Assert (not Is_Object (Id));
7030 Set_Uint12 (Id, Uint_0); -- Esize
7031 Set_Uint13 (Id, Uint_0); -- RM_Size
7032 Set_Uint14 (Id, Uint_0); -- Alignment
7033 end Init_Size_Align;
7035 ----------------------------------------------
7036 -- Type Representation Attribute Predicates --
7037 ----------------------------------------------
7039 function Known_Alignment (E : Entity_Id) return B is
7040 begin
7041 return Uint14 (E) /= Uint_0
7042 and then Uint14 (E) /= No_Uint;
7043 end Known_Alignment;
7045 function Known_Component_Bit_Offset (E : Entity_Id) return B is
7046 begin
7047 return Uint11 (E) /= No_Uint;
7048 end Known_Component_Bit_Offset;
7050 function Known_Component_Size (E : Entity_Id) return B is
7051 begin
7052 return Uint22 (Base_Type (E)) /= Uint_0
7053 and then Uint22 (Base_Type (E)) /= No_Uint;
7054 end Known_Component_Size;
7056 function Known_Esize (E : Entity_Id) return B is
7057 begin
7058 return Uint12 (E) /= Uint_0
7059 and then Uint12 (E) /= No_Uint;
7060 end Known_Esize;
7062 function Known_Normalized_First_Bit (E : Entity_Id) return B is
7063 begin
7064 return Uint8 (E) /= No_Uint;
7065 end Known_Normalized_First_Bit;
7067 function Known_Normalized_Position (E : Entity_Id) return B is
7068 begin
7069 return Uint14 (E) /= No_Uint;
7070 end Known_Normalized_Position;
7072 function Known_Normalized_Position_Max (E : Entity_Id) return B is
7073 begin
7074 return Uint10 (E) /= No_Uint;
7075 end Known_Normalized_Position_Max;
7077 function Known_RM_Size (E : Entity_Id) return B is
7078 begin
7079 return Uint13 (E) /= No_Uint
7080 and then (Uint13 (E) /= Uint_0
7081 or else Is_Discrete_Type (E)
7082 or else Is_Fixed_Point_Type (E));
7083 end Known_RM_Size;
7085 function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is
7086 begin
7087 return Uint11 (E) /= No_Uint
7088 and then Uint11 (E) >= Uint_0;
7089 end Known_Static_Component_Bit_Offset;
7091 function Known_Static_Component_Size (E : Entity_Id) return B is
7092 begin
7093 return Uint22 (Base_Type (E)) > Uint_0;
7094 end Known_Static_Component_Size;
7096 function Known_Static_Esize (E : Entity_Id) return B is
7097 begin
7098 return Uint12 (E) > Uint_0
7099 and then not Is_Generic_Type (E);
7100 end Known_Static_Esize;
7102 function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is
7103 begin
7104 return Uint8 (E) /= No_Uint
7105 and then Uint8 (E) >= Uint_0;
7106 end Known_Static_Normalized_First_Bit;
7108 function Known_Static_Normalized_Position (E : Entity_Id) return B is
7109 begin
7110 return Uint14 (E) /= No_Uint
7111 and then Uint14 (E) >= Uint_0;
7112 end Known_Static_Normalized_Position;
7114 function Known_Static_Normalized_Position_Max (E : Entity_Id) return B is
7115 begin
7116 return Uint10 (E) /= No_Uint
7117 and then Uint10 (E) >= Uint_0;
7118 end Known_Static_Normalized_Position_Max;
7120 function Known_Static_RM_Size (E : Entity_Id) return B is
7121 begin
7122 return (Uint13 (E) > Uint_0
7123 or else Is_Discrete_Type (E)
7124 or else Is_Fixed_Point_Type (E))
7125 and then not Is_Generic_Type (E);
7126 end Known_Static_RM_Size;
7128 function Unknown_Alignment (E : Entity_Id) return B is
7129 begin
7130 return Uint14 (E) = Uint_0
7131 or else Uint14 (E) = No_Uint;
7132 end Unknown_Alignment;
7134 function Unknown_Component_Bit_Offset (E : Entity_Id) return B is
7135 begin
7136 return Uint11 (E) = No_Uint;
7137 end Unknown_Component_Bit_Offset;
7139 function Unknown_Component_Size (E : Entity_Id) return B is
7140 begin
7141 return Uint22 (Base_Type (E)) = Uint_0
7142 or else
7143 Uint22 (Base_Type (E)) = No_Uint;
7144 end Unknown_Component_Size;
7146 function Unknown_Esize (E : Entity_Id) return B is
7147 begin
7148 return Uint12 (E) = No_Uint
7149 or else
7150 Uint12 (E) = Uint_0;
7151 end Unknown_Esize;
7153 function Unknown_Normalized_First_Bit (E : Entity_Id) return B is
7154 begin
7155 return Uint8 (E) = No_Uint;
7156 end Unknown_Normalized_First_Bit;
7158 function Unknown_Normalized_Position (E : Entity_Id) return B is
7159 begin
7160 return Uint14 (E) = No_Uint;
7161 end Unknown_Normalized_Position;
7163 function Unknown_Normalized_Position_Max (E : Entity_Id) return B is
7164 begin
7165 return Uint10 (E) = No_Uint;
7166 end Unknown_Normalized_Position_Max;
7168 function Unknown_RM_Size (E : Entity_Id) return B is
7169 begin
7170 return (Uint13 (E) = Uint_0
7171 and then not Is_Discrete_Type (E)
7172 and then not Is_Fixed_Point_Type (E))
7173 or else Uint13 (E) = No_Uint;
7174 end Unknown_RM_Size;
7176 --------------------
7177 -- Address_Clause --
7178 --------------------
7180 function Address_Clause (Id : E) return N is
7181 begin
7182 return Get_Attribute_Definition_Clause (Id, Attribute_Address);
7183 end Address_Clause;
7185 ---------------
7186 -- Aft_Value --
7187 ---------------
7189 function Aft_Value (Id : E) return U is
7190 Result : Nat := 1;
7191 Delta_Val : Ureal := Delta_Value (Id);
7192 begin
7193 while Delta_Val < Ureal_Tenth loop
7194 Delta_Val := Delta_Val * Ureal_10;
7195 Result := Result + 1;
7196 end loop;
7198 return UI_From_Int (Result);
7199 end Aft_Value;
7201 ----------------------
7202 -- Alignment_Clause --
7203 ----------------------
7205 function Alignment_Clause (Id : E) return N is
7206 begin
7207 return Get_Attribute_Definition_Clause (Id, Attribute_Alignment);
7208 end Alignment_Clause;
7210 -------------------
7211 -- Append_Entity --
7212 -------------------
7214 procedure Append_Entity (Id : Entity_Id; Scop : Entity_Id) is
7215 Last : constant Entity_Id := Last_Entity (Scop);
7217 begin
7218 Set_Scope (Id, Scop);
7219 Set_Prev_Entity (Id, Empty); -- Empty <-- Id
7221 -- The entity chain is empty
7223 if No (Last) then
7224 Set_First_Entity (Scop, Id);
7226 -- Otherwise the entity chain has at least one element
7228 else
7229 Link_Entities (Last, Id); -- Last <-- Id, Last --> Id
7230 end if;
7232 -- NOTE: The setting of the Next_Entity attribute of Id must happen
7233 -- here as opposed to at the beginning of the routine because doing
7234 -- so causes the binder to hang. It is not clear why ???
7236 Set_Next_Entity (Id, Empty); -- Id --> Empty
7238 Set_Last_Entity (Scop, Id);
7239 end Append_Entity;
7241 ---------------
7242 -- Base_Type --
7243 ---------------
7245 function Base_Type (Id : E) return E is
7246 begin
7247 if Is_Base_Type (Id) then
7248 return Id;
7249 else
7250 pragma Assert (Is_Type (Id));
7251 return Etype (Id);
7252 end if;
7253 end Base_Type;
7255 -------------------------
7256 -- Component_Alignment --
7257 -------------------------
7259 -- Component Alignment is encoded using two flags, Flag128/129 as
7260 -- follows. Note that both flags False = Align_Default, so that the
7261 -- default initialization of flags to False initializes component
7262 -- alignment to the default value as required.
7264 -- Flag128 Flag129 Value
7265 -- ------- ------- -----
7266 -- False False Calign_Default
7267 -- False True Calign_Component_Size
7268 -- True False Calign_Component_Size_4
7269 -- True True Calign_Storage_Unit
7271 function Component_Alignment (Id : E) return C is
7272 BT : constant Node_Id := Base_Type (Id);
7274 begin
7275 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
7277 if Flag128 (BT) then
7278 if Flag129 (BT) then
7279 return Calign_Storage_Unit;
7280 else
7281 return Calign_Component_Size_4;
7282 end if;
7284 else
7285 if Flag129 (BT) then
7286 return Calign_Component_Size;
7287 else
7288 return Calign_Default;
7289 end if;
7290 end if;
7291 end Component_Alignment;
7293 ----------------------
7294 -- Declaration_Node --
7295 ----------------------
7297 function Declaration_Node (Id : E) return N is
7298 P : Node_Id;
7300 begin
7301 if Ekind (Id) = E_Incomplete_Type
7302 and then Present (Full_View (Id))
7303 then
7304 P := Parent (Full_View (Id));
7305 else
7306 P := Parent (Id);
7307 end if;
7309 loop
7310 if Nkind_In (P, N_Selected_Component, N_Expanded_Name)
7311 or else (Nkind (P) = N_Defining_Program_Unit_Name
7312 and then Is_Child_Unit (Id))
7313 then
7314 P := Parent (P);
7315 else
7316 return P;
7317 end if;
7318 end loop;
7319 end Declaration_Node;
7321 ---------------------
7322 -- Designated_Type --
7323 ---------------------
7325 function Designated_Type (Id : E) return E is
7326 Desig_Type : E;
7328 begin
7329 Desig_Type := Directly_Designated_Type (Id);
7331 if Is_Incomplete_Type (Desig_Type)
7332 and then Present (Full_View (Desig_Type))
7333 then
7334 return Full_View (Desig_Type);
7336 elsif Is_Class_Wide_Type (Desig_Type)
7337 and then Is_Incomplete_Type (Etype (Desig_Type))
7338 and then Present (Full_View (Etype (Desig_Type)))
7339 and then Present (Class_Wide_Type (Full_View (Etype (Desig_Type))))
7340 then
7341 return Class_Wide_Type (Full_View (Etype (Desig_Type)));
7343 else
7344 return Desig_Type;
7345 end if;
7346 end Designated_Type;
7348 -------------------
7349 -- DIC_Procedure --
7350 -------------------
7352 function DIC_Procedure (Id : E) return E is
7353 Subp_Elmt : Elmt_Id;
7354 Subp_Id : Entity_Id;
7355 Subps : Elist_Id;
7357 begin
7358 pragma Assert (Is_Type (Id));
7360 Subps := Subprograms_For_Type (Base_Type (Id));
7362 if Present (Subps) then
7363 Subp_Elmt := First_Elmt (Subps);
7364 while Present (Subp_Elmt) loop
7365 Subp_Id := Node (Subp_Elmt);
7367 if Is_DIC_Procedure (Subp_Id) then
7368 return Subp_Id;
7369 end if;
7371 Next_Elmt (Subp_Elmt);
7372 end loop;
7373 end if;
7375 return Empty;
7376 end DIC_Procedure;
7378 ----------------------
7379 -- Entry_Index_Type --
7380 ----------------------
7382 function Entry_Index_Type (Id : E) return N is
7383 begin
7384 pragma Assert (Ekind (Id) = E_Entry_Family);
7385 return Etype (Discrete_Subtype_Definition (Parent (Id)));
7386 end Entry_Index_Type;
7388 ---------------------
7389 -- First_Component --
7390 ---------------------
7392 function First_Component (Id : E) return E is
7393 Comp_Id : E;
7395 begin
7396 pragma Assert
7397 (Is_Concurrent_Type (Id)
7398 or else Is_Incomplete_Or_Private_Type (Id)
7399 or else Is_Record_Type (Id));
7401 Comp_Id := First_Entity (Id);
7402 while Present (Comp_Id) loop
7403 exit when Ekind (Comp_Id) = E_Component;
7404 Comp_Id := Next_Entity (Comp_Id);
7405 end loop;
7407 return Comp_Id;
7408 end First_Component;
7410 -------------------------------------
7411 -- First_Component_Or_Discriminant --
7412 -------------------------------------
7414 function First_Component_Or_Discriminant (Id : E) return E is
7415 Comp_Id : E;
7417 begin
7418 pragma Assert
7419 (Is_Concurrent_Type (Id)
7420 or else Is_Incomplete_Or_Private_Type (Id)
7421 or else Is_Record_Type (Id)
7422 or else Has_Discriminants (Id));
7424 Comp_Id := First_Entity (Id);
7425 while Present (Comp_Id) loop
7426 exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
7427 Comp_Id := Next_Entity (Comp_Id);
7428 end loop;
7430 return Comp_Id;
7431 end First_Component_Or_Discriminant;
7433 ------------------
7434 -- First_Formal --
7435 ------------------
7437 function First_Formal (Id : E) return E is
7438 Formal : E;
7440 begin
7441 pragma Assert
7442 (Is_Generic_Subprogram (Id)
7443 or else Is_Overloadable (Id)
7444 or else Ekind_In (Id, E_Entry_Family,
7445 E_Subprogram_Body,
7446 E_Subprogram_Type));
7448 if Ekind (Id) = E_Enumeration_Literal then
7449 return Empty;
7451 else
7452 Formal := First_Entity (Id);
7454 -- Deal with the common, non-generic case first
7456 if No (Formal) or else Is_Formal (Formal) then
7457 return Formal;
7458 end if;
7460 -- The first/next entity chain of a generic subprogram contains all
7461 -- generic formal parameters, followed by the formal parameters.
7463 if Is_Generic_Subprogram (Id) then
7464 while Present (Formal) and then not Is_Formal (Formal) loop
7465 Next_Entity (Formal);
7466 end loop;
7467 return Formal;
7468 else
7469 return Empty;
7470 end if;
7471 end if;
7472 end First_Formal;
7474 ------------------------------
7475 -- First_Formal_With_Extras --
7476 ------------------------------
7478 function First_Formal_With_Extras (Id : E) return E is
7479 Formal : E;
7481 begin
7482 pragma Assert
7483 (Is_Generic_Subprogram (Id)
7484 or else Is_Overloadable (Id)
7485 or else Ekind_In (Id, E_Entry_Family,
7486 E_Subprogram_Body,
7487 E_Subprogram_Type));
7489 if Ekind (Id) = E_Enumeration_Literal then
7490 return Empty;
7492 else
7493 Formal := First_Entity (Id);
7495 -- The first/next entity chain of a generic subprogram contains all
7496 -- generic formal parameters, followed by the formal parameters. Go
7497 -- directly to the parameters by skipping the formal part.
7499 if Is_Generic_Subprogram (Id) then
7500 while Present (Formal) and then not Is_Formal (Formal) loop
7501 Next_Entity (Formal);
7502 end loop;
7503 end if;
7505 if Present (Formal) and then Is_Formal (Formal) then
7506 return Formal;
7507 else
7508 return Extra_Formals (Id); -- Empty if no extra formals
7509 end if;
7510 end if;
7511 end First_Formal_With_Extras;
7513 -------------------------------------
7514 -- Get_Attribute_Definition_Clause --
7515 -------------------------------------
7517 function Get_Attribute_Definition_Clause
7518 (E : Entity_Id;
7519 Id : Attribute_Id) return Node_Id
7521 N : Node_Id;
7523 begin
7524 N := First_Rep_Item (E);
7525 while Present (N) loop
7526 if Nkind (N) = N_Attribute_Definition_Clause
7527 and then Get_Attribute_Id (Chars (N)) = Id
7528 then
7529 return N;
7530 else
7531 Next_Rep_Item (N);
7532 end if;
7533 end loop;
7535 return Empty;
7536 end Get_Attribute_Definition_Clause;
7538 ---------------------------
7539 -- Get_Class_Wide_Pragma --
7540 ---------------------------
7542 function Get_Class_Wide_Pragma
7543 (E : Entity_Id;
7544 Id : Pragma_Id) return Node_Id
7546 Item : Node_Id;
7547 Items : Node_Id;
7549 begin
7550 Items := Contract (E);
7552 if No (Items) then
7553 return Empty;
7554 end if;
7556 Item := Pre_Post_Conditions (Items);
7557 while Present (Item) loop
7558 if Nkind (Item) = N_Pragma
7559 and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id
7560 and then Class_Present (Item)
7561 then
7562 return Item;
7563 end if;
7565 Item := Next_Pragma (Item);
7566 end loop;
7568 return Empty;
7569 end Get_Class_Wide_Pragma;
7571 -------------------
7572 -- Get_Full_View --
7573 -------------------
7575 function Get_Full_View (T : Entity_Id) return Entity_Id is
7576 begin
7577 if Is_Incomplete_Type (T) and then Present (Full_View (T)) then
7578 return Full_View (T);
7580 elsif Is_Class_Wide_Type (T)
7581 and then Is_Incomplete_Type (Root_Type (T))
7582 and then Present (Full_View (Root_Type (T)))
7583 then
7584 return Class_Wide_Type (Full_View (Root_Type (T)));
7586 else
7587 return T;
7588 end if;
7589 end Get_Full_View;
7591 ----------------
7592 -- Get_Pragma --
7593 ----------------
7595 function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is
7597 -- Classification pragmas
7599 Is_CLS : constant Boolean :=
7600 Id = Pragma_Abstract_State or else
7601 Id = Pragma_Attach_Handler or else
7602 Id = Pragma_Async_Readers or else
7603 Id = Pragma_Async_Writers or else
7604 Id = Pragma_Constant_After_Elaboration or else
7605 Id = Pragma_Depends or else
7606 Id = Pragma_Effective_Reads or else
7607 Id = Pragma_Effective_Writes or else
7608 Id = Pragma_Extensions_Visible or else
7609 Id = Pragma_Global or else
7610 Id = Pragma_Initial_Condition or else
7611 Id = Pragma_Initializes or else
7612 Id = Pragma_Interrupt_Handler or else
7613 Id = Pragma_Part_Of or else
7614 Id = Pragma_Refined_Depends or else
7615 Id = Pragma_Refined_Global or else
7616 Id = Pragma_Refined_State or else
7617 Id = Pragma_Volatile_Function;
7619 -- Contract / test case pragmas
7621 Is_CTC : constant Boolean :=
7622 Id = Pragma_Contract_Cases or else
7623 Id = Pragma_Test_Case;
7625 -- Pre / postcondition pragmas
7627 Is_PPC : constant Boolean :=
7628 Id = Pragma_Precondition or else
7629 Id = Pragma_Postcondition or else
7630 Id = Pragma_Refined_Post;
7632 In_Contract : constant Boolean := Is_CLS or Is_CTC or Is_PPC;
7634 Item : Node_Id;
7635 Items : Node_Id;
7637 begin
7638 -- Handle pragmas that appear in N_Contract nodes. Those have to be
7639 -- extracted from their specialized list.
7641 if In_Contract then
7642 Items := Contract (E);
7644 if No (Items) then
7645 return Empty;
7647 elsif Is_CLS then
7648 Item := Classifications (Items);
7650 elsif Is_CTC then
7651 Item := Contract_Test_Cases (Items);
7653 else
7654 Item := Pre_Post_Conditions (Items);
7655 end if;
7657 -- Regular pragmas
7659 else
7660 Item := First_Rep_Item (E);
7661 end if;
7663 while Present (Item) loop
7664 if Nkind (Item) = N_Pragma
7665 and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id
7666 then
7667 return Item;
7669 -- All nodes in N_Contract are chained using Next_Pragma
7671 elsif In_Contract then
7672 Item := Next_Pragma (Item);
7674 -- Regular pragmas
7676 else
7677 Next_Rep_Item (Item);
7678 end if;
7679 end loop;
7681 return Empty;
7682 end Get_Pragma;
7684 --------------------------------------
7685 -- Get_Record_Representation_Clause --
7686 --------------------------------------
7688 function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id is
7689 N : Node_Id;
7691 begin
7692 N := First_Rep_Item (E);
7693 while Present (N) loop
7694 if Nkind (N) = N_Record_Representation_Clause then
7695 return N;
7696 end if;
7698 Next_Rep_Item (N);
7699 end loop;
7701 return Empty;
7702 end Get_Record_Representation_Clause;
7704 ------------------------
7705 -- Has_Attach_Handler --
7706 ------------------------
7708 function Has_Attach_Handler (Id : E) return B is
7709 Ritem : Node_Id;
7711 begin
7712 pragma Assert (Is_Protected_Type (Id));
7714 Ritem := First_Rep_Item (Id);
7715 while Present (Ritem) loop
7716 if Nkind (Ritem) = N_Pragma
7717 and then Pragma_Name (Ritem) = Name_Attach_Handler
7718 then
7719 return True;
7720 else
7721 Next_Rep_Item (Ritem);
7722 end if;
7723 end loop;
7725 return False;
7726 end Has_Attach_Handler;
7728 -------------
7729 -- Has_DIC --
7730 -------------
7732 function Has_DIC (Id : E) return B is
7733 begin
7734 return Has_Own_DIC (Id) or else Has_Inherited_DIC (Id);
7735 end Has_DIC;
7737 -----------------
7738 -- Has_Entries --
7739 -----------------
7741 function Has_Entries (Id : E) return B is
7742 Ent : Entity_Id;
7744 begin
7745 pragma Assert (Is_Concurrent_Type (Id));
7747 Ent := First_Entity (Id);
7748 while Present (Ent) loop
7749 if Is_Entry (Ent) then
7750 return True;
7751 end if;
7753 Ent := Next_Entity (Ent);
7754 end loop;
7756 return False;
7757 end Has_Entries;
7759 ----------------------------
7760 -- Has_Foreign_Convention --
7761 ----------------------------
7763 function Has_Foreign_Convention (Id : E) return B is
7764 begin
7765 -- While regular Intrinsics such as the Standard operators fit in the
7766 -- "Ada" convention, those with an Interface_Name materialize GCC
7767 -- builtin imports for which Ada special treatments shouldn't apply.
7769 return Convention (Id) in Foreign_Convention
7770 or else (Convention (Id) = Convention_Intrinsic
7771 and then Present (Interface_Name (Id)));
7772 end Has_Foreign_Convention;
7774 ---------------------------
7775 -- Has_Interrupt_Handler --
7776 ---------------------------
7778 function Has_Interrupt_Handler (Id : E) return B is
7779 Ritem : Node_Id;
7781 begin
7782 pragma Assert (Is_Protected_Type (Id));
7784 Ritem := First_Rep_Item (Id);
7785 while Present (Ritem) loop
7786 if Nkind (Ritem) = N_Pragma
7787 and then Pragma_Name (Ritem) = Name_Interrupt_Handler
7788 then
7789 return True;
7790 else
7791 Next_Rep_Item (Ritem);
7792 end if;
7793 end loop;
7795 return False;
7796 end Has_Interrupt_Handler;
7798 --------------------
7799 -- Has_Invariants --
7800 --------------------
7802 function Has_Invariants (Id : E) return B is
7803 begin
7804 return Has_Own_Invariants (Id) or else Has_Inherited_Invariants (Id);
7805 end Has_Invariants;
7807 --------------------------
7808 -- Has_Non_Limited_View --
7809 --------------------------
7811 function Has_Non_Limited_View (Id : E) return B is
7812 begin
7813 return (Ekind (Id) in Incomplete_Kind
7814 or else Ekind (Id) in Class_Wide_Kind
7815 or else Ekind (Id) = E_Abstract_State)
7816 and then Present (Non_Limited_View (Id));
7817 end Has_Non_Limited_View;
7819 ---------------------------------
7820 -- Has_Non_Null_Abstract_State --
7821 ---------------------------------
7823 function Has_Non_Null_Abstract_State (Id : E) return B is
7824 begin
7825 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
7827 return
7828 Present (Abstract_States (Id))
7829 and then
7830 not Is_Null_State (Node (First_Elmt (Abstract_States (Id))));
7831 end Has_Non_Null_Abstract_State;
7833 -------------------------------------
7834 -- Has_Non_Null_Visible_Refinement --
7835 -------------------------------------
7837 function Has_Non_Null_Visible_Refinement (Id : E) return B is
7838 Constits : Elist_Id;
7840 begin
7841 -- "Refinement" is a concept applicable only to abstract states
7843 pragma Assert (Ekind (Id) = E_Abstract_State);
7844 Constits := Refinement_Constituents (Id);
7846 -- A partial refinement is always non-null. For a full refinement to be
7847 -- non-null, the first constituent must be anything other than null.
7849 return
7850 Has_Partial_Visible_Refinement (Id)
7851 or else (Has_Visible_Refinement (Id)
7852 and then Present (Constits)
7853 and then Nkind (Node (First_Elmt (Constits))) /= N_Null);
7854 end Has_Non_Null_Visible_Refinement;
7856 -----------------------------
7857 -- Has_Null_Abstract_State --
7858 -----------------------------
7860 function Has_Null_Abstract_State (Id : E) return B is
7861 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
7863 States : constant Elist_Id := Abstract_States (Id);
7865 begin
7866 -- Check first available state of related package. A null abstract
7867 -- state always appears as the sole element of the state list.
7869 return
7870 Present (States)
7871 and then Is_Null_State (Node (First_Elmt (States)));
7872 end Has_Null_Abstract_State;
7874 ---------------------------------
7875 -- Has_Null_Visible_Refinement --
7876 ---------------------------------
7878 function Has_Null_Visible_Refinement (Id : E) return B is
7879 Constits : Elist_Id;
7881 begin
7882 -- "Refinement" is a concept applicable only to abstract states
7884 pragma Assert (Ekind (Id) = E_Abstract_State);
7885 Constits := Refinement_Constituents (Id);
7887 -- For a refinement to be null, the state's sole constituent must be a
7888 -- null.
7890 return
7891 Has_Visible_Refinement (Id)
7892 and then Present (Constits)
7893 and then Nkind (Node (First_Elmt (Constits))) = N_Null;
7894 end Has_Null_Visible_Refinement;
7896 --------------------
7897 -- Has_Unmodified --
7898 --------------------
7900 function Has_Unmodified (E : Entity_Id) return Boolean is
7901 begin
7902 if Has_Pragma_Unmodified (E) then
7903 return True;
7904 elsif Warnings_Off (E) then
7905 Set_Warnings_Off_Used_Unmodified (E);
7906 return True;
7907 else
7908 return False;
7909 end if;
7910 end Has_Unmodified;
7912 ---------------------
7913 -- Has_Unreferenced --
7914 ---------------------
7916 function Has_Unreferenced (E : Entity_Id) return Boolean is
7917 begin
7918 if Has_Pragma_Unreferenced (E) then
7919 return True;
7920 elsif Warnings_Off (E) then
7921 Set_Warnings_Off_Used_Unreferenced (E);
7922 return True;
7923 else
7924 return False;
7925 end if;
7926 end Has_Unreferenced;
7928 ----------------------
7929 -- Has_Warnings_Off --
7930 ----------------------
7932 function Has_Warnings_Off (E : Entity_Id) return Boolean is
7933 begin
7934 if Warnings_Off (E) then
7935 Set_Warnings_Off_Used (E);
7936 return True;
7937 else
7938 return False;
7939 end if;
7940 end Has_Warnings_Off;
7942 ------------------------------
7943 -- Implementation_Base_Type --
7944 ------------------------------
7946 function Implementation_Base_Type (Id : E) return E is
7947 Bastyp : Entity_Id;
7948 Imptyp : Entity_Id;
7950 begin
7951 Bastyp := Base_Type (Id);
7953 if Is_Incomplete_Or_Private_Type (Bastyp) then
7954 Imptyp := Underlying_Type (Bastyp);
7956 -- If we have an implementation type, then just return it,
7957 -- otherwise we return the Base_Type anyway. This can only
7958 -- happen in error situations and should avoid some error bombs.
7960 if Present (Imptyp) then
7961 return Base_Type (Imptyp);
7962 else
7963 return Bastyp;
7964 end if;
7966 else
7967 return Bastyp;
7968 end if;
7969 end Implementation_Base_Type;
7971 -------------------------
7972 -- Invariant_Procedure --
7973 -------------------------
7975 function Invariant_Procedure (Id : E) return E is
7976 Subp_Elmt : Elmt_Id;
7977 Subp_Id : Entity_Id;
7978 Subps : Elist_Id;
7980 begin
7981 pragma Assert (Is_Type (Id));
7983 Subps := Subprograms_For_Type (Base_Type (Id));
7985 if Present (Subps) then
7986 Subp_Elmt := First_Elmt (Subps);
7987 while Present (Subp_Elmt) loop
7988 Subp_Id := Node (Subp_Elmt);
7990 if Is_Invariant_Procedure (Subp_Id) then
7991 return Subp_Id;
7992 end if;
7994 Next_Elmt (Subp_Elmt);
7995 end loop;
7996 end if;
7998 return Empty;
7999 end Invariant_Procedure;
8001 ----------------------
8002 -- Is_Atomic_Or_VFA --
8003 ----------------------
8005 function Is_Atomic_Or_VFA (Id : E) return B is
8006 begin
8007 return Is_Atomic (Id) or else Is_Volatile_Full_Access (Id);
8008 end Is_Atomic_Or_VFA;
8010 ------------------
8011 -- Is_Base_Type --
8012 ------------------
8014 -- Global flag table allowing rapid computation of this function
8016 Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean :=
8017 (E_Enumeration_Subtype |
8018 E_Incomplete_Subtype |
8019 E_Signed_Integer_Subtype |
8020 E_Modular_Integer_Subtype |
8021 E_Floating_Point_Subtype |
8022 E_Ordinary_Fixed_Point_Subtype |
8023 E_Decimal_Fixed_Point_Subtype |
8024 E_Array_Subtype |
8025 E_Record_Subtype |
8026 E_Private_Subtype |
8027 E_Record_Subtype_With_Private |
8028 E_Limited_Private_Subtype |
8029 E_Access_Subtype |
8030 E_Protected_Subtype |
8031 E_Task_Subtype |
8032 E_String_Literal_Subtype |
8033 E_Class_Wide_Subtype => False,
8034 others => True);
8036 function Is_Base_Type (Id : E) return Boolean is
8037 begin
8038 return Entity_Is_Base_Type (Ekind (Id));
8039 end Is_Base_Type;
8041 ---------------------
8042 -- Is_Boolean_Type --
8043 ---------------------
8045 function Is_Boolean_Type (Id : E) return B is
8046 begin
8047 return Root_Type (Id) = Standard_Boolean;
8048 end Is_Boolean_Type;
8050 ------------------------
8051 -- Is_Constant_Object --
8052 ------------------------
8054 function Is_Constant_Object (Id : E) return B is
8055 K : constant Entity_Kind := Ekind (Id);
8056 begin
8057 return
8058 K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;
8059 end Is_Constant_Object;
8061 -------------------
8062 -- Is_Controlled --
8063 -------------------
8065 function Is_Controlled (Id : E) return B is
8066 begin
8067 return Is_Controlled_Active (Id) and then not Disable_Controlled (Id);
8068 end Is_Controlled;
8070 --------------------
8071 -- Is_Discriminal --
8072 --------------------
8074 function Is_Discriminal (Id : E) return B is
8075 begin
8076 return (Ekind_In (Id, E_Constant, E_In_Parameter)
8077 and then Present (Discriminal_Link (Id)));
8078 end Is_Discriminal;
8080 ----------------------
8081 -- Is_Dynamic_Scope --
8082 ----------------------
8084 function Is_Dynamic_Scope (Id : E) return B is
8085 begin
8086 return
8087 Ekind (Id) = E_Block
8088 or else
8089 Ekind (Id) = E_Function
8090 or else
8091 Ekind (Id) = E_Procedure
8092 or else
8093 Ekind (Id) = E_Subprogram_Body
8094 or else
8095 Ekind (Id) = E_Task_Type
8096 or else
8097 (Ekind (Id) = E_Limited_Private_Type
8098 and then Present (Full_View (Id))
8099 and then Ekind (Full_View (Id)) = E_Task_Type)
8100 or else
8101 Ekind (Id) = E_Entry
8102 or else
8103 Ekind (Id) = E_Entry_Family
8104 or else
8105 Ekind (Id) = E_Return_Statement;
8106 end Is_Dynamic_Scope;
8108 --------------------
8109 -- Is_Entity_Name --
8110 --------------------
8112 function Is_Entity_Name (N : Node_Id) return Boolean is
8113 Kind : constant Node_Kind := Nkind (N);
8115 begin
8116 -- Identifiers, operator symbols, expanded names are entity names
8118 return Kind = N_Identifier
8119 or else Kind = N_Operator_Symbol
8120 or else Kind = N_Expanded_Name
8122 -- Attribute references are entity names if they refer to an entity.
8123 -- Note that we don't do this by testing for the presence of the
8124 -- Entity field in the N_Attribute_Reference node, since it may not
8125 -- have been set yet.
8127 or else (Kind = N_Attribute_Reference
8128 and then Is_Entity_Attribute_Name (Attribute_Name (N)));
8129 end Is_Entity_Name;
8131 ---------------------------
8132 -- Is_Elaboration_Target --
8133 ---------------------------
8135 function Is_Elaboration_Target (Id : Entity_Id) return Boolean is
8136 begin
8137 return
8138 Ekind_In (Id, E_Constant, E_Variable)
8139 or else Is_Entry (Id)
8140 or else Is_Generic_Unit (Id)
8141 or else Is_Subprogram (Id)
8142 or else Is_Task_Type (Id);
8143 end Is_Elaboration_Target;
8145 -----------------------
8146 -- Is_External_State --
8147 -----------------------
8149 function Is_External_State (Id : E) return B is
8150 begin
8151 -- To qualify, the abstract state must appear with option "external" or
8152 -- "synchronous" (SPARK RM 7.1.4(8) and (10)).
8154 return
8155 Ekind (Id) = E_Abstract_State
8156 and then (Has_Option (Id, Name_External)
8157 or else
8158 Has_Option (Id, Name_Synchronous));
8159 end Is_External_State;
8161 ------------------
8162 -- Is_Finalizer --
8163 ------------------
8165 function Is_Finalizer (Id : E) return B is
8166 begin
8167 return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer;
8168 end Is_Finalizer;
8170 -------------------
8171 -- Is_Null_State --
8172 -------------------
8174 function Is_Null_State (Id : E) return B is
8175 begin
8176 return
8177 Ekind (Id) = E_Abstract_State and then Nkind (Parent (Id)) = N_Null;
8178 end Is_Null_State;
8180 ---------------------
8181 -- Is_Packed_Array --
8182 ---------------------
8184 function Is_Packed_Array (Id : E) return B is
8185 begin
8186 return Is_Array_Type (Id) and then Is_Packed (Id);
8187 end Is_Packed_Array;
8189 -----------------------------------
8190 -- Is_Package_Or_Generic_Package --
8191 -----------------------------------
8193 function Is_Package_Or_Generic_Package (Id : E) return B is
8194 begin
8195 return Ekind_In (Id, E_Generic_Package, E_Package);
8196 end Is_Package_Or_Generic_Package;
8198 ---------------
8199 -- Is_Prival --
8200 ---------------
8202 function Is_Prival (Id : E) return B is
8203 begin
8204 return (Ekind_In (Id, E_Constant, E_Variable)
8205 and then Present (Prival_Link (Id)));
8206 end Is_Prival;
8208 ----------------------------
8209 -- Is_Protected_Component --
8210 ----------------------------
8212 function Is_Protected_Component (Id : E) return B is
8213 begin
8214 return Ekind (Id) = E_Component and then Is_Protected_Type (Scope (Id));
8215 end Is_Protected_Component;
8217 ----------------------------
8218 -- Is_Protected_Interface --
8219 ----------------------------
8221 function Is_Protected_Interface (Id : E) return B is
8222 Typ : constant Entity_Id := Base_Type (Id);
8223 begin
8224 if not Is_Interface (Typ) then
8225 return False;
8226 elsif Is_Class_Wide_Type (Typ) then
8227 return Is_Protected_Interface (Etype (Typ));
8228 else
8229 return Protected_Present (Type_Definition (Parent (Typ)));
8230 end if;
8231 end Is_Protected_Interface;
8233 ------------------------------
8234 -- Is_Protected_Record_Type --
8235 ------------------------------
8237 function Is_Protected_Record_Type (Id : E) return B is
8238 begin
8239 return
8240 Is_Concurrent_Record_Type (Id)
8241 and then Is_Protected_Type (Corresponding_Concurrent_Type (Id));
8242 end Is_Protected_Record_Type;
8244 --------------------------------
8245 -- Is_Standard_Character_Type --
8246 --------------------------------
8248 function Is_Standard_Character_Type (Id : E) return B is
8249 begin
8250 if Is_Type (Id) then
8251 declare
8252 R : constant Entity_Id := Root_Type (Id);
8253 begin
8254 return
8255 R = Standard_Character
8256 or else
8257 R = Standard_Wide_Character
8258 or else
8259 R = Standard_Wide_Wide_Character;
8260 end;
8262 else
8263 return False;
8264 end if;
8265 end Is_Standard_Character_Type;
8267 -----------------------------
8268 -- Is_Standard_String_Type --
8269 -----------------------------
8271 function Is_Standard_String_Type (Id : E) return B is
8272 begin
8273 if Is_Type (Id) then
8274 declare
8275 R : constant Entity_Id := Root_Type (Id);
8276 begin
8277 return
8278 R = Standard_String
8279 or else
8280 R = Standard_Wide_String
8281 or else
8282 R = Standard_Wide_Wide_String;
8283 end;
8285 else
8286 return False;
8287 end if;
8288 end Is_Standard_String_Type;
8290 --------------------
8291 -- Is_String_Type --
8292 --------------------
8294 function Is_String_Type (Id : E) return B is
8295 begin
8296 return Is_Array_Type (Id)
8297 and then Id /= Any_Composite
8298 and then Number_Dimensions (Id) = 1
8299 and then Is_Character_Type (Component_Type (Id));
8300 end Is_String_Type;
8302 -------------------------------
8303 -- Is_Synchronized_Interface --
8304 -------------------------------
8306 function Is_Synchronized_Interface (Id : E) return B is
8307 Typ : constant Entity_Id := Base_Type (Id);
8309 begin
8310 if not Is_Interface (Typ) then
8311 return False;
8313 elsif Is_Class_Wide_Type (Typ) then
8314 return Is_Synchronized_Interface (Etype (Typ));
8316 else
8317 return Protected_Present (Type_Definition (Parent (Typ)))
8318 or else Synchronized_Present (Type_Definition (Parent (Typ)))
8319 or else Task_Present (Type_Definition (Parent (Typ)));
8320 end if;
8321 end Is_Synchronized_Interface;
8323 ---------------------------
8324 -- Is_Synchronized_State --
8325 ---------------------------
8327 function Is_Synchronized_State (Id : E) return B is
8328 begin
8329 -- To qualify, the abstract state must appear with simple option
8330 -- "synchronous" (SPARK RM 7.1.4(10)).
8332 return
8333 Ekind (Id) = E_Abstract_State
8334 and then Has_Option (Id, Name_Synchronous);
8335 end Is_Synchronized_State;
8337 -----------------------
8338 -- Is_Task_Interface --
8339 -----------------------
8341 function Is_Task_Interface (Id : E) return B is
8342 Typ : constant Entity_Id := Base_Type (Id);
8343 begin
8344 if not Is_Interface (Typ) then
8345 return False;
8346 elsif Is_Class_Wide_Type (Typ) then
8347 return Is_Task_Interface (Etype (Typ));
8348 else
8349 return Task_Present (Type_Definition (Parent (Typ)));
8350 end if;
8351 end Is_Task_Interface;
8353 -------------------------
8354 -- Is_Task_Record_Type --
8355 -------------------------
8357 function Is_Task_Record_Type (Id : E) return B is
8358 begin
8359 return
8360 Is_Concurrent_Record_Type (Id)
8361 and then Is_Task_Type (Corresponding_Concurrent_Type (Id));
8362 end Is_Task_Record_Type;
8364 ------------------------
8365 -- Is_Wrapper_Package --
8366 ------------------------
8368 function Is_Wrapper_Package (Id : E) return B is
8369 begin
8370 return (Ekind (Id) = E_Package and then Present (Related_Instance (Id)));
8371 end Is_Wrapper_Package;
8373 -----------------
8374 -- Last_Formal --
8375 -----------------
8377 function Last_Formal (Id : E) return E is
8378 Formal : E;
8380 begin
8381 pragma Assert
8382 (Is_Overloadable (Id)
8383 or else Ekind_In (Id, E_Entry_Family,
8384 E_Subprogram_Body,
8385 E_Subprogram_Type));
8387 if Ekind (Id) = E_Enumeration_Literal then
8388 return Empty;
8390 else
8391 Formal := First_Formal (Id);
8393 if Present (Formal) then
8394 while Present (Next_Formal (Formal)) loop
8395 Formal := Next_Formal (Formal);
8396 end loop;
8397 end if;
8399 return Formal;
8400 end if;
8401 end Last_Formal;
8403 -------------------
8404 -- Link_Entities --
8405 -------------------
8407 procedure Link_Entities (First : Entity_Id; Second : Node_Id) is
8408 begin
8409 if Present (Second) then
8410 Set_Prev_Entity (Second, First); -- First <-- Second
8411 end if;
8413 Set_Next_Entity (First, Second); -- First --> Second
8414 end Link_Entities;
8416 ----------------------
8417 -- Model_Emin_Value --
8418 ----------------------
8420 function Model_Emin_Value (Id : E) return Uint is
8421 begin
8422 return Machine_Emin_Value (Id);
8423 end Model_Emin_Value;
8425 -------------------------
8426 -- Model_Epsilon_Value --
8427 -------------------------
8429 function Model_Epsilon_Value (Id : E) return Ureal is
8430 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
8431 begin
8432 return Radix ** (1 - Model_Mantissa_Value (Id));
8433 end Model_Epsilon_Value;
8435 --------------------------
8436 -- Model_Mantissa_Value --
8437 --------------------------
8439 function Model_Mantissa_Value (Id : E) return Uint is
8440 begin
8441 return Machine_Mantissa_Value (Id);
8442 end Model_Mantissa_Value;
8444 -----------------------
8445 -- Model_Small_Value --
8446 -----------------------
8448 function Model_Small_Value (Id : E) return Ureal is
8449 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
8450 begin
8451 return Radix ** (Model_Emin_Value (Id) - 1);
8452 end Model_Small_Value;
8454 ------------------------
8455 -- Machine_Emax_Value --
8456 ------------------------
8458 function Machine_Emax_Value (Id : E) return Uint is
8459 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
8461 begin
8462 case Float_Rep (Id) is
8463 when IEEE_Binary =>
8464 case Digs is
8465 when 1 .. 6 => return Uint_128;
8466 when 7 .. 15 => return 2**10;
8467 when 16 .. 33 => return 2**14;
8468 when others => return No_Uint;
8469 end case;
8471 when AAMP =>
8472 return Uint_2 ** Uint_7 - Uint_1;
8473 end case;
8474 end Machine_Emax_Value;
8476 ------------------------
8477 -- Machine_Emin_Value --
8478 ------------------------
8480 function Machine_Emin_Value (Id : E) return Uint is
8481 begin
8482 case Float_Rep (Id) is
8483 when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id);
8484 when AAMP => return -Machine_Emax_Value (Id);
8485 end case;
8486 end Machine_Emin_Value;
8488 ----------------------------
8489 -- Machine_Mantissa_Value --
8490 ----------------------------
8492 function Machine_Mantissa_Value (Id : E) return Uint is
8493 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
8495 begin
8496 case Float_Rep (Id) is
8497 when IEEE_Binary =>
8498 case Digs is
8499 when 1 .. 6 => return Uint_24;
8500 when 7 .. 15 => return UI_From_Int (53);
8501 when 16 .. 18 => return Uint_64;
8502 when 19 .. 33 => return UI_From_Int (113);
8503 when others => return No_Uint;
8504 end case;
8506 when AAMP =>
8507 case Digs is
8508 when 1 .. 6 => return Uint_24;
8509 when 7 .. 9 => return UI_From_Int (40);
8510 when others => return No_Uint;
8511 end case;
8512 end case;
8513 end Machine_Mantissa_Value;
8515 -------------------------
8516 -- Machine_Radix_Value --
8517 -------------------------
8519 function Machine_Radix_Value (Id : E) return U is
8520 begin
8521 case Float_Rep (Id) is
8522 when AAMP
8523 | IEEE_Binary
8525 return Uint_2;
8526 end case;
8527 end Machine_Radix_Value;
8529 --------------------
8530 -- Next_Component --
8531 --------------------
8533 function Next_Component (Id : E) return E is
8534 Comp_Id : E;
8536 begin
8537 Comp_Id := Next_Entity (Id);
8538 while Present (Comp_Id) loop
8539 exit when Ekind (Comp_Id) = E_Component;
8540 Comp_Id := Next_Entity (Comp_Id);
8541 end loop;
8543 return Comp_Id;
8544 end Next_Component;
8546 ------------------------------------
8547 -- Next_Component_Or_Discriminant --
8548 ------------------------------------
8550 function Next_Component_Or_Discriminant (Id : E) return E is
8551 Comp_Id : E;
8553 begin
8554 Comp_Id := Next_Entity (Id);
8555 while Present (Comp_Id) loop
8556 exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
8557 Comp_Id := Next_Entity (Comp_Id);
8558 end loop;
8560 return Comp_Id;
8561 end Next_Component_Or_Discriminant;
8563 -----------------------
8564 -- Next_Discriminant --
8565 -----------------------
8567 -- This function actually implements both Next_Discriminant and
8568 -- Next_Stored_Discriminant by making sure that the Discriminant
8569 -- returned is of the same variety as Id.
8571 function Next_Discriminant (Id : E) return E is
8573 -- Derived Tagged types with private extensions look like this...
8575 -- E_Discriminant d1
8576 -- E_Discriminant d2
8577 -- E_Component _tag
8578 -- E_Discriminant d1
8579 -- E_Discriminant d2
8580 -- ...
8582 -- so it is critical not to go past the leading discriminants
8584 D : E := Id;
8586 begin
8587 pragma Assert (Ekind (Id) = E_Discriminant);
8589 loop
8590 D := Next_Entity (D);
8591 if No (D)
8592 or else (Ekind (D) /= E_Discriminant
8593 and then not Is_Itype (D))
8594 then
8595 return Empty;
8596 end if;
8598 exit when Ekind (D) = E_Discriminant
8599 and then (Is_Completely_Hidden (D) = Is_Completely_Hidden (Id));
8600 end loop;
8602 return D;
8603 end Next_Discriminant;
8605 -----------------
8606 -- Next_Formal --
8607 -----------------
8609 function Next_Formal (Id : E) return E is
8610 P : E;
8612 begin
8613 -- Follow the chain of declared entities as long as the kind of the
8614 -- entity corresponds to a formal parameter. Skip internal entities
8615 -- that may have been created for implicit subtypes, in the process
8616 -- of analyzing default expressions.
8618 P := Id;
8619 loop
8620 Next_Entity (P);
8622 if No (P) or else Is_Formal (P) then
8623 return P;
8624 elsif not Is_Internal (P) then
8625 return Empty;
8626 end if;
8627 end loop;
8628 end Next_Formal;
8630 -----------------------------
8631 -- Next_Formal_With_Extras --
8632 -----------------------------
8634 function Next_Formal_With_Extras (Id : E) return E is
8635 begin
8636 if Present (Extra_Formal (Id)) then
8637 return Extra_Formal (Id);
8638 else
8639 return Next_Formal (Id);
8640 end if;
8641 end Next_Formal_With_Extras;
8643 ----------------
8644 -- Next_Index --
8645 ----------------
8647 function Next_Index (Id : Node_Id) return Node_Id is
8648 begin
8649 return Next (Id);
8650 end Next_Index;
8652 ------------------
8653 -- Next_Literal --
8654 ------------------
8656 function Next_Literal (Id : E) return E is
8657 begin
8658 pragma Assert (Nkind (Id) in N_Entity);
8659 return Next (Id);
8660 end Next_Literal;
8662 ------------------------------
8663 -- Next_Stored_Discriminant --
8664 ------------------------------
8666 function Next_Stored_Discriminant (Id : E) return E is
8667 begin
8668 -- See comment in Next_Discriminant
8670 return Next_Discriminant (Id);
8671 end Next_Stored_Discriminant;
8673 -----------------------
8674 -- Number_Dimensions --
8675 -----------------------
8677 function Number_Dimensions (Id : E) return Pos is
8678 N : Int;
8679 T : Node_Id;
8681 begin
8682 if Ekind (Id) = E_String_Literal_Subtype then
8683 return 1;
8685 else
8686 N := 0;
8687 T := First_Index (Id);
8688 while Present (T) loop
8689 N := N + 1;
8690 Next_Index (T);
8691 end loop;
8693 return N;
8694 end if;
8695 end Number_Dimensions;
8697 --------------------
8698 -- Number_Entries --
8699 --------------------
8701 function Number_Entries (Id : E) return Nat is
8702 N : Int;
8703 Ent : Entity_Id;
8705 begin
8706 pragma Assert (Is_Concurrent_Type (Id));
8708 N := 0;
8709 Ent := First_Entity (Id);
8710 while Present (Ent) loop
8711 if Is_Entry (Ent) then
8712 N := N + 1;
8713 end if;
8715 Ent := Next_Entity (Ent);
8716 end loop;
8718 return N;
8719 end Number_Entries;
8721 --------------------
8722 -- Number_Formals --
8723 --------------------
8725 function Number_Formals (Id : E) return Pos is
8726 N : Int;
8727 Formal : Entity_Id;
8729 begin
8730 N := 0;
8731 Formal := First_Formal (Id);
8732 while Present (Formal) loop
8733 N := N + 1;
8734 Formal := Next_Formal (Formal);
8735 end loop;
8737 return N;
8738 end Number_Formals;
8740 --------------------
8741 -- Parameter_Mode --
8742 --------------------
8744 function Parameter_Mode (Id : E) return Formal_Kind is
8745 begin
8746 return Ekind (Id);
8747 end Parameter_Mode;
8749 ---------------------------------
8750 -- Partial_Invariant_Procedure --
8751 ---------------------------------
8753 function Partial_Invariant_Procedure (Id : E) return E is
8754 Subp_Elmt : Elmt_Id;
8755 Subp_Id : Entity_Id;
8756 Subps : Elist_Id;
8758 begin
8759 pragma Assert (Is_Type (Id));
8761 Subps := Subprograms_For_Type (Base_Type (Id));
8763 if Present (Subps) then
8764 Subp_Elmt := First_Elmt (Subps);
8765 while Present (Subp_Elmt) loop
8766 Subp_Id := Node (Subp_Elmt);
8768 if Is_Partial_Invariant_Procedure (Subp_Id) then
8769 return Subp_Id;
8770 end if;
8772 Next_Elmt (Subp_Elmt);
8773 end loop;
8774 end if;
8776 return Empty;
8777 end Partial_Invariant_Procedure;
8779 -------------------------------------
8780 -- Partial_Refinement_Constituents --
8781 -------------------------------------
8783 function Partial_Refinement_Constituents (Id : E) return L is
8784 Constits : Elist_Id := No_Elist;
8786 procedure Add_Usable_Constituents (Item : E);
8787 -- Add global item Item and/or its constituents to list Constits when
8788 -- they can be used in a global refinement within the current scope. The
8789 -- criteria are:
8790 -- 1) If Item is an abstract state with full refinement visible, add
8791 -- its constituents.
8792 -- 2) If Item is an abstract state with only partial refinement
8793 -- visible, add both Item and its constituents.
8794 -- 3) If Item is an abstract state without a visible refinement, add
8795 -- it.
8796 -- 4) If Id is not an abstract state, add it.
8798 procedure Add_Usable_Constituents (List : Elist_Id);
8799 -- Apply Add_Usable_Constituents to every constituent in List
8801 -----------------------------
8802 -- Add_Usable_Constituents --
8803 -----------------------------
8805 procedure Add_Usable_Constituents (Item : E) is
8806 begin
8807 if Ekind (Item) = E_Abstract_State then
8808 if Has_Visible_Refinement (Item) then
8809 Add_Usable_Constituents (Refinement_Constituents (Item));
8811 elsif Has_Partial_Visible_Refinement (Item) then
8812 Append_New_Elmt (Item, Constits);
8813 Add_Usable_Constituents (Part_Of_Constituents (Item));
8815 else
8816 Append_New_Elmt (Item, Constits);
8817 end if;
8819 else
8820 Append_New_Elmt (Item, Constits);
8821 end if;
8822 end Add_Usable_Constituents;
8824 procedure Add_Usable_Constituents (List : Elist_Id) is
8825 Constit_Elmt : Elmt_Id;
8826 begin
8827 if Present (List) then
8828 Constit_Elmt := First_Elmt (List);
8829 while Present (Constit_Elmt) loop
8830 Add_Usable_Constituents (Node (Constit_Elmt));
8831 Next_Elmt (Constit_Elmt);
8832 end loop;
8833 end if;
8834 end Add_Usable_Constituents;
8836 -- Start of processing for Partial_Refinement_Constituents
8838 begin
8839 -- "Refinement" is a concept applicable only to abstract states
8841 pragma Assert (Ekind (Id) = E_Abstract_State);
8843 if Has_Visible_Refinement (Id) then
8844 Constits := Refinement_Constituents (Id);
8846 -- A refinement may be partially visible when objects declared in the
8847 -- private part of a package are subject to a Part_Of indicator.
8849 elsif Has_Partial_Visible_Refinement (Id) then
8850 Add_Usable_Constituents (Part_Of_Constituents (Id));
8852 -- Function should only be called when full or partial refinement is
8853 -- visible.
8855 else
8856 raise Program_Error;
8857 end if;
8859 return Constits;
8860 end Partial_Refinement_Constituents;
8862 ------------------------
8863 -- Predicate_Function --
8864 ------------------------
8866 function Predicate_Function (Id : E) return E is
8867 Subp_Elmt : Elmt_Id;
8868 Subp_Id : Entity_Id;
8869 Subps : Elist_Id;
8870 Typ : Entity_Id;
8872 begin
8873 pragma Assert (Is_Type (Id));
8875 -- If type is private and has a completion, predicate may be defined on
8876 -- the full view.
8878 if Is_Private_Type (Id)
8879 and then
8880 (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id)))
8881 and then Present (Full_View (Id))
8882 then
8883 Typ := Full_View (Id);
8885 elsif Ekind_In (Id, E_Array_Subtype,
8886 E_Record_Subtype,
8887 E_Record_Subtype_With_Private)
8888 and then Present (Predicated_Parent (Id))
8889 then
8890 Typ := Predicated_Parent (Id);
8892 else
8893 Typ := Id;
8894 end if;
8896 Subps := Subprograms_For_Type (Typ);
8898 if Present (Subps) then
8899 Subp_Elmt := First_Elmt (Subps);
8900 while Present (Subp_Elmt) loop
8901 Subp_Id := Node (Subp_Elmt);
8903 if Ekind (Subp_Id) = E_Function
8904 and then Is_Predicate_Function (Subp_Id)
8905 then
8906 return Subp_Id;
8907 end if;
8909 Next_Elmt (Subp_Elmt);
8910 end loop;
8911 end if;
8913 return Empty;
8914 end Predicate_Function;
8916 --------------------------
8917 -- Predicate_Function_M --
8918 --------------------------
8920 function Predicate_Function_M (Id : E) return E is
8921 Subp_Elmt : Elmt_Id;
8922 Subp_Id : Entity_Id;
8923 Subps : Elist_Id;
8924 Typ : Entity_Id;
8926 begin
8927 pragma Assert (Is_Type (Id));
8929 -- If type is private and has a completion, predicate may be defined on
8930 -- the full view.
8932 if Is_Private_Type (Id)
8933 and then
8934 (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id)))
8935 and then Present (Full_View (Id))
8936 then
8937 Typ := Full_View (Id);
8939 else
8940 Typ := Id;
8941 end if;
8943 Subps := Subprograms_For_Type (Typ);
8945 if Present (Subps) then
8946 Subp_Elmt := First_Elmt (Subps);
8947 while Present (Subp_Elmt) loop
8948 Subp_Id := Node (Subp_Elmt);
8950 if Ekind (Subp_Id) = E_Function
8951 and then Is_Predicate_Function_M (Subp_Id)
8952 then
8953 return Subp_Id;
8954 end if;
8956 Next_Elmt (Subp_Elmt);
8957 end loop;
8958 end if;
8960 return Empty;
8961 end Predicate_Function_M;
8963 -------------------------
8964 -- Present_In_Rep_Item --
8965 -------------------------
8967 function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean is
8968 Ritem : Node_Id;
8970 begin
8971 Ritem := First_Rep_Item (E);
8973 while Present (Ritem) loop
8974 if Ritem = N then
8975 return True;
8976 end if;
8978 Next_Rep_Item (Ritem);
8979 end loop;
8981 return False;
8982 end Present_In_Rep_Item;
8984 --------------------------
8985 -- Primitive_Operations --
8986 --------------------------
8988 function Primitive_Operations (Id : E) return L is
8989 begin
8990 if Is_Concurrent_Type (Id) then
8991 if Present (Corresponding_Record_Type (Id)) then
8992 return Direct_Primitive_Operations
8993 (Corresponding_Record_Type (Id));
8995 -- If expansion is disabled the corresponding record type is absent,
8996 -- but if the type has ancestors it may have primitive operations.
8998 elsif Is_Tagged_Type (Id) then
8999 return Direct_Primitive_Operations (Id);
9001 else
9002 return No_Elist;
9003 end if;
9004 else
9005 return Direct_Primitive_Operations (Id);
9006 end if;
9007 end Primitive_Operations;
9009 ---------------------
9010 -- Record_Rep_Item --
9011 ---------------------
9013 procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is
9014 begin
9015 Set_Next_Rep_Item (N, First_Rep_Item (E));
9016 Set_First_Rep_Item (E, N);
9017 end Record_Rep_Item;
9019 -------------------
9020 -- Remove_Entity --
9021 -------------------
9023 procedure Remove_Entity (Id : Entity_Id) is
9024 Next : constant Entity_Id := Next_Entity (Id);
9025 Prev : constant Entity_Id := Prev_Entity (Id);
9026 Scop : constant Entity_Id := Scope (Id);
9027 First : constant Entity_Id := First_Entity (Scop);
9028 Last : constant Entity_Id := Last_Entity (Scop);
9030 begin
9031 -- Eliminate any existing linkages from the entity
9033 Set_Prev_Entity (Id, Empty); -- Empty <-- Id
9034 Set_Next_Entity (Id, Empty); -- Id --> Empty
9036 -- The eliminated entity was the only element in the entity chain
9038 if Id = First and then Id = Last then
9039 Set_First_Entity (Scop, Empty);
9040 Set_Last_Entity (Scop, Empty);
9042 -- The eliminated entity was the head of the entity chain
9044 elsif Id = First then
9045 Set_First_Entity (Scop, Next);
9047 -- The eliminated entity was the tail of the entity chain
9049 elsif Id = Last then
9050 Set_Last_Entity (Scop, Prev);
9052 -- Otherwise the eliminated entity comes from the middle of the entity
9053 -- chain.
9055 else
9056 Link_Entities (Prev, Next); -- Prev <-- Next, Prev --> Next
9057 end if;
9058 end Remove_Entity;
9060 ---------------
9061 -- Root_Type --
9062 ---------------
9064 function Root_Type (Id : E) return E is
9065 T, Etyp : E;
9067 begin
9068 pragma Assert (Nkind (Id) in N_Entity);
9070 T := Base_Type (Id);
9072 if Ekind (T) = E_Class_Wide_Type then
9073 return Etype (T);
9075 -- Other cases
9077 else
9078 loop
9079 Etyp := Etype (T);
9081 if T = Etyp then
9082 return T;
9084 -- Following test catches some error cases resulting from
9085 -- previous errors.
9087 elsif No (Etyp) then
9088 Check_Error_Detected;
9089 return T;
9091 elsif Is_Private_Type (T) and then Etyp = Full_View (T) then
9092 return T;
9094 elsif Is_Private_Type (Etyp) and then Full_View (Etyp) = T then
9095 return T;
9096 end if;
9098 T := Etyp;
9100 -- Return if there is a circularity in the inheritance chain. This
9101 -- happens in some error situations and we do not want to get
9102 -- stuck in this loop.
9104 if T = Base_Type (Id) then
9105 return T;
9106 end if;
9107 end loop;
9108 end if;
9109 end Root_Type;
9111 ---------------------
9112 -- Safe_Emax_Value --
9113 ---------------------
9115 function Safe_Emax_Value (Id : E) return Uint is
9116 begin
9117 return Machine_Emax_Value (Id);
9118 end Safe_Emax_Value;
9120 ----------------------
9121 -- Safe_First_Value --
9122 ----------------------
9124 function Safe_First_Value (Id : E) return Ureal is
9125 begin
9126 return -Safe_Last_Value (Id);
9127 end Safe_First_Value;
9129 ---------------------
9130 -- Safe_Last_Value --
9131 ---------------------
9133 function Safe_Last_Value (Id : E) return Ureal is
9134 Radix : constant Uint := Machine_Radix_Value (Id);
9135 Mantissa : constant Uint := Machine_Mantissa_Value (Id);
9136 Emax : constant Uint := Safe_Emax_Value (Id);
9137 Significand : constant Uint := Radix ** Mantissa - 1;
9138 Exponent : constant Uint := Emax - Mantissa;
9140 begin
9141 if Radix = 2 then
9142 return
9143 UR_From_Components
9144 (Num => Significand * 2 ** (Exponent mod 4),
9145 Den => -Exponent / 4,
9146 Rbase => 16);
9147 else
9148 return
9149 UR_From_Components
9150 (Num => Significand,
9151 Den => -Exponent,
9152 Rbase => 16);
9153 end if;
9154 end Safe_Last_Value;
9156 -----------------
9157 -- Scope_Depth --
9158 -----------------
9160 function Scope_Depth (Id : E) return Uint is
9161 Scop : Entity_Id;
9163 begin
9164 Scop := Id;
9165 while Is_Record_Type (Scop) loop
9166 Scop := Scope (Scop);
9167 end loop;
9169 return Scope_Depth_Value (Scop);
9170 end Scope_Depth;
9172 ---------------------
9173 -- Scope_Depth_Set --
9174 ---------------------
9176 function Scope_Depth_Set (Id : E) return B is
9177 begin
9178 return not Is_Record_Type (Id)
9179 and then Field22 (Id) /= Union_Id (Empty);
9180 end Scope_Depth_Set;
9182 -----------------------------
9183 -- Set_Component_Alignment --
9184 -----------------------------
9186 -- Component Alignment is encoded using two flags, Flag128/129 as
9187 -- follows. Note that both flags False = Align_Default, so that the
9188 -- default initialization of flags to False initializes component
9189 -- alignment to the default value as required.
9191 -- Flag128 Flag129 Value
9192 -- ------- ------- -----
9193 -- False False Calign_Default
9194 -- False True Calign_Component_Size
9195 -- True False Calign_Component_Size_4
9196 -- True True Calign_Storage_Unit
9198 procedure Set_Component_Alignment (Id : E; V : C) is
9199 begin
9200 pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id))
9201 and then Is_Base_Type (Id));
9203 case V is
9204 when Calign_Default =>
9205 Set_Flag128 (Id, False);
9206 Set_Flag129 (Id, False);
9208 when Calign_Component_Size =>
9209 Set_Flag128 (Id, False);
9210 Set_Flag129 (Id, True);
9212 when Calign_Component_Size_4 =>
9213 Set_Flag128 (Id, True);
9214 Set_Flag129 (Id, False);
9216 when Calign_Storage_Unit =>
9217 Set_Flag128 (Id, True);
9218 Set_Flag129 (Id, True);
9219 end case;
9220 end Set_Component_Alignment;
9222 -----------------------
9223 -- Set_DIC_Procedure --
9224 -----------------------
9226 procedure Set_DIC_Procedure (Id : E; V : E) is
9227 Base_Typ : Entity_Id;
9228 Subp_Elmt : Elmt_Id;
9229 Subp_Id : Entity_Id;
9230 Subps : Elist_Id;
9232 begin
9233 pragma Assert (Is_Type (Id));
9235 Base_Typ := Base_Type (Id);
9236 Subps := Subprograms_For_Type (Base_Typ);
9238 if No (Subps) then
9239 Subps := New_Elmt_List;
9240 Set_Subprograms_For_Type (Base_Typ, Subps);
9241 end if;
9243 Subp_Elmt := First_Elmt (Subps);
9244 Prepend_Elmt (V, Subps);
9246 -- Check for a duplicate default initial condition procedure
9248 while Present (Subp_Elmt) loop
9249 Subp_Id := Node (Subp_Elmt);
9251 if Is_DIC_Procedure (Subp_Id) then
9252 raise Program_Error;
9253 end if;
9255 Next_Elmt (Subp_Elmt);
9256 end loop;
9257 end Set_DIC_Procedure;
9259 -----------------------------
9260 -- Set_Invariant_Procedure --
9261 -----------------------------
9263 procedure Set_Invariant_Procedure (Id : E; V : E) is
9264 Base_Typ : Entity_Id;
9265 Subp_Elmt : Elmt_Id;
9266 Subp_Id : Entity_Id;
9267 Subps : Elist_Id;
9269 begin
9270 pragma Assert (Is_Type (Id));
9272 Base_Typ := Base_Type (Id);
9273 Subps := Subprograms_For_Type (Base_Typ);
9275 if No (Subps) then
9276 Subps := New_Elmt_List;
9277 Set_Subprograms_For_Type (Base_Typ, Subps);
9278 end if;
9280 Subp_Elmt := First_Elmt (Subps);
9281 Prepend_Elmt (V, Subps);
9283 -- Check for a duplicate invariant procedure
9285 while Present (Subp_Elmt) loop
9286 Subp_Id := Node (Subp_Elmt);
9288 if Is_Invariant_Procedure (Subp_Id) then
9289 raise Program_Error;
9290 end if;
9292 Next_Elmt (Subp_Elmt);
9293 end loop;
9294 end Set_Invariant_Procedure;
9296 -------------------------------------
9297 -- Set_Partial_Invariant_Procedure --
9298 -------------------------------------
9300 procedure Set_Partial_Invariant_Procedure (Id : E; V : E) is
9301 Base_Typ : Entity_Id;
9302 Subp_Elmt : Elmt_Id;
9303 Subp_Id : Entity_Id;
9304 Subps : Elist_Id;
9306 begin
9307 pragma Assert (Is_Type (Id));
9309 Base_Typ := Base_Type (Id);
9310 Subps := Subprograms_For_Type (Base_Typ);
9312 if No (Subps) then
9313 Subps := New_Elmt_List;
9314 Set_Subprograms_For_Type (Base_Typ, Subps);
9315 end if;
9317 Subp_Elmt := First_Elmt (Subps);
9318 Prepend_Elmt (V, Subps);
9320 -- Check for a duplicate partial invariant procedure
9322 while Present (Subp_Elmt) loop
9323 Subp_Id := Node (Subp_Elmt);
9325 if Is_Partial_Invariant_Procedure (Subp_Id) then
9326 raise Program_Error;
9327 end if;
9329 Next_Elmt (Subp_Elmt);
9330 end loop;
9331 end Set_Partial_Invariant_Procedure;
9333 ----------------------------
9334 -- Set_Predicate_Function --
9335 ----------------------------
9337 procedure Set_Predicate_Function (Id : E; V : E) is
9338 Subp_Elmt : Elmt_Id;
9339 Subp_Id : Entity_Id;
9340 Subps : Elist_Id;
9342 begin
9343 pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
9345 Subps := Subprograms_For_Type (Id);
9347 if No (Subps) then
9348 Subps := New_Elmt_List;
9349 Set_Subprograms_For_Type (Id, Subps);
9350 end if;
9352 Subp_Elmt := First_Elmt (Subps);
9353 Prepend_Elmt (V, Subps);
9355 -- Check for a duplicate predication function
9357 while Present (Subp_Elmt) loop
9358 Subp_Id := Node (Subp_Elmt);
9360 if Ekind (Subp_Id) = E_Function
9361 and then Is_Predicate_Function (Subp_Id)
9362 then
9363 raise Program_Error;
9364 end if;
9366 Next_Elmt (Subp_Elmt);
9367 end loop;
9368 end Set_Predicate_Function;
9370 ------------------------------
9371 -- Set_Predicate_Function_M --
9372 ------------------------------
9374 procedure Set_Predicate_Function_M (Id : E; V : E) is
9375 Subp_Elmt : Elmt_Id;
9376 Subp_Id : Entity_Id;
9377 Subps : Elist_Id;
9379 begin
9380 pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
9382 Subps := Subprograms_For_Type (Id);
9384 if No (Subps) then
9385 Subps := New_Elmt_List;
9386 Set_Subprograms_For_Type (Id, Subps);
9387 end if;
9389 Subp_Elmt := First_Elmt (Subps);
9390 Prepend_Elmt (V, Subps);
9392 -- Check for a duplicate predication function
9394 while Present (Subp_Elmt) loop
9395 Subp_Id := Node (Subp_Elmt);
9397 if Ekind (Subp_Id) = E_Function
9398 and then Is_Predicate_Function_M (Subp_Id)
9399 then
9400 raise Program_Error;
9401 end if;
9403 Next_Elmt (Subp_Elmt);
9404 end loop;
9405 end Set_Predicate_Function_M;
9407 -----------------
9408 -- Size_Clause --
9409 -----------------
9411 function Size_Clause (Id : E) return N is
9412 begin
9413 return Get_Attribute_Definition_Clause (Id, Attribute_Size);
9414 end Size_Clause;
9416 ------------------------
9417 -- Stream_Size_Clause --
9418 ------------------------
9420 function Stream_Size_Clause (Id : E) return N is
9421 begin
9422 return Get_Attribute_Definition_Clause (Id, Attribute_Stream_Size);
9423 end Stream_Size_Clause;
9425 ------------------
9426 -- Subtype_Kind --
9427 ------------------
9429 function Subtype_Kind (K : Entity_Kind) return Entity_Kind is
9430 Kind : Entity_Kind;
9432 begin
9433 case K is
9434 when Access_Kind =>
9435 Kind := E_Access_Subtype;
9437 when E_Array_Subtype
9438 | E_Array_Type
9440 Kind := E_Array_Subtype;
9442 when E_Class_Wide_Subtype
9443 | E_Class_Wide_Type
9445 Kind := E_Class_Wide_Subtype;
9447 when E_Decimal_Fixed_Point_Subtype
9448 | E_Decimal_Fixed_Point_Type
9450 Kind := E_Decimal_Fixed_Point_Subtype;
9452 when E_Ordinary_Fixed_Point_Subtype
9453 | E_Ordinary_Fixed_Point_Type
9455 Kind := E_Ordinary_Fixed_Point_Subtype;
9457 when E_Private_Subtype
9458 | E_Private_Type
9460 Kind := E_Private_Subtype;
9462 when E_Limited_Private_Subtype
9463 | E_Limited_Private_Type
9465 Kind := E_Limited_Private_Subtype;
9467 when E_Record_Subtype_With_Private
9468 | E_Record_Type_With_Private
9470 Kind := E_Record_Subtype_With_Private;
9472 when E_Record_Subtype
9473 | E_Record_Type
9475 Kind := E_Record_Subtype;
9477 when Enumeration_Kind =>
9478 Kind := E_Enumeration_Subtype;
9480 when E_Incomplete_Type =>
9481 Kind := E_Incomplete_Subtype;
9483 when Float_Kind =>
9484 Kind := E_Floating_Point_Subtype;
9486 when Signed_Integer_Kind =>
9487 Kind := E_Signed_Integer_Subtype;
9489 when Modular_Integer_Kind =>
9490 Kind := E_Modular_Integer_Subtype;
9492 when Protected_Kind =>
9493 Kind := E_Protected_Subtype;
9495 when Task_Kind =>
9496 Kind := E_Task_Subtype;
9498 when others =>
9499 Kind := E_Void;
9500 raise Program_Error;
9501 end case;
9503 return Kind;
9504 end Subtype_Kind;
9506 ---------------------
9507 -- Type_High_Bound --
9508 ---------------------
9510 function Type_High_Bound (Id : E) return Node_Id is
9511 Rng : constant Node_Id := Scalar_Range (Id);
9512 begin
9513 if Nkind (Rng) = N_Subtype_Indication then
9514 return High_Bound (Range_Expression (Constraint (Rng)));
9515 else
9516 return High_Bound (Rng);
9517 end if;
9518 end Type_High_Bound;
9520 --------------------
9521 -- Type_Low_Bound --
9522 --------------------
9524 function Type_Low_Bound (Id : E) return Node_Id is
9525 Rng : constant Node_Id := Scalar_Range (Id);
9526 begin
9527 if Nkind (Rng) = N_Subtype_Indication then
9528 return Low_Bound (Range_Expression (Constraint (Rng)));
9529 else
9530 return Low_Bound (Rng);
9531 end if;
9532 end Type_Low_Bound;
9534 ---------------------
9535 -- Underlying_Type --
9536 ---------------------
9538 function Underlying_Type (Id : E) return E is
9539 begin
9540 -- For record_with_private the underlying type is always the direct full
9541 -- view. Never try to take the full view of the parent it does not make
9542 -- sense.
9544 if Ekind (Id) = E_Record_Type_With_Private then
9545 return Full_View (Id);
9547 -- If we have a class-wide type that comes from the limited view then we
9548 -- return the Underlying_Type of its nonlimited view.
9550 elsif Ekind (Id) = E_Class_Wide_Type
9551 and then From_Limited_With (Id)
9552 and then Present (Non_Limited_View (Id))
9553 then
9554 return Underlying_Type (Non_Limited_View (Id));
9556 elsif Ekind (Id) in Incomplete_Or_Private_Kind then
9558 -- If we have an incomplete or private type with a full view, then we
9559 -- return the Underlying_Type of this full view.
9561 if Present (Full_View (Id)) then
9562 if Id = Full_View (Id) then
9564 -- Previous error in declaration
9566 return Empty;
9568 else
9569 return Underlying_Type (Full_View (Id));
9570 end if;
9572 -- If we have a private type with an underlying full view, then we
9573 -- return the Underlying_Type of this underlying full view.
9575 elsif Ekind (Id) in Private_Kind
9576 and then Present (Underlying_Full_View (Id))
9577 then
9578 return Underlying_Type (Underlying_Full_View (Id));
9580 -- If we have an incomplete entity that comes from the limited view
9581 -- then we return the Underlying_Type of its nonlimited view.
9583 elsif From_Limited_With (Id)
9584 and then Present (Non_Limited_View (Id))
9585 then
9586 return Underlying_Type (Non_Limited_View (Id));
9588 -- Otherwise check for the case where we have a derived type or
9589 -- subtype, and if so get the Underlying_Type of the parent type.
9591 elsif Etype (Id) /= Id then
9592 return Underlying_Type (Etype (Id));
9594 -- Otherwise we have an incomplete or private type that has no full
9595 -- view, which means that we have not encountered the completion, so
9596 -- return Empty to indicate the underlying type is not yet known.
9598 else
9599 return Empty;
9600 end if;
9602 -- For non-incomplete, non-private types, return the type itself Also
9603 -- for entities that are not types at all return the entity itself.
9605 else
9606 return Id;
9607 end if;
9608 end Underlying_Type;
9610 ------------------------
9611 -- Unlink_Next_Entity --
9612 ------------------------
9614 procedure Unlink_Next_Entity (Id : Entity_Id) is
9615 Next : constant Entity_Id := Next_Entity (Id);
9617 begin
9618 if Present (Next) then
9619 Set_Prev_Entity (Next, Empty); -- Empty <-- Next
9620 end if;
9622 Set_Next_Entity (Id, Empty); -- Id --> Empty
9623 end Unlink_Next_Entity;
9625 ------------------------
9626 -- Write_Entity_Flags --
9627 ------------------------
9629 procedure Write_Entity_Flags (Id : Entity_Id; Prefix : String) is
9631 procedure W (Flag_Name : String; Flag : Boolean);
9632 -- Write out given flag if it is set
9634 -------
9635 -- W --
9636 -------
9638 procedure W (Flag_Name : String; Flag : Boolean) is
9639 begin
9640 if Flag then
9641 Write_Str (Prefix);
9642 Write_Str (Flag_Name);
9643 Write_Str (" = True");
9644 Write_Eol;
9645 end if;
9646 end W;
9648 -- Start of processing for Write_Entity_Flags
9650 begin
9651 if (Is_Array_Type (Id) or else Is_Record_Type (Id))
9652 and then Is_Base_Type (Id)
9653 then
9654 Write_Str (Prefix);
9655 Write_Str ("Component_Alignment = ");
9657 case Component_Alignment (Id) is
9658 when Calign_Default =>
9659 Write_Str ("Calign_Default");
9661 when Calign_Component_Size =>
9662 Write_Str ("Calign_Component_Size");
9664 when Calign_Component_Size_4 =>
9665 Write_Str ("Calign_Component_Size_4");
9667 when Calign_Storage_Unit =>
9668 Write_Str ("Calign_Storage_Unit");
9669 end case;
9671 Write_Eol;
9672 end if;
9674 W ("Address_Taken", Flag104 (Id));
9675 W ("Body_Needed_For_Inlining", Flag299 (Id));
9676 W ("Body_Needed_For_SAL", Flag40 (Id));
9677 W ("C_Pass_By_Copy", Flag125 (Id));
9678 W ("Can_Never_Be_Null", Flag38 (Id));
9679 W ("Checks_May_Be_Suppressed", Flag31 (Id));
9680 W ("Contains_Ignored_Ghost_Code", Flag279 (Id));
9681 W ("Debug_Info_Off", Flag166 (Id));
9682 W ("Default_Expressions_Processed", Flag108 (Id));
9683 W ("Delay_Cleanups", Flag114 (Id));
9684 W ("Delay_Subprogram_Descriptors", Flag50 (Id));
9685 W ("Depends_On_Private", Flag14 (Id));
9686 W ("Discard_Names", Flag88 (Id));
9687 W ("Elaboration_Entity_Required", Flag174 (Id));
9688 W ("Elaborate_Body_Desirable", Flag210 (Id));
9689 W ("Entry_Accepted", Flag152 (Id));
9690 W ("Can_Use_Internal_Rep", Flag229 (Id));
9691 W ("Finalize_Storage_Only", Flag158 (Id));
9692 W ("From_Limited_With", Flag159 (Id));
9693 W ("Has_Aliased_Components", Flag135 (Id));
9694 W ("Has_Alignment_Clause", Flag46 (Id));
9695 W ("Has_All_Calls_Remote", Flag79 (Id));
9696 W ("Has_Atomic_Components", Flag86 (Id));
9697 W ("Has_Biased_Representation", Flag139 (Id));
9698 W ("Has_Completion", Flag26 (Id));
9699 W ("Has_Completion_In_Body", Flag71 (Id));
9700 W ("Has_Complex_Representation", Flag140 (Id));
9701 W ("Has_Component_Size_Clause", Flag68 (Id));
9702 W ("Has_Contiguous_Rep", Flag181 (Id));
9703 W ("Has_Controlled_Component", Flag43 (Id));
9704 W ("Has_Controlling_Result", Flag98 (Id));
9705 W ("Has_Convention_Pragma", Flag119 (Id));
9706 W ("Has_Default_Aspect", Flag39 (Id));
9707 W ("Has_Delayed_Aspects", Flag200 (Id));
9708 W ("Has_Delayed_Freeze", Flag18 (Id));
9709 W ("Has_Delayed_Rep_Aspects", Flag261 (Id));
9710 W ("Has_Discriminants", Flag5 (Id));
9711 W ("Has_Dispatch_Table", Flag220 (Id));
9712 W ("Has_Dynamic_Predicate_Aspect", Flag258 (Id));
9713 W ("Has_Enumeration_Rep_Clause", Flag66 (Id));
9714 W ("Has_Exit", Flag47 (Id));
9715 W ("Has_Expanded_Contract", Flag240 (Id));
9716 W ("Has_Forward_Instantiation", Flag175 (Id));
9717 W ("Has_Fully_Qualified_Name", Flag173 (Id));
9718 W ("Has_Gigi_Rep_Item", Flag82 (Id));
9719 W ("Has_Homonym", Flag56 (Id));
9720 W ("Has_Implicit_Dereference", Flag251 (Id));
9721 W ("Has_Independent_Components", Flag34 (Id));
9722 W ("Has_Inheritable_Invariants", Flag248 (Id));
9723 W ("Has_Inherited_DIC", Flag133 (Id));
9724 W ("Has_Inherited_Invariants", Flag291 (Id));
9725 W ("Has_Initial_Value", Flag219 (Id));
9726 W ("Has_Loop_Entry_Attributes", Flag260 (Id));
9727 W ("Has_Machine_Radix_Clause", Flag83 (Id));
9728 W ("Has_Master_Entity", Flag21 (Id));
9729 W ("Has_Missing_Return", Flag142 (Id));
9730 W ("Has_Nested_Block_With_Handler", Flag101 (Id));
9731 W ("Has_Nested_Subprogram", Flag282 (Id));
9732 W ("Has_Non_Standard_Rep", Flag75 (Id));
9733 W ("Has_Out_Or_In_Out_Parameter", Flag110 (Id));
9734 W ("Has_Object_Size_Clause", Flag172 (Id));
9735 W ("Has_Own_DIC", Flag3 (Id));
9736 W ("Has_Own_Invariants", Flag232 (Id));
9737 W ("Has_Per_Object_Constraint", Flag154 (Id));
9738 W ("Has_Pragma_Controlled", Flag27 (Id));
9739 W ("Has_Pragma_Elaborate_Body", Flag150 (Id));
9740 W ("Has_Pragma_Inline", Flag157 (Id));
9741 W ("Has_Pragma_Inline_Always", Flag230 (Id));
9742 W ("Has_Pragma_No_Inline", Flag201 (Id));
9743 W ("Has_Pragma_Ordered", Flag198 (Id));
9744 W ("Has_Pragma_Pack", Flag121 (Id));
9745 W ("Has_Pragma_Preelab_Init", Flag221 (Id));
9746 W ("Has_Pragma_Pure", Flag203 (Id));
9747 W ("Has_Pragma_Pure_Function", Flag179 (Id));
9748 W ("Has_Pragma_Thread_Local_Storage", Flag169 (Id));
9749 W ("Has_Pragma_Unmodified", Flag233 (Id));
9750 W ("Has_Pragma_Unreferenced", Flag180 (Id));
9751 W ("Has_Pragma_Unreferenced_Objects", Flag212 (Id));
9752 W ("Has_Pragma_Unused", Flag294 (Id));
9753 W ("Has_Predicates", Flag250 (Id));
9754 W ("Has_Primitive_Operations", Flag120 (Id));
9755 W ("Has_Private_Ancestor", Flag151 (Id));
9756 W ("Has_Private_Declaration", Flag155 (Id));
9757 W ("Has_Private_Extension", Flag300 (Id));
9758 W ("Has_Protected", Flag271 (Id));
9759 W ("Has_Qualified_Name", Flag161 (Id));
9760 W ("Has_RACW", Flag214 (Id));
9761 W ("Has_Record_Rep_Clause", Flag65 (Id));
9762 W ("Has_Recursive_Call", Flag143 (Id));
9763 W ("Has_Shift_Operator", Flag267 (Id));
9764 W ("Has_Size_Clause", Flag29 (Id));
9765 W ("Has_Small_Clause", Flag67 (Id));
9766 W ("Has_Specified_Layout", Flag100 (Id));
9767 W ("Has_Specified_Stream_Input", Flag190 (Id));
9768 W ("Has_Specified_Stream_Output", Flag191 (Id));
9769 W ("Has_Specified_Stream_Read", Flag192 (Id));
9770 W ("Has_Specified_Stream_Write", Flag193 (Id));
9771 W ("Has_Static_Discriminants", Flag211 (Id));
9772 W ("Has_Static_Predicate", Flag269 (Id));
9773 W ("Has_Static_Predicate_Aspect", Flag259 (Id));
9774 W ("Has_Storage_Size_Clause", Flag23 (Id));
9775 W ("Has_Stream_Size_Clause", Flag184 (Id));
9776 W ("Has_Task", Flag30 (Id));
9777 W ("Has_Timing_Event", Flag289 (Id));
9778 W ("Has_Thunks", Flag228 (Id));
9779 W ("Has_Unchecked_Union", Flag123 (Id));
9780 W ("Has_Unknown_Discriminants", Flag72 (Id));
9781 W ("Has_Visible_Refinement", Flag263 (Id));
9782 W ("Has_Volatile_Components", Flag87 (Id));
9783 W ("Has_Xref_Entry", Flag182 (Id));
9784 W ("Ignore_SPARK_Mode_Pragmas", Flag301 (Id));
9785 W ("In_Package_Body", Flag48 (Id));
9786 W ("In_Private_Part", Flag45 (Id));
9787 W ("In_Use", Flag8 (Id));
9788 W ("Is_Abstract_Subprogram", Flag19 (Id));
9789 W ("Is_Abstract_Type", Flag146 (Id));
9790 W ("Is_Access_Constant", Flag69 (Id));
9791 W ("Is_Actual_Subtype", Flag293 (Id));
9792 W ("Is_Ada_2005_Only", Flag185 (Id));
9793 W ("Is_Ada_2012_Only", Flag199 (Id));
9794 W ("Is_Aliased", Flag15 (Id));
9795 W ("Is_Asynchronous", Flag81 (Id));
9796 W ("Is_Atomic", Flag85 (Id));
9797 W ("Is_Bit_Packed_Array", Flag122 (Id));
9798 W ("Is_CPP_Class", Flag74 (Id));
9799 W ("Is_Called", Flag102 (Id));
9800 W ("Is_Character_Type", Flag63 (Id));
9801 W ("Is_Checked_Ghost_Entity", Flag277 (Id));
9802 W ("Is_Child_Unit", Flag73 (Id));
9803 W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id));
9804 W ("Is_Compilation_Unit", Flag149 (Id));
9805 W ("Is_Completely_Hidden", Flag103 (Id));
9806 W ("Is_Concurrent_Record_Type", Flag20 (Id));
9807 W ("Is_Constr_Subt_For_UN_Aliased", Flag141 (Id));
9808 W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
9809 W ("Is_Constrained", Flag12 (Id));
9810 W ("Is_Constructor", Flag76 (Id));
9811 W ("Is_Controlled_Active", Flag42 (Id));
9812 W ("Is_Controlling_Formal", Flag97 (Id));
9813 W ("Is_Descendant_Of_Address", Flag223 (Id));
9814 W ("Is_DIC_Procedure", Flag132 (Id));
9815 W ("Is_Discrim_SO_Function", Flag176 (Id));
9816 W ("Is_Discriminant_Check_Function", Flag264 (Id));
9817 W ("Is_Dispatch_Table_Entity", Flag234 (Id));
9818 W ("Is_Dispatching_Operation", Flag6 (Id));
9819 W ("Is_Elaboration_Checks_OK_Id", Flag148 (Id));
9820 W ("Is_Elaboration_Warnings_OK_Id", Flag304 (Id));
9821 W ("Is_Eliminated", Flag124 (Id));
9822 W ("Is_Entry_Formal", Flag52 (Id));
9823 W ("Is_Exception_Handler", Flag286 (Id));
9824 W ("Is_Exported", Flag99 (Id));
9825 W ("Is_Finalized_Transient", Flag252 (Id));
9826 W ("Is_First_Subtype", Flag70 (Id));
9827 W ("Is_For_Access_Subtype", Flag118 (Id));
9828 W ("Is_Formal_Subprogram", Flag111 (Id));
9829 W ("Is_Frozen", Flag4 (Id));
9830 W ("Is_Generic_Actual_Subprogram", Flag274 (Id));
9831 W ("Is_Generic_Actual_Type", Flag94 (Id));
9832 W ("Is_Generic_Instance", Flag130 (Id));
9833 W ("Is_Generic_Type", Flag13 (Id));
9834 W ("Is_Hidden", Flag57 (Id));
9835 W ("Is_Hidden_Non_Overridden_Subpgm", Flag2 (Id));
9836 W ("Is_Hidden_Open_Scope", Flag171 (Id));
9837 W ("Is_Ignored_Ghost_Entity", Flag278 (Id));
9838 W ("Is_Ignored_Transient", Flag295 (Id));
9839 W ("Is_Immediately_Visible", Flag7 (Id));
9840 W ("Is_Implementation_Defined", Flag254 (Id));
9841 W ("Is_Imported", Flag24 (Id));
9842 W ("Is_Independent", Flag268 (Id));
9843 W ("Is_Initial_Condition_Procedure", Flag302 (Id));
9844 W ("Is_Inlined", Flag11 (Id));
9845 W ("Is_Inlined_Always", Flag1 (Id));
9846 W ("Is_Instantiated", Flag126 (Id));
9847 W ("Is_Interface", Flag186 (Id));
9848 W ("Is_Internal", Flag17 (Id));
9849 W ("Is_Interrupt_Handler", Flag89 (Id));
9850 W ("Is_Intrinsic_Subprogram", Flag64 (Id));
9851 W ("Is_Invariant_Procedure", Flag257 (Id));
9852 W ("Is_Itype", Flag91 (Id));
9853 W ("Is_Known_Non_Null", Flag37 (Id));
9854 W ("Is_Known_Null", Flag204 (Id));
9855 W ("Is_Known_Valid", Flag170 (Id));
9856 W ("Is_Limited_Composite", Flag106 (Id));
9857 W ("Is_Limited_Interface", Flag197 (Id));
9858 W ("Is_Limited_Record", Flag25 (Id));
9859 W ("Is_Local_Anonymous_Access", Flag194 (Id));
9860 W ("Is_Machine_Code_Subprogram", Flag137 (Id));
9861 W ("Is_Non_Static_Subtype", Flag109 (Id));
9862 W ("Is_Null_Init_Proc", Flag178 (Id));
9863 W ("Is_Obsolescent", Flag153 (Id));
9864 W ("Is_Only_Out_Parameter", Flag226 (Id));
9865 W ("Is_Package_Body_Entity", Flag160 (Id));
9866 W ("Is_Packed", Flag51 (Id));
9867 W ("Is_Packed_Array_Impl_Type", Flag138 (Id));
9868 W ("Is_Param_Block_Component_Type", Flag215 (Id));
9869 W ("Is_Partial_Invariant_Procedure", Flag292 (Id));
9870 W ("Is_Potentially_Use_Visible", Flag9 (Id));
9871 W ("Is_Predicate_Function", Flag255 (Id));
9872 W ("Is_Predicate_Function_M", Flag256 (Id));
9873 W ("Is_Preelaborated", Flag59 (Id));
9874 W ("Is_Primitive", Flag218 (Id));
9875 W ("Is_Primitive_Wrapper", Flag195 (Id));
9876 W ("Is_Private_Composite", Flag107 (Id));
9877 W ("Is_Private_Descendant", Flag53 (Id));
9878 W ("Is_Private_Primitive", Flag245 (Id));
9879 W ("Is_Public", Flag10 (Id));
9880 W ("Is_Pure", Flag44 (Id));
9881 W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
9882 W ("Is_RACW_Stub_Type", Flag244 (Id));
9883 W ("Is_Raised", Flag224 (Id));
9884 W ("Is_Remote_Call_Interface", Flag62 (Id));
9885 W ("Is_Remote_Types", Flag61 (Id));
9886 W ("Is_Renaming_Of_Object", Flag112 (Id));
9887 W ("Is_Return_Object", Flag209 (Id));
9888 W ("Is_Safe_To_Reevaluate", Flag249 (Id));
9889 W ("Is_Shared_Passive", Flag60 (Id));
9890 W ("Is_Static_Type", Flag281 (Id));
9891 W ("Is_Statically_Allocated", Flag28 (Id));
9892 W ("Is_Tag", Flag78 (Id));
9893 W ("Is_Tagged_Type", Flag55 (Id));
9894 W ("Is_Thunk", Flag225 (Id));
9895 W ("Is_Trivial_Subprogram", Flag235 (Id));
9896 W ("Is_True_Constant", Flag163 (Id));
9897 W ("Is_Unchecked_Union", Flag117 (Id));
9898 W ("Is_Underlying_Full_View", Flag298 (Id));
9899 W ("Is_Underlying_Record_View", Flag246 (Id));
9900 W ("Is_Unimplemented", Flag284 (Id));
9901 W ("Is_Unsigned_Type", Flag144 (Id));
9902 W ("Is_Uplevel_Referenced_Entity", Flag283 (Id));
9903 W ("Is_Valued_Procedure", Flag127 (Id));
9904 W ("Is_Visible_Formal", Flag206 (Id));
9905 W ("Is_Visible_Lib_Unit", Flag116 (Id));
9906 W ("Is_Volatile", Flag16 (Id));
9907 W ("Is_Volatile_Full_Access", Flag285 (Id));
9908 W ("Itype_Printed", Flag202 (Id));
9909 W ("Kill_Elaboration_Checks", Flag32 (Id));
9910 W ("Kill_Range_Checks", Flag33 (Id));
9911 W ("Known_To_Have_Preelab_Init", Flag207 (Id));
9912 W ("Low_Bound_Tested", Flag205 (Id));
9913 W ("Machine_Radix_10", Flag84 (Id));
9914 W ("Materialize_Entity", Flag168 (Id));
9915 W ("May_Inherit_Delayed_Rep_Aspects", Flag262 (Id));
9916 W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
9917 W ("Must_Have_Preelab_Init", Flag208 (Id));
9918 W ("Needs_Debug_Info", Flag147 (Id));
9919 W ("Needs_No_Actuals", Flag22 (Id));
9920 W ("Never_Set_In_Source", Flag115 (Id));
9921 W ("No_Dynamic_Predicate_On_actual", Flag276 (Id));
9922 W ("No_Pool_Assigned", Flag131 (Id));
9923 W ("No_Predicate_On_actual", Flag275 (Id));
9924 W ("No_Reordering", Flag239 (Id));
9925 W ("No_Return", Flag113 (Id));
9926 W ("No_Strict_Aliasing", Flag136 (Id));
9927 W ("Non_Binary_Modulus", Flag58 (Id));
9928 W ("Nonzero_Is_True", Flag162 (Id));
9929 W ("OK_To_Rename", Flag247 (Id));
9930 W ("Optimize_Alignment_Space", Flag241 (Id));
9931 W ("Optimize_Alignment_Time", Flag242 (Id));
9932 W ("Overlays_Constant", Flag243 (Id));
9933 W ("Partial_View_Has_Unknown_Discr", Flag280 (Id));
9934 W ("Reachable", Flag49 (Id));
9935 W ("Referenced", Flag156 (Id));
9936 W ("Referenced_As_LHS", Flag36 (Id));
9937 W ("Referenced_As_Out_Parameter", Flag227 (Id));
9938 W ("Renamed_In_Spec", Flag231 (Id));
9939 W ("Requires_Overriding", Flag213 (Id));
9940 W ("Return_Present", Flag54 (Id));
9941 W ("Returns_By_Ref", Flag90 (Id));
9942 W ("Reverse_Bit_Order", Flag164 (Id));
9943 W ("Reverse_Storage_Order", Flag93 (Id));
9944 W ("Rewritten_For_C", Flag287 (Id));
9945 W ("Predicates_Ignored", Flag288 (Id));
9946 W ("Sec_Stack_Needed_For_Return", Flag167 (Id));
9947 W ("Size_Depends_On_Discriminant", Flag177 (Id));
9948 W ("Size_Known_At_Compile_Time", Flag92 (Id));
9949 W ("SPARK_Aux_Pragma_Inherited", Flag266 (Id));
9950 W ("SPARK_Pragma_Inherited", Flag265 (Id));
9951 W ("SSO_Set_High_By_Default", Flag273 (Id));
9952 W ("SSO_Set_Low_By_Default", Flag272 (Id));
9953 W ("Static_Elaboration_Desired", Flag77 (Id));
9954 W ("Stores_Attribute_Old_Prefix", Flag270 (Id));
9955 W ("Strict_Alignment", Flag145 (Id));
9956 W ("Suppress_Elaboration_Warnings", Flag303 (Id));
9957 W ("Suppress_Initialization", Flag105 (Id));
9958 W ("Suppress_Style_Checks", Flag165 (Id));
9959 W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
9960 W ("Treat_As_Volatile", Flag41 (Id));
9961 W ("Universal_Aliasing", Flag216 (Id));
9962 W ("Used_As_Generic_Actual", Flag222 (Id));
9963 W ("Uses_Sec_Stack", Flag95 (Id));
9964 W ("Warnings_Off", Flag96 (Id));
9965 W ("Warnings_Off_Used", Flag236 (Id));
9966 W ("Warnings_Off_Used_Unmodified", Flag237 (Id));
9967 W ("Warnings_Off_Used_Unreferenced", Flag238 (Id));
9968 W ("Was_Hidden", Flag196 (Id));
9969 end Write_Entity_Flags;
9971 -----------------------
9972 -- Write_Entity_Info --
9973 -----------------------
9975 procedure Write_Entity_Info (Id : Entity_Id; Prefix : String) is
9977 procedure Write_Attribute (Which : String; Nam : E);
9978 -- Write attribute value with given string name
9980 procedure Write_Kind (Id : Entity_Id);
9981 -- Write Ekind field of entity
9983 ---------------------
9984 -- Write_Attribute --
9985 ---------------------
9987 procedure Write_Attribute (Which : String; Nam : E) is
9988 begin
9989 Write_Str (Prefix);
9990 Write_Str (Which);
9991 Write_Int (Int (Nam));
9992 Write_Str (" ");
9993 Write_Name (Chars (Nam));
9994 Write_Str (" ");
9995 end Write_Attribute;
9997 ----------------
9998 -- Write_Kind --
9999 ----------------
10001 procedure Write_Kind (Id : Entity_Id) is
10002 K : constant String := Entity_Kind'Image (Ekind (Id));
10004 begin
10005 Write_Str (Prefix);
10006 Write_Str (" Kind ");
10008 if Is_Type (Id) and then Is_Tagged_Type (Id) then
10009 Write_Str ("TAGGED ");
10010 end if;
10012 Write_Str (K (3 .. K'Length));
10013 Write_Str (" ");
10015 if Is_Type (Id) and then Depends_On_Private (Id) then
10016 Write_Str ("Depends_On_Private ");
10017 end if;
10018 end Write_Kind;
10020 -- Start of processing for Write_Entity_Info
10022 begin
10023 Write_Eol;
10024 Write_Attribute ("Name ", Id);
10025 Write_Int (Int (Id));
10026 Write_Eol;
10027 Write_Kind (Id);
10028 Write_Eol;
10029 Write_Attribute (" Type ", Etype (Id));
10030 Write_Eol;
10031 Write_Attribute (" Scope ", Scope (Id));
10032 Write_Eol;
10034 case Ekind (Id) is
10035 when Discrete_Kind =>
10036 Write_Str ("Bounds: Id = ");
10038 if Present (Scalar_Range (Id)) then
10039 Write_Int (Int (Type_Low_Bound (Id)));
10040 Write_Str (" .. Id = ");
10041 Write_Int (Int (Type_High_Bound (Id)));
10042 else
10043 Write_Str ("Empty");
10044 end if;
10046 Write_Eol;
10048 when Array_Kind =>
10049 declare
10050 Index : E;
10052 begin
10053 Write_Attribute
10054 (" Component Type ", Component_Type (Id));
10055 Write_Eol;
10056 Write_Str (Prefix);
10057 Write_Str (" Indexes ");
10059 Index := First_Index (Id);
10060 while Present (Index) loop
10061 Write_Attribute (" ", Etype (Index));
10062 Index := Next_Index (Index);
10063 end loop;
10065 Write_Eol;
10066 end;
10068 when Access_Kind =>
10069 Write_Attribute
10070 (" Directly Designated Type ",
10071 Directly_Designated_Type (Id));
10072 Write_Eol;
10074 when Overloadable_Kind =>
10075 if Present (Homonym (Id)) then
10076 Write_Str (" Homonym ");
10077 Write_Name (Chars (Homonym (Id)));
10078 Write_Str (" ");
10079 Write_Int (Int (Homonym (Id)));
10080 Write_Eol;
10081 end if;
10083 Write_Eol;
10085 when E_Component =>
10086 if Ekind (Scope (Id)) in Record_Kind then
10087 Write_Attribute (
10088 " Original_Record_Component ",
10089 Original_Record_Component (Id));
10090 Write_Int (Int (Original_Record_Component (Id)));
10091 Write_Eol;
10092 end if;
10094 when others =>
10095 null;
10096 end case;
10097 end Write_Entity_Info;
10099 -----------------------
10100 -- Write_Field6_Name --
10101 -----------------------
10103 procedure Write_Field6_Name (Id : Entity_Id) is
10104 pragma Unreferenced (Id);
10105 begin
10106 Write_Str ("First_Rep_Item");
10107 end Write_Field6_Name;
10109 -----------------------
10110 -- Write_Field7_Name --
10111 -----------------------
10113 procedure Write_Field7_Name (Id : Entity_Id) is
10114 pragma Unreferenced (Id);
10115 begin
10116 Write_Str ("Freeze_Node");
10117 end Write_Field7_Name;
10119 -----------------------
10120 -- Write_Field8_Name --
10121 -----------------------
10123 procedure Write_Field8_Name (Id : Entity_Id) is
10124 begin
10125 case Ekind (Id) is
10126 when Type_Kind =>
10127 Write_Str ("Associated_Node_For_Itype");
10129 when E_Package =>
10130 Write_Str ("Dependent_Instances");
10132 when E_Loop =>
10133 Write_Str ("First_Exit_Statement");
10135 when E_Variable =>
10136 Write_Str ("Hiding_Loop_Variable");
10138 when Formal_Kind
10139 | E_Function
10140 | E_Subprogram_Body
10142 Write_Str ("Mechanism");
10144 when E_Component
10145 | E_Discriminant
10147 Write_Str ("Normalized_First_Bit");
10149 when E_Abstract_State =>
10150 Write_Str ("Refinement_Constituents");
10152 when E_Return_Statement =>
10153 Write_Str ("Return_Applies_To");
10155 when others =>
10156 Write_Str ("Field8??");
10157 end case;
10158 end Write_Field8_Name;
10160 -----------------------
10161 -- Write_Field9_Name --
10162 -----------------------
10164 procedure Write_Field9_Name (Id : Entity_Id) is
10165 begin
10166 case Ekind (Id) is
10167 when Type_Kind =>
10168 Write_Str ("Class_Wide_Type");
10170 when Object_Kind =>
10171 Write_Str ("Current_Value");
10173 when E_Function
10174 | E_Generic_Function
10175 | E_Generic_Package
10176 | E_Generic_Procedure
10177 | E_Package
10178 | E_Procedure
10180 Write_Str ("Renaming_Map");
10182 when others =>
10183 Write_Str ("Field9??");
10184 end case;
10185 end Write_Field9_Name;
10187 ------------------------
10188 -- Write_Field10_Name --
10189 ------------------------
10191 procedure Write_Field10_Name (Id : Entity_Id) is
10192 begin
10193 case Ekind (Id) is
10194 when Class_Wide_Kind
10195 | Incomplete_Kind
10196 | E_Record_Type
10197 | E_Record_Subtype
10198 | Private_Kind
10199 | Concurrent_Kind
10201 Write_Str ("Direct_Primitive_Operations");
10203 when E_Constant
10204 | E_In_Parameter
10206 Write_Str ("Discriminal_Link");
10208 when Float_Kind =>
10209 Write_Str ("Float_Rep");
10211 when E_Function
10212 | E_Package
10213 | E_Package_Body
10214 | E_Procedure
10216 Write_Str ("Handler_Records");
10218 when E_Component
10219 | E_Discriminant
10221 Write_Str ("Normalized_Position_Max");
10223 when E_Abstract_State
10224 | E_Variable
10226 Write_Str ("Part_Of_Constituents");
10228 when others =>
10229 Write_Str ("Field10??");
10230 end case;
10231 end Write_Field10_Name;
10233 ------------------------
10234 -- Write_Field11_Name --
10235 ------------------------
10237 procedure Write_Field11_Name (Id : Entity_Id) is
10238 begin
10239 case Ekind (Id) is
10240 when E_Block =>
10241 Write_Str ("Block_Node");
10243 when E_Component
10244 | E_Discriminant
10246 Write_Str ("Component_Bit_Offset");
10248 when Formal_Kind =>
10249 Write_Str ("Entry_Component");
10251 when E_Enumeration_Literal =>
10252 Write_Str ("Enumeration_Pos");
10254 when Type_Kind
10255 | E_Constant
10257 Write_Str ("Full_View");
10259 when E_Generic_Package =>
10260 Write_Str ("Generic_Homonym");
10262 when E_Variable =>
10263 Write_Str ("Part_Of_References");
10265 when E_Entry
10266 | E_Entry_Family
10267 | E_Function
10268 | E_Procedure
10270 Write_Str ("Protected_Body_Subprogram");
10272 when others =>
10273 Write_Str ("Field11??");
10274 end case;
10275 end Write_Field11_Name;
10277 ------------------------
10278 -- Write_Field12_Name --
10279 ------------------------
10281 procedure Write_Field12_Name (Id : Entity_Id) is
10282 begin
10283 case Ekind (Id) is
10284 when E_Package =>
10285 Write_Str ("Associated_Formal_Package");
10287 when Entry_Kind =>
10288 Write_Str ("Barrier_Function");
10290 when E_Enumeration_Literal =>
10291 Write_Str ("Enumeration_Rep");
10293 when Type_Kind
10294 | E_Component
10295 | E_Constant
10296 | E_Discriminant
10297 | E_Exception
10298 | E_In_Parameter
10299 | E_In_Out_Parameter
10300 | E_Out_Parameter
10301 | E_Loop_Parameter
10302 | E_Variable
10304 Write_Str ("Esize");
10306 when E_Function
10307 | E_Procedure
10309 Write_Str ("Next_Inlined_Subprogram");
10311 when others =>
10312 Write_Str ("Field12??");
10313 end case;
10314 end Write_Field12_Name;
10316 ------------------------
10317 -- Write_Field13_Name --
10318 ------------------------
10320 procedure Write_Field13_Name (Id : Entity_Id) is
10321 begin
10322 case Ekind (Id) is
10323 when E_Component
10324 | E_Discriminant
10326 Write_Str ("Component_Clause");
10328 when E_Function
10329 | E_Procedure
10330 | E_Package
10331 | Generic_Unit_Kind
10333 Write_Str ("Elaboration_Entity");
10335 when Formal_Kind
10336 | E_Variable
10338 Write_Str ("Extra_Accessibility");
10340 when Type_Kind =>
10341 Write_Str ("RM_Size");
10343 when others =>
10344 Write_Str ("Field13??");
10345 end case;
10346 end Write_Field13_Name;
10348 -----------------------
10349 -- Write_Field14_Name --
10350 -----------------------
10352 procedure Write_Field14_Name (Id : Entity_Id) is
10353 begin
10354 case Ekind (Id) is
10355 when Type_Kind
10356 | Formal_Kind
10357 | E_Constant
10358 | E_Exception
10359 | E_Loop_Parameter
10360 | E_Variable
10362 Write_Str ("Alignment");
10364 when E_Component
10365 | E_Discriminant
10367 Write_Str ("Normalized_Position");
10369 when E_Entry
10370 | E_Entry_Family
10371 | E_Function
10372 | E_Procedure
10374 Write_Str ("Postconditions_Proc");
10376 when E_Generic_Package
10377 | E_Package
10379 Write_Str ("Shadow_Entities");
10381 when others =>
10382 Write_Str ("Field14??");
10383 end case;
10384 end Write_Field14_Name;
10386 ------------------------
10387 -- Write_Field15_Name --
10388 ------------------------
10390 procedure Write_Field15_Name (Id : Entity_Id) is
10391 begin
10392 case Ekind (Id) is
10393 when E_Discriminant =>
10394 Write_Str ("Discriminant_Number");
10396 when E_Component =>
10397 Write_Str ("DT_Entry_Count");
10399 when E_Function
10400 | E_Procedure
10402 Write_Str ("DT_Position");
10404 when Entry_Kind =>
10405 Write_Str ("Entry_Parameters_Type");
10407 when Formal_Kind =>
10408 Write_Str ("Extra_Formal");
10410 when Type_Kind =>
10411 Write_Str ("Pending_Access_Types");
10413 when E_Package
10414 | E_Package_Body
10416 Write_Str ("Related_Instance");
10418 when E_Constant
10419 | E_Loop_Parameter
10420 | E_Variable
10422 Write_Str ("Status_Flag_Or_Transient_Decl");
10424 when others =>
10425 Write_Str ("Field15??");
10426 end case;
10427 end Write_Field15_Name;
10429 ------------------------
10430 -- Write_Field16_Name --
10431 ------------------------
10433 procedure Write_Field16_Name (Id : Entity_Id) is
10434 begin
10435 case Ekind (Id) is
10436 when E_Record_Type
10437 | E_Record_Type_With_Private
10439 Write_Str ("Access_Disp_Table");
10441 when E_Abstract_State =>
10442 Write_Str ("Body_References");
10444 when E_Class_Wide_Subtype
10445 | E_Record_Subtype
10447 Write_Str ("Cloned_Subtype");
10449 when E_Function
10450 | E_Procedure
10452 Write_Str ("DTC_Entity");
10454 when E_Component =>
10455 Write_Str ("Entry_Formal");
10457 when Concurrent_Kind
10458 | E_Generic_Package
10459 | E_Package
10461 Write_Str ("First_Private_Entity");
10463 when Enumeration_Kind =>
10464 Write_Str ("Lit_Strings");
10466 when Decimal_Fixed_Point_Kind =>
10467 Write_Str ("Scale_Value");
10469 when E_String_Literal_Subtype =>
10470 Write_Str ("String_Literal_Length");
10472 when E_Out_Parameter
10473 | E_Variable
10475 Write_Str ("Unset_Reference");
10477 when others =>
10478 Write_Str ("Field16??");
10479 end case;
10480 end Write_Field16_Name;
10482 ------------------------
10483 -- Write_Field17_Name --
10484 ------------------------
10486 procedure Write_Field17_Name (Id : Entity_Id) is
10487 begin
10488 case Ekind (Id) is
10489 when Formal_Kind
10490 | E_Constant
10491 | E_Generic_In_Out_Parameter
10492 | E_Variable
10494 Write_Str ("Actual_Subtype");
10496 when Digits_Kind =>
10497 Write_Str ("Digits_Value");
10499 when E_Discriminant =>
10500 Write_Str ("Discriminal");
10502 when Class_Wide_Kind
10503 | Concurrent_Kind
10504 | Private_Kind
10505 | E_Block
10506 | E_Entry
10507 | E_Entry_Family
10508 | E_Function
10509 | E_Generic_Function
10510 | E_Generic_Package
10511 | E_Generic_Procedure
10512 | E_Loop
10513 | E_Operator
10514 | E_Package
10515 | E_Package_Body
10516 | E_Procedure
10517 | E_Record_Type
10518 | E_Record_Subtype
10519 | E_Return_Statement
10520 | E_Subprogram_Body
10521 | E_Subprogram_Type
10523 Write_Str ("First_Entity");
10525 when Array_Kind =>
10526 Write_Str ("First_Index");
10528 when Enumeration_Kind =>
10529 Write_Str ("First_Literal");
10531 when Access_Kind =>
10532 Write_Str ("Master_Id");
10534 when Modular_Integer_Kind =>
10535 Write_Str ("Modulus");
10537 when E_Component =>
10538 Write_Str ("Prival");
10540 when others =>
10541 Write_Str ("Field17??");
10542 end case;
10543 end Write_Field17_Name;
10545 ------------------------
10546 -- Write_Field18_Name --
10547 ------------------------
10549 procedure Write_Field18_Name (Id : Entity_Id) is
10550 begin
10551 case Ekind (Id) is
10552 when E_Enumeration_Literal
10553 | E_Function
10554 | E_Operator
10555 | E_Procedure
10557 Write_Str ("Alias");
10559 when E_Record_Type =>
10560 Write_Str ("Corresponding_Concurrent_Type");
10562 when E_Subprogram_Body =>
10563 Write_Str ("Corresponding_Protected_Entry");
10565 when Concurrent_Kind =>
10566 Write_Str ("Corresponding_Record_Type");
10568 when E_Block
10569 | E_Label
10570 | E_Loop
10572 Write_Str ("Enclosing_Scope");
10574 when E_Entry_Index_Parameter =>
10575 Write_Str ("Entry_Index_Constant");
10577 when E_Access_Protected_Subprogram_Type
10578 | E_Access_Subprogram_Type
10579 | E_Anonymous_Access_Protected_Subprogram_Type
10580 | E_Exception_Type
10581 | E_Class_Wide_Subtype
10583 Write_Str ("Equivalent_Type");
10585 when Fixed_Point_Kind =>
10586 Write_Str ("Delta_Value");
10588 when Enumeration_Kind =>
10589 Write_Str ("Lit_Indexes");
10591 when Incomplete_Or_Private_Kind
10592 | E_Record_Subtype
10594 Write_Str ("Private_Dependents");
10596 when E_Exception
10597 | E_Generic_Function
10598 | E_Generic_Package
10599 | E_Generic_Procedure
10600 | E_Package
10602 Write_Str ("Renamed_Entity");
10604 when Object_Kind =>
10605 Write_Str ("Renamed_Object");
10607 when E_String_Literal_Subtype =>
10608 Write_Str ("String_Literal_Low_Bound");
10610 when others =>
10611 Write_Str ("Field18??");
10612 end case;
10613 end Write_Field18_Name;
10615 -----------------------
10616 -- Write_Field19_Name --
10617 -----------------------
10619 procedure Write_Field19_Name (Id : Entity_Id) is
10620 begin
10621 case Ekind (Id) is
10622 when E_Generic_Package
10623 | E_Package
10625 Write_Str ("Body_Entity");
10627 when E_Discriminant =>
10628 Write_Str ("Corresponding_Discriminant");
10630 when Scalar_Kind =>
10631 Write_Str ("Default_Aspect_Value");
10633 when E_Array_Type =>
10634 Write_Str ("Default_Component_Value");
10636 when E_Protected_Type =>
10637 Write_Str ("Entry_Bodies_Array");
10639 when E_Function
10640 | E_Operator
10641 | E_Subprogram_Type
10643 Write_Str ("Extra_Accessibility_Of_Result");
10645 when E_Abstract_State
10646 | E_Class_Wide_Type
10647 | E_Incomplete_Type
10649 Write_Str ("Non_Limited_View");
10651 when E_Incomplete_Subtype =>
10652 if From_Limited_With (Id) then
10653 Write_Str ("Non_Limited_View");
10654 end if;
10656 when E_Record_Type =>
10657 Write_Str ("Parent_Subtype");
10659 when E_Procedure =>
10660 Write_Str ("Receiving_Entry");
10662 when E_Constant
10663 | E_Variable
10665 Write_Str ("Size_Check_Code");
10667 when Formal_Kind
10668 | E_Package_Body
10670 Write_Str ("Spec_Entity");
10672 when Private_Kind =>
10673 Write_Str ("Underlying_Full_View");
10675 when others =>
10676 Write_Str ("Field19??");
10677 end case;
10678 end Write_Field19_Name;
10680 -----------------------
10681 -- Write_Field20_Name --
10682 -----------------------
10684 procedure Write_Field20_Name (Id : Entity_Id) is
10685 begin
10686 case Ekind (Id) is
10687 when Array_Kind =>
10688 Write_Str ("Component_Type");
10690 when E_Generic_In_Parameter
10691 | E_In_Parameter
10693 Write_Str ("Default_Value");
10695 when Access_Kind =>
10696 Write_Str ("Directly_Designated_Type");
10698 when E_Component =>
10699 Write_Str ("Discriminant_Checking_Func");
10701 when E_Discriminant =>
10702 Write_Str ("Discriminant_Default_Value");
10704 when Class_Wide_Kind
10705 | Concurrent_Kind
10706 | Private_Kind
10707 | E_Block
10708 | E_Entry
10709 | E_Entry_Family
10710 | E_Function
10711 | E_Generic_Function
10712 | E_Generic_Package
10713 | E_Generic_Procedure
10714 | E_Loop
10715 | E_Operator
10716 | E_Package
10717 | E_Package_Body
10718 | E_Procedure
10719 | E_Record_Type
10720 | E_Record_Subtype
10721 | E_Return_Statement
10722 | E_Subprogram_Body
10723 | E_Subprogram_Type
10725 Write_Str ("Last_Entity");
10727 when E_Constant
10728 | E_Variable
10730 Write_Str ("Prival_Link");
10732 when E_Exception =>
10733 Write_Str ("Register_Exception_Call");
10735 when Scalar_Kind =>
10736 Write_Str ("Scalar_Range");
10738 when others =>
10739 Write_Str ("Field20??");
10740 end case;
10741 end Write_Field20_Name;
10743 -----------------------
10744 -- Write_Field21_Name --
10745 -----------------------
10747 procedure Write_Field21_Name (Id : Entity_Id) is
10748 begin
10749 case Ekind (Id) is
10750 when Entry_Kind =>
10751 Write_Str ("Accept_Address");
10753 when E_Component
10754 | E_Discriminant
10756 Write_Str ("Corresponding_Record_Component");
10758 when E_In_Parameter =>
10759 Write_Str ("Default_Expr_Function");
10761 when Concurrent_Kind
10762 | Incomplete_Or_Private_Kind
10763 | Class_Wide_Kind
10764 | E_Record_Type
10765 | E_Record_Subtype
10767 Write_Str ("Discriminant_Constraint");
10769 when E_Constant
10770 | E_Exception
10771 | E_Function
10772 | E_Generic_Function
10773 | E_Generic_Procedure
10774 | E_Procedure
10775 | E_Variable
10777 Write_Str ("Interface_Name");
10779 when Array_Kind
10780 | Modular_Integer_Kind
10782 Write_Str ("Original_Array_Type");
10784 when Fixed_Point_Kind =>
10785 Write_Str ("Small_Value");
10787 when others =>
10788 Write_Str ("Field21??");
10789 end case;
10790 end Write_Field21_Name;
10792 -----------------------
10793 -- Write_Field22_Name --
10794 -----------------------
10796 procedure Write_Field22_Name (Id : Entity_Id) is
10797 begin
10798 case Ekind (Id) is
10799 when Access_Kind =>
10800 Write_Str ("Associated_Storage_Pool");
10802 when Array_Kind =>
10803 Write_Str ("Component_Size");
10805 when E_Record_Type =>
10806 Write_Str ("Corresponding_Remote_Type");
10808 when E_Component
10809 | E_Discriminant
10811 Write_Str ("Original_Record_Component");
10813 when E_Enumeration_Literal =>
10814 Write_Str ("Enumeration_Rep_Expr");
10816 when E_Limited_Private_Subtype
10817 | E_Limited_Private_Type
10818 | E_Private_Subtype
10819 | E_Private_Type
10820 | E_Record_Subtype_With_Private
10821 | E_Record_Type_With_Private
10823 Write_Str ("Private_View");
10825 when Formal_Kind =>
10826 Write_Str ("Protected_Formal");
10828 when E_Block
10829 | E_Entry
10830 | E_Entry_Family
10831 | E_Function
10832 | E_Generic_Function
10833 | E_Generic_Package
10834 | E_Generic_Procedure
10835 | E_Loop
10836 | E_Package
10837 | E_Package_Body
10838 | E_Procedure
10839 | E_Protected_Type
10840 | E_Return_Statement
10841 | E_Subprogram_Body
10842 | E_Task_Type
10844 Write_Str ("Scope_Depth_Value");
10846 when E_Variable =>
10847 Write_Str ("Shared_Var_Procs_Instance");
10849 when others =>
10850 Write_Str ("Field22??");
10851 end case;
10852 end Write_Field22_Name;
10854 ------------------------
10855 -- Write_Field23_Name --
10856 ------------------------
10858 procedure Write_Field23_Name (Id : Entity_Id) is
10859 begin
10860 case Ekind (Id) is
10861 when E_Discriminant =>
10862 Write_Str ("CR_Discriminant");
10864 when E_Block =>
10865 Write_Str ("Entry_Cancel_Parameter");
10867 when E_Enumeration_Type =>
10868 Write_Str ("Enum_Pos_To_Rep");
10870 when Formal_Kind
10871 | E_Variable
10873 Write_Str ("Extra_Constrained");
10875 when Access_Kind =>
10876 Write_Str ("Finalization_Master");
10878 when E_Generic_Function
10879 | E_Generic_Package
10880 | E_Generic_Procedure
10882 Write_Str ("Inner_Instances");
10884 when Array_Kind =>
10885 Write_Str ("Packed_Array_Impl_Type");
10887 when Entry_Kind =>
10888 Write_Str ("Protection_Object");
10890 when Class_Wide_Kind
10891 | Concurrent_Kind
10892 | Incomplete_Or_Private_Kind
10893 | E_Record_Type
10894 | E_Record_Subtype
10896 Write_Str ("Stored_Constraint");
10898 when E_Function
10899 | E_Procedure
10901 if Present (Scope (Id))
10902 and then Is_Protected_Type (Scope (Id))
10903 then
10904 Write_Str ("Protection_Object");
10905 else
10906 Write_Str ("Generic_Renamings");
10907 end if;
10909 when E_Package =>
10910 if Is_Generic_Instance (Id) then
10911 Write_Str ("Generic_Renamings");
10912 else
10913 Write_Str ("Limited_View");
10914 end if;
10916 when others =>
10917 Write_Str ("Field23??");
10918 end case;
10919 end Write_Field23_Name;
10921 ------------------------
10922 -- Write_Field24_Name --
10923 ------------------------
10925 procedure Write_Field24_Name (Id : Entity_Id) is
10926 begin
10927 case Ekind (Id) is
10928 when E_Package =>
10929 Write_Str ("Incomplete_Actuals");
10931 when Type_Kind
10932 | E_Constant
10933 | E_Variable
10935 Write_Str ("Related_Expression");
10937 when E_Function
10938 | E_Operator
10939 | E_Procedure
10941 Write_Str ("Subps_Index");
10943 when others =>
10944 Write_Str ("Field24???");
10945 end case;
10946 end Write_Field24_Name;
10948 ------------------------
10949 -- Write_Field25_Name --
10950 ------------------------
10952 procedure Write_Field25_Name (Id : Entity_Id) is
10953 begin
10954 case Ekind (Id) is
10955 when E_Generic_Package
10956 | E_Package
10958 Write_Str ("Abstract_States");
10960 when E_Entry
10961 | E_Entry_Family
10963 Write_Str ("Contract_Wrapper");
10965 when E_Variable =>
10966 Write_Str ("Debug_Renaming_Link");
10968 when E_Component =>
10969 Write_Str ("DT_Offset_To_Top_Func");
10971 when E_Function
10972 | E_Procedure
10974 Write_Str ("Interface_Alias");
10976 when E_Record_Subtype
10977 | E_Record_Subtype_With_Private
10978 | E_Record_Type
10979 | E_Record_Type_With_Private
10981 Write_Str ("Interfaces");
10983 when E_Array_Subtype
10984 | E_Array_Type
10986 Write_Str ("Related_Array_Object");
10988 when Discrete_Kind =>
10989 Write_Str ("Static_Discrete_Predicate");
10991 when Real_Kind =>
10992 Write_Str ("Static_Real_Or_String_Predicate");
10994 when Task_Kind =>
10995 Write_Str ("Task_Body_Procedure");
10997 when others =>
10998 Write_Str ("Field25??");
10999 end case;
11000 end Write_Field25_Name;
11002 ------------------------
11003 -- Write_Field26_Name --
11004 ------------------------
11006 procedure Write_Field26_Name (Id : Entity_Id) is
11007 begin
11008 case Ekind (Id) is
11009 when E_Record_Type
11010 | E_Record_Type_With_Private
11012 Write_Str ("Dispatch_Table_Wrappers");
11014 when E_In_Out_Parameter
11015 | E_Out_Parameter
11016 | E_Variable
11018 Write_Str ("Last_Assignment");
11020 when E_Function
11021 | E_Procedure
11023 Write_Str ("Overridden_Operation");
11025 when E_Generic_Package
11026 | E_Package
11028 Write_Str ("Package_Instantiation");
11030 when E_Component
11031 | E_Constant
11033 Write_Str ("Related_Type");
11035 when Access_Kind
11036 | Task_Kind
11038 Write_Str ("Storage_Size_Variable");
11040 when others =>
11041 Write_Str ("Field26??");
11042 end case;
11043 end Write_Field26_Name;
11045 ------------------------
11046 -- Write_Field27_Name --
11047 ------------------------
11049 procedure Write_Field27_Name (Id : Entity_Id) is
11050 begin
11051 case Ekind (Id) is
11052 when Type_Kind
11053 | E_Package
11055 Write_Str ("Current_Use_Clause");
11057 when E_Component
11058 | E_Constant
11059 | E_Variable
11061 Write_Str ("Related_Type");
11063 when E_Function
11064 | E_Procedure
11066 Write_Str ("Wrapped_Entity");
11068 when others =>
11069 Write_Str ("Field27??");
11070 end case;
11071 end Write_Field27_Name;
11073 ------------------------
11074 -- Write_Field28_Name --
11075 ------------------------
11077 procedure Write_Field28_Name (Id : Entity_Id) is
11078 begin
11079 case Ekind (Id) is
11080 when E_Entry
11081 | E_Entry_Family
11082 | E_Function
11083 | E_Procedure
11084 | E_Subprogram_Body
11085 | E_Subprogram_Type
11087 Write_Str ("Extra_Formals");
11089 when E_Package
11090 | E_Package_Body
11092 Write_Str ("Finalizer");
11094 when E_Constant
11095 | E_Variable
11097 Write_Str ("Initialization_Statements");
11099 when E_Access_Subprogram_Type =>
11100 Write_Str ("Original_Access_Type");
11102 when Task_Kind =>
11103 Write_Str ("Relative_Deadline_Variable");
11105 when E_Record_Type =>
11106 Write_Str ("Underlying_Record_View");
11108 when others =>
11109 Write_Str ("Field28??");
11110 end case;
11111 end Write_Field28_Name;
11113 ------------------------
11114 -- Write_Field29_Name --
11115 ------------------------
11117 procedure Write_Field29_Name (Id : Entity_Id) is
11118 begin
11119 case Ekind (Id) is
11120 when E_Function
11121 | E_Package
11122 | E_Procedure
11123 | E_Subprogram_Body
11125 Write_Str ("Anonymous_Masters");
11127 when E_Constant
11128 | E_Variable
11130 Write_Str ("BIP_Initialization_Call");
11132 when Type_Kind =>
11133 Write_Str ("Subprograms_For_Type");
11135 when others =>
11136 Write_Str ("Field29??");
11137 end case;
11138 end Write_Field29_Name;
11140 ------------------------
11141 -- Write_Field30_Name --
11142 ------------------------
11144 procedure Write_Field30_Name (Id : Entity_Id) is
11145 begin
11146 case Ekind (Id) is
11147 when E_Record_Type
11148 | E_Record_Type_With_Private
11150 Write_Str ("Access_Disp_Table_Elab_Flag");
11152 when E_Protected_Type
11153 | E_Task_Type
11155 Write_Str ("Anonymous_Object");
11157 when E_Function =>
11158 Write_Str ("Corresponding_Equality");
11160 when E_Constant
11161 | E_Variable
11163 Write_Str ("Last_Aggregate_Assignment");
11165 when E_Procedure =>
11166 Write_Str ("Static_Initialization");
11168 when others =>
11169 Write_Str ("Field30??");
11170 end case;
11171 end Write_Field30_Name;
11173 ------------------------
11174 -- Write_Field31_Name --
11175 ------------------------
11177 procedure Write_Field31_Name (Id : Entity_Id) is
11178 begin
11179 case Ekind (Id) is
11180 when E_Constant
11181 | E_In_Parameter
11182 | E_In_Out_Parameter
11183 | E_Loop_Parameter
11184 | E_Out_Parameter
11185 | E_Variable
11187 Write_Str ("Activation_Record_Component");
11189 when Type_Kind =>
11190 Write_Str ("Derived_Type_Link");
11192 when E_Function
11193 | E_Procedure
11195 Write_Str ("Thunk_Entity");
11197 when others =>
11198 Write_Str ("Field31??");
11199 end case;
11200 end Write_Field31_Name;
11202 ------------------------
11203 -- Write_Field32_Name --
11204 ------------------------
11206 procedure Write_Field32_Name (Id : Entity_Id) is
11207 begin
11208 case Ekind (Id) is
11209 when E_Procedure =>
11210 Write_Str ("Corresponding_Function");
11212 when E_Function =>
11213 Write_Str ("Corresponding_Procedure");
11215 when E_Abstract_State
11216 | E_Constant
11217 | E_Variable
11219 Write_Str ("Encapsulating_State");
11221 when Type_Kind =>
11222 Write_Str ("No_Tagged_Streams_Pragma");
11224 when others =>
11225 Write_Str ("Field32??");
11226 end case;
11227 end Write_Field32_Name;
11229 ------------------------
11230 -- Write_Field33_Name --
11231 ------------------------
11233 procedure Write_Field33_Name (Id : Entity_Id) is
11234 begin
11235 case Ekind (Id) is
11236 when Subprogram_Kind
11237 | Type_Kind
11238 | E_Constant
11239 | E_Variable
11241 Write_Str ("Linker_Section_Pragma");
11243 when others =>
11244 Write_Str ("Field33??");
11245 end case;
11246 end Write_Field33_Name;
11248 ------------------------
11249 -- Write_Field34_Name --
11250 ------------------------
11252 procedure Write_Field34_Name (Id : Entity_Id) is
11253 begin
11254 case Ekind (Id) is
11255 when E_Constant
11256 | E_Entry
11257 | E_Entry_Family
11258 | E_Function
11259 | E_Generic_Function
11260 | E_Generic_Package
11261 | E_Generic_Procedure
11262 | E_Operator
11263 | E_Package
11264 | E_Package_Body
11265 | E_Procedure
11266 | E_Protected_Type
11267 | E_Subprogram_Body
11268 | E_Task_Body
11269 | E_Task_Type
11270 | E_Variable
11271 | E_Void
11273 Write_Str ("Contract");
11275 when others =>
11276 Write_Str ("Field34??");
11277 end case;
11278 end Write_Field34_Name;
11280 ------------------------
11281 -- Write_Field35_Name --
11282 ------------------------
11284 procedure Write_Field35_Name (Id : Entity_Id) is
11285 begin
11286 case Ekind (Id) is
11287 when E_Variable =>
11288 Write_Str ("Anonymous_Designated_Type");
11290 when E_Entry
11291 | E_Entry_Family
11293 Write_Str ("Entry_Max_Queue_Lenghts_Array");
11295 when Subprogram_Kind =>
11296 Write_Str ("Import_Pragma");
11298 when others =>
11299 Write_Str ("Field35??");
11300 end case;
11301 end Write_Field35_Name;
11303 ------------------------
11304 -- Write_Field36_Name --
11305 ------------------------
11307 procedure Write_Field36_Name (Id : Entity_Id) is
11308 pragma Unreferenced (Id);
11309 begin
11310 Write_Str ("Prev_Entity");
11311 end Write_Field36_Name;
11313 ------------------------
11314 -- Write_Field37_Name --
11315 ------------------------
11317 procedure Write_Field37_Name (Id : Entity_Id) is
11318 pragma Unreferenced (Id);
11319 begin
11320 Write_Str ("Associated_Entity");
11321 end Write_Field37_Name;
11323 ------------------------
11324 -- Write_Field38_Name --
11325 ------------------------
11327 procedure Write_Field38_Name (Id : Entity_Id) is
11328 begin
11329 case Ekind (Id) is
11330 when E_Function
11331 | E_Procedure
11333 Write_Str ("Class_Wide_Clone");
11335 when E_Array_Subtype
11336 | E_Record_Subtype
11337 | E_Record_Subtype_With_Private
11339 Write_Str ("Predicated_Parent");
11341 when E_Variable =>
11342 Write_Str ("Validated_Object");
11344 when others =>
11345 Write_Str ("Field38??");
11346 end case;
11347 end Write_Field38_Name;
11349 ------------------------
11350 -- Write_Field39_Name --
11351 ------------------------
11353 procedure Write_Field39_Name (Id : Entity_Id) is
11354 begin
11355 case Ekind (Id) is
11356 when E_Function
11357 | E_Procedure
11359 Write_Str ("Protected_Subprogram");
11361 when others =>
11362 Write_Str ("Field39??");
11363 end case;
11364 end Write_Field39_Name;
11366 ------------------------
11367 -- Write_Field40_Name --
11368 ------------------------
11370 procedure Write_Field40_Name (Id : Entity_Id) is
11371 begin
11372 case Ekind (Id) is
11373 when E_Abstract_State
11374 | E_Constant
11375 | E_Entry
11376 | E_Entry_Family
11377 | E_Function
11378 | E_Generic_Function
11379 | E_Generic_Package
11380 | E_Generic_Procedure
11381 | E_Operator
11382 | E_Package
11383 | E_Package_Body
11384 | E_Procedure
11385 | E_Protected_Body
11386 | E_Subprogram_Body
11387 | E_Task_Body
11388 | E_Variable
11389 | E_Void
11390 | Type_Kind
11392 Write_Str ("SPARK_Pragma");
11394 when others =>
11395 Write_Str ("Field40??");
11396 end case;
11397 end Write_Field40_Name;
11399 ------------------------
11400 -- Write_Field41_Name --
11401 ------------------------
11403 procedure Write_Field41_Name (Id : Entity_Id) is
11404 begin
11405 case Ekind (Id) is
11406 when E_Function
11407 | E_Procedure
11409 Write_Str ("Original_Protected_Subprogram");
11411 when E_Generic_Package
11412 | E_Package
11413 | E_Package_Body
11414 | E_Protected_Type
11415 | E_Task_Type
11417 Write_Str ("SPARK_Aux_Pragma");
11419 when others =>
11420 Write_Str ("Field41??");
11421 end case;
11422 end Write_Field41_Name;
11424 -------------------------
11425 -- Iterator Procedures --
11426 -------------------------
11428 procedure Proc_Next_Component (N : in out Node_Id) is
11429 begin
11430 N := Next_Component (N);
11431 end Proc_Next_Component;
11433 procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id) is
11434 begin
11435 N := Next_Entity (N);
11436 while Present (N) loop
11437 exit when Ekind_In (N, E_Component, E_Discriminant);
11438 N := Next_Entity (N);
11439 end loop;
11440 end Proc_Next_Component_Or_Discriminant;
11442 procedure Proc_Next_Discriminant (N : in out Node_Id) is
11443 begin
11444 N := Next_Discriminant (N);
11445 end Proc_Next_Discriminant;
11447 procedure Proc_Next_Formal (N : in out Node_Id) is
11448 begin
11449 N := Next_Formal (N);
11450 end Proc_Next_Formal;
11452 procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is
11453 begin
11454 N := Next_Formal_With_Extras (N);
11455 end Proc_Next_Formal_With_Extras;
11457 procedure Proc_Next_Index (N : in out Node_Id) is
11458 begin
11459 N := Next_Index (N);
11460 end Proc_Next_Index;
11462 procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is
11463 begin
11464 N := Next_Inlined_Subprogram (N);
11465 end Proc_Next_Inlined_Subprogram;
11467 procedure Proc_Next_Literal (N : in out Node_Id) is
11468 begin
11469 N := Next_Literal (N);
11470 end Proc_Next_Literal;
11472 procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is
11473 begin
11474 N := Next_Stored_Discriminant (N);
11475 end Proc_Next_Stored_Discriminant;
11477 end Einfo;