PR rtl-optimization/79386
[official-gcc.git] / gcc / ada / einfo.adb
blobe97d1478bb254fc07ba27c4d194a61c0c8148c64
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E I N F O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2016, 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 -- Associated_Entity Node37
75 -- The usage of other fields (and the entity kinds to which it applies)
76 -- depends on the particular field (see Einfo spec for details).
78 -- Associated_Node_For_Itype Node8
79 -- Dependent_Instances Elist8
80 -- Hiding_Loop_Variable Node8
81 -- Mechanism Uint8 (but returns Mechanism_Type)
82 -- Normalized_First_Bit Uint8
83 -- Refinement_Constituents Elist8
84 -- Return_Applies_To Node8
85 -- First_Exit_Statement Node8
87 -- Class_Wide_Type Node9
88 -- Current_Value Node9
89 -- Renaming_Map Uint9
91 -- Direct_Primitive_Operations Elist10
92 -- Discriminal_Link Node10
93 -- Float_Rep Uint10 (but returns Float_Rep_Kind)
94 -- Handler_Records List10
95 -- Normalized_Position_Max Uint10
96 -- Part_Of_Constituents Elist10
98 -- Block_Node Node11
99 -- Component_Bit_Offset Uint11
100 -- Full_View Node11
101 -- Entry_Component Node11
102 -- Enumeration_Pos Uint11
103 -- Generic_Homonym Node11
104 -- Part_Of_References Elist11
105 -- Protected_Body_Subprogram Node11
107 -- Barrier_Function Node12
108 -- Enumeration_Rep Uint12
109 -- Esize Uint12
110 -- Next_Inlined_Subprogram Node12
112 -- Component_Clause Node13
113 -- Elaboration_Entity Node13
114 -- Extra_Accessibility Node13
115 -- RM_Size Uint13
117 -- Alignment Uint14
118 -- Normalized_Position Uint14
119 -- Postconditions_Proc Node14
120 -- Shadow_Entities List14
122 -- Discriminant_Number Uint15
123 -- DT_Position Uint15
124 -- DT_Entry_Count Uint15
125 -- Entry_Parameters_Type Node15
126 -- Extra_Formal Node15
127 -- Pending_Access_Types Elist15
128 -- Related_Instance Node15
129 -- Status_Flag_Or_Transient_Decl Node15
131 -- Access_Disp_Table Elist16
132 -- Body_References Elist16
133 -- Cloned_Subtype Node16
134 -- DTC_Entity Node16
135 -- Entry_Formal Node16
136 -- First_Private_Entity Node16
137 -- Lit_Strings Node16
138 -- Scale_Value Uint16
139 -- String_Literal_Length Uint16
140 -- Unset_Reference Node16
142 -- Actual_Subtype Node17
143 -- Digits_Value Uint17
144 -- Discriminal Node17
145 -- First_Entity Node17
146 -- First_Index Node17
147 -- First_Literal Node17
148 -- Master_Id Node17
149 -- Modulus Uint17
150 -- Prival Node17
152 -- Alias Node18
153 -- Corresponding_Concurrent_Type Node18
154 -- Corresponding_Protected_Entry Node18
155 -- Corresponding_Record_Type Node18
156 -- Delta_Value Ureal18
157 -- Enclosing_Scope Node18
158 -- Equivalent_Type Node18
159 -- Lit_Indexes Node18
160 -- Private_Dependents Elist18
161 -- Renamed_Entity Node18
162 -- Renamed_Object Node18
163 -- String_Literal_Low_Bound Node18
165 -- Body_Entity Node19
166 -- Corresponding_Discriminant Node19
167 -- Default_Aspect_Component_Value Node19
168 -- Default_Aspect_Value Node19
169 -- Entry_Bodies_Array Node19
170 -- Extra_Accessibility_Of_Result Node19
171 -- Non_Limited_View Node19
172 -- Parent_Subtype Node19
173 -- Size_Check_Code Node19
174 -- Spec_Entity Node19
175 -- Underlying_Full_View Node19
177 -- Component_Type Node20
178 -- Default_Value Node20
179 -- Directly_Designated_Type Node20
180 -- Discriminant_Checking_Func Node20
181 -- Discriminant_Default_Value Node20
182 -- Last_Entity Node20
183 -- Prival_Link Node20
184 -- Register_Exception_Call Node20
185 -- Scalar_Range Node20
187 -- Accept_Address Elist21
188 -- Default_Expr_Function Node21
189 -- Discriminant_Constraint Elist21
190 -- Interface_Name Node21
191 -- Original_Array_Type Node21
192 -- Small_Value Ureal21
194 -- Associated_Storage_Pool Node22
195 -- Component_Size Uint22
196 -- Corresponding_Remote_Type Node22
197 -- Enumeration_Rep_Expr Node22
198 -- Original_Record_Component Node22
199 -- Private_View Node22
200 -- Protected_Formal Node22
201 -- Scope_Depth_Value Uint22
202 -- Shared_Var_Procs_Instance Node22
204 -- CR_Discriminant Node23
205 -- Entry_Cancel_Parameter Node23
206 -- Enum_Pos_To_Rep Node23
207 -- Extra_Constrained Node23
208 -- Finalization_Master Node23
209 -- Generic_Renamings Elist23
210 -- Inner_Instances Elist23
211 -- Limited_View Node23
212 -- Packed_Array_Impl_Type Node23
213 -- Protection_Object Node23
214 -- Stored_Constraint Elist23
216 -- Incomplete_Actuals Elist24
217 -- Related_Expression Node24
218 -- Subps_Index Uint24
220 -- Contract_Wrapper Node25
221 -- Debug_Renaming_Link Node25
222 -- DT_Offset_To_Top_Func Node25
223 -- Interface_Alias Node25
224 -- Interfaces Elist25
225 -- Related_Array_Object Node25
226 -- Static_Discrete_Predicate List25
227 -- Static_Real_Or_String_Predicate Node25
228 -- Task_Body_Procedure Node25
230 -- Dispatch_Table_Wrappers Elist26
231 -- Last_Assignment Node26
232 -- Overridden_Operation Node26
233 -- Package_Instantiation Node26
234 -- Storage_Size_Variable Node26
236 -- Current_Use_Clause Node27
237 -- Related_Type Node27
238 -- Wrapped_Entity Node27
240 -- Extra_Formals Node28
241 -- Finalizer Node28
242 -- Initialization_Statements Node28
243 -- Original_Access_Type Node28
244 -- Relative_Deadline_Variable Node28
245 -- Underlying_Record_View Node28
247 -- Anonymous_Masters Elist29
248 -- BIP_Initialization_Call Node29
249 -- Subprograms_For_Type Elist29
251 -- Anonymous_Object Node30
252 -- Corresponding_Equality Node30
253 -- Last_Aggregate_Assignment Node30
254 -- Static_Initialization Node30
256 -- Derived_Type_Link Node31
257 -- Thunk_Entity Node31
258 -- Activation_Record_Component Node31
260 -- Corresponding_Function Node32
261 -- Corresponding_Procedure Node32
262 -- Encapsulating_State Node32
263 -- No_Tagged_Streams_Pragma Node32
265 -- Linker_Section_Pragma Node33
267 -- Contract Node34
269 -- Anonymous_Designated_Type Node35
270 -- Entry_Max_Queue_Lengths_Array Node35
271 -- Import_Pragma Node35
273 -- Class_Wide_Preconds List38
275 -- Class_Wide_Postconds List39
277 -- SPARK_Pragma Node40
279 -- Original_Protected_Subprogram Node41
280 -- SPARK_Aux_Pragma Node41
282 ---------------------------------------------
283 -- Usage of Flags in Defining Entity Nodes --
284 ---------------------------------------------
286 -- All flags are unique, there is no overlaying, so each flag is physically
287 -- present in every entity. However, for many of the flags, it only makes
288 -- sense for them to be set true for certain subsets of entity kinds. See
289 -- the spec of Einfo for further details.
291 -- Is_Inlined_Always Flag1
292 -- Is_Hidden_Non_Overridden_Subpgm Flag2
293 -- Has_Own_DIC Flag3
294 -- Is_Frozen Flag4
295 -- Has_Discriminants Flag5
296 -- Is_Dispatching_Operation Flag6
297 -- Is_Immediately_Visible Flag7
298 -- In_Use Flag8
299 -- Is_Potentially_Use_Visible Flag9
300 -- Is_Public Flag10
302 -- Is_Inlined Flag11
303 -- Is_Constrained Flag12
304 -- Is_Generic_Type Flag13
305 -- Depends_On_Private Flag14
306 -- Is_Aliased Flag15
307 -- Is_Volatile Flag16
308 -- Is_Internal Flag17
309 -- Has_Delayed_Freeze Flag18
310 -- Is_Abstract_Subprogram Flag19
311 -- Is_Concurrent_Record_Type Flag20
313 -- Has_Master_Entity Flag21
314 -- Needs_No_Actuals Flag22
315 -- Has_Storage_Size_Clause Flag23
316 -- Is_Imported Flag24
317 -- Is_Limited_Record Flag25
318 -- Has_Completion Flag26
319 -- Has_Pragma_Controlled Flag27
320 -- Is_Statically_Allocated Flag28
321 -- Has_Size_Clause Flag29
322 -- Has_Task Flag30
324 -- Checks_May_Be_Suppressed Flag31
325 -- Kill_Elaboration_Checks Flag32
326 -- Kill_Range_Checks Flag33
327 -- Has_Independent_Components Flag34
328 -- Is_Class_Wide_Equivalent_Type Flag35
329 -- Referenced_As_LHS Flag36
330 -- Is_Known_Non_Null Flag37
331 -- Can_Never_Be_Null Flag38
332 -- Has_Default_Aspect Flag39
333 -- Body_Needed_For_SAL Flag40
335 -- Treat_As_Volatile Flag41
336 -- Is_Controlled Flag42
337 -- Has_Controlled_Component Flag43
338 -- Is_Pure Flag44
339 -- In_Private_Part Flag45
340 -- Has_Alignment_Clause Flag46
341 -- Has_Exit Flag47
342 -- In_Package_Body Flag48
343 -- Reachable Flag49
344 -- Delay_Subprogram_Descriptors Flag50
346 -- Is_Packed Flag51
347 -- Is_Entry_Formal Flag52
348 -- Is_Private_Descendant Flag53
349 -- Return_Present Flag54
350 -- Is_Tagged_Type Flag55
351 -- Has_Homonym Flag56
352 -- Is_Hidden Flag57
353 -- Non_Binary_Modulus Flag58
354 -- Is_Preelaborated Flag59
355 -- Is_Shared_Passive Flag60
357 -- Is_Remote_Types Flag61
358 -- Is_Remote_Call_Interface Flag62
359 -- Is_Character_Type Flag63
360 -- Is_Intrinsic_Subprogram Flag64
361 -- Has_Record_Rep_Clause Flag65
362 -- Has_Enumeration_Rep_Clause Flag66
363 -- Has_Small_Clause Flag67
364 -- Has_Component_Size_Clause Flag68
365 -- Is_Access_Constant Flag69
366 -- Is_First_Subtype Flag70
368 -- Has_Completion_In_Body Flag71
369 -- Has_Unknown_Discriminants Flag72
370 -- Is_Child_Unit Flag73
371 -- Is_CPP_Class Flag74
372 -- Has_Non_Standard_Rep Flag75
373 -- Is_Constructor Flag76
374 -- Static_Elaboration_Desired Flag77
375 -- Is_Tag Flag78
376 -- Has_All_Calls_Remote Flag79
377 -- Is_Constr_Subt_For_U_Nominal Flag80
379 -- Is_Asynchronous Flag81
380 -- Has_Gigi_Rep_Item Flag82
381 -- Has_Machine_Radix_Clause Flag83
382 -- Machine_Radix_10 Flag84
383 -- Is_Atomic Flag85
384 -- Has_Atomic_Components Flag86
385 -- Has_Volatile_Components Flag87
386 -- Discard_Names Flag88
387 -- Is_Interrupt_Handler Flag89
388 -- Returns_By_Ref Flag90
390 -- Is_Itype Flag91
391 -- Size_Known_At_Compile_Time Flag92
392 -- Reverse_Storage_Order Flag93
393 -- Is_Generic_Actual_Type Flag94
394 -- Uses_Sec_Stack Flag95
395 -- Warnings_Off Flag96
396 -- Is_Controlling_Formal Flag97
397 -- Has_Controlling_Result Flag98
398 -- Is_Exported Flag99
399 -- Has_Specified_Layout Flag100
401 -- Has_Nested_Block_With_Handler Flag101
402 -- Is_Called Flag102
403 -- Is_Completely_Hidden Flag103
404 -- Address_Taken Flag104
405 -- Suppress_Initialization Flag105
406 -- Is_Limited_Composite Flag106
407 -- Is_Private_Composite Flag107
408 -- Default_Expressions_Processed Flag108
409 -- Is_Non_Static_Subtype Flag109
410 -- Has_Out_Or_In_Out_Parameter Flag110
412 -- Is_Formal_Subprogram Flag111
413 -- Is_Renaming_Of_Object Flag112
414 -- No_Return Flag113
415 -- Delay_Cleanups Flag114
416 -- Never_Set_In_Source Flag115
417 -- Is_Visible_Lib_Unit Flag116
418 -- Is_Unchecked_Union Flag117
419 -- Is_For_Access_Subtype Flag118
420 -- Has_Convention_Pragma Flag119
421 -- Has_Primitive_Operations Flag120
423 -- Has_Pragma_Pack Flag121
424 -- Is_Bit_Packed_Array Flag122
425 -- Has_Unchecked_Union Flag123
426 -- Is_Eliminated Flag124
427 -- C_Pass_By_Copy Flag125
428 -- Is_Instantiated Flag126
429 -- Is_Valued_Procedure Flag127
430 -- (used for Component_Alignment) Flag128
431 -- (used for Component_Alignment) Flag129
432 -- Is_Generic_Instance Flag130
434 -- No_Pool_Assigned Flag131
435 -- Is_DIC_Procedure Flag132
436 -- Has_Inherited_DIC Flag133
437 -- Has_Aliased_Components Flag135
438 -- No_Strict_Aliasing Flag136
439 -- Is_Machine_Code_Subprogram Flag137
440 -- Is_Packed_Array_Impl_Type Flag138
441 -- Has_Biased_Representation Flag139
442 -- Has_Complex_Representation Flag140
444 -- Is_Constr_Subt_For_UN_Aliased Flag141
445 -- Has_Missing_Return Flag142
446 -- Has_Recursive_Call Flag143
447 -- Is_Unsigned_Type Flag144
448 -- Strict_Alignment Flag145
449 -- Is_Abstract_Type Flag146
450 -- Needs_Debug_Info Flag147
451 -- Suppress_Elaboration_Warnings Flag148
452 -- Is_Compilation_Unit Flag149
453 -- Has_Pragma_Elaborate_Body Flag150
455 -- Has_Private_Ancestor Flag151
456 -- Entry_Accepted Flag152
457 -- Is_Obsolescent Flag153
458 -- Has_Per_Object_Constraint Flag154
459 -- Has_Private_Declaration Flag155
460 -- Referenced Flag156
461 -- Has_Pragma_Inline Flag157
462 -- Finalize_Storage_Only Flag158
463 -- From_Limited_With Flag159
464 -- Is_Package_Body_Entity Flag160
466 -- Has_Qualified_Name Flag161
467 -- Nonzero_Is_True Flag162
468 -- Is_True_Constant Flag163
469 -- Reverse_Bit_Order Flag164
470 -- Suppress_Style_Checks Flag165
471 -- Debug_Info_Off Flag166
472 -- Sec_Stack_Needed_For_Return Flag167
473 -- Materialize_Entity Flag168
474 -- Has_Pragma_Thread_Local_Storage Flag169
475 -- Is_Known_Valid Flag170
477 -- Is_Hidden_Open_Scope Flag171
478 -- Has_Object_Size_Clause Flag172
479 -- Has_Fully_Qualified_Name Flag173
480 -- Elaboration_Entity_Required Flag174
481 -- Has_Forward_Instantiation Flag175
482 -- Is_Discrim_SO_Function Flag176
483 -- Size_Depends_On_Discriminant Flag177
484 -- Is_Null_Init_Proc Flag178
485 -- Has_Pragma_Pure_Function Flag179
486 -- Has_Pragma_Unreferenced Flag180
488 -- Has_Contiguous_Rep Flag181
489 -- Has_Xref_Entry Flag182
490 -- Must_Be_On_Byte_Boundary Flag183
491 -- Has_Stream_Size_Clause Flag184
492 -- Is_Ada_2005_Only Flag185
493 -- Is_Interface Flag186
494 -- Has_Constrained_Partial_View Flag187
495 -- Uses_Lock_Free Flag188
496 -- Is_Pure_Unit_Access_Type Flag189
497 -- Has_Specified_Stream_Input Flag190
499 -- Has_Specified_Stream_Output Flag191
500 -- Has_Specified_Stream_Read Flag192
501 -- Has_Specified_Stream_Write Flag193
502 -- Is_Local_Anonymous_Access Flag194
503 -- Is_Primitive_Wrapper Flag195
504 -- Was_Hidden Flag196
505 -- Is_Limited_Interface Flag197
506 -- Has_Pragma_Ordered Flag198
507 -- Is_Ada_2012_Only Flag199
509 -- Has_Delayed_Aspects Flag200
510 -- Has_Pragma_No_Inline Flag201
511 -- Itype_Printed Flag202
512 -- Has_Pragma_Pure Flag203
513 -- Is_Known_Null Flag204
514 -- Low_Bound_Tested Flag205
515 -- Is_Visible_Formal Flag206
516 -- Known_To_Have_Preelab_Init Flag207
517 -- Must_Have_Preelab_Init Flag208
518 -- Is_Return_Object Flag209
519 -- Elaborate_Body_Desirable Flag210
521 -- Has_Static_Discriminants Flag211
522 -- Has_Pragma_Unreferenced_Objects Flag212
523 -- Requires_Overriding Flag213
524 -- Has_RACW Flag214
525 -- Is_Param_Block_Component_Type Flag215
526 -- Universal_Aliasing Flag216
527 -- Suppress_Value_Tracking_On_Call Flag217
528 -- Is_Primitive Flag218
529 -- Has_Initial_Value Flag219
530 -- Has_Dispatch_Table Flag220
532 -- Has_Pragma_Preelab_Init Flag221
533 -- Used_As_Generic_Actual Flag222
534 -- Is_Descendant_Of_Address Flag223
535 -- Is_Raised Flag224
536 -- Is_Thunk Flag225
537 -- Is_Only_Out_Parameter Flag226
538 -- Referenced_As_Out_Parameter Flag227
539 -- Has_Thunks Flag228
540 -- Can_Use_Internal_Rep Flag229
541 -- Has_Pragma_Inline_Always Flag230
543 -- Renamed_In_Spec Flag231
544 -- Has_Own_Invariants Flag232
545 -- Has_Pragma_Unmodified Flag233
546 -- Is_Dispatch_Table_Entity Flag234
547 -- Is_Trivial_Subprogram Flag235
548 -- Warnings_Off_Used Flag236
549 -- Warnings_Off_Used_Unmodified Flag237
550 -- Warnings_Off_Used_Unreferenced Flag238
551 -- OK_To_Reorder_Components Flag239
552 -- Has_Expanded_Contract Flag240
554 -- Optimize_Alignment_Space Flag241
555 -- Optimize_Alignment_Time Flag242
556 -- Overlays_Constant Flag243
557 -- Is_RACW_Stub_Type Flag244
558 -- Is_Private_Primitive Flag245
559 -- Is_Underlying_Record_View Flag246
560 -- OK_To_Rename Flag247
561 -- Has_Inheritable_Invariants Flag248
562 -- Is_Safe_To_Reevaluate Flag249
563 -- Has_Predicates Flag250
565 -- Has_Implicit_Dereference Flag251
566 -- Is_Finalized_Transient Flag252
567 -- Disable_Controlled Flag253
568 -- Is_Implementation_Defined Flag254
569 -- Is_Predicate_Function Flag255
570 -- Is_Predicate_Function_M Flag256
571 -- Is_Invariant_Procedure Flag257
572 -- Has_Dynamic_Predicate_Aspect Flag258
573 -- Has_Static_Predicate_Aspect Flag259
574 -- Has_Loop_Entry_Attributes Flag260
576 -- Has_Delayed_Rep_Aspects Flag261
577 -- May_Inherit_Delayed_Rep_Aspects Flag262
578 -- Has_Visible_Refinement Flag263
579 -- Is_Discriminant_Check_Function Flag264
580 -- SPARK_Pragma_Inherited Flag265
581 -- SPARK_Aux_Pragma_Inherited Flag266
582 -- Has_Shift_Operator Flag267
583 -- Is_Independent Flag268
584 -- Has_Static_Predicate Flag269
585 -- Stores_Attribute_Old_Prefix Flag270
587 -- Has_Protected Flag271
588 -- SSO_Set_Low_By_Default Flag272
589 -- SSO_Set_High_By_Default Flag273
590 -- Is_Generic_Actual_Subprogram Flag274
591 -- No_Predicate_On_Actual Flag275
592 -- No_Dynamic_Predicate_On_Actual Flag276
593 -- Is_Checked_Ghost_Entity Flag277
594 -- Is_Ignored_Ghost_Entity Flag278
595 -- Contains_Ignored_Ghost_Code Flag279
596 -- Partial_View_Has_Unknown_Discr Flag280
598 -- Is_Static_Type Flag281
599 -- Has_Nested_Subprogram Flag282
600 -- Is_Uplevel_Referenced_Entity Flag283
601 -- Is_Unimplemented Flag284
602 -- Is_Volatile_Full_Access Flag285
603 -- Is_Exception_Handler Flag286
604 -- Rewritten_For_C Flag287
605 -- Predicates_Ignored Flag288
606 -- Has_Timing_Event Flag289
608 -- (unused) Flag290 -- ??? flag breaks einfo.h
610 -- Has_Inherited_Invariants Flag291
611 -- Is_Partial_Invariant_Procedure Flag292
612 -- Is_Actual_Subtype Flag293
613 -- Has_Pragma_Unused Flag294
614 -- Is_Ignored_Transient Flag295
615 -- Has_Partial_Visible_Refinement Flag296
616 -- Is_Entry_Wrapper Flag297
617 -- Is_Underlying_Full_View Flag298
619 -- (unused) Flag299
620 -- (unused) Flag300
622 -- (unused) Flag301
623 -- (unused) Flag302
624 -- (unused) Flag303
625 -- (unused) Flag304
626 -- (unused) Flag305
627 -- (unused) Flag306
628 -- (unused) Flag307
629 -- (unused) Flag308
630 -- (unused) Flag309
632 -- Note: Flag310-317 are defined in atree.ads/adb, but not yet in atree.h
634 -----------------------
635 -- Local subprograms --
636 -----------------------
638 function Has_Option
639 (State_Id : Entity_Id;
640 Option_Nam : Name_Id) return Boolean;
641 -- Determine whether abstract state State_Id has particular option denoted
642 -- by the name Option_Nam.
644 ---------------
645 -- Float_Rep --
646 ---------------
648 function Float_Rep (Id : E) return F is
649 pragma Assert (Is_Floating_Point_Type (Id));
650 begin
651 return F'Val (UI_To_Int (Uint10 (Base_Type (Id))));
652 end Float_Rep;
654 ----------------
655 -- Has_Option --
656 ----------------
658 function Has_Option
659 (State_Id : Entity_Id;
660 Option_Nam : Name_Id) return Boolean
662 Decl : constant Node_Id := Parent (State_Id);
663 Opt : Node_Id;
664 Opt_Nam : Node_Id;
666 begin
667 pragma Assert (Ekind (State_Id) = E_Abstract_State);
669 -- The declaration of abstract states with options appear as an
670 -- extension aggregate. If this is not the case, the option is not
671 -- available.
673 if Nkind (Decl) /= N_Extension_Aggregate then
674 return False;
675 end if;
677 -- Simple options
679 Opt := First (Expressions (Decl));
680 while Present (Opt) loop
681 if Nkind (Opt) = N_Identifier and then Chars (Opt) = Option_Nam then
682 return True;
683 end if;
685 Next (Opt);
686 end loop;
688 -- Complex options with various specifiers
690 Opt := First (Component_Associations (Decl));
691 while Present (Opt) loop
692 Opt_Nam := First (Choices (Opt));
694 if Nkind (Opt_Nam) = N_Identifier
695 and then Chars (Opt_Nam) = Option_Nam
696 then
697 return True;
698 end if;
700 Next (Opt);
701 end loop;
703 return False;
704 end Has_Option;
706 --------------------------------
707 -- Attribute Access Functions --
708 --------------------------------
710 function Abstract_States (Id : E) return L is
711 begin
712 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
713 return Elist25 (Id);
714 end Abstract_States;
716 function Accept_Address (Id : E) return L is
717 begin
718 return Elist21 (Id);
719 end Accept_Address;
721 function Access_Disp_Table (Id : E) return L is
722 begin
723 pragma Assert (Ekind_In (Id, E_Record_Type,
724 E_Record_Type_With_Private,
725 E_Record_Subtype));
726 return Elist16 (Implementation_Base_Type (Id));
727 end Access_Disp_Table;
729 function Activation_Record_Component (Id : E) return E is
730 begin
731 pragma Assert (Ekind_In (Id, E_Constant,
732 E_In_Parameter,
733 E_In_Out_Parameter,
734 E_Loop_Parameter,
735 E_Out_Parameter,
736 E_Variable));
737 return Node31 (Id);
738 end Activation_Record_Component;
740 function Actual_Subtype (Id : E) return E is
741 begin
742 pragma Assert
743 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
744 or else Is_Formal (Id));
745 return Node17 (Id);
746 end Actual_Subtype;
748 function Address_Taken (Id : E) return B is
749 begin
750 return Flag104 (Id);
751 end Address_Taken;
753 function Alias (Id : E) return E is
754 begin
755 pragma Assert
756 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
757 return Node18 (Id);
758 end Alias;
760 function Alignment (Id : E) return U is
761 begin
762 pragma Assert (Is_Type (Id)
763 or else Is_Formal (Id)
764 or else Ekind_In (Id, E_Loop_Parameter,
765 E_Constant,
766 E_Exception,
767 E_Variable));
768 return Uint14 (Id);
769 end Alignment;
771 function Anonymous_Designated_Type (Id : E) return E is
772 begin
773 pragma Assert (Ekind (Id) = E_Variable);
774 return Node35 (Id);
775 end Anonymous_Designated_Type;
777 function Anonymous_Masters (Id : E) return L is
778 begin
779 pragma Assert (Ekind_In (Id, E_Function,
780 E_Package,
781 E_Procedure,
782 E_Subprogram_Body));
783 return Elist29 (Id);
784 end Anonymous_Masters;
786 function Anonymous_Object (Id : E) return E is
787 begin
788 pragma Assert (Ekind_In (Id, E_Protected_Type, E_Task_Type));
789 return Node30 (Id);
790 end Anonymous_Object;
792 function Associated_Entity (Id : E) return E is
793 begin
794 return Node37 (Id);
795 end Associated_Entity;
797 function Associated_Formal_Package (Id : E) return E is
798 begin
799 pragma Assert (Ekind (Id) = E_Package);
800 return Node12 (Id);
801 end Associated_Formal_Package;
803 function Associated_Node_For_Itype (Id : E) return N is
804 begin
805 return Node8 (Id);
806 end Associated_Node_For_Itype;
808 function Associated_Storage_Pool (Id : E) return E is
809 begin
810 pragma Assert (Is_Access_Type (Id));
811 return Node22 (Root_Type (Id));
812 end Associated_Storage_Pool;
814 function Barrier_Function (Id : E) return N is
815 begin
816 pragma Assert (Is_Entry (Id));
817 return Node12 (Id);
818 end Barrier_Function;
820 function Block_Node (Id : E) return N is
821 begin
822 pragma Assert (Ekind (Id) = E_Block);
823 return Node11 (Id);
824 end Block_Node;
826 function Body_Entity (Id : E) return E is
827 begin
828 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
829 return Node19 (Id);
830 end Body_Entity;
832 function Body_Needed_For_SAL (Id : E) return B is
833 begin
834 pragma Assert
835 (Ekind (Id) = E_Package
836 or else Is_Subprogram (Id)
837 or else Is_Generic_Unit (Id));
838 return Flag40 (Id);
839 end Body_Needed_For_SAL;
841 function Body_References (Id : E) return L is
842 begin
843 pragma Assert (Ekind (Id) = E_Abstract_State);
844 return Elist16 (Id);
845 end Body_References;
847 function BIP_Initialization_Call (Id : E) return N is
848 begin
849 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
850 return Node29 (Id);
851 end BIP_Initialization_Call;
853 function C_Pass_By_Copy (Id : E) return B is
854 begin
855 pragma Assert (Is_Record_Type (Id));
856 return Flag125 (Implementation_Base_Type (Id));
857 end C_Pass_By_Copy;
859 function Can_Never_Be_Null (Id : E) return B is
860 begin
861 return Flag38 (Id);
862 end Can_Never_Be_Null;
864 function Checks_May_Be_Suppressed (Id : E) return B is
865 begin
866 return Flag31 (Id);
867 end Checks_May_Be_Suppressed;
869 function Class_Wide_Postconds (Id : E) return S is
870 begin
871 pragma Assert (Is_Subprogram (Id));
872 return List39 (Id);
873 end Class_Wide_Postconds;
875 function Class_Wide_Preconds (Id : E) return S is
876 begin
877 pragma Assert (Is_Subprogram (Id));
878 return List38 (Id);
879 end Class_Wide_Preconds;
881 function Class_Wide_Type (Id : E) return E is
882 begin
883 pragma Assert (Is_Type (Id));
884 return Node9 (Id);
885 end Class_Wide_Type;
887 function Cloned_Subtype (Id : E) return E is
888 begin
889 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
890 return Node16 (Id);
891 end Cloned_Subtype;
893 function Component_Bit_Offset (Id : E) return U is
894 begin
895 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
896 return Uint11 (Id);
897 end Component_Bit_Offset;
899 function Component_Clause (Id : E) return N is
900 begin
901 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
902 return Node13 (Id);
903 end Component_Clause;
905 function Component_Size (Id : E) return U is
906 begin
907 pragma Assert (Is_Array_Type (Id));
908 return Uint22 (Implementation_Base_Type (Id));
909 end Component_Size;
911 function Component_Type (Id : E) return E is
912 begin
913 pragma Assert (Is_Array_Type (Id));
914 return Node20 (Implementation_Base_Type (Id));
915 end Component_Type;
917 function Corresponding_Concurrent_Type (Id : E) return E is
918 begin
919 pragma Assert (Ekind (Id) = E_Record_Type);
920 return Node18 (Id);
921 end Corresponding_Concurrent_Type;
923 function Corresponding_Discriminant (Id : E) return E is
924 begin
925 pragma Assert (Ekind (Id) = E_Discriminant);
926 return Node19 (Id);
927 end Corresponding_Discriminant;
929 function Corresponding_Equality (Id : E) return E is
930 begin
931 pragma Assert
932 (Ekind (Id) = E_Function
933 and then not Comes_From_Source (Id)
934 and then Chars (Id) = Name_Op_Ne);
935 return Node30 (Id);
936 end Corresponding_Equality;
938 function Corresponding_Function (Id : E) return E is
939 begin
940 pragma Assert (Ekind (Id) = E_Procedure);
941 return Node32 (Id);
942 end Corresponding_Function;
944 function Corresponding_Procedure (Id : E) return E is
945 begin
946 pragma Assert (Ekind (Id) = E_Function);
947 return Node32 (Id);
948 end Corresponding_Procedure;
950 function Corresponding_Protected_Entry (Id : E) return E is
951 begin
952 pragma Assert (Ekind (Id) = E_Subprogram_Body);
953 return Node18 (Id);
954 end Corresponding_Protected_Entry;
956 function Corresponding_Record_Type (Id : E) return E is
957 begin
958 pragma Assert (Is_Concurrent_Type (Id));
959 return Node18 (Id);
960 end Corresponding_Record_Type;
962 function Corresponding_Remote_Type (Id : E) return E is
963 begin
964 return Node22 (Id);
965 end Corresponding_Remote_Type;
967 function Current_Use_Clause (Id : E) return E is
968 begin
969 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
970 return Node27 (Id);
971 end Current_Use_Clause;
973 function Current_Value (Id : E) return N is
974 begin
975 pragma Assert (Ekind (Id) in Object_Kind);
976 return Node9 (Id);
977 end Current_Value;
979 function CR_Discriminant (Id : E) return E is
980 begin
981 return Node23 (Id);
982 end CR_Discriminant;
984 function Debug_Info_Off (Id : E) return B is
985 begin
986 return Flag166 (Id);
987 end Debug_Info_Off;
989 function Debug_Renaming_Link (Id : E) return E is
990 begin
991 return Node25 (Id);
992 end Debug_Renaming_Link;
994 function Default_Aspect_Component_Value (Id : E) return N is
995 begin
996 pragma Assert (Is_Array_Type (Id));
997 return Node19 (Base_Type (Id));
998 end Default_Aspect_Component_Value;
1000 function Default_Aspect_Value (Id : E) return N is
1001 begin
1002 pragma Assert (Is_Scalar_Type (Id));
1003 return Node19 (Base_Type (Id));
1004 end Default_Aspect_Value;
1006 function Default_Expr_Function (Id : E) return E is
1007 begin
1008 pragma Assert (Is_Formal (Id));
1009 return Node21 (Id);
1010 end Default_Expr_Function;
1012 function Default_Expressions_Processed (Id : E) return B is
1013 begin
1014 return Flag108 (Id);
1015 end Default_Expressions_Processed;
1017 function Default_Value (Id : E) return N is
1018 begin
1019 pragma Assert (Is_Formal (Id));
1020 return Node20 (Id);
1021 end Default_Value;
1023 function Delay_Cleanups (Id : E) return B is
1024 begin
1025 return Flag114 (Id);
1026 end Delay_Cleanups;
1028 function Delay_Subprogram_Descriptors (Id : E) return B is
1029 begin
1030 return Flag50 (Id);
1031 end Delay_Subprogram_Descriptors;
1033 function Delta_Value (Id : E) return R is
1034 begin
1035 pragma Assert (Is_Fixed_Point_Type (Id));
1036 return Ureal18 (Id);
1037 end Delta_Value;
1039 function Dependent_Instances (Id : E) return L is
1040 begin
1041 pragma Assert (Is_Generic_Instance (Id));
1042 return Elist8 (Id);
1043 end Dependent_Instances;
1045 function Depends_On_Private (Id : E) return B is
1046 begin
1047 pragma Assert (Nkind (Id) in N_Entity);
1048 return Flag14 (Id);
1049 end Depends_On_Private;
1051 function Derived_Type_Link (Id : E) return E is
1052 begin
1053 pragma Assert (Is_Type (Id));
1054 return Node31 (Base_Type (Id));
1055 end Derived_Type_Link;
1057 function Digits_Value (Id : E) return U is
1058 begin
1059 pragma Assert
1060 (Is_Floating_Point_Type (Id)
1061 or else Is_Decimal_Fixed_Point_Type (Id));
1062 return Uint17 (Id);
1063 end Digits_Value;
1065 function Direct_Primitive_Operations (Id : E) return L is
1066 begin
1067 pragma Assert (Is_Tagged_Type (Id));
1068 return Elist10 (Id);
1069 end Direct_Primitive_Operations;
1071 function Directly_Designated_Type (Id : E) return E is
1072 begin
1073 pragma Assert (Is_Access_Type (Id));
1074 return Node20 (Id);
1075 end Directly_Designated_Type;
1077 function Disable_Controlled (Id : E) return B is
1078 begin
1079 return Flag253 (Base_Type (Id));
1080 end Disable_Controlled;
1082 function Discard_Names (Id : E) return B is
1083 begin
1084 return Flag88 (Id);
1085 end Discard_Names;
1087 function Discriminal (Id : E) return E is
1088 begin
1089 pragma Assert (Ekind (Id) = E_Discriminant);
1090 return Node17 (Id);
1091 end Discriminal;
1093 function Discriminal_Link (Id : E) return N is
1094 begin
1095 return Node10 (Id);
1096 end Discriminal_Link;
1098 function Discriminant_Checking_Func (Id : E) return E is
1099 begin
1100 pragma Assert (Ekind (Id) = E_Component);
1101 return Node20 (Id);
1102 end Discriminant_Checking_Func;
1104 function Discriminant_Constraint (Id : E) return L is
1105 begin
1106 pragma Assert (Is_Composite_Type (Id) and then Has_Discriminants (Id));
1107 return Elist21 (Id);
1108 end Discriminant_Constraint;
1110 function Discriminant_Default_Value (Id : E) return N is
1111 begin
1112 pragma Assert (Ekind (Id) = E_Discriminant);
1113 return Node20 (Id);
1114 end Discriminant_Default_Value;
1116 function Discriminant_Number (Id : E) return U is
1117 begin
1118 pragma Assert (Ekind (Id) = E_Discriminant);
1119 return Uint15 (Id);
1120 end Discriminant_Number;
1122 function Dispatch_Table_Wrappers (Id : E) return L is
1123 begin
1124 pragma Assert (Ekind_In (Id, E_Record_Type,
1125 E_Record_Subtype));
1126 return Elist26 (Implementation_Base_Type (Id));
1127 end Dispatch_Table_Wrappers;
1129 function DT_Entry_Count (Id : E) return U is
1130 begin
1131 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
1132 return Uint15 (Id);
1133 end DT_Entry_Count;
1135 function DT_Offset_To_Top_Func (Id : E) return E is
1136 begin
1137 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
1138 return Node25 (Id);
1139 end DT_Offset_To_Top_Func;
1141 function DT_Position (Id : E) return U is
1142 begin
1143 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
1144 and then Present (DTC_Entity (Id)));
1145 return Uint15 (Id);
1146 end DT_Position;
1148 function DTC_Entity (Id : E) return E is
1149 begin
1150 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
1151 return Node16 (Id);
1152 end DTC_Entity;
1154 function Elaborate_Body_Desirable (Id : E) return B is
1155 begin
1156 pragma Assert (Ekind (Id) = E_Package);
1157 return Flag210 (Id);
1158 end Elaborate_Body_Desirable;
1160 function Elaboration_Entity (Id : E) return E is
1161 begin
1162 pragma Assert
1163 (Is_Subprogram (Id)
1164 or else
1165 Ekind (Id) = E_Package
1166 or else
1167 Is_Generic_Unit (Id));
1168 return Node13 (Id);
1169 end Elaboration_Entity;
1171 function Elaboration_Entity_Required (Id : E) return B is
1172 begin
1173 pragma Assert
1174 (Is_Subprogram (Id)
1175 or else
1176 Ekind (Id) = E_Package
1177 or else
1178 Is_Generic_Unit (Id));
1179 return Flag174 (Id);
1180 end Elaboration_Entity_Required;
1182 function Encapsulating_State (Id : E) return N is
1183 begin
1184 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Constant, E_Variable));
1185 return Node32 (Id);
1186 end Encapsulating_State;
1188 function Enclosing_Scope (Id : E) return E is
1189 begin
1190 return Node18 (Id);
1191 end Enclosing_Scope;
1193 function Entry_Accepted (Id : E) return B is
1194 begin
1195 pragma Assert (Is_Entry (Id));
1196 return Flag152 (Id);
1197 end Entry_Accepted;
1199 function Entry_Bodies_Array (Id : E) return E is
1200 begin
1201 return Node19 (Id);
1202 end Entry_Bodies_Array;
1204 function Entry_Cancel_Parameter (Id : E) return E is
1205 begin
1206 return Node23 (Id);
1207 end Entry_Cancel_Parameter;
1209 function Entry_Component (Id : E) return E is
1210 begin
1211 return Node11 (Id);
1212 end Entry_Component;
1214 function Entry_Formal (Id : E) return E is
1215 begin
1216 return Node16 (Id);
1217 end Entry_Formal;
1219 function Entry_Index_Constant (Id : E) return N is
1220 begin
1221 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
1222 return Node18 (Id);
1223 end Entry_Index_Constant;
1225 function Entry_Max_Queue_Lengths_Array (Id : E) return N is
1226 begin
1227 pragma Assert (Ekind (Id) = E_Protected_Type);
1228 return Node35 (Id);
1229 end Entry_Max_Queue_Lengths_Array;
1231 function Contains_Ignored_Ghost_Code (Id : E) return B is
1232 begin
1233 pragma Assert
1234 (Ekind_In (Id, E_Block,
1235 E_Function,
1236 E_Generic_Function,
1237 E_Generic_Package,
1238 E_Generic_Procedure,
1239 E_Package,
1240 E_Package_Body,
1241 E_Procedure,
1242 E_Subprogram_Body));
1243 return Flag279 (Id);
1244 end Contains_Ignored_Ghost_Code;
1246 function Contract (Id : E) return N is
1247 begin
1248 pragma Assert
1249 (Ekind_In (Id, E_Protected_Type, -- concurrent variants
1250 E_Task_Body,
1251 E_Task_Type)
1252 or else
1253 Ekind_In (Id, E_Constant, -- object variants
1254 E_Variable)
1255 or else
1256 Ekind_In (Id, E_Entry, -- overloadable variants
1257 E_Entry_Family,
1258 E_Function,
1259 E_Generic_Function,
1260 E_Generic_Procedure,
1261 E_Operator,
1262 E_Procedure,
1263 E_Subprogram_Body)
1264 or else
1265 Ekind_In (Id, E_Generic_Package, -- package variants
1266 E_Package,
1267 E_Package_Body)
1268 or else
1269 Ekind (Id) = E_Void); -- special purpose
1270 return Node34 (Id);
1271 end Contract;
1273 function Contract_Wrapper (Id : E) return E is
1274 begin
1275 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
1276 return Node25 (Id);
1277 end Contract_Wrapper;
1279 function Entry_Parameters_Type (Id : E) return E is
1280 begin
1281 return Node15 (Id);
1282 end Entry_Parameters_Type;
1284 function Enum_Pos_To_Rep (Id : E) return E is
1285 begin
1286 pragma Assert (Ekind (Id) = E_Enumeration_Type);
1287 return Node23 (Id);
1288 end Enum_Pos_To_Rep;
1290 function Enumeration_Pos (Id : E) return Uint is
1291 begin
1292 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1293 return Uint11 (Id);
1294 end Enumeration_Pos;
1296 function Enumeration_Rep (Id : E) return U is
1297 begin
1298 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1299 return Uint12 (Id);
1300 end Enumeration_Rep;
1302 function Enumeration_Rep_Expr (Id : E) return N is
1303 begin
1304 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1305 return Node22 (Id);
1306 end Enumeration_Rep_Expr;
1308 function Equivalent_Type (Id : E) return E is
1309 begin
1310 pragma Assert
1311 (Ekind_In (Id, E_Class_Wide_Type,
1312 E_Class_Wide_Subtype,
1313 E_Access_Subprogram_Type,
1314 E_Access_Protected_Subprogram_Type,
1315 E_Anonymous_Access_Protected_Subprogram_Type,
1316 E_Access_Subprogram_Type,
1317 E_Exception_Type));
1318 return Node18 (Id);
1319 end Equivalent_Type;
1321 function Esize (Id : E) return Uint is
1322 begin
1323 return Uint12 (Id);
1324 end Esize;
1326 function Extra_Accessibility (Id : E) return E is
1327 begin
1328 pragma Assert
1329 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
1330 return Node13 (Id);
1331 end Extra_Accessibility;
1333 function Extra_Accessibility_Of_Result (Id : E) return E is
1334 begin
1335 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
1336 return Node19 (Id);
1337 end Extra_Accessibility_Of_Result;
1339 function Extra_Constrained (Id : E) return E is
1340 begin
1341 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
1342 return Node23 (Id);
1343 end Extra_Constrained;
1345 function Extra_Formal (Id : E) return E is
1346 begin
1347 return Node15 (Id);
1348 end Extra_Formal;
1350 function Extra_Formals (Id : E) return E is
1351 begin
1352 pragma Assert
1353 (Is_Overloadable (Id)
1354 or else Ekind_In (Id, E_Entry_Family,
1355 E_Subprogram_Body,
1356 E_Subprogram_Type));
1357 return Node28 (Id);
1358 end Extra_Formals;
1360 function Can_Use_Internal_Rep (Id : E) return B is
1361 begin
1362 pragma Assert (Is_Access_Subprogram_Type (Base_Type (Id)));
1363 return Flag229 (Base_Type (Id));
1364 end Can_Use_Internal_Rep;
1366 function Finalization_Master (Id : E) return E is
1367 begin
1368 pragma Assert (Is_Access_Type (Id));
1369 return Node23 (Root_Type (Id));
1370 end Finalization_Master;
1372 function Finalize_Storage_Only (Id : E) return B is
1373 begin
1374 pragma Assert (Is_Type (Id));
1375 return Flag158 (Base_Type (Id));
1376 end Finalize_Storage_Only;
1378 function Finalizer (Id : E) return E is
1379 begin
1380 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
1381 return Node28 (Id);
1382 end Finalizer;
1384 function First_Entity (Id : E) return E is
1385 begin
1386 return Node17 (Id);
1387 end First_Entity;
1389 function First_Exit_Statement (Id : E) return N is
1390 begin
1391 pragma Assert (Ekind (Id) = E_Loop);
1392 return Node8 (Id);
1393 end First_Exit_Statement;
1395 function First_Index (Id : E) return N is
1396 begin
1397 pragma Assert (Is_Array_Type (Id));
1398 return Node17 (Id);
1399 end First_Index;
1401 function First_Literal (Id : E) return E is
1402 begin
1403 pragma Assert (Is_Enumeration_Type (Id));
1404 return Node17 (Id);
1405 end First_Literal;
1407 function First_Private_Entity (Id : E) return E is
1408 begin
1409 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
1410 or else Ekind (Id) in Concurrent_Kind);
1411 return Node16 (Id);
1412 end First_Private_Entity;
1414 function First_Rep_Item (Id : E) return E is
1415 begin
1416 return Node6 (Id);
1417 end First_Rep_Item;
1419 function Freeze_Node (Id : E) return N is
1420 begin
1421 return Node7 (Id);
1422 end Freeze_Node;
1424 function From_Limited_With (Id : E) return B is
1425 begin
1426 return Flag159 (Id);
1427 end From_Limited_With;
1429 function Full_View (Id : E) return E is
1430 begin
1431 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
1432 return Node11 (Id);
1433 end Full_View;
1435 function Generic_Homonym (Id : E) return E is
1436 begin
1437 pragma Assert (Ekind (Id) = E_Generic_Package);
1438 return Node11 (Id);
1439 end Generic_Homonym;
1441 function Generic_Renamings (Id : E) return L is
1442 begin
1443 return Elist23 (Id);
1444 end Generic_Renamings;
1446 function Handler_Records (Id : E) return S is
1447 begin
1448 return List10 (Id);
1449 end Handler_Records;
1451 function Has_Aliased_Components (Id : E) return B is
1452 begin
1453 return Flag135 (Implementation_Base_Type (Id));
1454 end Has_Aliased_Components;
1456 function Has_Alignment_Clause (Id : E) return B is
1457 begin
1458 return Flag46 (Id);
1459 end Has_Alignment_Clause;
1461 function Has_All_Calls_Remote (Id : E) return B is
1462 begin
1463 return Flag79 (Id);
1464 end Has_All_Calls_Remote;
1466 function Has_Atomic_Components (Id : E) return B is
1467 begin
1468 return Flag86 (Implementation_Base_Type (Id));
1469 end Has_Atomic_Components;
1471 function Has_Biased_Representation (Id : E) return B is
1472 begin
1473 return Flag139 (Id);
1474 end Has_Biased_Representation;
1476 function Has_Completion (Id : E) return B is
1477 begin
1478 return Flag26 (Id);
1479 end Has_Completion;
1481 function Has_Completion_In_Body (Id : E) return B is
1482 begin
1483 pragma Assert (Is_Type (Id));
1484 return Flag71 (Id);
1485 end Has_Completion_In_Body;
1487 function Has_Complex_Representation (Id : E) return B is
1488 begin
1489 pragma Assert (Is_Type (Id));
1490 return Flag140 (Implementation_Base_Type (Id));
1491 end Has_Complex_Representation;
1493 function Has_Component_Size_Clause (Id : E) return B is
1494 begin
1495 pragma Assert (Is_Array_Type (Id));
1496 return Flag68 (Implementation_Base_Type (Id));
1497 end Has_Component_Size_Clause;
1499 function Has_Constrained_Partial_View (Id : E) return B is
1500 begin
1501 pragma Assert (Is_Type (Id));
1502 return Flag187 (Id);
1503 end Has_Constrained_Partial_View;
1505 function Has_Controlled_Component (Id : E) return B is
1506 begin
1507 return Flag43 (Base_Type (Id));
1508 end Has_Controlled_Component;
1510 function Has_Contiguous_Rep (Id : E) return B is
1511 begin
1512 return Flag181 (Id);
1513 end Has_Contiguous_Rep;
1515 function Has_Controlling_Result (Id : E) return B is
1516 begin
1517 return Flag98 (Id);
1518 end Has_Controlling_Result;
1520 function Has_Convention_Pragma (Id : E) return B is
1521 begin
1522 return Flag119 (Id);
1523 end Has_Convention_Pragma;
1525 function Has_Default_Aspect (Id : E) return B is
1526 begin
1527 return Flag39 (Base_Type (Id));
1528 end Has_Default_Aspect;
1530 function Has_Delayed_Aspects (Id : E) return B is
1531 begin
1532 pragma Assert (Nkind (Id) in N_Entity);
1533 return Flag200 (Id);
1534 end Has_Delayed_Aspects;
1536 function Has_Delayed_Freeze (Id : E) return B is
1537 begin
1538 pragma Assert (Nkind (Id) in N_Entity);
1539 return Flag18 (Id);
1540 end Has_Delayed_Freeze;
1542 function Has_Delayed_Rep_Aspects (Id : E) return B is
1543 begin
1544 pragma Assert (Nkind (Id) in N_Entity);
1545 return Flag261 (Id);
1546 end Has_Delayed_Rep_Aspects;
1548 function Has_Discriminants (Id : E) return B is
1549 begin
1550 pragma Assert (Nkind (Id) in N_Entity);
1551 return Flag5 (Id);
1552 end Has_Discriminants;
1554 function Has_Dispatch_Table (Id : E) return B is
1555 begin
1556 pragma Assert (Is_Tagged_Type (Id));
1557 return Flag220 (Id);
1558 end Has_Dispatch_Table;
1560 function Has_Dynamic_Predicate_Aspect (Id : E) return B is
1561 begin
1562 pragma Assert (Is_Type (Id));
1563 return Flag258 (Id);
1564 end Has_Dynamic_Predicate_Aspect;
1566 function Has_Enumeration_Rep_Clause (Id : E) return B is
1567 begin
1568 pragma Assert (Is_Enumeration_Type (Id));
1569 return Flag66 (Id);
1570 end Has_Enumeration_Rep_Clause;
1572 function Has_Exit (Id : E) return B is
1573 begin
1574 return Flag47 (Id);
1575 end Has_Exit;
1577 function Has_Expanded_Contract (Id : E) return B is
1578 begin
1579 pragma Assert (Is_Subprogram (Id));
1580 return Flag240 (Id);
1581 end Has_Expanded_Contract;
1583 function Has_Forward_Instantiation (Id : E) return B is
1584 begin
1585 return Flag175 (Id);
1586 end Has_Forward_Instantiation;
1588 function Has_Fully_Qualified_Name (Id : E) return B is
1589 begin
1590 return Flag173 (Id);
1591 end Has_Fully_Qualified_Name;
1593 function Has_Gigi_Rep_Item (Id : E) return B is
1594 begin
1595 return Flag82 (Id);
1596 end Has_Gigi_Rep_Item;
1598 function Has_Homonym (Id : E) return B is
1599 begin
1600 return Flag56 (Id);
1601 end Has_Homonym;
1603 function Has_Implicit_Dereference (Id : E) return B is
1604 begin
1605 return Flag251 (Id);
1606 end Has_Implicit_Dereference;
1608 function Has_Independent_Components (Id : E) return B is
1609 begin
1610 return Flag34 (Implementation_Base_Type (Id));
1611 end Has_Independent_Components;
1613 function Has_Inheritable_Invariants (Id : E) return B is
1614 begin
1615 pragma Assert (Is_Type (Id));
1616 return Flag248 (Base_Type (Id));
1617 end Has_Inheritable_Invariants;
1619 function Has_Inherited_DIC (Id : E) return B is
1620 begin
1621 pragma Assert (Is_Type (Id));
1622 return Flag133 (Base_Type (Id));
1623 end Has_Inherited_DIC;
1625 function Has_Inherited_Invariants (Id : E) return B is
1626 begin
1627 pragma Assert (Is_Type (Id));
1628 return Flag291 (Base_Type (Id));
1629 end Has_Inherited_Invariants;
1631 function Has_Initial_Value (Id : E) return B is
1632 begin
1633 pragma Assert (Ekind (Id) = E_Variable or else Is_Formal (Id));
1634 return Flag219 (Id);
1635 end Has_Initial_Value;
1637 function Has_Loop_Entry_Attributes (Id : E) return B is
1638 begin
1639 pragma Assert (Ekind (Id) = E_Loop);
1640 return Flag260 (Id);
1641 end Has_Loop_Entry_Attributes;
1643 function Has_Machine_Radix_Clause (Id : E) return B is
1644 begin
1645 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
1646 return Flag83 (Id);
1647 end Has_Machine_Radix_Clause;
1649 function Has_Master_Entity (Id : E) return B is
1650 begin
1651 return Flag21 (Id);
1652 end Has_Master_Entity;
1654 function Has_Missing_Return (Id : E) return B is
1655 begin
1656 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
1657 return Flag142 (Id);
1658 end Has_Missing_Return;
1660 function Has_Nested_Block_With_Handler (Id : E) return B is
1661 begin
1662 return Flag101 (Id);
1663 end Has_Nested_Block_With_Handler;
1665 function Has_Nested_Subprogram (Id : E) return B is
1666 begin
1667 pragma Assert (Is_Subprogram (Id));
1668 return Flag282 (Id);
1669 end Has_Nested_Subprogram;
1671 function Has_Non_Standard_Rep (Id : E) return B is
1672 begin
1673 return Flag75 (Implementation_Base_Type (Id));
1674 end Has_Non_Standard_Rep;
1676 function Has_Object_Size_Clause (Id : E) return B is
1677 begin
1678 pragma Assert (Is_Type (Id));
1679 return Flag172 (Id);
1680 end Has_Object_Size_Clause;
1682 function Has_Out_Or_In_Out_Parameter (Id : E) return B is
1683 begin
1684 pragma Assert
1685 (Ekind_In (Id, E_Entry, E_Entry_Family)
1686 or else Is_Subprogram_Or_Generic_Subprogram (Id));
1687 return Flag110 (Id);
1688 end Has_Out_Or_In_Out_Parameter;
1690 function Has_Own_DIC (Id : E) return B is
1691 begin
1692 pragma Assert (Is_Type (Id));
1693 return Flag3 (Base_Type (Id));
1694 end Has_Own_DIC;
1696 function Has_Own_Invariants (Id : E) return B is
1697 begin
1698 pragma Assert (Is_Type (Id));
1699 return Flag232 (Base_Type (Id));
1700 end Has_Own_Invariants;
1702 function Has_Partial_Visible_Refinement (Id : E) return B is
1703 begin
1704 pragma Assert (Ekind (Id) = E_Abstract_State);
1705 return Flag296 (Id);
1706 end Has_Partial_Visible_Refinement;
1708 function Has_Per_Object_Constraint (Id : E) return B is
1709 begin
1710 return Flag154 (Id);
1711 end Has_Per_Object_Constraint;
1713 function Has_Pragma_Controlled (Id : E) return B is
1714 begin
1715 pragma Assert (Is_Access_Type (Id));
1716 return Flag27 (Implementation_Base_Type (Id));
1717 end Has_Pragma_Controlled;
1719 function Has_Pragma_Elaborate_Body (Id : E) return B is
1720 begin
1721 return Flag150 (Id);
1722 end Has_Pragma_Elaborate_Body;
1724 function Has_Pragma_Inline (Id : E) return B is
1725 begin
1726 return Flag157 (Id);
1727 end Has_Pragma_Inline;
1729 function Has_Pragma_Inline_Always (Id : E) return B is
1730 begin
1731 return Flag230 (Id);
1732 end Has_Pragma_Inline_Always;
1734 function Has_Pragma_No_Inline (Id : E) return B is
1735 begin
1736 return Flag201 (Id);
1737 end Has_Pragma_No_Inline;
1739 function Has_Pragma_Ordered (Id : E) return B is
1740 begin
1741 pragma Assert (Is_Enumeration_Type (Id));
1742 return Flag198 (Implementation_Base_Type (Id));
1743 end Has_Pragma_Ordered;
1745 function Has_Pragma_Pack (Id : E) return B is
1746 begin
1747 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
1748 return Flag121 (Implementation_Base_Type (Id));
1749 end Has_Pragma_Pack;
1751 function Has_Pragma_Preelab_Init (Id : E) return B is
1752 begin
1753 return Flag221 (Id);
1754 end Has_Pragma_Preelab_Init;
1756 function Has_Pragma_Pure (Id : E) return B is
1757 begin
1758 return Flag203 (Id);
1759 end Has_Pragma_Pure;
1761 function Has_Pragma_Pure_Function (Id : E) return B is
1762 begin
1763 return Flag179 (Id);
1764 end Has_Pragma_Pure_Function;
1766 function Has_Pragma_Thread_Local_Storage (Id : E) return B is
1767 begin
1768 return Flag169 (Id);
1769 end Has_Pragma_Thread_Local_Storage;
1771 function Has_Pragma_Unmodified (Id : E) return B is
1772 begin
1773 return Flag233 (Id);
1774 end Has_Pragma_Unmodified;
1776 function Has_Pragma_Unreferenced (Id : E) return B is
1777 begin
1778 return Flag180 (Id);
1779 end Has_Pragma_Unreferenced;
1781 function Has_Pragma_Unreferenced_Objects (Id : E) return B is
1782 begin
1783 pragma Assert (Is_Type (Id));
1784 return Flag212 (Id);
1785 end Has_Pragma_Unreferenced_Objects;
1787 function Has_Pragma_Unused (Id : E) return B is
1788 begin
1789 return Flag294 (Id);
1790 end Has_Pragma_Unused;
1792 function Has_Predicates (Id : E) return B is
1793 begin
1794 pragma Assert (Is_Type (Id));
1795 return Flag250 (Id);
1796 end Has_Predicates;
1798 function Has_Primitive_Operations (Id : E) return B is
1799 begin
1800 pragma Assert (Is_Type (Id));
1801 return Flag120 (Base_Type (Id));
1802 end Has_Primitive_Operations;
1804 function Has_Private_Ancestor (Id : E) return B is
1805 begin
1806 return Flag151 (Id);
1807 end Has_Private_Ancestor;
1809 function Has_Private_Declaration (Id : E) return B is
1810 begin
1811 return Flag155 (Id);
1812 end Has_Private_Declaration;
1814 function Has_Protected (Id : E) return B is
1815 begin
1816 return Flag271 (Base_Type (Id));
1817 end Has_Protected;
1819 function Has_Qualified_Name (Id : E) return B is
1820 begin
1821 return Flag161 (Id);
1822 end Has_Qualified_Name;
1824 function Has_RACW (Id : E) return B is
1825 begin
1826 pragma Assert (Ekind (Id) = E_Package);
1827 return Flag214 (Id);
1828 end Has_RACW;
1830 function Has_Record_Rep_Clause (Id : E) return B is
1831 begin
1832 pragma Assert (Is_Record_Type (Id));
1833 return Flag65 (Implementation_Base_Type (Id));
1834 end Has_Record_Rep_Clause;
1836 function Has_Recursive_Call (Id : E) return B is
1837 begin
1838 pragma Assert (Is_Subprogram (Id));
1839 return Flag143 (Id);
1840 end Has_Recursive_Call;
1842 function Has_Shift_Operator (Id : E) return B is
1843 begin
1844 pragma Assert (Is_Integer_Type (Id));
1845 return Flag267 (Base_Type (Id));
1846 end Has_Shift_Operator;
1848 function Has_Size_Clause (Id : E) return B is
1849 begin
1850 return Flag29 (Id);
1851 end Has_Size_Clause;
1853 function Has_Small_Clause (Id : E) return B is
1854 begin
1855 pragma Assert (Is_Ordinary_Fixed_Point_Type (Id));
1856 return Flag67 (Id);
1857 end Has_Small_Clause;
1859 function Has_Specified_Layout (Id : E) return B is
1860 begin
1861 pragma Assert (Is_Type (Id));
1862 return Flag100 (Implementation_Base_Type (Id));
1863 end Has_Specified_Layout;
1865 function Has_Specified_Stream_Input (Id : E) return B is
1866 begin
1867 pragma Assert (Is_Type (Id));
1868 return Flag190 (Id);
1869 end Has_Specified_Stream_Input;
1871 function Has_Specified_Stream_Output (Id : E) return B is
1872 begin
1873 pragma Assert (Is_Type (Id));
1874 return Flag191 (Id);
1875 end Has_Specified_Stream_Output;
1877 function Has_Specified_Stream_Read (Id : E) return B is
1878 begin
1879 pragma Assert (Is_Type (Id));
1880 return Flag192 (Id);
1881 end Has_Specified_Stream_Read;
1883 function Has_Specified_Stream_Write (Id : E) return B is
1884 begin
1885 pragma Assert (Is_Type (Id));
1886 return Flag193 (Id);
1887 end Has_Specified_Stream_Write;
1889 function Has_Static_Discriminants (Id : E) return B is
1890 begin
1891 pragma Assert (Is_Type (Id));
1892 return Flag211 (Id);
1893 end Has_Static_Discriminants;
1895 function Has_Static_Predicate (Id : E) return B is
1896 begin
1897 pragma Assert (Is_Type (Id));
1898 return Flag269 (Id);
1899 end Has_Static_Predicate;
1901 function Has_Static_Predicate_Aspect (Id : E) return B is
1902 begin
1903 pragma Assert (Is_Type (Id));
1904 return Flag259 (Id);
1905 end Has_Static_Predicate_Aspect;
1907 function Has_Storage_Size_Clause (Id : E) return B is
1908 begin
1909 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
1910 return Flag23 (Implementation_Base_Type (Id));
1911 end Has_Storage_Size_Clause;
1913 function Has_Stream_Size_Clause (Id : E) return B is
1914 begin
1915 return Flag184 (Id);
1916 end Has_Stream_Size_Clause;
1918 function Has_Task (Id : E) return B is
1919 begin
1920 return Flag30 (Base_Type (Id));
1921 end Has_Task;
1923 function Has_Thunks (Id : E) return B is
1924 begin
1925 return Flag228 (Id);
1926 end Has_Thunks;
1928 function Has_Timing_Event (Id : E) return B is
1929 begin
1930 return Flag289 (Base_Type (Id));
1931 end Has_Timing_Event;
1933 function Has_Unchecked_Union (Id : E) return B is
1934 begin
1935 return Flag123 (Base_Type (Id));
1936 end Has_Unchecked_Union;
1938 function Has_Unknown_Discriminants (Id : E) return B is
1939 begin
1940 pragma Assert (Is_Type (Id));
1941 return Flag72 (Id);
1942 end Has_Unknown_Discriminants;
1944 function Has_Visible_Refinement (Id : E) return B is
1945 begin
1946 pragma Assert (Ekind (Id) = E_Abstract_State);
1947 return Flag263 (Id);
1948 end Has_Visible_Refinement;
1950 function Has_Volatile_Components (Id : E) return B is
1951 begin
1952 return Flag87 (Implementation_Base_Type (Id));
1953 end Has_Volatile_Components;
1955 function Has_Xref_Entry (Id : E) return B is
1956 begin
1957 return Flag182 (Id);
1958 end Has_Xref_Entry;
1960 function Hiding_Loop_Variable (Id : E) return E is
1961 begin
1962 pragma Assert (Ekind (Id) = E_Variable);
1963 return Node8 (Id);
1964 end Hiding_Loop_Variable;
1966 function Homonym (Id : E) return E is
1967 begin
1968 return Node4 (Id);
1969 end Homonym;
1971 function Import_Pragma (Id : E) return E is
1972 begin
1973 pragma Assert (Is_Subprogram (Id));
1974 return Node35 (Id);
1975 end Import_Pragma;
1977 function Incomplete_Actuals (Id : E) return L is
1978 begin
1979 pragma Assert (Ekind (Id) = E_Package);
1980 return Elist24 (Id);
1981 end Incomplete_Actuals;
1983 function Interface_Alias (Id : E) return E is
1984 begin
1985 pragma Assert (Is_Subprogram (Id));
1986 return Node25 (Id);
1987 end Interface_Alias;
1989 function Interfaces (Id : E) return L is
1990 begin
1991 pragma Assert (Is_Record_Type (Id));
1992 return Elist25 (Id);
1993 end Interfaces;
1995 function In_Package_Body (Id : E) return B is
1996 begin
1997 return Flag48 (Id);
1998 end In_Package_Body;
2000 function In_Private_Part (Id : E) return B is
2001 begin
2002 return Flag45 (Id);
2003 end In_Private_Part;
2005 function In_Use (Id : E) return B is
2006 begin
2007 pragma Assert (Nkind (Id) in N_Entity);
2008 return Flag8 (Id);
2009 end In_Use;
2011 function Initialization_Statements (Id : E) return N is
2012 begin
2013 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2014 return Node28 (Id);
2015 end Initialization_Statements;
2017 function Inner_Instances (Id : E) return L is
2018 begin
2019 return Elist23 (Id);
2020 end Inner_Instances;
2022 function Interface_Name (Id : E) return N is
2023 begin
2024 return Node21 (Id);
2025 end Interface_Name;
2027 function Is_Abstract_Subprogram (Id : E) return B is
2028 begin
2029 pragma Assert (Is_Overloadable (Id));
2030 return Flag19 (Id);
2031 end Is_Abstract_Subprogram;
2033 function Is_Abstract_Type (Id : E) return B is
2034 begin
2035 pragma Assert (Is_Type (Id));
2036 return Flag146 (Id);
2037 end Is_Abstract_Type;
2039 function Is_Access_Constant (Id : E) return B is
2040 begin
2041 pragma Assert (Is_Access_Type (Id));
2042 return Flag69 (Id);
2043 end Is_Access_Constant;
2045 function Is_Actual_Subtype (Id : E) return B is
2046 begin
2047 pragma Assert (Is_Type (Id));
2048 return Flag293 (Id);
2049 end Is_Actual_Subtype;
2051 function Is_Ada_2005_Only (Id : E) return B is
2052 begin
2053 return Flag185 (Id);
2054 end Is_Ada_2005_Only;
2056 function Is_Ada_2012_Only (Id : E) return B is
2057 begin
2058 return Flag199 (Id);
2059 end Is_Ada_2012_Only;
2061 function Is_Aliased (Id : E) return B is
2062 begin
2063 pragma Assert (Nkind (Id) in N_Entity);
2064 return Flag15 (Id);
2065 end Is_Aliased;
2067 function Is_Asynchronous (Id : E) return B is
2068 begin
2069 pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id));
2070 return Flag81 (Id);
2071 end Is_Asynchronous;
2073 function Is_Atomic (Id : E) return B is
2074 begin
2075 return Flag85 (Id);
2076 end Is_Atomic;
2078 function Is_Bit_Packed_Array (Id : E) return B is
2079 begin
2080 return Flag122 (Implementation_Base_Type (Id));
2081 end Is_Bit_Packed_Array;
2083 function Is_Called (Id : E) return B is
2084 begin
2085 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
2086 return Flag102 (Id);
2087 end Is_Called;
2089 function Is_Character_Type (Id : E) return B is
2090 begin
2091 return Flag63 (Id);
2092 end Is_Character_Type;
2094 function Is_Checked_Ghost_Entity (Id : E) return B is
2095 begin
2096 -- Allow this attribute to appear on unanalyzed entities
2098 pragma Assert (Nkind (Id) in N_Entity
2099 or else Ekind (Id) = E_Void);
2100 return Flag277 (Id);
2101 end Is_Checked_Ghost_Entity;
2103 function Is_Child_Unit (Id : E) return B is
2104 begin
2105 return Flag73 (Id);
2106 end Is_Child_Unit;
2108 function Is_Class_Wide_Equivalent_Type (Id : E) return B is
2109 begin
2110 return Flag35 (Id);
2111 end Is_Class_Wide_Equivalent_Type;
2113 function Is_Compilation_Unit (Id : E) return B is
2114 begin
2115 return Flag149 (Id);
2116 end Is_Compilation_Unit;
2118 function Is_Completely_Hidden (Id : E) return B is
2119 begin
2120 pragma Assert (Ekind (Id) = E_Discriminant);
2121 return Flag103 (Id);
2122 end Is_Completely_Hidden;
2124 function Is_Constr_Subt_For_U_Nominal (Id : E) return B is
2125 begin
2126 return Flag80 (Id);
2127 end Is_Constr_Subt_For_U_Nominal;
2129 function Is_Constr_Subt_For_UN_Aliased (Id : E) return B is
2130 begin
2131 return Flag141 (Id);
2132 end Is_Constr_Subt_For_UN_Aliased;
2134 function Is_Constrained (Id : E) return B is
2135 begin
2136 pragma Assert (Nkind (Id) in N_Entity);
2137 return Flag12 (Id);
2138 end Is_Constrained;
2140 function Is_Constructor (Id : E) return B is
2141 begin
2142 return Flag76 (Id);
2143 end Is_Constructor;
2145 function Is_Controlled (Id : E) return B is
2146 begin
2147 return Flag42 (Base_Type (Id));
2148 end Is_Controlled;
2150 function Is_Controlling_Formal (Id : E) return B is
2151 begin
2152 pragma Assert (Is_Formal (Id));
2153 return Flag97 (Id);
2154 end Is_Controlling_Formal;
2156 function Is_CPP_Class (Id : E) return B is
2157 begin
2158 return Flag74 (Id);
2159 end Is_CPP_Class;
2161 function Is_DIC_Procedure (Id : E) return B is
2162 begin
2163 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2164 return Flag132 (Id);
2165 end Is_DIC_Procedure;
2167 function Is_Descendant_Of_Address (Id : E) return B is
2168 begin
2169 return Flag223 (Id);
2170 end Is_Descendant_Of_Address;
2172 function Is_Discrim_SO_Function (Id : E) return B is
2173 begin
2174 return Flag176 (Id);
2175 end Is_Discrim_SO_Function;
2177 function Is_Discriminant_Check_Function (Id : E) return B is
2178 begin
2179 return Flag264 (Id);
2180 end Is_Discriminant_Check_Function;
2182 function Is_Dispatch_Table_Entity (Id : E) return B is
2183 begin
2184 return Flag234 (Id);
2185 end Is_Dispatch_Table_Entity;
2187 function Is_Dispatching_Operation (Id : E) return B is
2188 begin
2189 pragma Assert (Nkind (Id) in N_Entity);
2190 return Flag6 (Id);
2191 end Is_Dispatching_Operation;
2193 function Is_Eliminated (Id : E) return B is
2194 begin
2195 return Flag124 (Id);
2196 end Is_Eliminated;
2198 function Is_Entry_Formal (Id : E) return B is
2199 begin
2200 return Flag52 (Id);
2201 end Is_Entry_Formal;
2203 function Is_Entry_Wrapper (Id : E) return B is
2204 begin
2205 return Flag297 (Id);
2206 end Is_Entry_Wrapper;
2208 function Is_Exception_Handler (Id : E) return B is
2209 begin
2210 pragma Assert (Ekind (Id) = E_Block);
2211 return Flag286 (Id);
2212 end Is_Exception_Handler;
2214 function Is_Exported (Id : E) return B is
2215 begin
2216 return Flag99 (Id);
2217 end Is_Exported;
2219 function Is_Finalized_Transient (Id : E) return B is
2220 begin
2221 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
2222 return Flag252 (Id);
2223 end Is_Finalized_Transient;
2225 function Is_First_Subtype (Id : E) return B is
2226 begin
2227 return Flag70 (Id);
2228 end Is_First_Subtype;
2230 function Is_For_Access_Subtype (Id : E) return B is
2231 begin
2232 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
2233 return Flag118 (Id);
2234 end Is_For_Access_Subtype;
2236 function Is_Formal_Subprogram (Id : E) return B is
2237 begin
2238 return Flag111 (Id);
2239 end Is_Formal_Subprogram;
2241 function Is_Frozen (Id : E) return B is
2242 begin
2243 return Flag4 (Id);
2244 end Is_Frozen;
2246 function Is_Generic_Actual_Subprogram (Id : E) return B is
2247 begin
2248 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2249 return Flag274 (Id);
2250 end Is_Generic_Actual_Subprogram;
2252 function Is_Generic_Actual_Type (Id : E) return B is
2253 begin
2254 pragma Assert (Is_Type (Id));
2255 return Flag94 (Id);
2256 end Is_Generic_Actual_Type;
2258 function Is_Generic_Instance (Id : E) return B is
2259 begin
2260 return Flag130 (Id);
2261 end Is_Generic_Instance;
2263 function Is_Generic_Type (Id : E) return B is
2264 begin
2265 pragma Assert (Nkind (Id) in N_Entity);
2266 return Flag13 (Id);
2267 end Is_Generic_Type;
2269 function Is_Hidden (Id : E) return B is
2270 begin
2271 return Flag57 (Id);
2272 end Is_Hidden;
2274 function Is_Hidden_Non_Overridden_Subpgm (Id : E) return B is
2275 begin
2276 return Flag2 (Id);
2277 end Is_Hidden_Non_Overridden_Subpgm;
2279 function Is_Hidden_Open_Scope (Id : E) return B is
2280 begin
2281 return Flag171 (Id);
2282 end Is_Hidden_Open_Scope;
2284 function Is_Ignored_Ghost_Entity (Id : E) return B is
2285 begin
2286 -- Allow this attribute to appear on unanalyzed entities
2288 pragma Assert (Nkind (Id) in N_Entity
2289 or else Ekind (Id) = E_Void);
2290 return Flag278 (Id);
2291 end Is_Ignored_Ghost_Entity;
2293 function Is_Ignored_Transient (Id : E) return B is
2294 begin
2295 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
2296 return Flag295 (Id);
2297 end Is_Ignored_Transient;
2299 function Is_Immediately_Visible (Id : E) return B is
2300 begin
2301 pragma Assert (Nkind (Id) in N_Entity);
2302 return Flag7 (Id);
2303 end Is_Immediately_Visible;
2305 function Is_Implementation_Defined (Id : E) return B is
2306 begin
2307 return Flag254 (Id);
2308 end Is_Implementation_Defined;
2310 function Is_Imported (Id : E) return B is
2311 begin
2312 return Flag24 (Id);
2313 end Is_Imported;
2315 function Is_Independent (Id : E) return B is
2316 begin
2317 return Flag268 (Id);
2318 end Is_Independent;
2320 function Is_Inlined (Id : E) return B is
2321 begin
2322 return Flag11 (Id);
2323 end Is_Inlined;
2325 function Is_Inlined_Always (Id : E) return B is
2326 begin
2327 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2328 return Flag1 (Id);
2329 end Is_Inlined_Always;
2331 function Is_Interface (Id : E) return B is
2332 begin
2333 return Flag186 (Id);
2334 end Is_Interface;
2336 function Is_Instantiated (Id : E) return B is
2337 begin
2338 return Flag126 (Id);
2339 end Is_Instantiated;
2341 function Is_Internal (Id : E) return B is
2342 begin
2343 pragma Assert (Nkind (Id) in N_Entity);
2344 return Flag17 (Id);
2345 end Is_Internal;
2347 function Is_Interrupt_Handler (Id : E) return B is
2348 begin
2349 pragma Assert (Nkind (Id) in N_Entity);
2350 return Flag89 (Id);
2351 end Is_Interrupt_Handler;
2353 function Is_Intrinsic_Subprogram (Id : E) return B is
2354 begin
2355 return Flag64 (Id);
2356 end Is_Intrinsic_Subprogram;
2358 function Is_Invariant_Procedure (Id : E) return B is
2359 begin
2360 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2361 return Flag257 (Id);
2362 end Is_Invariant_Procedure;
2364 function Is_Itype (Id : E) return B is
2365 begin
2366 return Flag91 (Id);
2367 end Is_Itype;
2369 function Is_Known_Non_Null (Id : E) return B is
2370 begin
2371 return Flag37 (Id);
2372 end Is_Known_Non_Null;
2374 function Is_Known_Null (Id : E) return B is
2375 begin
2376 return Flag204 (Id);
2377 end Is_Known_Null;
2379 function Is_Known_Valid (Id : E) return B is
2380 begin
2381 return Flag170 (Id);
2382 end Is_Known_Valid;
2384 function Is_Limited_Composite (Id : E) return B is
2385 begin
2386 return Flag106 (Id);
2387 end Is_Limited_Composite;
2389 function Is_Limited_Interface (Id : E) return B is
2390 begin
2391 return Flag197 (Id);
2392 end Is_Limited_Interface;
2394 function Is_Limited_Record (Id : E) return B is
2395 begin
2396 return Flag25 (Id);
2397 end Is_Limited_Record;
2399 function Is_Local_Anonymous_Access (Id : E) return B is
2400 begin
2401 pragma Assert (Is_Access_Type (Id));
2402 return Flag194 (Id);
2403 end Is_Local_Anonymous_Access;
2405 function Is_Machine_Code_Subprogram (Id : E) return B is
2406 begin
2407 pragma Assert (Is_Subprogram (Id));
2408 return Flag137 (Id);
2409 end Is_Machine_Code_Subprogram;
2411 function Is_Non_Static_Subtype (Id : E) return B is
2412 begin
2413 pragma Assert (Is_Type (Id));
2414 return Flag109 (Id);
2415 end Is_Non_Static_Subtype;
2417 function Is_Null_Init_Proc (Id : E) return B is
2418 begin
2419 pragma Assert (Ekind (Id) = E_Procedure);
2420 return Flag178 (Id);
2421 end Is_Null_Init_Proc;
2423 function Is_Obsolescent (Id : E) return B is
2424 begin
2425 return Flag153 (Id);
2426 end Is_Obsolescent;
2428 function Is_Only_Out_Parameter (Id : E) return B is
2429 begin
2430 pragma Assert (Is_Formal (Id));
2431 return Flag226 (Id);
2432 end Is_Only_Out_Parameter;
2434 function Is_Package_Body_Entity (Id : E) return B is
2435 begin
2436 return Flag160 (Id);
2437 end Is_Package_Body_Entity;
2439 function Is_Packed (Id : E) return B is
2440 begin
2441 return Flag51 (Implementation_Base_Type (Id));
2442 end Is_Packed;
2444 function Is_Packed_Array_Impl_Type (Id : E) return B is
2445 begin
2446 return Flag138 (Id);
2447 end Is_Packed_Array_Impl_Type;
2449 function Is_Param_Block_Component_Type (Id : E) return B is
2450 begin
2451 pragma Assert (Is_Access_Type (Id));
2452 return Flag215 (Base_Type (Id));
2453 end Is_Param_Block_Component_Type;
2455 function Is_Partial_Invariant_Procedure (Id : E) return B is
2456 begin
2457 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2458 return Flag292 (Id);
2459 end Is_Partial_Invariant_Procedure;
2461 function Is_Potentially_Use_Visible (Id : E) return B is
2462 begin
2463 pragma Assert (Nkind (Id) in N_Entity);
2464 return Flag9 (Id);
2465 end Is_Potentially_Use_Visible;
2467 function Is_Predicate_Function (Id : E) return B is
2468 begin
2469 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2470 return Flag255 (Id);
2471 end Is_Predicate_Function;
2473 function Is_Predicate_Function_M (Id : E) return B is
2474 begin
2475 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2476 return Flag256 (Id);
2477 end Is_Predicate_Function_M;
2479 function Is_Preelaborated (Id : E) return B is
2480 begin
2481 return Flag59 (Id);
2482 end Is_Preelaborated;
2484 function Is_Primitive (Id : E) return B is
2485 begin
2486 pragma Assert
2487 (Is_Overloadable (Id)
2488 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
2489 return Flag218 (Id);
2490 end Is_Primitive;
2492 function Is_Primitive_Wrapper (Id : E) return B is
2493 begin
2494 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2495 return Flag195 (Id);
2496 end Is_Primitive_Wrapper;
2498 function Is_Private_Composite (Id : E) return B is
2499 begin
2500 pragma Assert (Is_Type (Id));
2501 return Flag107 (Id);
2502 end Is_Private_Composite;
2504 function Is_Private_Descendant (Id : E) return B is
2505 begin
2506 return Flag53 (Id);
2507 end Is_Private_Descendant;
2509 function Is_Private_Primitive (Id : E) return B is
2510 begin
2511 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2512 return Flag245 (Id);
2513 end Is_Private_Primitive;
2515 function Is_Public (Id : E) return B is
2516 begin
2517 pragma Assert (Nkind (Id) in N_Entity);
2518 return Flag10 (Id);
2519 end Is_Public;
2521 function Is_Pure (Id : E) return B is
2522 begin
2523 return Flag44 (Id);
2524 end Is_Pure;
2526 function Is_Pure_Unit_Access_Type (Id : E) return B is
2527 begin
2528 pragma Assert (Is_Access_Type (Id));
2529 return Flag189 (Id);
2530 end Is_Pure_Unit_Access_Type;
2532 function Is_RACW_Stub_Type (Id : E) return B is
2533 begin
2534 pragma Assert (Is_Type (Id));
2535 return Flag244 (Id);
2536 end Is_RACW_Stub_Type;
2538 function Is_Raised (Id : E) return B is
2539 begin
2540 pragma Assert (Ekind (Id) = E_Exception);
2541 return Flag224 (Id);
2542 end Is_Raised;
2544 function Is_Remote_Call_Interface (Id : E) return B is
2545 begin
2546 return Flag62 (Id);
2547 end Is_Remote_Call_Interface;
2549 function Is_Remote_Types (Id : E) return B is
2550 begin
2551 return Flag61 (Id);
2552 end Is_Remote_Types;
2554 function Is_Renaming_Of_Object (Id : E) return B is
2555 begin
2556 return Flag112 (Id);
2557 end Is_Renaming_Of_Object;
2559 function Is_Return_Object (Id : E) return B is
2560 begin
2561 return Flag209 (Id);
2562 end Is_Return_Object;
2564 function Is_Safe_To_Reevaluate (Id : E) return B is
2565 begin
2566 return Flag249 (Id);
2567 end Is_Safe_To_Reevaluate;
2569 function Is_Shared_Passive (Id : E) return B is
2570 begin
2571 return Flag60 (Id);
2572 end Is_Shared_Passive;
2574 function Is_Static_Type (Id : E) return B is
2575 begin
2576 return Flag281 (Id);
2577 end Is_Static_Type;
2579 function Is_Statically_Allocated (Id : E) return B is
2580 begin
2581 return Flag28 (Id);
2582 end Is_Statically_Allocated;
2584 function Is_Tag (Id : E) return B is
2585 begin
2586 pragma Assert (Nkind (Id) in N_Entity);
2587 return Flag78 (Id);
2588 end Is_Tag;
2590 function Is_Tagged_Type (Id : E) return B is
2591 begin
2592 return Flag55 (Id);
2593 end Is_Tagged_Type;
2595 function Is_Thunk (Id : E) return B is
2596 begin
2597 return Flag225 (Id);
2598 end Is_Thunk;
2600 function Is_Trivial_Subprogram (Id : E) return B is
2601 begin
2602 return Flag235 (Id);
2603 end Is_Trivial_Subprogram;
2605 function Is_True_Constant (Id : E) return B is
2606 begin
2607 return Flag163 (Id);
2608 end Is_True_Constant;
2610 function Is_Unchecked_Union (Id : E) return B is
2611 begin
2612 return Flag117 (Implementation_Base_Type (Id));
2613 end Is_Unchecked_Union;
2615 function Is_Underlying_Full_View (Id : E) return B is
2616 begin
2617 return Flag298 (Id);
2618 end Is_Underlying_Full_View;
2620 function Is_Underlying_Record_View (Id : E) return B is
2621 begin
2622 return Flag246 (Id);
2623 end Is_Underlying_Record_View;
2625 function Is_Unimplemented (Id : E) return B is
2626 begin
2627 return Flag284 (Id);
2628 end Is_Unimplemented;
2630 function Is_Unsigned_Type (Id : E) return B is
2631 begin
2632 pragma Assert (Is_Type (Id));
2633 return Flag144 (Id);
2634 end Is_Unsigned_Type;
2636 function Is_Uplevel_Referenced_Entity (Id : E) return B is
2637 begin
2638 return Flag283 (Id);
2639 end Is_Uplevel_Referenced_Entity;
2641 function Is_Valued_Procedure (Id : E) return B is
2642 begin
2643 pragma Assert (Ekind (Id) = E_Procedure);
2644 return Flag127 (Id);
2645 end Is_Valued_Procedure;
2647 function Is_Visible_Formal (Id : E) return B is
2648 begin
2649 return Flag206 (Id);
2650 end Is_Visible_Formal;
2652 function Is_Visible_Lib_Unit (Id : E) return B is
2653 begin
2654 return Flag116 (Id);
2655 end Is_Visible_Lib_Unit;
2657 function Is_Volatile (Id : E) return B is
2658 begin
2659 pragma Assert (Nkind (Id) in N_Entity);
2661 if Is_Type (Id) then
2662 return Flag16 (Base_Type (Id));
2663 else
2664 return Flag16 (Id);
2665 end if;
2666 end Is_Volatile;
2668 function Is_Volatile_Full_Access (Id : E) return B is
2669 begin
2670 return Flag285 (Id);
2671 end Is_Volatile_Full_Access;
2673 function Itype_Printed (Id : E) return B is
2674 begin
2675 pragma Assert (Is_Itype (Id));
2676 return Flag202 (Id);
2677 end Itype_Printed;
2679 function Kill_Elaboration_Checks (Id : E) return B is
2680 begin
2681 return Flag32 (Id);
2682 end Kill_Elaboration_Checks;
2684 function Kill_Range_Checks (Id : E) return B is
2685 begin
2686 return Flag33 (Id);
2687 end Kill_Range_Checks;
2689 function Known_To_Have_Preelab_Init (Id : E) return B is
2690 begin
2691 pragma Assert (Is_Type (Id));
2692 return Flag207 (Id);
2693 end Known_To_Have_Preelab_Init;
2695 function Last_Aggregate_Assignment (Id : E) return N is
2696 begin
2697 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2698 return Node30 (Id);
2699 end Last_Aggregate_Assignment;
2701 function Last_Assignment (Id : E) return N is
2702 begin
2703 pragma Assert (Is_Assignable (Id));
2704 return Node26 (Id);
2705 end Last_Assignment;
2707 function Last_Entity (Id : E) return E is
2708 begin
2709 return Node20 (Id);
2710 end Last_Entity;
2712 function Limited_View (Id : E) return E is
2713 begin
2714 pragma Assert (Ekind (Id) = E_Package);
2715 return Node23 (Id);
2716 end Limited_View;
2718 function Linker_Section_Pragma (Id : E) return N is
2719 begin
2720 pragma Assert
2721 (Is_Type (Id) or else Is_Object (Id) or else Is_Subprogram (Id));
2722 return Node33 (Id);
2723 end Linker_Section_Pragma;
2725 function Lit_Indexes (Id : E) return E is
2726 begin
2727 pragma Assert (Is_Enumeration_Type (Id));
2728 return Node18 (Id);
2729 end Lit_Indexes;
2731 function Lit_Strings (Id : E) return E is
2732 begin
2733 pragma Assert (Is_Enumeration_Type (Id));
2734 return Node16 (Id);
2735 end Lit_Strings;
2737 function Low_Bound_Tested (Id : E) return B is
2738 begin
2739 return Flag205 (Id);
2740 end Low_Bound_Tested;
2742 function Machine_Radix_10 (Id : E) return B is
2743 begin
2744 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
2745 return Flag84 (Id);
2746 end Machine_Radix_10;
2748 function Master_Id (Id : E) return E is
2749 begin
2750 pragma Assert (Is_Access_Type (Id));
2751 return Node17 (Id);
2752 end Master_Id;
2754 function Materialize_Entity (Id : E) return B is
2755 begin
2756 return Flag168 (Id);
2757 end Materialize_Entity;
2759 function May_Inherit_Delayed_Rep_Aspects (Id : E) return B is
2760 begin
2761 return Flag262 (Id);
2762 end May_Inherit_Delayed_Rep_Aspects;
2764 function Mechanism (Id : E) return M is
2765 begin
2766 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
2767 return UI_To_Int (Uint8 (Id));
2768 end Mechanism;
2770 function Modulus (Id : E) return Uint is
2771 begin
2772 pragma Assert (Is_Modular_Integer_Type (Id));
2773 return Uint17 (Base_Type (Id));
2774 end Modulus;
2776 function Must_Be_On_Byte_Boundary (Id : E) return B is
2777 begin
2778 pragma Assert (Is_Type (Id));
2779 return Flag183 (Id);
2780 end Must_Be_On_Byte_Boundary;
2782 function Must_Have_Preelab_Init (Id : E) return B is
2783 begin
2784 pragma Assert (Is_Type (Id));
2785 return Flag208 (Id);
2786 end Must_Have_Preelab_Init;
2788 function Needs_Debug_Info (Id : E) return B is
2789 begin
2790 return Flag147 (Id);
2791 end Needs_Debug_Info;
2793 function Needs_No_Actuals (Id : E) return B is
2794 begin
2795 pragma Assert
2796 (Is_Overloadable (Id)
2797 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
2798 return Flag22 (Id);
2799 end Needs_No_Actuals;
2801 function Never_Set_In_Source (Id : E) return B is
2802 begin
2803 return Flag115 (Id);
2804 end Never_Set_In_Source;
2806 function Next_Inlined_Subprogram (Id : E) return E is
2807 begin
2808 return Node12 (Id);
2809 end Next_Inlined_Subprogram;
2811 function No_Dynamic_Predicate_On_Actual (Id : E) return Boolean is
2812 begin
2813 pragma Assert (Is_Discrete_Type (Id));
2814 return Flag276 (Id);
2815 end No_Dynamic_Predicate_On_Actual;
2817 function No_Pool_Assigned (Id : E) return B is
2818 begin
2819 pragma Assert (Is_Access_Type (Id));
2820 return Flag131 (Root_Type (Id));
2821 end No_Pool_Assigned;
2823 function No_Predicate_On_Actual (Id : E) return Boolean is
2824 begin
2825 pragma Assert (Is_Discrete_Type (Id));
2826 return Flag275 (Id);
2827 end No_Predicate_On_Actual;
2829 function No_Return (Id : E) return B is
2830 begin
2831 return Flag113 (Id);
2832 end No_Return;
2834 function No_Strict_Aliasing (Id : E) return B is
2835 begin
2836 pragma Assert (Is_Access_Type (Id));
2837 return Flag136 (Base_Type (Id));
2838 end No_Strict_Aliasing;
2840 function No_Tagged_Streams_Pragma (Id : E) return N is
2841 begin
2842 pragma Assert (Is_Tagged_Type (Id));
2843 return Node32 (Id);
2844 end No_Tagged_Streams_Pragma;
2846 function Non_Binary_Modulus (Id : E) return B is
2847 begin
2848 pragma Assert (Is_Type (Id));
2849 return Flag58 (Base_Type (Id));
2850 end Non_Binary_Modulus;
2852 function Non_Limited_View (Id : E) return E is
2853 begin
2854 pragma Assert
2855 (Ekind (Id) in Incomplete_Kind
2856 or else
2857 Ekind (Id) in Class_Wide_Kind
2858 or else
2859 Ekind (Id) = E_Abstract_State);
2860 return Node19 (Id);
2861 end Non_Limited_View;
2863 function Nonzero_Is_True (Id : E) return B is
2864 begin
2865 pragma Assert (Root_Type (Id) = Standard_Boolean);
2866 return Flag162 (Base_Type (Id));
2867 end Nonzero_Is_True;
2869 function Normalized_First_Bit (Id : E) return U is
2870 begin
2871 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2872 return Uint8 (Id);
2873 end Normalized_First_Bit;
2875 function Normalized_Position (Id : E) return U is
2876 begin
2877 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2878 return Uint14 (Id);
2879 end Normalized_Position;
2881 function Normalized_Position_Max (Id : E) return U is
2882 begin
2883 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2884 return Uint10 (Id);
2885 end Normalized_Position_Max;
2887 function OK_To_Rename (Id : E) return B is
2888 begin
2889 pragma Assert (Ekind (Id) = E_Variable);
2890 return Flag247 (Id);
2891 end OK_To_Rename;
2893 function OK_To_Reorder_Components (Id : E) return B is
2894 begin
2895 pragma Assert (Is_Record_Type (Id));
2896 return Flag239 (Base_Type (Id));
2897 end OK_To_Reorder_Components;
2899 function Optimize_Alignment_Space (Id : E) return B is
2900 begin
2901 pragma Assert
2902 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2903 return Flag241 (Id);
2904 end Optimize_Alignment_Space;
2906 function Optimize_Alignment_Time (Id : E) return B is
2907 begin
2908 pragma Assert
2909 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2910 return Flag242 (Id);
2911 end Optimize_Alignment_Time;
2913 function Original_Access_Type (Id : E) return E is
2914 begin
2915 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
2916 return Node28 (Id);
2917 end Original_Access_Type;
2919 function Original_Array_Type (Id : E) return E is
2920 begin
2921 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
2922 return Node21 (Id);
2923 end Original_Array_Type;
2925 function Original_Protected_Subprogram (Id : E) return N is
2926 begin
2927 return Node41 (Id);
2928 end Original_Protected_Subprogram;
2930 function Original_Record_Component (Id : E) return E is
2931 begin
2932 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
2933 return Node22 (Id);
2934 end Original_Record_Component;
2936 function Overlays_Constant (Id : E) return B is
2937 begin
2938 return Flag243 (Id);
2939 end Overlays_Constant;
2941 function Overridden_Operation (Id : E) return E is
2942 begin
2943 pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
2944 return Node26 (Id);
2945 end Overridden_Operation;
2947 function Package_Instantiation (Id : E) return N is
2948 begin
2949 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
2950 return Node26 (Id);
2951 end Package_Instantiation;
2953 function Packed_Array_Impl_Type (Id : E) return E is
2954 begin
2955 pragma Assert (Is_Array_Type (Id));
2956 return Node23 (Id);
2957 end Packed_Array_Impl_Type;
2959 function Parent_Subtype (Id : E) return E is
2960 begin
2961 pragma Assert (Is_Record_Type (Id));
2962 return Node19 (Base_Type (Id));
2963 end Parent_Subtype;
2965 function Part_Of_Constituents (Id : E) return L is
2966 begin
2967 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
2968 return Elist10 (Id);
2969 end Part_Of_Constituents;
2971 function Part_Of_References (Id : E) return L is
2972 begin
2973 pragma Assert (Ekind (Id) = E_Variable);
2974 return Elist11 (Id);
2975 end Part_Of_References;
2977 function Partial_View_Has_Unknown_Discr (Id : E) return B is
2978 begin
2979 pragma Assert (Is_Type (Id));
2980 return Flag280 (Id);
2981 end Partial_View_Has_Unknown_Discr;
2983 function Pending_Access_Types (Id : E) return L is
2984 begin
2985 pragma Assert (Is_Type (Id));
2986 return Elist15 (Id);
2987 end Pending_Access_Types;
2989 function Postconditions_Proc (Id : E) return E is
2990 begin
2991 pragma Assert (Ekind_In (Id, E_Entry,
2992 E_Entry_Family,
2993 E_Function,
2994 E_Procedure));
2995 return Node14 (Id);
2996 end Postconditions_Proc;
2998 function Predicates_Ignored (Id : E) return B is
2999 begin
3000 pragma Assert (Is_Type (Id));
3001 return Flag288 (Id);
3002 end Predicates_Ignored;
3004 function Prival (Id : E) return E is
3005 begin
3006 pragma Assert (Is_Protected_Component (Id));
3007 return Node17 (Id);
3008 end Prival;
3010 function Prival_Link (Id : E) return E is
3011 begin
3012 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
3013 return Node20 (Id);
3014 end Prival_Link;
3016 function Private_Dependents (Id : E) return L is
3017 begin
3018 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
3019 return Elist18 (Id);
3020 end Private_Dependents;
3022 function Private_View (Id : E) return N is
3023 begin
3024 pragma Assert (Is_Private_Type (Id));
3025 return Node22 (Id);
3026 end Private_View;
3028 function Protected_Body_Subprogram (Id : E) return E is
3029 begin
3030 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
3031 return Node11 (Id);
3032 end Protected_Body_Subprogram;
3034 function Protected_Formal (Id : E) return E is
3035 begin
3036 pragma Assert (Is_Formal (Id));
3037 return Node22 (Id);
3038 end Protected_Formal;
3040 function Protection_Object (Id : E) return E is
3041 begin
3042 pragma Assert
3043 (Ekind_In (Id, E_Entry, E_Entry_Family, E_Function, E_Procedure));
3044 return Node23 (Id);
3045 end Protection_Object;
3047 function Reachable (Id : E) return B is
3048 begin
3049 return Flag49 (Id);
3050 end Reachable;
3052 function Referenced (Id : E) return B is
3053 begin
3054 return Flag156 (Id);
3055 end Referenced;
3057 function Referenced_As_LHS (Id : E) return B is
3058 begin
3059 return Flag36 (Id);
3060 end Referenced_As_LHS;
3062 function Referenced_As_Out_Parameter (Id : E) return B is
3063 begin
3064 return Flag227 (Id);
3065 end Referenced_As_Out_Parameter;
3067 function Refinement_Constituents (Id : E) return L is
3068 begin
3069 pragma Assert (Ekind (Id) = E_Abstract_State);
3070 return Elist8 (Id);
3071 end Refinement_Constituents;
3073 function Register_Exception_Call (Id : E) return N is
3074 begin
3075 pragma Assert (Ekind (Id) = E_Exception);
3076 return Node20 (Id);
3077 end Register_Exception_Call;
3079 function Related_Array_Object (Id : E) return E is
3080 begin
3081 pragma Assert (Is_Array_Type (Id));
3082 return Node25 (Id);
3083 end Related_Array_Object;
3085 function Related_Expression (Id : E) return N is
3086 begin
3087 pragma Assert (Ekind (Id) in Type_Kind
3088 or else Ekind_In (Id, E_Constant, E_Variable));
3089 return Node24 (Id);
3090 end Related_Expression;
3092 function Related_Instance (Id : E) return E is
3093 begin
3094 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
3095 return Node15 (Id);
3096 end Related_Instance;
3098 function Related_Type (Id : E) return E is
3099 begin
3100 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
3101 return Node27 (Id);
3102 end Related_Type;
3104 function Relative_Deadline_Variable (Id : E) return E is
3105 begin
3106 pragma Assert (Is_Task_Type (Id));
3107 return Node28 (Implementation_Base_Type (Id));
3108 end Relative_Deadline_Variable;
3110 function Renamed_Entity (Id : E) return N is
3111 begin
3112 return Node18 (Id);
3113 end Renamed_Entity;
3115 function Renamed_In_Spec (Id : E) return B is
3116 begin
3117 pragma Assert (Ekind (Id) = E_Package);
3118 return Flag231 (Id);
3119 end Renamed_In_Spec;
3121 function Renamed_Object (Id : E) return N is
3122 begin
3123 return Node18 (Id);
3124 end Renamed_Object;
3126 function Renaming_Map (Id : E) return U is
3127 begin
3128 return Uint9 (Id);
3129 end Renaming_Map;
3131 function Requires_Overriding (Id : E) return B is
3132 begin
3133 pragma Assert (Is_Overloadable (Id));
3134 return Flag213 (Id);
3135 end Requires_Overriding;
3137 function Return_Present (Id : E) return B is
3138 begin
3139 return Flag54 (Id);
3140 end Return_Present;
3142 function Return_Applies_To (Id : E) return N is
3143 begin
3144 return Node8 (Id);
3145 end Return_Applies_To;
3147 function Returns_By_Ref (Id : E) return B is
3148 begin
3149 return Flag90 (Id);
3150 end Returns_By_Ref;
3152 function Reverse_Bit_Order (Id : E) return B is
3153 begin
3154 pragma Assert (Is_Record_Type (Id));
3155 return Flag164 (Base_Type (Id));
3156 end Reverse_Bit_Order;
3158 function Reverse_Storage_Order (Id : E) return B is
3159 begin
3160 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
3161 return Flag93 (Base_Type (Id));
3162 end Reverse_Storage_Order;
3164 function Rewritten_For_C (Id : E) return B is
3165 begin
3166 pragma Assert (Ekind (Id) = E_Function);
3167 return Flag287 (Id);
3168 end Rewritten_For_C;
3170 function RM_Size (Id : E) return U is
3171 begin
3172 pragma Assert (Is_Type (Id));
3173 return Uint13 (Id);
3174 end RM_Size;
3176 function Scalar_Range (Id : E) return N is
3177 begin
3178 return Node20 (Id);
3179 end Scalar_Range;
3181 function Scale_Value (Id : E) return U is
3182 begin
3183 return Uint16 (Id);
3184 end Scale_Value;
3186 function Scope_Depth_Value (Id : E) return U is
3187 begin
3188 return Uint22 (Id);
3189 end Scope_Depth_Value;
3191 function Sec_Stack_Needed_For_Return (Id : E) return B is
3192 begin
3193 return Flag167 (Id);
3194 end Sec_Stack_Needed_For_Return;
3196 function Shadow_Entities (Id : E) return S is
3197 begin
3198 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
3199 return List14 (Id);
3200 end Shadow_Entities;
3202 function Shared_Var_Procs_Instance (Id : E) return E is
3203 begin
3204 pragma Assert (Ekind (Id) = E_Variable);
3205 return Node22 (Id);
3206 end Shared_Var_Procs_Instance;
3208 function Size_Check_Code (Id : E) return N is
3209 begin
3210 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
3211 return Node19 (Id);
3212 end Size_Check_Code;
3214 function Size_Depends_On_Discriminant (Id : E) return B is
3215 begin
3216 return Flag177 (Id);
3217 end Size_Depends_On_Discriminant;
3219 function Size_Known_At_Compile_Time (Id : E) return B is
3220 begin
3221 return Flag92 (Id);
3222 end Size_Known_At_Compile_Time;
3224 function Small_Value (Id : E) return R is
3225 begin
3226 pragma Assert (Is_Fixed_Point_Type (Id));
3227 return Ureal21 (Id);
3228 end Small_Value;
3230 function SPARK_Aux_Pragma (Id : E) return N is
3231 begin
3232 pragma Assert
3233 (Ekind_In (Id, E_Protected_Type, -- concurrent variants
3234 E_Task_Type)
3235 or else
3236 Ekind_In (Id, E_Generic_Package, -- package variants
3237 E_Package,
3238 E_Package_Body));
3239 return Node41 (Id);
3240 end SPARK_Aux_Pragma;
3242 function SPARK_Aux_Pragma_Inherited (Id : E) return B is
3243 begin
3244 pragma Assert
3245 (Ekind_In (Id, E_Protected_Type, -- concurrent variants
3246 E_Task_Type)
3247 or else
3248 Ekind_In (Id, E_Generic_Package, -- package variants
3249 E_Package,
3250 E_Package_Body));
3251 return Flag266 (Id);
3252 end SPARK_Aux_Pragma_Inherited;
3254 function SPARK_Pragma (Id : E) return N is
3255 begin
3256 pragma Assert
3257 (Ekind_In (Id, E_Protected_Body, -- concurrent variants
3258 E_Protected_Type,
3259 E_Task_Body,
3260 E_Task_Type)
3261 or else
3262 Ekind_In (Id, E_Entry, -- overloadable variants
3263 E_Entry_Family,
3264 E_Function,
3265 E_Generic_Function,
3266 E_Generic_Procedure,
3267 E_Operator,
3268 E_Procedure,
3269 E_Subprogram_Body)
3270 or else
3271 Ekind_In (Id, E_Generic_Package, -- package variants
3272 E_Package,
3273 E_Package_Body)
3274 or else
3275 Ekind (Id) = E_Variable); -- variable
3276 return Node40 (Id);
3277 end SPARK_Pragma;
3279 function SPARK_Pragma_Inherited (Id : E) return B is
3280 begin
3281 pragma Assert
3282 (Ekind_In (Id, E_Protected_Body, -- concurrent variants
3283 E_Protected_Type,
3284 E_Task_Body,
3285 E_Task_Type)
3286 or else
3287 Ekind_In (Id, E_Entry, -- overloadable variants
3288 E_Entry_Family,
3289 E_Function,
3290 E_Generic_Function,
3291 E_Generic_Procedure,
3292 E_Operator,
3293 E_Procedure,
3294 E_Subprogram_Body)
3295 or else
3296 Ekind_In (Id, E_Generic_Package, -- package variants
3297 E_Package,
3298 E_Package_Body)
3299 or else
3300 Ekind (Id) = E_Variable); -- variable
3301 return Flag265 (Id);
3302 end SPARK_Pragma_Inherited;
3304 function Spec_Entity (Id : E) return E is
3305 begin
3306 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
3307 return Node19 (Id);
3308 end Spec_Entity;
3310 function SSO_Set_High_By_Default (Id : E) return B is
3311 begin
3312 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
3313 return Flag273 (Base_Type (Id));
3314 end SSO_Set_High_By_Default;
3316 function SSO_Set_Low_By_Default (Id : E) return B is
3317 begin
3318 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
3319 return Flag272 (Base_Type (Id));
3320 end SSO_Set_Low_By_Default;
3322 function Static_Discrete_Predicate (Id : E) return S is
3323 begin
3324 pragma Assert (Is_Discrete_Type (Id));
3325 return List25 (Id);
3326 end Static_Discrete_Predicate;
3328 function Static_Real_Or_String_Predicate (Id : E) return N is
3329 begin
3330 pragma Assert (Is_Real_Type (Id) or else Is_String_Type (Id));
3331 return Node25 (Id);
3332 end Static_Real_Or_String_Predicate;
3334 function Status_Flag_Or_Transient_Decl (Id : E) return N is
3335 begin
3336 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
3337 return Node15 (Id);
3338 end Status_Flag_Or_Transient_Decl;
3340 function Storage_Size_Variable (Id : E) return E is
3341 begin
3342 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
3343 return Node26 (Implementation_Base_Type (Id));
3344 end Storage_Size_Variable;
3346 function Static_Elaboration_Desired (Id : E) return B is
3347 begin
3348 pragma Assert (Ekind (Id) = E_Package);
3349 return Flag77 (Id);
3350 end Static_Elaboration_Desired;
3352 function Static_Initialization (Id : E) return N is
3353 begin
3354 pragma Assert
3355 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
3356 return Node30 (Id);
3357 end Static_Initialization;
3359 function Stored_Constraint (Id : E) return L is
3360 begin
3361 pragma Assert
3362 (Is_Composite_Type (Id) and then not Is_Array_Type (Id));
3363 return Elist23 (Id);
3364 end Stored_Constraint;
3366 function Stores_Attribute_Old_Prefix (Id : E) return B is
3367 begin
3368 return Flag270 (Id);
3369 end Stores_Attribute_Old_Prefix;
3371 function Strict_Alignment (Id : E) return B is
3372 begin
3373 return Flag145 (Implementation_Base_Type (Id));
3374 end Strict_Alignment;
3376 function String_Literal_Length (Id : E) return U is
3377 begin
3378 return Uint16 (Id);
3379 end String_Literal_Length;
3381 function String_Literal_Low_Bound (Id : E) return N is
3382 begin
3383 return Node18 (Id);
3384 end String_Literal_Low_Bound;
3386 function Subprograms_For_Type (Id : E) return L is
3387 begin
3388 pragma Assert (Is_Type (Id));
3389 return Elist29 (Id);
3390 end Subprograms_For_Type;
3392 function Subps_Index (Id : E) return U is
3393 begin
3394 pragma Assert (Is_Subprogram (Id));
3395 return Uint24 (Id);
3396 end Subps_Index;
3398 function Suppress_Elaboration_Warnings (Id : E) return B is
3399 begin
3400 return Flag148 (Id);
3401 end Suppress_Elaboration_Warnings;
3403 function Suppress_Initialization (Id : E) return B is
3404 begin
3405 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
3406 return Flag105 (Id);
3407 end Suppress_Initialization;
3409 function Suppress_Style_Checks (Id : E) return B is
3410 begin
3411 return Flag165 (Id);
3412 end Suppress_Style_Checks;
3414 function Suppress_Value_Tracking_On_Call (Id : E) return B is
3415 begin
3416 return Flag217 (Id);
3417 end Suppress_Value_Tracking_On_Call;
3419 function Task_Body_Procedure (Id : E) return N is
3420 begin
3421 pragma Assert (Ekind (Id) in Task_Kind);
3422 return Node25 (Id);
3423 end Task_Body_Procedure;
3425 function Thunk_Entity (Id : E) return E is
3426 begin
3427 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
3428 and then Is_Thunk (Id));
3429 return Node31 (Id);
3430 end Thunk_Entity;
3432 function Treat_As_Volatile (Id : E) return B is
3433 begin
3434 return Flag41 (Id);
3435 end Treat_As_Volatile;
3437 function Underlying_Full_View (Id : E) return E is
3438 begin
3439 pragma Assert (Ekind (Id) in Private_Kind);
3440 return Node19 (Id);
3441 end Underlying_Full_View;
3443 function Underlying_Record_View (Id : E) return E is
3444 begin
3445 return Node28 (Id);
3446 end Underlying_Record_View;
3448 function Universal_Aliasing (Id : E) return B is
3449 begin
3450 pragma Assert (Is_Type (Id));
3451 return Flag216 (Implementation_Base_Type (Id));
3452 end Universal_Aliasing;
3454 function Unset_Reference (Id : E) return N is
3455 begin
3456 return Node16 (Id);
3457 end Unset_Reference;
3459 function Used_As_Generic_Actual (Id : E) return B is
3460 begin
3461 return Flag222 (Id);
3462 end Used_As_Generic_Actual;
3464 function Uses_Lock_Free (Id : E) return B is
3465 begin
3466 pragma Assert (Is_Protected_Type (Id));
3467 return Flag188 (Id);
3468 end Uses_Lock_Free;
3470 function Uses_Sec_Stack (Id : E) return B is
3471 begin
3472 return Flag95 (Id);
3473 end Uses_Sec_Stack;
3475 function Warnings_Off (Id : E) return B is
3476 begin
3477 return Flag96 (Id);
3478 end Warnings_Off;
3480 function Warnings_Off_Used (Id : E) return B is
3481 begin
3482 return Flag236 (Id);
3483 end Warnings_Off_Used;
3485 function Warnings_Off_Used_Unmodified (Id : E) return B is
3486 begin
3487 return Flag237 (Id);
3488 end Warnings_Off_Used_Unmodified;
3490 function Warnings_Off_Used_Unreferenced (Id : E) return B is
3491 begin
3492 return Flag238 (Id);
3493 end Warnings_Off_Used_Unreferenced;
3495 function Wrapped_Entity (Id : E) return E is
3496 begin
3497 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
3498 and then Is_Primitive_Wrapper (Id));
3499 return Node27 (Id);
3500 end Wrapped_Entity;
3502 function Was_Hidden (Id : E) return B is
3503 begin
3504 return Flag196 (Id);
3505 end Was_Hidden;
3507 ------------------------------
3508 -- Classification Functions --
3509 ------------------------------
3511 function Is_Access_Type (Id : E) return B is
3512 begin
3513 return Ekind (Id) in Access_Kind;
3514 end Is_Access_Type;
3516 function Is_Access_Protected_Subprogram_Type (Id : E) return B is
3517 begin
3518 return Ekind (Id) in Access_Protected_Kind;
3519 end Is_Access_Protected_Subprogram_Type;
3521 function Is_Access_Subprogram_Type (Id : E) return B is
3522 begin
3523 return Ekind (Id) in Access_Subprogram_Kind;
3524 end Is_Access_Subprogram_Type;
3526 function Is_Aggregate_Type (Id : E) return B is
3527 begin
3528 return Ekind (Id) in Aggregate_Kind;
3529 end Is_Aggregate_Type;
3531 function Is_Array_Type (Id : E) return B is
3532 begin
3533 return Ekind (Id) in Array_Kind;
3534 end Is_Array_Type;
3536 function Is_Assignable (Id : E) return B is
3537 begin
3538 return Ekind (Id) in Assignable_Kind;
3539 end Is_Assignable;
3541 function Is_Class_Wide_Type (Id : E) return B is
3542 begin
3543 return Ekind (Id) in Class_Wide_Kind;
3544 end Is_Class_Wide_Type;
3546 function Is_Composite_Type (Id : E) return B is
3547 begin
3548 return Ekind (Id) in Composite_Kind;
3549 end Is_Composite_Type;
3551 function Is_Concurrent_Body (Id : E) return B is
3552 begin
3553 return Ekind (Id) in Concurrent_Body_Kind;
3554 end Is_Concurrent_Body;
3556 function Is_Concurrent_Record_Type (Id : E) return B is
3557 begin
3558 return Flag20 (Id);
3559 end Is_Concurrent_Record_Type;
3561 function Is_Concurrent_Type (Id : E) return B is
3562 begin
3563 return Ekind (Id) in Concurrent_Kind;
3564 end Is_Concurrent_Type;
3566 function Is_Decimal_Fixed_Point_Type (Id : E) return B is
3567 begin
3568 return Ekind (Id) in Decimal_Fixed_Point_Kind;
3569 end Is_Decimal_Fixed_Point_Type;
3571 function Is_Digits_Type (Id : E) return B is
3572 begin
3573 return Ekind (Id) in Digits_Kind;
3574 end Is_Digits_Type;
3576 function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B is
3577 begin
3578 return Ekind (Id) in Discrete_Or_Fixed_Point_Kind;
3579 end Is_Discrete_Or_Fixed_Point_Type;
3581 function Is_Discrete_Type (Id : E) return B is
3582 begin
3583 return Ekind (Id) in Discrete_Kind;
3584 end Is_Discrete_Type;
3586 function Is_Elementary_Type (Id : E) return B is
3587 begin
3588 return Ekind (Id) in Elementary_Kind;
3589 end Is_Elementary_Type;
3591 function Is_Entry (Id : E) return B is
3592 begin
3593 return Ekind (Id) in Entry_Kind;
3594 end Is_Entry;
3596 function Is_Enumeration_Type (Id : E) return B is
3597 begin
3598 return Ekind (Id) in Enumeration_Kind;
3599 end Is_Enumeration_Type;
3601 function Is_Fixed_Point_Type (Id : E) return B is
3602 begin
3603 return Ekind (Id) in Fixed_Point_Kind;
3604 end Is_Fixed_Point_Type;
3606 function Is_Floating_Point_Type (Id : E) return B is
3607 begin
3608 return Ekind (Id) in Float_Kind;
3609 end Is_Floating_Point_Type;
3611 function Is_Formal (Id : E) return B is
3612 begin
3613 return Ekind (Id) in Formal_Kind;
3614 end Is_Formal;
3616 function Is_Formal_Object (Id : E) return B is
3617 begin
3618 return Ekind (Id) in Formal_Object_Kind;
3619 end Is_Formal_Object;
3621 function Is_Generic_Subprogram (Id : E) return B is
3622 begin
3623 return Ekind (Id) in Generic_Subprogram_Kind;
3624 end Is_Generic_Subprogram;
3626 function Is_Generic_Unit (Id : E) return B is
3627 begin
3628 return Ekind (Id) in Generic_Unit_Kind;
3629 end Is_Generic_Unit;
3631 function Is_Ghost_Entity (Id : Entity_Id) return Boolean is
3632 begin
3633 return Is_Checked_Ghost_Entity (Id) or else Is_Ignored_Ghost_Entity (Id);
3634 end Is_Ghost_Entity;
3636 function Is_Incomplete_Or_Private_Type (Id : E) return B is
3637 begin
3638 return Ekind (Id) in Incomplete_Or_Private_Kind;
3639 end Is_Incomplete_Or_Private_Type;
3641 function Is_Incomplete_Type (Id : E) return B is
3642 begin
3643 return Ekind (Id) in Incomplete_Kind;
3644 end Is_Incomplete_Type;
3646 function Is_Integer_Type (Id : E) return B is
3647 begin
3648 return Ekind (Id) in Integer_Kind;
3649 end Is_Integer_Type;
3651 function Is_Modular_Integer_Type (Id : E) return B is
3652 begin
3653 return Ekind (Id) in Modular_Integer_Kind;
3654 end Is_Modular_Integer_Type;
3656 function Is_Named_Number (Id : E) return B is
3657 begin
3658 return Ekind (Id) in Named_Kind;
3659 end Is_Named_Number;
3661 function Is_Numeric_Type (Id : E) return B is
3662 begin
3663 return Ekind (Id) in Numeric_Kind;
3664 end Is_Numeric_Type;
3666 function Is_Object (Id : E) return B is
3667 begin
3668 return Ekind (Id) in Object_Kind;
3669 end Is_Object;
3671 function Is_Ordinary_Fixed_Point_Type (Id : E) return B is
3672 begin
3673 return Ekind (Id) in Ordinary_Fixed_Point_Kind;
3674 end Is_Ordinary_Fixed_Point_Type;
3676 function Is_Overloadable (Id : E) return B is
3677 begin
3678 return Ekind (Id) in Overloadable_Kind;
3679 end Is_Overloadable;
3681 function Is_Private_Type (Id : E) return B is
3682 begin
3683 return Ekind (Id) in Private_Kind;
3684 end Is_Private_Type;
3686 function Is_Protected_Type (Id : E) return B is
3687 begin
3688 return Ekind (Id) in Protected_Kind;
3689 end Is_Protected_Type;
3691 function Is_Real_Type (Id : E) return B is
3692 begin
3693 return Ekind (Id) in Real_Kind;
3694 end Is_Real_Type;
3696 function Is_Record_Type (Id : E) return B is
3697 begin
3698 return Ekind (Id) in Record_Kind;
3699 end Is_Record_Type;
3701 function Is_Scalar_Type (Id : E) return B is
3702 begin
3703 return Ekind (Id) in Scalar_Kind;
3704 end Is_Scalar_Type;
3706 function Is_Signed_Integer_Type (Id : E) return B is
3707 begin
3708 return Ekind (Id) in Signed_Integer_Kind;
3709 end Is_Signed_Integer_Type;
3711 function Is_Subprogram (Id : E) return B is
3712 begin
3713 return Ekind (Id) in Subprogram_Kind;
3714 end Is_Subprogram;
3716 function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B is
3717 begin
3718 return Ekind (Id) in Subprogram_Kind
3719 or else
3720 Ekind (Id) in Generic_Subprogram_Kind;
3721 end Is_Subprogram_Or_Generic_Subprogram;
3723 function Is_Task_Type (Id : E) return B is
3724 begin
3725 return Ekind (Id) in Task_Kind;
3726 end Is_Task_Type;
3728 function Is_Type (Id : E) return B is
3729 begin
3730 return Ekind (Id) in Type_Kind;
3731 end Is_Type;
3733 ------------------------------
3734 -- Attribute Set Procedures --
3735 ------------------------------
3737 -- Note: in many of these set procedures an "obvious" assertion is missing.
3738 -- The reason for this is that in many cases, a field is set before the
3739 -- Ekind field is set, so that the field is set when Ekind = E_Void. It
3740 -- it is possible to add assertions that specifically include the E_Void
3741 -- possibility, but in some cases, we just omit the assertions.
3743 procedure Set_Abstract_States (Id : E; V : L) is
3744 begin
3745 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
3746 Set_Elist25 (Id, V);
3747 end Set_Abstract_States;
3749 procedure Set_Accept_Address (Id : E; V : L) is
3750 begin
3751 Set_Elist21 (Id, V);
3752 end Set_Accept_Address;
3754 procedure Set_Access_Disp_Table (Id : E; V : L) is
3755 begin
3756 pragma Assert (Ekind (Id) = E_Record_Type
3757 and then Id = Implementation_Base_Type (Id));
3758 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
3759 Set_Elist16 (Id, V);
3760 end Set_Access_Disp_Table;
3762 procedure Set_Anonymous_Designated_Type (Id : E; V : E) is
3763 begin
3764 pragma Assert (Ekind (Id) = E_Variable);
3765 Set_Node35 (Id, V);
3766 end Set_Anonymous_Designated_Type;
3768 procedure Set_Anonymous_Masters (Id : E; V : L) is
3769 begin
3770 pragma Assert (Ekind_In (Id, E_Function,
3771 E_Package,
3772 E_Procedure,
3773 E_Subprogram_Body));
3774 Set_Elist29 (Id, V);
3775 end Set_Anonymous_Masters;
3777 procedure Set_Anonymous_Object (Id : E; V : E) is
3778 begin
3779 pragma Assert (Ekind_In (Id, E_Protected_Type, E_Task_Type));
3780 Set_Node30 (Id, V);
3781 end Set_Anonymous_Object;
3783 procedure Set_Associated_Entity (Id : E; V : E) is
3784 begin
3785 Set_Node37 (Id, V);
3786 end Set_Associated_Entity;
3788 procedure Set_Associated_Formal_Package (Id : E; V : E) is
3789 begin
3790 Set_Node12 (Id, V);
3791 end Set_Associated_Formal_Package;
3793 procedure Set_Associated_Node_For_Itype (Id : E; V : E) is
3794 begin
3795 Set_Node8 (Id, V);
3796 end Set_Associated_Node_For_Itype;
3798 procedure Set_Associated_Storage_Pool (Id : E; V : E) is
3799 begin
3800 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
3801 Set_Node22 (Id, V);
3802 end Set_Associated_Storage_Pool;
3804 procedure Set_Activation_Record_Component (Id : E; V : E) is
3805 begin
3806 pragma Assert (Ekind_In (Id, E_Constant,
3807 E_In_Parameter,
3808 E_In_Out_Parameter,
3809 E_Loop_Parameter,
3810 E_Out_Parameter,
3811 E_Variable));
3812 Set_Node31 (Id, V);
3813 end Set_Activation_Record_Component;
3815 procedure Set_Actual_Subtype (Id : E; V : E) is
3816 begin
3817 pragma Assert
3818 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
3819 or else Is_Formal (Id));
3820 Set_Node17 (Id, V);
3821 end Set_Actual_Subtype;
3823 procedure Set_Address_Taken (Id : E; V : B := True) is
3824 begin
3825 Set_Flag104 (Id, V);
3826 end Set_Address_Taken;
3828 procedure Set_Alias (Id : E; V : E) is
3829 begin
3830 pragma Assert
3831 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
3832 Set_Node18 (Id, V);
3833 end Set_Alias;
3835 procedure Set_Alignment (Id : E; V : U) is
3836 begin
3837 pragma Assert (Is_Type (Id)
3838 or else Is_Formal (Id)
3839 or else Ekind_In (Id, E_Loop_Parameter,
3840 E_Constant,
3841 E_Exception,
3842 E_Variable));
3843 Set_Uint14 (Id, V);
3844 end Set_Alignment;
3846 procedure Set_Barrier_Function (Id : E; V : N) is
3847 begin
3848 pragma Assert (Is_Entry (Id));
3849 Set_Node12 (Id, V);
3850 end Set_Barrier_Function;
3852 procedure Set_Block_Node (Id : E; V : N) is
3853 begin
3854 pragma Assert (Ekind (Id) = E_Block);
3855 Set_Node11 (Id, V);
3856 end Set_Block_Node;
3858 procedure Set_Body_Entity (Id : E; V : E) is
3859 begin
3860 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
3861 Set_Node19 (Id, V);
3862 end Set_Body_Entity;
3864 procedure Set_Body_Needed_For_SAL (Id : E; V : B := True) is
3865 begin
3866 pragma Assert
3867 (Ekind (Id) = E_Package
3868 or else Is_Subprogram (Id)
3869 or else Is_Generic_Unit (Id));
3870 Set_Flag40 (Id, V);
3871 end Set_Body_Needed_For_SAL;
3873 procedure Set_Body_References (Id : E; V : L) is
3874 begin
3875 pragma Assert (Ekind (Id) = E_Abstract_State);
3876 Set_Elist16 (Id, V);
3877 end Set_Body_References;
3879 procedure Set_BIP_Initialization_Call (Id : E; V : N) is
3880 begin
3881 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
3882 Set_Node29 (Id, V);
3883 end Set_BIP_Initialization_Call;
3885 procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is
3886 begin
3887 pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id));
3888 Set_Flag125 (Id, V);
3889 end Set_C_Pass_By_Copy;
3891 procedure Set_Can_Never_Be_Null (Id : E; V : B := True) is
3892 begin
3893 Set_Flag38 (Id, V);
3894 end Set_Can_Never_Be_Null;
3896 procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
3897 begin
3898 pragma Assert
3899 (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
3900 Set_Flag229 (Id, V);
3901 end Set_Can_Use_Internal_Rep;
3903 procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is
3904 begin
3905 Set_Flag31 (Id, V);
3906 end Set_Checks_May_Be_Suppressed;
3908 procedure Set_Class_Wide_Preconds (Id : E; V : S) is
3909 begin
3910 pragma Assert (Is_Subprogram (Id));
3911 Set_List38 (Id, V);
3912 end Set_Class_Wide_Preconds;
3914 procedure Set_Class_Wide_Postconds (Id : E; V : S) is
3915 begin
3916 pragma Assert (Is_Subprogram (Id));
3917 Set_List39 (Id, V);
3918 end Set_Class_Wide_Postconds;
3920 procedure Set_Class_Wide_Type (Id : E; V : E) is
3921 begin
3922 pragma Assert (Is_Type (Id));
3923 Set_Node9 (Id, V);
3924 end Set_Class_Wide_Type;
3926 procedure Set_Cloned_Subtype (Id : E; V : E) is
3927 begin
3928 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
3929 Set_Node16 (Id, V);
3930 end Set_Cloned_Subtype;
3932 procedure Set_Component_Bit_Offset (Id : E; V : U) is
3933 begin
3934 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
3935 Set_Uint11 (Id, V);
3936 end Set_Component_Bit_Offset;
3938 procedure Set_Component_Clause (Id : E; V : N) is
3939 begin
3940 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
3941 Set_Node13 (Id, V);
3942 end Set_Component_Clause;
3944 procedure Set_Component_Size (Id : E; V : U) is
3945 begin
3946 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
3947 Set_Uint22 (Id, V);
3948 end Set_Component_Size;
3950 procedure Set_Component_Type (Id : E; V : E) is
3951 begin
3952 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
3953 Set_Node20 (Id, V);
3954 end Set_Component_Type;
3956 procedure Set_Contains_Ignored_Ghost_Code (Id : E; V : B := True) is
3957 begin
3958 pragma Assert
3959 (Ekind_In (Id, E_Block,
3960 E_Function,
3961 E_Generic_Function,
3962 E_Generic_Package,
3963 E_Generic_Procedure,
3964 E_Package,
3965 E_Package_Body,
3966 E_Procedure,
3967 E_Subprogram_Body));
3968 Set_Flag279 (Id, V);
3969 end Set_Contains_Ignored_Ghost_Code;
3971 procedure Set_Contract (Id : E; V : N) is
3972 begin
3973 pragma Assert
3974 (Ekind_In (Id, E_Protected_Type, -- concurrent variants
3975 E_Task_Body,
3976 E_Task_Type)
3977 or else
3978 Ekind_In (Id, E_Constant, -- object variants
3979 E_Variable)
3980 or else
3981 Ekind_In (Id, E_Entry, -- overloadable variants
3982 E_Entry_Family,
3983 E_Function,
3984 E_Generic_Function,
3985 E_Generic_Procedure,
3986 E_Operator,
3987 E_Procedure,
3988 E_Subprogram_Body)
3989 or else
3990 Ekind_In (Id, E_Generic_Package, -- package variants
3991 E_Package,
3992 E_Package_Body)
3993 or else
3994 Ekind (Id) = E_Void); -- special purpose
3995 Set_Node34 (Id, V);
3996 end Set_Contract;
3998 procedure Set_Contract_Wrapper (Id : E; V : E) is
3999 begin
4000 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
4001 Set_Node25 (Id, V);
4002 end Set_Contract_Wrapper;
4004 procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is
4005 begin
4006 pragma Assert
4007 (Ekind (Id) = E_Record_Type and then Is_Concurrent_Type (V));
4008 Set_Node18 (Id, V);
4009 end Set_Corresponding_Concurrent_Type;
4011 procedure Set_Corresponding_Discriminant (Id : E; V : E) is
4012 begin
4013 pragma Assert (Ekind (Id) = E_Discriminant);
4014 Set_Node19 (Id, V);
4015 end Set_Corresponding_Discriminant;
4017 procedure Set_Corresponding_Equality (Id : E; V : E) is
4018 begin
4019 pragma Assert
4020 (Ekind (Id) = E_Function
4021 and then not Comes_From_Source (Id)
4022 and then Chars (Id) = Name_Op_Ne);
4023 Set_Node30 (Id, V);
4024 end Set_Corresponding_Equality;
4026 procedure Set_Corresponding_Function (Id : E; V : E) is
4027 begin
4028 pragma Assert (Ekind (Id) = E_Procedure and then Rewritten_For_C (V));
4029 Set_Node32 (Id, V);
4030 end Set_Corresponding_Function;
4032 procedure Set_Corresponding_Procedure (Id : E; V : E) is
4033 begin
4034 pragma Assert (Ekind (Id) = E_Function and then Rewritten_For_C (Id));
4035 Set_Node32 (Id, V);
4036 end Set_Corresponding_Procedure;
4038 procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
4039 begin
4040 pragma Assert (Ekind_In (Id, E_Void, E_Subprogram_Body));
4041 Set_Node18 (Id, V);
4042 end Set_Corresponding_Protected_Entry;
4044 procedure Set_Corresponding_Record_Type (Id : E; V : E) is
4045 begin
4046 pragma Assert (Is_Concurrent_Type (Id));
4047 Set_Node18 (Id, V);
4048 end Set_Corresponding_Record_Type;
4050 procedure Set_Corresponding_Remote_Type (Id : E; V : E) is
4051 begin
4052 Set_Node22 (Id, V);
4053 end Set_Corresponding_Remote_Type;
4055 procedure Set_Current_Use_Clause (Id : E; V : E) is
4056 begin
4057 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
4058 Set_Node27 (Id, V);
4059 end Set_Current_Use_Clause;
4061 procedure Set_Current_Value (Id : E; V : N) is
4062 begin
4063 pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void);
4064 Set_Node9 (Id, V);
4065 end Set_Current_Value;
4067 procedure Set_CR_Discriminant (Id : E; V : E) is
4068 begin
4069 Set_Node23 (Id, V);
4070 end Set_CR_Discriminant;
4072 procedure Set_Debug_Info_Off (Id : E; V : B := True) is
4073 begin
4074 Set_Flag166 (Id, V);
4075 end Set_Debug_Info_Off;
4077 procedure Set_Debug_Renaming_Link (Id : E; V : E) is
4078 begin
4079 Set_Node25 (Id, V);
4080 end Set_Debug_Renaming_Link;
4082 procedure Set_Default_Aspect_Component_Value (Id : E; V : E) is
4083 begin
4084 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
4085 Set_Node19 (Id, V);
4086 end Set_Default_Aspect_Component_Value;
4088 procedure Set_Default_Aspect_Value (Id : E; V : E) is
4089 begin
4090 pragma Assert (Is_Scalar_Type (Id) and then Is_Base_Type (Id));
4091 Set_Node19 (Id, V);
4092 end Set_Default_Aspect_Value;
4094 procedure Set_Default_Expr_Function (Id : E; V : E) is
4095 begin
4096 pragma Assert (Is_Formal (Id));
4097 Set_Node21 (Id, V);
4098 end Set_Default_Expr_Function;
4100 procedure Set_Default_Expressions_Processed (Id : E; V : B := True) is
4101 begin
4102 Set_Flag108 (Id, V);
4103 end Set_Default_Expressions_Processed;
4105 procedure Set_Default_Value (Id : E; V : N) is
4106 begin
4107 pragma Assert (Is_Formal (Id));
4108 Set_Node20 (Id, V);
4109 end Set_Default_Value;
4111 procedure Set_Delay_Cleanups (Id : E; V : B := True) is
4112 begin
4113 pragma Assert
4114 (Is_Subprogram (Id)
4115 or else Is_Task_Type (Id)
4116 or else Ekind (Id) = E_Block);
4117 Set_Flag114 (Id, V);
4118 end Set_Delay_Cleanups;
4120 procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True) is
4121 begin
4122 pragma Assert
4123 (Is_Subprogram (Id) or else Ekind_In (Id, E_Package, E_Package_Body));
4125 Set_Flag50 (Id, V);
4126 end Set_Delay_Subprogram_Descriptors;
4128 procedure Set_Delta_Value (Id : E; V : R) is
4129 begin
4130 pragma Assert (Is_Fixed_Point_Type (Id));
4131 Set_Ureal18 (Id, V);
4132 end Set_Delta_Value;
4134 procedure Set_Dependent_Instances (Id : E; V : L) is
4135 begin
4136 pragma Assert (Is_Generic_Instance (Id));
4137 Set_Elist8 (Id, V);
4138 end Set_Dependent_Instances;
4140 procedure Set_Depends_On_Private (Id : E; V : B := True) is
4141 begin
4142 pragma Assert (Nkind (Id) in N_Entity);
4143 Set_Flag14 (Id, V);
4144 end Set_Depends_On_Private;
4146 procedure Set_Derived_Type_Link (Id : E; V : E) is
4147 begin
4148 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
4149 Set_Node31 (Id, V);
4150 end Set_Derived_Type_Link;
4152 procedure Set_Digits_Value (Id : E; V : U) is
4153 begin
4154 pragma Assert
4155 (Is_Floating_Point_Type (Id)
4156 or else Is_Decimal_Fixed_Point_Type (Id));
4157 Set_Uint17 (Id, V);
4158 end Set_Digits_Value;
4160 procedure Set_Directly_Designated_Type (Id : E; V : E) is
4161 begin
4162 Set_Node20 (Id, V);
4163 end Set_Directly_Designated_Type;
4165 procedure Set_Disable_Controlled (Id : E; V : B := True) is
4166 begin
4167 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
4168 Set_Flag253 (Id, V);
4169 end Set_Disable_Controlled;
4171 procedure Set_Discard_Names (Id : E; V : B := True) is
4172 begin
4173 Set_Flag88 (Id, V);
4174 end Set_Discard_Names;
4176 procedure Set_Discriminal (Id : E; V : E) is
4177 begin
4178 pragma Assert (Ekind (Id) = E_Discriminant);
4179 Set_Node17 (Id, V);
4180 end Set_Discriminal;
4182 procedure Set_Discriminal_Link (Id : E; V : E) is
4183 begin
4184 Set_Node10 (Id, V);
4185 end Set_Discriminal_Link;
4187 procedure Set_Discriminant_Checking_Func (Id : E; V : E) is
4188 begin
4189 pragma Assert (Ekind (Id) = E_Component);
4190 Set_Node20 (Id, V);
4191 end Set_Discriminant_Checking_Func;
4193 procedure Set_Discriminant_Constraint (Id : E; V : L) is
4194 begin
4195 pragma Assert (Nkind (Id) in N_Entity);
4196 Set_Elist21 (Id, V);
4197 end Set_Discriminant_Constraint;
4199 procedure Set_Discriminant_Default_Value (Id : E; V : N) is
4200 begin
4201 Set_Node20 (Id, V);
4202 end Set_Discriminant_Default_Value;
4204 procedure Set_Discriminant_Number (Id : E; V : U) is
4205 begin
4206 Set_Uint15 (Id, V);
4207 end Set_Discriminant_Number;
4209 procedure Set_Dispatch_Table_Wrappers (Id : E; V : L) is
4210 begin
4211 pragma Assert (Ekind (Id) = E_Record_Type
4212 and then Id = Implementation_Base_Type (Id));
4213 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
4214 Set_Elist26 (Id, V);
4215 end Set_Dispatch_Table_Wrappers;
4217 procedure Set_DT_Entry_Count (Id : E; V : U) is
4218 begin
4219 pragma Assert (Ekind (Id) = E_Component);
4220 Set_Uint15 (Id, V);
4221 end Set_DT_Entry_Count;
4223 procedure Set_DT_Offset_To_Top_Func (Id : E; V : E) is
4224 begin
4225 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
4226 Set_Node25 (Id, V);
4227 end Set_DT_Offset_To_Top_Func;
4229 procedure Set_DT_Position (Id : E; V : U) is
4230 begin
4231 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
4232 Set_Uint15 (Id, V);
4233 end Set_DT_Position;
4235 procedure Set_DTC_Entity (Id : E; V : E) is
4236 begin
4237 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
4238 Set_Node16 (Id, V);
4239 end Set_DTC_Entity;
4241 procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True) is
4242 begin
4243 pragma Assert (Ekind (Id) = E_Package);
4244 Set_Flag210 (Id, V);
4245 end Set_Elaborate_Body_Desirable;
4247 procedure Set_Elaboration_Entity (Id : E; V : E) is
4248 begin
4249 pragma Assert
4250 (Is_Subprogram (Id)
4251 or else
4252 Ekind (Id) = E_Package
4253 or else
4254 Is_Generic_Unit (Id));
4255 Set_Node13 (Id, V);
4256 end Set_Elaboration_Entity;
4258 procedure Set_Elaboration_Entity_Required (Id : E; V : B := True) is
4259 begin
4260 pragma Assert
4261 (Is_Subprogram (Id)
4262 or else
4263 Ekind (Id) = E_Package
4264 or else
4265 Is_Generic_Unit (Id));
4266 Set_Flag174 (Id, V);
4267 end Set_Elaboration_Entity_Required;
4269 procedure Set_Encapsulating_State (Id : E; V : E) is
4270 begin
4271 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Constant, E_Variable));
4272 Set_Node32 (Id, V);
4273 end Set_Encapsulating_State;
4275 procedure Set_Enclosing_Scope (Id : E; V : E) is
4276 begin
4277 Set_Node18 (Id, V);
4278 end Set_Enclosing_Scope;
4280 procedure Set_Entry_Accepted (Id : E; V : B := True) is
4281 begin
4282 pragma Assert (Is_Entry (Id));
4283 Set_Flag152 (Id, V);
4284 end Set_Entry_Accepted;
4286 procedure Set_Entry_Bodies_Array (Id : E; V : E) is
4287 begin
4288 Set_Node19 (Id, V);
4289 end Set_Entry_Bodies_Array;
4291 procedure Set_Entry_Cancel_Parameter (Id : E; V : E) is
4292 begin
4293 Set_Node23 (Id, V);
4294 end Set_Entry_Cancel_Parameter;
4296 procedure Set_Entry_Component (Id : E; V : E) is
4297 begin
4298 Set_Node11 (Id, V);
4299 end Set_Entry_Component;
4301 procedure Set_Entry_Formal (Id : E; V : E) is
4302 begin
4303 Set_Node16 (Id, V);
4304 end Set_Entry_Formal;
4306 procedure Set_Entry_Index_Constant (Id : E; V : E) is
4307 begin
4308 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
4309 Set_Node18 (Id, V);
4310 end Set_Entry_Index_Constant;
4312 procedure Set_Entry_Max_Queue_Lengths_Array (Id : E; V : E) is
4313 begin
4314 pragma Assert (Ekind (Id) = E_Protected_Type);
4315 Set_Node35 (Id, V);
4316 end Set_Entry_Max_Queue_Lengths_Array;
4318 procedure Set_Entry_Parameters_Type (Id : E; V : E) is
4319 begin
4320 Set_Node15 (Id, V);
4321 end Set_Entry_Parameters_Type;
4323 procedure Set_Enum_Pos_To_Rep (Id : E; V : E) is
4324 begin
4325 pragma Assert (Ekind (Id) = E_Enumeration_Type);
4326 Set_Node23 (Id, V);
4327 end Set_Enum_Pos_To_Rep;
4329 procedure Set_Enumeration_Pos (Id : E; V : U) is
4330 begin
4331 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
4332 Set_Uint11 (Id, V);
4333 end Set_Enumeration_Pos;
4335 procedure Set_Enumeration_Rep (Id : E; V : U) is
4336 begin
4337 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
4338 Set_Uint12 (Id, V);
4339 end Set_Enumeration_Rep;
4341 procedure Set_Enumeration_Rep_Expr (Id : E; V : N) is
4342 begin
4343 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
4344 Set_Node22 (Id, V);
4345 end Set_Enumeration_Rep_Expr;
4347 procedure Set_Equivalent_Type (Id : E; V : E) is
4348 begin
4349 pragma Assert
4350 (Ekind_In (Id, E_Class_Wide_Type,
4351 E_Class_Wide_Subtype,
4352 E_Access_Protected_Subprogram_Type,
4353 E_Anonymous_Access_Protected_Subprogram_Type,
4354 E_Access_Subprogram_Type,
4355 E_Exception_Type));
4356 Set_Node18 (Id, V);
4357 end Set_Equivalent_Type;
4359 procedure Set_Esize (Id : E; V : U) is
4360 begin
4361 Set_Uint12 (Id, V);
4362 end Set_Esize;
4364 procedure Set_Extra_Accessibility (Id : E; V : E) is
4365 begin
4366 pragma Assert
4367 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
4368 Set_Node13 (Id, V);
4369 end Set_Extra_Accessibility;
4371 procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E) is
4372 begin
4373 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
4374 Set_Node19 (Id, V);
4375 end Set_Extra_Accessibility_Of_Result;
4377 procedure Set_Extra_Constrained (Id : E; V : E) is
4378 begin
4379 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
4380 Set_Node23 (Id, V);
4381 end Set_Extra_Constrained;
4383 procedure Set_Extra_Formal (Id : E; V : E) is
4384 begin
4385 Set_Node15 (Id, V);
4386 end Set_Extra_Formal;
4388 procedure Set_Extra_Formals (Id : E; V : E) is
4389 begin
4390 pragma Assert
4391 (Is_Overloadable (Id)
4392 or else Ekind_In (Id, E_Entry_Family,
4393 E_Subprogram_Body,
4394 E_Subprogram_Type));
4395 Set_Node28 (Id, V);
4396 end Set_Extra_Formals;
4398 procedure Set_Finalization_Master (Id : E; V : E) is
4399 begin
4400 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
4401 Set_Node23 (Id, V);
4402 end Set_Finalization_Master;
4404 procedure Set_Finalize_Storage_Only (Id : E; V : B := True) is
4405 begin
4406 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
4407 Set_Flag158 (Id, V);
4408 end Set_Finalize_Storage_Only;
4410 procedure Set_Finalizer (Id : E; V : E) is
4411 begin
4412 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
4413 Set_Node28 (Id, V);
4414 end Set_Finalizer;
4416 procedure Set_First_Entity (Id : E; V : E) is
4417 begin
4418 Set_Node17 (Id, V);
4419 end Set_First_Entity;
4421 procedure Set_First_Exit_Statement (Id : E; V : N) is
4422 begin
4423 pragma Assert (Ekind (Id) = E_Loop);
4424 Set_Node8 (Id, V);
4425 end Set_First_Exit_Statement;
4427 procedure Set_First_Index (Id : E; V : N) is
4428 begin
4429 pragma Assert (Is_Array_Type (Id));
4430 Set_Node17 (Id, V);
4431 end Set_First_Index;
4433 procedure Set_First_Literal (Id : E; V : E) is
4434 begin
4435 pragma Assert (Is_Enumeration_Type (Id));
4436 Set_Node17 (Id, V);
4437 end Set_First_Literal;
4439 procedure Set_First_Private_Entity (Id : E; V : E) is
4440 begin
4441 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
4442 or else Ekind (Id) in Concurrent_Kind);
4443 Set_Node16 (Id, V);
4444 end Set_First_Private_Entity;
4446 procedure Set_First_Rep_Item (Id : E; V : N) is
4447 begin
4448 Set_Node6 (Id, V);
4449 end Set_First_Rep_Item;
4451 procedure Set_Float_Rep (Id : E; V : F) is
4452 pragma Assert (Ekind (Id) = E_Floating_Point_Type);
4453 begin
4454 Set_Uint10 (Id, UI_From_Int (F'Pos (V)));
4455 end Set_Float_Rep;
4457 procedure Set_Freeze_Node (Id : E; V : N) is
4458 begin
4459 Set_Node7 (Id, V);
4460 end Set_Freeze_Node;
4462 procedure Set_From_Limited_With (Id : E; V : B := True) is
4463 begin
4464 pragma Assert
4465 (Is_Type (Id) or else Ekind_In (Id, E_Abstract_State, E_Package));
4466 Set_Flag159 (Id, V);
4467 end Set_From_Limited_With;
4469 procedure Set_Full_View (Id : E; V : E) is
4470 begin
4471 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
4472 Set_Node11 (Id, V);
4473 end Set_Full_View;
4475 procedure Set_Generic_Homonym (Id : E; V : E) is
4476 begin
4477 Set_Node11 (Id, V);
4478 end Set_Generic_Homonym;
4480 procedure Set_Generic_Renamings (Id : E; V : L) is
4481 begin
4482 Set_Elist23 (Id, V);
4483 end Set_Generic_Renamings;
4485 procedure Set_Handler_Records (Id : E; V : S) is
4486 begin
4487 Set_List10 (Id, V);
4488 end Set_Handler_Records;
4490 procedure Set_Has_Aliased_Components (Id : E; V : B := True) is
4491 begin
4492 pragma Assert (Id = Base_Type (Id));
4493 Set_Flag135 (Id, V);
4494 end Set_Has_Aliased_Components;
4496 procedure Set_Has_Alignment_Clause (Id : E; V : B := True) is
4497 begin
4498 Set_Flag46 (Id, V);
4499 end Set_Has_Alignment_Clause;
4501 procedure Set_Has_All_Calls_Remote (Id : E; V : B := True) is
4502 begin
4503 Set_Flag79 (Id, V);
4504 end Set_Has_All_Calls_Remote;
4506 procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
4507 begin
4508 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
4509 Set_Flag86 (Id, V);
4510 end Set_Has_Atomic_Components;
4512 procedure Set_Has_Biased_Representation (Id : E; V : B := True) is
4513 begin
4514 pragma Assert
4515 ((V = False) or else (Is_Discrete_Type (Id) or else Is_Object (Id)));
4516 Set_Flag139 (Id, V);
4517 end Set_Has_Biased_Representation;
4519 procedure Set_Has_Completion (Id : E; V : B := True) is
4520 begin
4521 Set_Flag26 (Id, V);
4522 end Set_Has_Completion;
4524 procedure Set_Has_Completion_In_Body (Id : E; V : B := True) is
4525 begin
4526 pragma Assert (Is_Type (Id));
4527 Set_Flag71 (Id, V);
4528 end Set_Has_Completion_In_Body;
4530 procedure Set_Has_Complex_Representation (Id : E; V : B := True) is
4531 begin
4532 pragma Assert (Ekind (Id) = E_Record_Type);
4533 Set_Flag140 (Id, V);
4534 end Set_Has_Complex_Representation;
4536 procedure Set_Has_Component_Size_Clause (Id : E; V : B := True) is
4537 begin
4538 pragma Assert (Ekind (Id) = E_Array_Type);
4539 Set_Flag68 (Id, V);
4540 end Set_Has_Component_Size_Clause;
4542 procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True) is
4543 begin
4544 pragma Assert (Is_Type (Id));
4545 Set_Flag187 (Id, V);
4546 end Set_Has_Constrained_Partial_View;
4548 procedure Set_Has_Contiguous_Rep (Id : E; V : B := True) is
4549 begin
4550 Set_Flag181 (Id, V);
4551 end Set_Has_Contiguous_Rep;
4553 procedure Set_Has_Controlled_Component (Id : E; V : B := True) is
4554 begin
4555 pragma Assert (Id = Base_Type (Id));
4556 Set_Flag43 (Id, V);
4557 end Set_Has_Controlled_Component;
4559 procedure Set_Has_Controlling_Result (Id : E; V : B := True) is
4560 begin
4561 Set_Flag98 (Id, V);
4562 end Set_Has_Controlling_Result;
4564 procedure Set_Has_Convention_Pragma (Id : E; V : B := True) is
4565 begin
4566 Set_Flag119 (Id, V);
4567 end Set_Has_Convention_Pragma;
4569 procedure Set_Has_Default_Aspect (Id : E; V : B := True) is
4570 begin
4571 pragma Assert
4572 ((Is_Scalar_Type (Id) or else Is_Array_Type (Id))
4573 and then Is_Base_Type (Id));
4574 Set_Flag39 (Id, V);
4575 end Set_Has_Default_Aspect;
4577 procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is
4578 begin
4579 pragma Assert (Nkind (Id) in N_Entity);
4580 Set_Flag200 (Id, V);
4581 end Set_Has_Delayed_Aspects;
4583 procedure Set_Has_Delayed_Freeze (Id : E; V : B := True) is
4584 begin
4585 pragma Assert (Nkind (Id) in N_Entity);
4586 Set_Flag18 (Id, V);
4587 end Set_Has_Delayed_Freeze;
4589 procedure Set_Has_Delayed_Rep_Aspects (Id : E; V : B := True) is
4590 begin
4591 pragma Assert (Nkind (Id) in N_Entity);
4592 Set_Flag261 (Id, V);
4593 end Set_Has_Delayed_Rep_Aspects;
4595 procedure Set_Has_Discriminants (Id : E; V : B := True) is
4596 begin
4597 pragma Assert (Nkind (Id) in N_Entity);
4598 Set_Flag5 (Id, V);
4599 end Set_Has_Discriminants;
4601 procedure Set_Has_Dispatch_Table (Id : E; V : B := True) is
4602 begin
4603 pragma Assert (Ekind (Id) = E_Record_Type
4604 and then Is_Tagged_Type (Id));
4605 Set_Flag220 (Id, V);
4606 end Set_Has_Dispatch_Table;
4608 procedure Set_Has_Dynamic_Predicate_Aspect (Id : E; V : B := True) is
4609 begin
4610 pragma Assert (Is_Type (Id));
4611 Set_Flag258 (Id, V);
4612 end Set_Has_Dynamic_Predicate_Aspect;
4614 procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True) is
4615 begin
4616 pragma Assert (Is_Enumeration_Type (Id));
4617 Set_Flag66 (Id, V);
4618 end Set_Has_Enumeration_Rep_Clause;
4620 procedure Set_Has_Exit (Id : E; V : B := True) is
4621 begin
4622 Set_Flag47 (Id, V);
4623 end Set_Has_Exit;
4625 procedure Set_Has_Expanded_Contract (Id : E; V : B := True) is
4626 begin
4627 pragma Assert (Ekind_In (Id, E_Entry,
4628 E_Entry_Family,
4629 E_Function,
4630 E_Procedure));
4631 Set_Flag240 (Id, V);
4632 end Set_Has_Expanded_Contract;
4634 procedure Set_Has_Forward_Instantiation (Id : E; V : B := True) is
4635 begin
4636 Set_Flag175 (Id, V);
4637 end Set_Has_Forward_Instantiation;
4639 procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True) is
4640 begin
4641 Set_Flag173 (Id, V);
4642 end Set_Has_Fully_Qualified_Name;
4644 procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True) is
4645 begin
4646 Set_Flag82 (Id, V);
4647 end Set_Has_Gigi_Rep_Item;
4649 procedure Set_Has_Homonym (Id : E; V : B := True) is
4650 begin
4651 Set_Flag56 (Id, V);
4652 end Set_Has_Homonym;
4654 procedure Set_Has_Implicit_Dereference (Id : E; V : B := True) is
4655 begin
4656 Set_Flag251 (Id, V);
4657 end Set_Has_Implicit_Dereference;
4659 procedure Set_Has_Independent_Components (Id : E; V : B := True) is
4660 begin
4661 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
4662 Set_Flag34 (Id, V);
4663 end Set_Has_Independent_Components;
4665 procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True) is
4666 begin
4667 pragma Assert (Is_Type (Id));
4668 Set_Flag248 (Base_Type (Id), V);
4669 end Set_Has_Inheritable_Invariants;
4671 procedure Set_Has_Inherited_DIC (Id : E; V : B := True) is
4672 begin
4673 pragma Assert (Is_Type (Id));
4674 Set_Flag133 (Base_Type (Id), V);
4675 end Set_Has_Inherited_DIC;
4677 procedure Set_Has_Inherited_Invariants (Id : E; V : B := True) is
4678 begin
4679 pragma Assert (Is_Type (Id));
4680 Set_Flag291 (Base_Type (Id), V);
4681 end Set_Has_Inherited_Invariants;
4683 procedure Set_Has_Initial_Value (Id : E; V : B := True) is
4684 begin
4685 pragma Assert (Ekind_In (Id, E_Variable, E_Out_Parameter));
4686 Set_Flag219 (Id, V);
4687 end Set_Has_Initial_Value;
4689 procedure Set_Has_Loop_Entry_Attributes (Id : E; V : B := True) is
4690 begin
4691 pragma Assert (Ekind (Id) = E_Loop);
4692 Set_Flag260 (Id, V);
4693 end Set_Has_Loop_Entry_Attributes;
4695 procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True) is
4696 begin
4697 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
4698 Set_Flag83 (Id, V);
4699 end Set_Has_Machine_Radix_Clause;
4701 procedure Set_Has_Master_Entity (Id : E; V : B := True) is
4702 begin
4703 Set_Flag21 (Id, V);
4704 end Set_Has_Master_Entity;
4706 procedure Set_Has_Missing_Return (Id : E; V : B := True) is
4707 begin
4708 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
4709 Set_Flag142 (Id, V);
4710 end Set_Has_Missing_Return;
4712 procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True) is
4713 begin
4714 Set_Flag101 (Id, V);
4715 end Set_Has_Nested_Block_With_Handler;
4717 procedure Set_Has_Nested_Subprogram (Id : E; V : B := True) is
4718 begin
4719 pragma Assert (Is_Subprogram (Id));
4720 Set_Flag282 (Id, V);
4721 end Set_Has_Nested_Subprogram;
4723 procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
4724 begin
4725 pragma Assert (Id = Base_Type (Id));
4726 Set_Flag75 (Id, V);
4727 end Set_Has_Non_Standard_Rep;
4729 procedure Set_Has_Object_Size_Clause (Id : E; V : B := True) is
4730 begin
4731 pragma Assert (Is_Type (Id));
4732 Set_Flag172 (Id, V);
4733 end Set_Has_Object_Size_Clause;
4735 procedure Set_Has_Out_Or_In_Out_Parameter (Id : E; V : B := True) is
4736 begin
4737 pragma Assert
4738 (Ekind_In (Id, E_Entry, E_Entry_Family)
4739 or else Is_Subprogram_Or_Generic_Subprogram (Id));
4740 Set_Flag110 (Id, V);
4741 end Set_Has_Out_Or_In_Out_Parameter;
4743 procedure Set_Has_Own_DIC (Id : E; V : B := True) is
4744 begin
4745 pragma Assert (Is_Type (Id));
4746 Set_Flag3 (Base_Type (Id), V);
4747 end Set_Has_Own_DIC;
4749 procedure Set_Has_Own_Invariants (Id : E; V : B := True) is
4750 begin
4751 pragma Assert (Is_Type (Id));
4752 Set_Flag232 (Base_Type (Id), V);
4753 end Set_Has_Own_Invariants;
4755 procedure Set_Has_Partial_Visible_Refinement (Id : E; V : B := True) is
4756 begin
4757 pragma Assert (Ekind (Id) = E_Abstract_State);
4758 Set_Flag296 (Id, V);
4759 end Set_Has_Partial_Visible_Refinement;
4761 procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True) is
4762 begin
4763 Set_Flag154 (Id, V);
4764 end Set_Has_Per_Object_Constraint;
4766 procedure Set_Has_Pragma_Controlled (Id : E; V : B := True) is
4767 begin
4768 pragma Assert (Is_Access_Type (Id));
4769 Set_Flag27 (Base_Type (Id), V);
4770 end Set_Has_Pragma_Controlled;
4772 procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True) is
4773 begin
4774 Set_Flag150 (Id, V);
4775 end Set_Has_Pragma_Elaborate_Body;
4777 procedure Set_Has_Pragma_Inline (Id : E; V : B := True) is
4778 begin
4779 Set_Flag157 (Id, V);
4780 end Set_Has_Pragma_Inline;
4782 procedure Set_Has_Pragma_Inline_Always (Id : E; V : B := True) is
4783 begin
4784 Set_Flag230 (Id, V);
4785 end Set_Has_Pragma_Inline_Always;
4787 procedure Set_Has_Pragma_No_Inline (Id : E; V : B := True) is
4788 begin
4789 Set_Flag201 (Id, V);
4790 end Set_Has_Pragma_No_Inline;
4792 procedure Set_Has_Pragma_Ordered (Id : E; V : B := True) is
4793 begin
4794 pragma Assert (Is_Enumeration_Type (Id));
4795 pragma Assert (Id = Base_Type (Id));
4796 Set_Flag198 (Id, V);
4797 end Set_Has_Pragma_Ordered;
4799 procedure Set_Has_Pragma_Pack (Id : E; V : B := True) is
4800 begin
4801 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
4802 pragma Assert (Id = Base_Type (Id));
4803 Set_Flag121 (Id, V);
4804 end Set_Has_Pragma_Pack;
4806 procedure Set_Has_Pragma_Preelab_Init (Id : E; V : B := True) is
4807 begin
4808 Set_Flag221 (Id, V);
4809 end Set_Has_Pragma_Preelab_Init;
4811 procedure Set_Has_Pragma_Pure (Id : E; V : B := True) is
4812 begin
4813 Set_Flag203 (Id, V);
4814 end Set_Has_Pragma_Pure;
4816 procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True) is
4817 begin
4818 Set_Flag179 (Id, V);
4819 end Set_Has_Pragma_Pure_Function;
4821 procedure Set_Has_Pragma_Thread_Local_Storage (Id : E; V : B := True) is
4822 begin
4823 Set_Flag169 (Id, V);
4824 end Set_Has_Pragma_Thread_Local_Storage;
4826 procedure Set_Has_Pragma_Unmodified (Id : E; V : B := True) is
4827 begin
4828 Set_Flag233 (Id, V);
4829 end Set_Has_Pragma_Unmodified;
4831 procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True) is
4832 begin
4833 Set_Flag180 (Id, V);
4834 end Set_Has_Pragma_Unreferenced;
4836 procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True) is
4837 begin
4838 pragma Assert (Is_Type (Id));
4839 Set_Flag212 (Id, V);
4840 end Set_Has_Pragma_Unreferenced_Objects;
4842 procedure Set_Has_Pragma_Unused (Id : E; V : B := True) is
4843 begin
4844 Set_Flag294 (Id, V);
4845 end Set_Has_Pragma_Unused;
4847 procedure Set_Has_Predicates (Id : E; V : B := True) is
4848 begin
4849 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Void);
4850 Set_Flag250 (Id, V);
4851 end Set_Has_Predicates;
4853 procedure Set_Has_Primitive_Operations (Id : E; V : B := True) is
4854 begin
4855 pragma Assert (Id = Base_Type (Id));
4856 Set_Flag120 (Id, V);
4857 end Set_Has_Primitive_Operations;
4859 procedure Set_Has_Private_Ancestor (Id : E; V : B := True) is
4860 begin
4861 pragma Assert (Is_Type (Id));
4862 Set_Flag151 (Id, V);
4863 end Set_Has_Private_Ancestor;
4865 procedure Set_Has_Private_Declaration (Id : E; V : B := True) is
4866 begin
4867 Set_Flag155 (Id, V);
4868 end Set_Has_Private_Declaration;
4870 procedure Set_Has_Protected (Id : E; V : B := True) is
4871 begin
4872 Set_Flag271 (Id, V);
4873 end Set_Has_Protected;
4875 procedure Set_Has_Qualified_Name (Id : E; V : B := True) is
4876 begin
4877 Set_Flag161 (Id, V);
4878 end Set_Has_Qualified_Name;
4880 procedure Set_Has_RACW (Id : E; V : B := True) is
4881 begin
4882 pragma Assert (Ekind (Id) = E_Package);
4883 Set_Flag214 (Id, V);
4884 end Set_Has_RACW;
4886 procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True) is
4887 begin
4888 pragma Assert (Id = Base_Type (Id));
4889 Set_Flag65 (Id, V);
4890 end Set_Has_Record_Rep_Clause;
4892 procedure Set_Has_Recursive_Call (Id : E; V : B := True) is
4893 begin
4894 pragma Assert (Is_Subprogram (Id));
4895 Set_Flag143 (Id, V);
4896 end Set_Has_Recursive_Call;
4898 procedure Set_Has_Shift_Operator (Id : E; V : B := True) is
4899 begin
4900 pragma Assert (Is_Integer_Type (Id) and then Is_Base_Type (Id));
4901 Set_Flag267 (Id, V);
4902 end Set_Has_Shift_Operator;
4904 procedure Set_Has_Size_Clause (Id : E; V : B := True) is
4905 begin
4906 Set_Flag29 (Id, V);
4907 end Set_Has_Size_Clause;
4909 procedure Set_Has_Small_Clause (Id : E; V : B := True) is
4910 begin
4911 pragma Assert (Is_Ordinary_Fixed_Point_Type (Id));
4912 Set_Flag67 (Id, V);
4913 end Set_Has_Small_Clause;
4915 procedure Set_Has_Specified_Layout (Id : E; V : B := True) is
4916 begin
4917 pragma Assert (Id = Base_Type (Id));
4918 Set_Flag100 (Id, V);
4919 end Set_Has_Specified_Layout;
4921 procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True) is
4922 begin
4923 pragma Assert (Is_Type (Id));
4924 Set_Flag190 (Id, V);
4925 end Set_Has_Specified_Stream_Input;
4927 procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True) is
4928 begin
4929 pragma Assert (Is_Type (Id));
4930 Set_Flag191 (Id, V);
4931 end Set_Has_Specified_Stream_Output;
4933 procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True) is
4934 begin
4935 pragma Assert (Is_Type (Id));
4936 Set_Flag192 (Id, V);
4937 end Set_Has_Specified_Stream_Read;
4939 procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True) is
4940 begin
4941 pragma Assert (Is_Type (Id));
4942 Set_Flag193 (Id, V);
4943 end Set_Has_Specified_Stream_Write;
4945 procedure Set_Has_Static_Discriminants (Id : E; V : B := True) is
4946 begin
4947 Set_Flag211 (Id, V);
4948 end Set_Has_Static_Discriminants;
4950 procedure Set_Has_Static_Predicate (Id : E; V : B := True) is
4951 begin
4952 pragma Assert (Is_Type (Id));
4953 Set_Flag269 (Id, V);
4954 end Set_Has_Static_Predicate;
4956 procedure Set_Has_Static_Predicate_Aspect (Id : E; V : B := True) is
4957 begin
4958 pragma Assert (Is_Type (Id));
4959 Set_Flag259 (Id, V);
4960 end Set_Has_Static_Predicate_Aspect;
4962 procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True) is
4963 begin
4964 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
4965 pragma Assert (Id = Base_Type (Id));
4966 Set_Flag23 (Id, V);
4967 end Set_Has_Storage_Size_Clause;
4969 procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True) is
4970 begin
4971 pragma Assert (Is_Elementary_Type (Id));
4972 Set_Flag184 (Id, V);
4973 end Set_Has_Stream_Size_Clause;
4975 procedure Set_Has_Task (Id : E; V : B := True) is
4976 begin
4977 pragma Assert (Id = Base_Type (Id));
4978 Set_Flag30 (Id, V);
4979 end Set_Has_Task;
4981 procedure Set_Has_Thunks (Id : E; V : B := True) is
4982 begin
4983 pragma Assert (Is_Tag (Id));
4984 Set_Flag228 (Id, V);
4985 end Set_Has_Thunks;
4987 procedure Set_Has_Timing_Event (Id : E; V : B := True) is
4988 begin
4989 pragma Assert (Id = Base_Type (Id));
4990 Set_Flag289 (Id, V);
4991 end Set_Has_Timing_Event;
4993 procedure Set_Has_Unchecked_Union (Id : E; V : B := True) is
4994 begin
4995 pragma Assert (Id = Base_Type (Id));
4996 Set_Flag123 (Id, V);
4997 end Set_Has_Unchecked_Union;
4999 procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True) is
5000 begin
5001 pragma Assert (Is_Type (Id));
5002 Set_Flag72 (Id, V);
5003 end Set_Has_Unknown_Discriminants;
5005 procedure Set_Has_Visible_Refinement (Id : E; V : B := True) is
5006 begin
5007 pragma Assert (Ekind (Id) = E_Abstract_State);
5008 Set_Flag263 (Id, V);
5009 end Set_Has_Visible_Refinement;
5011 procedure Set_Has_Volatile_Components (Id : E; V : B := True) is
5012 begin
5013 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
5014 Set_Flag87 (Id, V);
5015 end Set_Has_Volatile_Components;
5017 procedure Set_Has_Xref_Entry (Id : E; V : B := True) is
5018 begin
5019 Set_Flag182 (Id, V);
5020 end Set_Has_Xref_Entry;
5022 procedure Set_Hiding_Loop_Variable (Id : E; V : E) is
5023 begin
5024 pragma Assert (Ekind (Id) = E_Variable);
5025 Set_Node8 (Id, V);
5026 end Set_Hiding_Loop_Variable;
5028 procedure Set_Homonym (Id : E; V : E) is
5029 begin
5030 pragma Assert (Id /= V);
5031 Set_Node4 (Id, V);
5032 end Set_Homonym;
5034 procedure Set_Incomplete_Actuals (Id : E; V : L) is
5035 begin
5036 pragma Assert (Ekind (Id) = E_Package);
5037 Set_Elist24 (Id, V);
5038 end Set_Incomplete_Actuals;
5040 procedure Set_Import_Pragma (Id : E; V : E) is
5041 begin
5042 pragma Assert (Is_Subprogram (Id));
5043 Set_Node35 (Id, V);
5044 end Set_Import_Pragma;
5046 procedure Set_Interface_Alias (Id : E; V : E) is
5047 begin
5048 pragma Assert
5049 (Is_Internal (Id)
5050 and then Is_Hidden (Id)
5051 and then (Ekind_In (Id, E_Procedure, E_Function)));
5052 Set_Node25 (Id, V);
5053 end Set_Interface_Alias;
5055 procedure Set_Interfaces (Id : E; V : L) is
5056 begin
5057 pragma Assert (Is_Record_Type (Id));
5058 Set_Elist25 (Id, V);
5059 end Set_Interfaces;
5061 procedure Set_In_Package_Body (Id : E; V : B := True) is
5062 begin
5063 Set_Flag48 (Id, V);
5064 end Set_In_Package_Body;
5066 procedure Set_In_Private_Part (Id : E; V : B := True) is
5067 begin
5068 Set_Flag45 (Id, V);
5069 end Set_In_Private_Part;
5071 procedure Set_In_Use (Id : E; V : B := True) is
5072 begin
5073 pragma Assert (Nkind (Id) in N_Entity);
5074 Set_Flag8 (Id, V);
5075 end Set_In_Use;
5077 procedure Set_Initialization_Statements (Id : E; V : N) is
5078 begin
5079 -- Tolerate an E_Void entity since this can be called while resolving
5080 -- an aggregate used as the initialization expression for an object
5081 -- declaration, and this occurs before the Ekind for the object is set.
5083 pragma Assert (Ekind_In (Id, E_Void, E_Constant, E_Variable));
5084 Set_Node28 (Id, V);
5085 end Set_Initialization_Statements;
5087 procedure Set_Inner_Instances (Id : E; V : L) is
5088 begin
5089 Set_Elist23 (Id, V);
5090 end Set_Inner_Instances;
5092 procedure Set_Interface_Name (Id : E; V : N) is
5093 begin
5094 Set_Node21 (Id, V);
5095 end Set_Interface_Name;
5097 procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True) is
5098 begin
5099 pragma Assert (Is_Overloadable (Id));
5100 Set_Flag19 (Id, V);
5101 end Set_Is_Abstract_Subprogram;
5103 procedure Set_Is_Abstract_Type (Id : E; V : B := True) is
5104 begin
5105 pragma Assert (Is_Type (Id));
5106 Set_Flag146 (Id, V);
5107 end Set_Is_Abstract_Type;
5109 procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
5110 begin
5111 pragma Assert (Is_Access_Type (Id));
5112 Set_Flag194 (Id, V);
5113 end Set_Is_Local_Anonymous_Access;
5115 procedure Set_Is_Access_Constant (Id : E; V : B := True) is
5116 begin
5117 pragma Assert (Is_Access_Type (Id));
5118 Set_Flag69 (Id, V);
5119 end Set_Is_Access_Constant;
5121 procedure Set_Is_Actual_Subtype (Id : E; V : B := True) is
5122 begin
5123 pragma Assert (Is_Type (Id));
5124 Set_Flag293 (Id, V);
5125 end Set_Is_Actual_Subtype;
5127 procedure Set_Is_Ada_2005_Only (Id : E; V : B := True) is
5128 begin
5129 Set_Flag185 (Id, V);
5130 end Set_Is_Ada_2005_Only;
5132 procedure Set_Is_Ada_2012_Only (Id : E; V : B := True) is
5133 begin
5134 Set_Flag199 (Id, V);
5135 end Set_Is_Ada_2012_Only;
5137 procedure Set_Is_Aliased (Id : E; V : B := True) is
5138 begin
5139 pragma Assert (Nkind (Id) in N_Entity);
5140 Set_Flag15 (Id, V);
5141 end Set_Is_Aliased;
5143 procedure Set_Is_Asynchronous (Id : E; V : B := True) is
5144 begin
5145 pragma Assert
5146 (Ekind (Id) = E_Procedure or else Is_Type (Id));
5147 Set_Flag81 (Id, V);
5148 end Set_Is_Asynchronous;
5150 procedure Set_Is_Atomic (Id : E; V : B := True) is
5151 begin
5152 Set_Flag85 (Id, V);
5153 end Set_Is_Atomic;
5155 procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True) is
5156 begin
5157 pragma Assert ((not V)
5158 or else (Is_Array_Type (Id) and then Is_Base_Type (Id)));
5159 Set_Flag122 (Id, V);
5160 end Set_Is_Bit_Packed_Array;
5162 procedure Set_Is_Called (Id : E; V : B := True) is
5163 begin
5164 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
5165 Set_Flag102 (Id, V);
5166 end Set_Is_Called;
5168 procedure Set_Is_Character_Type (Id : E; V : B := True) is
5169 begin
5170 Set_Flag63 (Id, V);
5171 end Set_Is_Character_Type;
5173 procedure Set_Is_Checked_Ghost_Entity (Id : E; V : B := True) is
5174 begin
5175 -- Allow this attribute to appear on unanalyzed entities
5177 pragma Assert (Nkind (Id) in N_Entity
5178 or else Ekind (Id) = E_Void);
5179 Set_Flag277 (Id, V);
5180 end Set_Is_Checked_Ghost_Entity;
5182 procedure Set_Is_Child_Unit (Id : E; V : B := True) is
5183 begin
5184 Set_Flag73 (Id, V);
5185 end Set_Is_Child_Unit;
5187 procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True) is
5188 begin
5189 Set_Flag35 (Id, V);
5190 end Set_Is_Class_Wide_Equivalent_Type;
5192 procedure Set_Is_Compilation_Unit (Id : E; V : B := True) is
5193 begin
5194 Set_Flag149 (Id, V);
5195 end Set_Is_Compilation_Unit;
5197 procedure Set_Is_Completely_Hidden (Id : E; V : B := True) is
5198 begin
5199 pragma Assert (Ekind (Id) = E_Discriminant);
5200 Set_Flag103 (Id, V);
5201 end Set_Is_Completely_Hidden;
5203 procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True) is
5204 begin
5205 Set_Flag20 (Id, V);
5206 end Set_Is_Concurrent_Record_Type;
5208 procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True) is
5209 begin
5210 Set_Flag80 (Id, V);
5211 end Set_Is_Constr_Subt_For_U_Nominal;
5213 procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True) is
5214 begin
5215 Set_Flag141 (Id, V);
5216 end Set_Is_Constr_Subt_For_UN_Aliased;
5218 procedure Set_Is_Constrained (Id : E; V : B := True) is
5219 begin
5220 pragma Assert (Nkind (Id) in N_Entity);
5221 Set_Flag12 (Id, V);
5222 end Set_Is_Constrained;
5224 procedure Set_Is_Constructor (Id : E; V : B := True) is
5225 begin
5226 Set_Flag76 (Id, V);
5227 end Set_Is_Constructor;
5229 procedure Set_Is_Controlled (Id : E; V : B := True) is
5230 begin
5231 pragma Assert (Id = Base_Type (Id));
5232 Set_Flag42 (Id, V);
5233 end Set_Is_Controlled;
5235 procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is
5236 begin
5237 pragma Assert (Is_Formal (Id));
5238 Set_Flag97 (Id, V);
5239 end Set_Is_Controlling_Formal;
5241 procedure Set_Is_CPP_Class (Id : E; V : B := True) is
5242 begin
5243 Set_Flag74 (Id, V);
5244 end Set_Is_CPP_Class;
5246 procedure Set_Is_DIC_Procedure (Id : E; V : B := True) is
5247 begin
5248 pragma Assert (Ekind (Id) = E_Procedure);
5249 Set_Flag132 (Id, V);
5250 end Set_Is_DIC_Procedure;
5252 procedure Set_Is_Descendant_Of_Address (Id : E; V : B := True) is
5253 begin
5254 pragma Assert (Is_Type (Id));
5255 Set_Flag223 (Id, V);
5256 end Set_Is_Descendant_Of_Address;
5258 procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True) is
5259 begin
5260 Set_Flag176 (Id, V);
5261 end Set_Is_Discrim_SO_Function;
5263 procedure Set_Is_Discriminant_Check_Function (Id : E; V : B := True) is
5264 begin
5265 Set_Flag264 (Id, V);
5266 end Set_Is_Discriminant_Check_Function;
5268 procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True) is
5269 begin
5270 Set_Flag234 (Id, V);
5271 end Set_Is_Dispatch_Table_Entity;
5273 procedure Set_Is_Dispatching_Operation (Id : E; V : B := True) is
5274 begin
5275 pragma Assert
5276 (V = False
5277 or else
5278 Is_Overloadable (Id)
5279 or else
5280 Ekind (Id) = E_Subprogram_Type);
5282 Set_Flag6 (Id, V);
5283 end Set_Is_Dispatching_Operation;
5285 procedure Set_Is_Eliminated (Id : E; V : B := True) is
5286 begin
5287 Set_Flag124 (Id, V);
5288 end Set_Is_Eliminated;
5290 procedure Set_Is_Entry_Formal (Id : E; V : B := True) is
5291 begin
5292 Set_Flag52 (Id, V);
5293 end Set_Is_Entry_Formal;
5295 procedure Set_Is_Entry_Wrapper (Id : E; V : B := True) is
5296 begin
5297 Set_Flag297 (Id, V);
5298 end Set_Is_Entry_Wrapper;
5300 procedure Set_Is_Exception_Handler (Id : E; V : B := True) is
5301 begin
5302 pragma Assert (Ekind (Id) = E_Block);
5303 Set_Flag286 (Id, V);
5304 end Set_Is_Exception_Handler;
5306 procedure Set_Is_Exported (Id : E; V : B := True) is
5307 begin
5308 Set_Flag99 (Id, V);
5309 end Set_Is_Exported;
5311 procedure Set_Is_Finalized_Transient (Id : E; V : B := True) is
5312 begin
5313 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
5314 Set_Flag252 (Id, V);
5315 end Set_Is_Finalized_Transient;
5317 procedure Set_Is_First_Subtype (Id : E; V : B := True) is
5318 begin
5319 Set_Flag70 (Id, V);
5320 end Set_Is_First_Subtype;
5322 procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is
5323 begin
5324 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
5325 Set_Flag118 (Id, V);
5326 end Set_Is_For_Access_Subtype;
5328 procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is
5329 begin
5330 Set_Flag111 (Id, V);
5331 end Set_Is_Formal_Subprogram;
5333 procedure Set_Is_Frozen (Id : E; V : B := True) is
5334 begin
5335 pragma Assert (Nkind (Id) in N_Entity);
5336 Set_Flag4 (Id, V);
5337 end Set_Is_Frozen;
5339 procedure Set_Is_Generic_Actual_Subprogram (Id : E; V : B := True) is
5340 begin
5341 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5342 Set_Flag274 (Id, V);
5343 end Set_Is_Generic_Actual_Subprogram;
5345 procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True) is
5346 begin
5347 pragma Assert (Is_Type (Id));
5348 Set_Flag94 (Id, V);
5349 end Set_Is_Generic_Actual_Type;
5351 procedure Set_Is_Generic_Instance (Id : E; V : B := True) is
5352 begin
5353 Set_Flag130 (Id, V);
5354 end Set_Is_Generic_Instance;
5356 procedure Set_Is_Generic_Type (Id : E; V : B := True) is
5357 begin
5358 pragma Assert (Nkind (Id) in N_Entity);
5359 Set_Flag13 (Id, V);
5360 end Set_Is_Generic_Type;
5362 procedure Set_Is_Hidden (Id : E; V : B := True) is
5363 begin
5364 Set_Flag57 (Id, V);
5365 end Set_Is_Hidden;
5367 procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True) is
5368 begin
5369 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5370 Set_Flag2 (Id, V);
5371 end Set_Is_Hidden_Non_Overridden_Subpgm;
5373 procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True) is
5374 begin
5375 Set_Flag171 (Id, V);
5376 end Set_Is_Hidden_Open_Scope;
5378 procedure Set_Is_Ignored_Ghost_Entity (Id : E; V : B := True) is
5379 begin
5380 -- Allow this attribute to appear on unanalyzed entities
5382 pragma Assert (Nkind (Id) in N_Entity
5383 or else Ekind (Id) = E_Void);
5384 Set_Flag278 (Id, V);
5385 end Set_Is_Ignored_Ghost_Entity;
5387 procedure Set_Is_Ignored_Transient (Id : E; V : B := True) is
5388 begin
5389 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
5390 Set_Flag295 (Id, V);
5391 end Set_Is_Ignored_Transient;
5393 procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is
5394 begin
5395 pragma Assert (Nkind (Id) in N_Entity);
5396 Set_Flag7 (Id, V);
5397 end Set_Is_Immediately_Visible;
5399 procedure Set_Is_Implementation_Defined (Id : E; V : B := True) is
5400 begin
5401 Set_Flag254 (Id, V);
5402 end Set_Is_Implementation_Defined;
5404 procedure Set_Is_Imported (Id : E; V : B := True) is
5405 begin
5406 Set_Flag24 (Id, V);
5407 end Set_Is_Imported;
5409 procedure Set_Is_Independent (Id : E; V : B := True) is
5410 begin
5411 Set_Flag268 (Id, V);
5412 end Set_Is_Independent;
5414 procedure Set_Is_Inlined (Id : E; V : B := True) is
5415 begin
5416 Set_Flag11 (Id, V);
5417 end Set_Is_Inlined;
5419 procedure Set_Is_Inlined_Always (Id : E; V : B := True) is
5420 begin
5421 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
5422 Set_Flag1 (Id, V);
5423 end Set_Is_Inlined_Always;
5425 procedure Set_Is_Interface (Id : E; V : B := True) is
5426 begin
5427 pragma Assert (Is_Record_Type (Id));
5428 Set_Flag186 (Id, V);
5429 end Set_Is_Interface;
5431 procedure Set_Is_Instantiated (Id : E; V : B := True) is
5432 begin
5433 Set_Flag126 (Id, V);
5434 end Set_Is_Instantiated;
5436 procedure Set_Is_Internal (Id : E; V : B := True) is
5437 begin
5438 pragma Assert (Nkind (Id) in N_Entity);
5439 Set_Flag17 (Id, V);
5440 end Set_Is_Internal;
5442 procedure Set_Is_Interrupt_Handler (Id : E; V : B := True) is
5443 begin
5444 pragma Assert (Nkind (Id) in N_Entity);
5445 Set_Flag89 (Id, V);
5446 end Set_Is_Interrupt_Handler;
5448 procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True) is
5449 begin
5450 Set_Flag64 (Id, V);
5451 end Set_Is_Intrinsic_Subprogram;
5453 procedure Set_Is_Invariant_Procedure (Id : E; V : B := True) is
5454 begin
5455 pragma Assert (Ekind (Id) = E_Procedure);
5456 Set_Flag257 (Id, V);
5457 end Set_Is_Invariant_Procedure;
5459 procedure Set_Is_Itype (Id : E; V : B := True) is
5460 begin
5461 Set_Flag91 (Id, V);
5462 end Set_Is_Itype;
5464 procedure Set_Is_Known_Non_Null (Id : E; V : B := True) is
5465 begin
5466 Set_Flag37 (Id, V);
5467 end Set_Is_Known_Non_Null;
5469 procedure Set_Is_Known_Null (Id : E; V : B := True) is
5470 begin
5471 Set_Flag204 (Id, V);
5472 end Set_Is_Known_Null;
5474 procedure Set_Is_Known_Valid (Id : E; V : B := True) is
5475 begin
5476 Set_Flag170 (Id, V);
5477 end Set_Is_Known_Valid;
5479 procedure Set_Is_Limited_Composite (Id : E; V : B := True) is
5480 begin
5481 pragma Assert (Is_Type (Id));
5482 Set_Flag106 (Id, V);
5483 end Set_Is_Limited_Composite;
5485 procedure Set_Is_Limited_Interface (Id : E; V : B := True) is
5486 begin
5487 pragma Assert (Is_Interface (Id));
5488 Set_Flag197 (Id, V);
5489 end Set_Is_Limited_Interface;
5491 procedure Set_Is_Limited_Record (Id : E; V : B := True) is
5492 begin
5493 Set_Flag25 (Id, V);
5494 end Set_Is_Limited_Record;
5496 procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is
5497 begin
5498 pragma Assert (Is_Subprogram (Id));
5499 Set_Flag137 (Id, V);
5500 end Set_Is_Machine_Code_Subprogram;
5502 procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True) is
5503 begin
5504 pragma Assert (Is_Type (Id));
5505 Set_Flag109 (Id, V);
5506 end Set_Is_Non_Static_Subtype;
5508 procedure Set_Is_Null_Init_Proc (Id : E; V : B := True) is
5509 begin
5510 pragma Assert (Ekind (Id) = E_Procedure);
5511 Set_Flag178 (Id, V);
5512 end Set_Is_Null_Init_Proc;
5514 procedure Set_Is_Obsolescent (Id : E; V : B := True) is
5515 begin
5516 Set_Flag153 (Id, V);
5517 end Set_Is_Obsolescent;
5519 procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True) is
5520 begin
5521 pragma Assert (Ekind (Id) = E_Out_Parameter);
5522 Set_Flag226 (Id, V);
5523 end Set_Is_Only_Out_Parameter;
5525 procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is
5526 begin
5527 Set_Flag160 (Id, V);
5528 end Set_Is_Package_Body_Entity;
5530 procedure Set_Is_Packed (Id : E; V : B := True) is
5531 begin
5532 pragma Assert (Id = Base_Type (Id));
5533 Set_Flag51 (Id, V);
5534 end Set_Is_Packed;
5536 procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True) is
5537 begin
5538 Set_Flag138 (Id, V);
5539 end Set_Is_Packed_Array_Impl_Type;
5541 procedure Set_Is_Param_Block_Component_Type (Id : E; V : B := True) is
5542 begin
5543 pragma Assert (Ekind_In (Id, E_Void, E_General_Access_Type));
5544 Set_Flag215 (Id, V);
5545 end Set_Is_Param_Block_Component_Type;
5547 procedure Set_Is_Partial_Invariant_Procedure (Id : E; V : B := True) is
5548 begin
5549 pragma Assert (Ekind (Id) = E_Procedure);
5550 Set_Flag292 (Id, V);
5551 end Set_Is_Partial_Invariant_Procedure;
5553 procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is
5554 begin
5555 pragma Assert (Nkind (Id) in N_Entity);
5556 Set_Flag9 (Id, V);
5557 end Set_Is_Potentially_Use_Visible;
5559 procedure Set_Is_Predicate_Function (Id : E; V : B := True) is
5560 begin
5561 pragma Assert (Ekind (Id) = E_Function);
5562 Set_Flag255 (Id, V);
5563 end Set_Is_Predicate_Function;
5565 procedure Set_Is_Predicate_Function_M (Id : E; V : B := True) is
5566 begin
5567 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5568 Set_Flag256 (Id, V);
5569 end Set_Is_Predicate_Function_M;
5571 procedure Set_Is_Preelaborated (Id : E; V : B := True) is
5572 begin
5573 Set_Flag59 (Id, V);
5574 end Set_Is_Preelaborated;
5576 procedure Set_Is_Primitive (Id : E; V : B := True) is
5577 begin
5578 pragma Assert
5579 (Is_Overloadable (Id)
5580 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
5581 Set_Flag218 (Id, V);
5582 end Set_Is_Primitive;
5584 procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is
5585 begin
5586 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5587 Set_Flag195 (Id, V);
5588 end Set_Is_Primitive_Wrapper;
5590 procedure Set_Is_Private_Composite (Id : E; V : B := True) is
5591 begin
5592 pragma Assert (Is_Type (Id));
5593 Set_Flag107 (Id, V);
5594 end Set_Is_Private_Composite;
5596 procedure Set_Is_Private_Descendant (Id : E; V : B := True) is
5597 begin
5598 Set_Flag53 (Id, V);
5599 end Set_Is_Private_Descendant;
5601 procedure Set_Is_Private_Primitive (Id : E; V : B := True) is
5602 begin
5603 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5604 Set_Flag245 (Id, V);
5605 end Set_Is_Private_Primitive;
5607 procedure Set_Is_Public (Id : E; V : B := True) is
5608 begin
5609 pragma Assert (Nkind (Id) in N_Entity);
5610 Set_Flag10 (Id, V);
5611 end Set_Is_Public;
5613 procedure Set_Is_Pure (Id : E; V : B := True) is
5614 begin
5615 Set_Flag44 (Id, V);
5616 end Set_Is_Pure;
5618 procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True) is
5619 begin
5620 pragma Assert (Is_Access_Type (Id));
5621 Set_Flag189 (Id, V);
5622 end Set_Is_Pure_Unit_Access_Type;
5624 procedure Set_Is_RACW_Stub_Type (Id : E; V : B := True) is
5625 begin
5626 pragma Assert (Is_Type (Id));
5627 Set_Flag244 (Id, V);
5628 end Set_Is_RACW_Stub_Type;
5630 procedure Set_Is_Raised (Id : E; V : B := True) is
5631 begin
5632 pragma Assert (Ekind (Id) = E_Exception);
5633 Set_Flag224 (Id, V);
5634 end Set_Is_Raised;
5636 procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True) is
5637 begin
5638 Set_Flag62 (Id, V);
5639 end Set_Is_Remote_Call_Interface;
5641 procedure Set_Is_Remote_Types (Id : E; V : B := True) is
5642 begin
5643 Set_Flag61 (Id, V);
5644 end Set_Is_Remote_Types;
5646 procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True) is
5647 begin
5648 Set_Flag112 (Id, V);
5649 end Set_Is_Renaming_Of_Object;
5651 procedure Set_Is_Return_Object (Id : E; V : B := True) is
5652 begin
5653 Set_Flag209 (Id, V);
5654 end Set_Is_Return_Object;
5656 procedure Set_Is_Safe_To_Reevaluate (Id : E; V : B := True) is
5657 begin
5658 pragma Assert (Ekind (Id) = E_Variable);
5659 Set_Flag249 (Id, V);
5660 end Set_Is_Safe_To_Reevaluate;
5662 procedure Set_Is_Shared_Passive (Id : E; V : B := True) is
5663 begin
5664 Set_Flag60 (Id, V);
5665 end Set_Is_Shared_Passive;
5667 procedure Set_Is_Static_Type (Id : E; V : B := True) is
5668 begin
5669 pragma Assert (Is_Type (Id));
5670 Set_Flag281 (Id, V);
5671 end Set_Is_Static_Type;
5673 procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is
5674 begin
5675 pragma Assert
5676 (Is_Type (Id)
5677 or else Ekind_In (Id, E_Exception,
5678 E_Variable,
5679 E_Constant,
5680 E_Void));
5681 Set_Flag28 (Id, V);
5682 end Set_Is_Statically_Allocated;
5684 procedure Set_Is_Tag (Id : E; V : B := True) is
5685 begin
5686 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
5687 Set_Flag78 (Id, V);
5688 end Set_Is_Tag;
5690 procedure Set_Is_Tagged_Type (Id : E; V : B := True) is
5691 begin
5692 Set_Flag55 (Id, V);
5693 end Set_Is_Tagged_Type;
5695 procedure Set_Is_Thunk (Id : E; V : B := True) is
5696 begin
5697 pragma Assert (Is_Subprogram (Id));
5698 Set_Flag225 (Id, V);
5699 end Set_Is_Thunk;
5701 procedure Set_Is_Trivial_Subprogram (Id : E; V : B := True) is
5702 begin
5703 Set_Flag235 (Id, V);
5704 end Set_Is_Trivial_Subprogram;
5706 procedure Set_Is_True_Constant (Id : E; V : B := True) is
5707 begin
5708 Set_Flag163 (Id, V);
5709 end Set_Is_True_Constant;
5711 procedure Set_Is_Unchecked_Union (Id : E; V : B := True) is
5712 begin
5713 pragma Assert (Id = Base_Type (Id));
5714 Set_Flag117 (Id, V);
5715 end Set_Is_Unchecked_Union;
5717 procedure Set_Is_Underlying_Full_View (Id : E; V : B := True) is
5718 begin
5719 pragma Assert (Is_Type (Id));
5720 Set_Flag298 (Id, V);
5721 end Set_Is_Underlying_Full_View;
5723 procedure Set_Is_Underlying_Record_View (Id : E; V : B := True) is
5724 begin
5725 pragma Assert (Ekind (Id) = E_Record_Type);
5726 Set_Flag246 (Id, V);
5727 end Set_Is_Underlying_Record_View;
5729 procedure Set_Is_Unimplemented (Id : E; V : B := True) is
5730 begin
5731 Set_Flag284 (Id, V);
5732 end Set_Is_Unimplemented;
5734 procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
5735 begin
5736 pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
5737 Set_Flag144 (Id, V);
5738 end Set_Is_Unsigned_Type;
5740 procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is
5741 begin
5742 pragma Assert
5743 (Ekind_In (Id, E_Constant, E_Variable)
5744 or else Is_Formal (Id)
5745 or else Is_Type (Id));
5746 Set_Flag283 (Id, V);
5747 end Set_Is_Uplevel_Referenced_Entity;
5749 procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
5750 begin
5751 pragma Assert (Ekind (Id) = E_Procedure);
5752 Set_Flag127 (Id, V);
5753 end Set_Is_Valued_Procedure;
5755 procedure Set_Is_Visible_Formal (Id : E; V : B := True) is
5756 begin
5757 Set_Flag206 (Id, V);
5758 end Set_Is_Visible_Formal;
5760 procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True) is
5761 begin
5762 Set_Flag116 (Id, V);
5763 end Set_Is_Visible_Lib_Unit;
5765 procedure Set_Is_Volatile (Id : E; V : B := True) is
5766 begin
5767 pragma Assert (Nkind (Id) in N_Entity);
5768 Set_Flag16 (Id, V);
5769 end Set_Is_Volatile;
5771 procedure Set_Is_Volatile_Full_Access (Id : E; V : B := True) is
5772 begin
5773 Set_Flag285 (Id, V);
5774 end Set_Is_Volatile_Full_Access;
5776 procedure Set_Itype_Printed (Id : E; V : B := True) is
5777 begin
5778 pragma Assert (Is_Itype (Id));
5779 Set_Flag202 (Id, V);
5780 end Set_Itype_Printed;
5782 procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is
5783 begin
5784 Set_Flag32 (Id, V);
5785 end Set_Kill_Elaboration_Checks;
5787 procedure Set_Kill_Range_Checks (Id : E; V : B := True) is
5788 begin
5789 Set_Flag33 (Id, V);
5790 end Set_Kill_Range_Checks;
5792 procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True) is
5793 begin
5794 pragma Assert (Is_Type (Id));
5795 Set_Flag207 (Id, V);
5796 end Set_Known_To_Have_Preelab_Init;
5798 procedure Set_Last_Aggregate_Assignment (Id : E; V : N) is
5799 begin
5800 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5801 Set_Node30 (Id, V);
5802 end Set_Last_Aggregate_Assignment;
5804 procedure Set_Last_Assignment (Id : E; V : N) is
5805 begin
5806 pragma Assert (Is_Assignable (Id));
5807 Set_Node26 (Id, V);
5808 end Set_Last_Assignment;
5810 procedure Set_Last_Entity (Id : E; V : E) is
5811 begin
5812 Set_Node20 (Id, V);
5813 end Set_Last_Entity;
5815 procedure Set_Limited_View (Id : E; V : E) is
5816 begin
5817 pragma Assert (Ekind (Id) = E_Package);
5818 Set_Node23 (Id, V);
5819 end Set_Limited_View;
5821 procedure Set_Linker_Section_Pragma (Id : E; V : N) is
5822 begin
5823 pragma Assert (Is_Type (Id)
5824 or else Ekind_In (Id, E_Constant, E_Variable)
5825 or else Is_Subprogram (Id));
5826 Set_Node33 (Id, V);
5827 end Set_Linker_Section_Pragma;
5829 procedure Set_Lit_Indexes (Id : E; V : E) is
5830 begin
5831 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
5832 Set_Node18 (Id, V);
5833 end Set_Lit_Indexes;
5835 procedure Set_Lit_Strings (Id : E; V : E) is
5836 begin
5837 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
5838 Set_Node16 (Id, V);
5839 end Set_Lit_Strings;
5841 procedure Set_Low_Bound_Tested (Id : E; V : B := True) is
5842 begin
5843 pragma Assert (Is_Formal (Id));
5844 Set_Flag205 (Id, V);
5845 end Set_Low_Bound_Tested;
5847 procedure Set_Machine_Radix_10 (Id : E; V : B := True) is
5848 begin
5849 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
5850 Set_Flag84 (Id, V);
5851 end Set_Machine_Radix_10;
5853 procedure Set_Master_Id (Id : E; V : E) is
5854 begin
5855 pragma Assert (Is_Access_Type (Id));
5856 Set_Node17 (Id, V);
5857 end Set_Master_Id;
5859 procedure Set_Materialize_Entity (Id : E; V : B := True) is
5860 begin
5861 Set_Flag168 (Id, V);
5862 end Set_Materialize_Entity;
5864 procedure Set_May_Inherit_Delayed_Rep_Aspects (Id : E; V : B := True) is
5865 begin
5866 Set_Flag262 (Id, V);
5867 end Set_May_Inherit_Delayed_Rep_Aspects;
5869 procedure Set_Mechanism (Id : E; V : M) is
5870 begin
5871 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
5872 Set_Uint8 (Id, UI_From_Int (V));
5873 end Set_Mechanism;
5875 procedure Set_Modulus (Id : E; V : U) is
5876 begin
5877 pragma Assert (Ekind (Id) = E_Modular_Integer_Type);
5878 Set_Uint17 (Id, V);
5879 end Set_Modulus;
5881 procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True) is
5882 begin
5883 pragma Assert (Is_Type (Id));
5884 Set_Flag183 (Id, V);
5885 end Set_Must_Be_On_Byte_Boundary;
5887 procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True) is
5888 begin
5889 pragma Assert (Is_Type (Id));
5890 Set_Flag208 (Id, V);
5891 end Set_Must_Have_Preelab_Init;
5893 procedure Set_Needs_Debug_Info (Id : E; V : B := True) is
5894 begin
5895 Set_Flag147 (Id, V);
5896 end Set_Needs_Debug_Info;
5898 procedure Set_Needs_No_Actuals (Id : E; V : B := True) is
5899 begin
5900 pragma Assert
5901 (Is_Overloadable (Id)
5902 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
5903 Set_Flag22 (Id, V);
5904 end Set_Needs_No_Actuals;
5906 procedure Set_Never_Set_In_Source (Id : E; V : B := True) is
5907 begin
5908 Set_Flag115 (Id, V);
5909 end Set_Never_Set_In_Source;
5911 procedure Set_Next_Inlined_Subprogram (Id : E; V : E) is
5912 begin
5913 Set_Node12 (Id, V);
5914 end Set_Next_Inlined_Subprogram;
5916 procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True) is
5917 begin
5918 pragma Assert (Is_Discrete_Type (Id));
5919 Set_Flag276 (Id, V);
5920 end Set_No_Dynamic_Predicate_On_Actual;
5922 procedure Set_No_Pool_Assigned (Id : E; V : B := True) is
5923 begin
5924 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
5925 Set_Flag131 (Id, V);
5926 end Set_No_Pool_Assigned;
5928 procedure Set_No_Predicate_On_Actual (Id : E; V : B := True) is
5929 begin
5930 pragma Assert (Is_Discrete_Type (Id));
5931 Set_Flag275 (Id, V);
5932 end Set_No_Predicate_On_Actual;
5934 procedure Set_No_Return (Id : E; V : B := True) is
5935 begin
5936 pragma Assert
5937 (V = False or else Ekind_In (Id, E_Procedure, E_Generic_Procedure));
5938 Set_Flag113 (Id, V);
5939 end Set_No_Return;
5941 procedure Set_No_Strict_Aliasing (Id : E; V : B := True) is
5942 begin
5943 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
5944 Set_Flag136 (Id, V);
5945 end Set_No_Strict_Aliasing;
5947 procedure Set_No_Tagged_Streams_Pragma (Id : E; V : E) is
5948 begin
5949 pragma Assert (Is_Tagged_Type (Id));
5950 Set_Node32 (Id, V);
5951 end Set_No_Tagged_Streams_Pragma;
5953 procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
5954 begin
5955 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
5956 Set_Flag58 (Id, V);
5957 end Set_Non_Binary_Modulus;
5959 procedure Set_Non_Limited_View (Id : E; V : E) is
5960 begin
5961 pragma Assert
5962 (Ekind (Id) in Incomplete_Kind
5963 or else Ekind_In (Id, E_Abstract_State, E_Class_Wide_Type));
5964 Set_Node19 (Id, V);
5965 end Set_Non_Limited_View;
5967 procedure Set_Nonzero_Is_True (Id : E; V : B := True) is
5968 begin
5969 pragma Assert
5970 (Root_Type (Id) = Standard_Boolean
5971 and then Ekind (Id) = E_Enumeration_Type);
5972 Set_Flag162 (Id, V);
5973 end Set_Nonzero_Is_True;
5975 procedure Set_Normalized_First_Bit (Id : E; V : U) is
5976 begin
5977 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
5978 Set_Uint8 (Id, V);
5979 end Set_Normalized_First_Bit;
5981 procedure Set_Normalized_Position (Id : E; V : U) is
5982 begin
5983 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
5984 Set_Uint14 (Id, V);
5985 end Set_Normalized_Position;
5987 procedure Set_Normalized_Position_Max (Id : E; V : U) is
5988 begin
5989 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
5990 Set_Uint10 (Id, V);
5991 end Set_Normalized_Position_Max;
5993 procedure Set_OK_To_Rename (Id : E; V : B := True) is
5994 begin
5995 pragma Assert (Ekind (Id) = E_Variable);
5996 Set_Flag247 (Id, V);
5997 end Set_OK_To_Rename;
5999 procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is
6000 begin
6001 pragma Assert
6002 (Is_Record_Type (Id) and then Is_Base_Type (Id));
6003 Set_Flag239 (Id, V);
6004 end Set_OK_To_Reorder_Components;
6006 procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is
6007 begin
6008 pragma Assert
6009 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
6010 Set_Flag241 (Id, V);
6011 end Set_Optimize_Alignment_Space;
6013 procedure Set_Optimize_Alignment_Time (Id : E; V : B := True) is
6014 begin
6015 pragma Assert
6016 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
6017 Set_Flag242 (Id, V);
6018 end Set_Optimize_Alignment_Time;
6020 procedure Set_Original_Access_Type (Id : E; V : E) is
6021 begin
6022 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
6023 Set_Node28 (Id, V);
6024 end Set_Original_Access_Type;
6026 procedure Set_Original_Array_Type (Id : E; V : E) is
6027 begin
6028 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
6029 Set_Node21 (Id, V);
6030 end Set_Original_Array_Type;
6032 procedure Set_Original_Protected_Subprogram (Id : E; V : N) is
6033 begin
6034 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
6035 Set_Node41 (Id, V);
6036 end Set_Original_Protected_Subprogram;
6038 procedure Set_Original_Record_Component (Id : E; V : E) is
6039 begin
6040 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
6041 Set_Node22 (Id, V);
6042 end Set_Original_Record_Component;
6044 procedure Set_Overlays_Constant (Id : E; V : B := True) is
6045 begin
6046 Set_Flag243 (Id, V);
6047 end Set_Overlays_Constant;
6049 procedure Set_Overridden_Operation (Id : E; V : E) is
6050 begin
6051 pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
6052 Set_Node26 (Id, V);
6053 end Set_Overridden_Operation;
6055 procedure Set_Package_Instantiation (Id : E; V : N) is
6056 begin
6057 pragma Assert (Ekind_In (Id, E_Void, E_Generic_Package, E_Package));
6058 Set_Node26 (Id, V);
6059 end Set_Package_Instantiation;
6061 procedure Set_Packed_Array_Impl_Type (Id : E; V : E) is
6062 begin
6063 pragma Assert (Is_Array_Type (Id));
6064 Set_Node23 (Id, V);
6065 end Set_Packed_Array_Impl_Type;
6067 procedure Set_Parent_Subtype (Id : E; V : E) is
6068 begin
6069 pragma Assert (Ekind (Id) = E_Record_Type);
6070 Set_Node19 (Id, V);
6071 end Set_Parent_Subtype;
6073 procedure Set_Part_Of_Constituents (Id : E; V : L) is
6074 begin
6075 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
6076 Set_Elist10 (Id, V);
6077 end Set_Part_Of_Constituents;
6079 procedure Set_Part_Of_References (Id : E; V : L) is
6080 begin
6081 pragma Assert (Ekind (Id) = E_Variable);
6082 Set_Elist11 (Id, V);
6083 end Set_Part_Of_References;
6085 procedure Set_Partial_View_Has_Unknown_Discr (Id : E; V : B := True) is
6086 begin
6087 pragma Assert (Is_Type (Id));
6088 Set_Flag280 (Id, V);
6089 end Set_Partial_View_Has_Unknown_Discr;
6091 procedure Set_Pending_Access_Types (Id : E; V : L) is
6092 begin
6093 pragma Assert (Is_Type (Id));
6094 Set_Elist15 (Id, V);
6095 end Set_Pending_Access_Types;
6097 procedure Set_Postconditions_Proc (Id : E; V : E) is
6098 begin
6099 pragma Assert (Ekind_In (Id, E_Entry,
6100 E_Entry_Family,
6101 E_Function,
6102 E_Procedure));
6103 Set_Node14 (Id, V);
6104 end Set_Postconditions_Proc;
6106 procedure Set_Predicates_Ignored (Id : E; V : B) is
6107 begin
6108 pragma Assert (Is_Type (Id));
6109 Set_Flag288 (Id, V);
6110 end Set_Predicates_Ignored;
6112 procedure Set_Direct_Primitive_Operations (Id : E; V : L) is
6113 begin
6114 pragma Assert (Is_Tagged_Type (Id));
6115 Set_Elist10 (Id, V);
6116 end Set_Direct_Primitive_Operations;
6118 procedure Set_Prival (Id : E; V : E) is
6119 begin
6120 pragma Assert (Is_Protected_Component (Id));
6121 Set_Node17 (Id, V);
6122 end Set_Prival;
6124 procedure Set_Prival_Link (Id : E; V : E) is
6125 begin
6126 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
6127 Set_Node20 (Id, V);
6128 end Set_Prival_Link;
6130 procedure Set_Private_Dependents (Id : E; V : L) is
6131 begin
6132 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
6133 Set_Elist18 (Id, V);
6134 end Set_Private_Dependents;
6136 procedure Set_Private_View (Id : E; V : N) is
6137 begin
6138 pragma Assert (Is_Private_Type (Id));
6139 Set_Node22 (Id, V);
6140 end Set_Private_View;
6142 procedure Set_Protected_Body_Subprogram (Id : E; V : E) is
6143 begin
6144 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
6145 Set_Node11 (Id, V);
6146 end Set_Protected_Body_Subprogram;
6148 procedure Set_Protected_Formal (Id : E; V : E) is
6149 begin
6150 pragma Assert (Is_Formal (Id));
6151 Set_Node22 (Id, V);
6152 end Set_Protected_Formal;
6154 procedure Set_Protection_Object (Id : E; V : E) is
6155 begin
6156 pragma Assert (Ekind_In (Id, E_Entry,
6157 E_Entry_Family,
6158 E_Function,
6159 E_Procedure));
6160 Set_Node23 (Id, V);
6161 end Set_Protection_Object;
6163 procedure Set_Reachable (Id : E; V : B := True) is
6164 begin
6165 Set_Flag49 (Id, V);
6166 end Set_Reachable;
6168 procedure Set_Referenced (Id : E; V : B := True) is
6169 begin
6170 Set_Flag156 (Id, V);
6171 end Set_Referenced;
6173 procedure Set_Referenced_As_LHS (Id : E; V : B := True) is
6174 begin
6175 Set_Flag36 (Id, V);
6176 end Set_Referenced_As_LHS;
6178 procedure Set_Referenced_As_Out_Parameter (Id : E; V : B := True) is
6179 begin
6180 Set_Flag227 (Id, V);
6181 end Set_Referenced_As_Out_Parameter;
6183 procedure Set_Refinement_Constituents (Id : E; V : L) is
6184 begin
6185 pragma Assert (Ekind (Id) = E_Abstract_State);
6186 Set_Elist8 (Id, V);
6187 end Set_Refinement_Constituents;
6189 procedure Set_Register_Exception_Call (Id : E; V : N) is
6190 begin
6191 pragma Assert (Ekind (Id) = E_Exception);
6192 Set_Node20 (Id, V);
6193 end Set_Register_Exception_Call;
6195 procedure Set_Related_Array_Object (Id : E; V : E) is
6196 begin
6197 pragma Assert (Is_Array_Type (Id));
6198 Set_Node25 (Id, V);
6199 end Set_Related_Array_Object;
6201 procedure Set_Related_Expression (Id : E; V : N) is
6202 begin
6203 pragma Assert (Ekind (Id) in Type_Kind
6204 or else Ekind_In (Id, E_Constant, E_Variable, E_Void));
6205 Set_Node24 (Id, V);
6206 end Set_Related_Expression;
6208 procedure Set_Related_Instance (Id : E; V : E) is
6209 begin
6210 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
6211 Set_Node15 (Id, V);
6212 end Set_Related_Instance;
6214 procedure Set_Related_Type (Id : E; V : E) is
6215 begin
6216 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
6217 Set_Node27 (Id, V);
6218 end Set_Related_Type;
6220 procedure Set_Relative_Deadline_Variable (Id : E; V : E) is
6221 begin
6222 pragma Assert (Is_Task_Type (Id) and then Is_Base_Type (Id));
6223 Set_Node28 (Id, V);
6224 end Set_Relative_Deadline_Variable;
6226 procedure Set_Renamed_Entity (Id : E; V : N) is
6227 begin
6228 Set_Node18 (Id, V);
6229 end Set_Renamed_Entity;
6231 procedure Set_Renamed_In_Spec (Id : E; V : B := True) is
6232 begin
6233 pragma Assert (Ekind (Id) = E_Package);
6234 Set_Flag231 (Id, V);
6235 end Set_Renamed_In_Spec;
6237 procedure Set_Renamed_Object (Id : E; V : N) is
6238 begin
6239 Set_Node18 (Id, V);
6240 end Set_Renamed_Object;
6242 procedure Set_Renaming_Map (Id : E; V : U) is
6243 begin
6244 Set_Uint9 (Id, V);
6245 end Set_Renaming_Map;
6247 procedure Set_Requires_Overriding (Id : E; V : B := True) is
6248 begin
6249 pragma Assert (Is_Overloadable (Id));
6250 Set_Flag213 (Id, V);
6251 end Set_Requires_Overriding;
6253 procedure Set_Return_Present (Id : E; V : B := True) is
6254 begin
6255 Set_Flag54 (Id, V);
6256 end Set_Return_Present;
6258 procedure Set_Return_Applies_To (Id : E; V : N) is
6259 begin
6260 Set_Node8 (Id, V);
6261 end Set_Return_Applies_To;
6263 procedure Set_Returns_By_Ref (Id : E; V : B := True) is
6264 begin
6265 Set_Flag90 (Id, V);
6266 end Set_Returns_By_Ref;
6268 procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
6269 begin
6270 pragma Assert
6271 (Is_Record_Type (Id) and then Is_Base_Type (Id));
6272 Set_Flag164 (Id, V);
6273 end Set_Reverse_Bit_Order;
6275 procedure Set_Reverse_Storage_Order (Id : E; V : B := True) is
6276 begin
6277 pragma Assert
6278 (Is_Base_Type (Id)
6279 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
6280 Set_Flag93 (Id, V);
6281 end Set_Reverse_Storage_Order;
6283 procedure Set_Rewritten_For_C (Id : E; V : B := True) is
6284 begin
6285 pragma Assert (Ekind (Id) = E_Function);
6286 Set_Flag287 (Id, V);
6287 end Set_Rewritten_For_C;
6289 procedure Set_RM_Size (Id : E; V : U) is
6290 begin
6291 pragma Assert (Is_Type (Id));
6292 Set_Uint13 (Id, V);
6293 end Set_RM_Size;
6295 procedure Set_Scalar_Range (Id : E; V : N) is
6296 begin
6297 Set_Node20 (Id, V);
6298 end Set_Scalar_Range;
6300 procedure Set_Scale_Value (Id : E; V : U) is
6301 begin
6302 Set_Uint16 (Id, V);
6303 end Set_Scale_Value;
6305 procedure Set_Scope_Depth_Value (Id : E; V : U) is
6306 begin
6307 pragma Assert (not Is_Record_Type (Id));
6308 Set_Uint22 (Id, V);
6309 end Set_Scope_Depth_Value;
6311 procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True) is
6312 begin
6313 Set_Flag167 (Id, V);
6314 end Set_Sec_Stack_Needed_For_Return;
6316 procedure Set_Shadow_Entities (Id : E; V : S) is
6317 begin
6318 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
6319 Set_List14 (Id, V);
6320 end Set_Shadow_Entities;
6322 procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is
6323 begin
6324 pragma Assert (Ekind (Id) = E_Variable);
6325 Set_Node22 (Id, V);
6326 end Set_Shared_Var_Procs_Instance;
6328 procedure Set_Size_Check_Code (Id : E; V : N) is
6329 begin
6330 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
6331 Set_Node19 (Id, V);
6332 end Set_Size_Check_Code;
6334 procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True) is
6335 begin
6336 Set_Flag177 (Id, V);
6337 end Set_Size_Depends_On_Discriminant;
6339 procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True) is
6340 begin
6341 Set_Flag92 (Id, V);
6342 end Set_Size_Known_At_Compile_Time;
6344 procedure Set_Small_Value (Id : E; V : R) is
6345 begin
6346 pragma Assert (Is_Fixed_Point_Type (Id));
6347 Set_Ureal21 (Id, V);
6348 end Set_Small_Value;
6350 procedure Set_SPARK_Aux_Pragma (Id : E; V : N) is
6351 begin
6352 pragma Assert
6353 (Ekind_In (Id, E_Protected_Type, -- concurrent variants
6354 E_Task_Type)
6355 or else
6356 Ekind_In (Id, E_Generic_Package, -- package variants
6357 E_Package,
6358 E_Package_Body));
6359 Set_Node41 (Id, V);
6360 end Set_SPARK_Aux_Pragma;
6362 procedure Set_SPARK_Aux_Pragma_Inherited (Id : E; V : B := True) is
6363 begin
6364 pragma Assert
6365 (Ekind_In (Id, E_Protected_Type, -- concurrent variants
6366 E_Task_Type)
6367 or else
6368 Ekind_In (Id, E_Generic_Package, -- package variants
6369 E_Package,
6370 E_Package_Body));
6371 Set_Flag266 (Id, V);
6372 end Set_SPARK_Aux_Pragma_Inherited;
6374 procedure Set_SPARK_Pragma (Id : E; V : N) is
6375 begin
6376 pragma Assert
6377 (Ekind_In (Id, E_Protected_Body, -- concurrent variants
6378 E_Protected_Type,
6379 E_Task_Body,
6380 E_Task_Type)
6381 or else
6382 Ekind_In (Id, E_Entry, -- overloadable variants
6383 E_Entry_Family,
6384 E_Function,
6385 E_Generic_Function,
6386 E_Generic_Procedure,
6387 E_Operator,
6388 E_Procedure,
6389 E_Subprogram_Body)
6390 or else
6391 Ekind_In (Id, E_Generic_Package, -- package variants
6392 E_Package,
6393 E_Package_Body)
6394 or else
6395 Ekind (Id) = E_Variable); -- variable
6396 Set_Node40 (Id, V);
6397 end Set_SPARK_Pragma;
6399 procedure Set_SPARK_Pragma_Inherited (Id : E; V : B := True) is
6400 begin
6401 pragma Assert
6402 (Ekind_In (Id, E_Protected_Body, -- concurrent variants
6403 E_Protected_Type,
6404 E_Task_Body,
6405 E_Task_Type)
6406 or else
6407 Ekind_In (Id, E_Entry, -- overloadable variants
6408 E_Entry_Family,
6409 E_Function,
6410 E_Generic_Function,
6411 E_Generic_Procedure,
6412 E_Operator,
6413 E_Procedure,
6414 E_Subprogram_Body)
6415 or else
6416 Ekind_In (Id, E_Generic_Package, -- package variants
6417 E_Package,
6418 E_Package_Body)
6419 or else
6420 Ekind (Id) = E_Variable); -- variable
6421 Set_Flag265 (Id, V);
6422 end Set_SPARK_Pragma_Inherited;
6424 procedure Set_Spec_Entity (Id : E; V : E) is
6425 begin
6426 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
6427 Set_Node19 (Id, V);
6428 end Set_Spec_Entity;
6430 procedure Set_SSO_Set_High_By_Default (Id : E; V : B := True) is
6431 begin
6432 pragma Assert
6433 (Is_Base_Type (Id)
6434 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
6435 Set_Flag273 (Id, V);
6436 end Set_SSO_Set_High_By_Default;
6438 procedure Set_SSO_Set_Low_By_Default (Id : E; V : B := True) is
6439 begin
6440 pragma Assert
6441 (Is_Base_Type (Id)
6442 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
6443 Set_Flag272 (Id, V);
6444 end Set_SSO_Set_Low_By_Default;
6446 procedure Set_Static_Discrete_Predicate (Id : E; V : S) is
6447 begin
6448 pragma Assert (Is_Discrete_Type (Id) and then Has_Predicates (Id));
6449 Set_List25 (Id, V);
6450 end Set_Static_Discrete_Predicate;
6452 procedure Set_Static_Real_Or_String_Predicate (Id : E; V : N) is
6453 begin
6454 pragma Assert ((Is_Real_Type (Id) or else Is_String_Type (Id))
6455 and then Has_Predicates (Id));
6456 Set_Node25 (Id, V);
6457 end Set_Static_Real_Or_String_Predicate;
6459 procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E) is
6460 begin
6461 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
6462 Set_Node15 (Id, V);
6463 end Set_Status_Flag_Or_Transient_Decl;
6465 procedure Set_Storage_Size_Variable (Id : E; V : E) is
6466 begin
6467 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
6468 pragma Assert (Id = Base_Type (Id));
6469 Set_Node26 (Id, V);
6470 end Set_Storage_Size_Variable;
6472 procedure Set_Static_Elaboration_Desired (Id : E; V : B) is
6473 begin
6474 pragma Assert (Ekind (Id) = E_Package);
6475 Set_Flag77 (Id, V);
6476 end Set_Static_Elaboration_Desired;
6478 procedure Set_Static_Initialization (Id : E; V : N) is
6479 begin
6480 pragma Assert
6481 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
6482 Set_Node30 (Id, V);
6483 end Set_Static_Initialization;
6485 procedure Set_Stored_Constraint (Id : E; V : L) is
6486 begin
6487 pragma Assert (Nkind (Id) in N_Entity);
6488 Set_Elist23 (Id, V);
6489 end Set_Stored_Constraint;
6491 procedure Set_Stores_Attribute_Old_Prefix (Id : E; V : B := True) is
6492 begin
6493 pragma Assert (Ekind (Id) = E_Constant);
6494 Set_Flag270 (Id, V);
6495 end Set_Stores_Attribute_Old_Prefix;
6497 procedure Set_Strict_Alignment (Id : E; V : B := True) is
6498 begin
6499 pragma Assert (Id = Base_Type (Id));
6500 Set_Flag145 (Id, V);
6501 end Set_Strict_Alignment;
6503 procedure Set_String_Literal_Length (Id : E; V : U) is
6504 begin
6505 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
6506 Set_Uint16 (Id, V);
6507 end Set_String_Literal_Length;
6509 procedure Set_String_Literal_Low_Bound (Id : E; V : N) is
6510 begin
6511 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
6512 Set_Node18 (Id, V);
6513 end Set_String_Literal_Low_Bound;
6515 procedure Set_Subprograms_For_Type (Id : E; V : L) is
6516 begin
6517 pragma Assert (Is_Type (Id));
6518 Set_Elist29 (Id, V);
6519 end Set_Subprograms_For_Type;
6521 procedure Set_Subps_Index (Id : E; V : U) is
6522 begin
6523 pragma Assert (Is_Subprogram (Id));
6524 Set_Uint24 (Id, V);
6525 end Set_Subps_Index;
6527 procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is
6528 begin
6529 Set_Flag148 (Id, V);
6530 end Set_Suppress_Elaboration_Warnings;
6532 procedure Set_Suppress_Initialization (Id : E; V : B := True) is
6533 begin
6534 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
6535 Set_Flag105 (Id, V);
6536 end Set_Suppress_Initialization;
6538 procedure Set_Suppress_Style_Checks (Id : E; V : B := True) is
6539 begin
6540 Set_Flag165 (Id, V);
6541 end Set_Suppress_Style_Checks;
6543 procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True) is
6544 begin
6545 Set_Flag217 (Id, V);
6546 end Set_Suppress_Value_Tracking_On_Call;
6548 procedure Set_Task_Body_Procedure (Id : E; V : N) is
6549 begin
6550 pragma Assert (Ekind (Id) in Task_Kind);
6551 Set_Node25 (Id, V);
6552 end Set_Task_Body_Procedure;
6554 procedure Set_Thunk_Entity (Id : E; V : E) is
6555 begin
6556 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
6557 and then Is_Thunk (Id));
6558 Set_Node31 (Id, V);
6559 end Set_Thunk_Entity;
6561 procedure Set_Treat_As_Volatile (Id : E; V : B := True) is
6562 begin
6563 Set_Flag41 (Id, V);
6564 end Set_Treat_As_Volatile;
6566 procedure Set_Underlying_Full_View (Id : E; V : E) is
6567 begin
6568 pragma Assert (Ekind (Id) in Private_Kind);
6569 Set_Node19 (Id, V);
6570 end Set_Underlying_Full_View;
6572 procedure Set_Underlying_Record_View (Id : E; V : E) is
6573 begin
6574 pragma Assert (Ekind (Id) = E_Record_Type);
6575 Set_Node28 (Id, V);
6576 end Set_Underlying_Record_View;
6578 procedure Set_Universal_Aliasing (Id : E; V : B := True) is
6579 begin
6580 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
6581 Set_Flag216 (Id, V);
6582 end Set_Universal_Aliasing;
6584 procedure Set_Unset_Reference (Id : E; V : N) is
6585 begin
6586 Set_Node16 (Id, V);
6587 end Set_Unset_Reference;
6589 procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
6590 begin
6591 Set_Flag222 (Id, V);
6592 end Set_Used_As_Generic_Actual;
6594 procedure Set_Uses_Lock_Free (Id : E; V : B := True) is
6595 begin
6596 pragma Assert (Ekind (Id) = E_Protected_Type);
6597 Set_Flag188 (Id, V);
6598 end Set_Uses_Lock_Free;
6600 procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
6601 begin
6602 Set_Flag95 (Id, V);
6603 end Set_Uses_Sec_Stack;
6605 procedure Set_Warnings_Off (Id : E; V : B := True) is
6606 begin
6607 Set_Flag96 (Id, V);
6608 end Set_Warnings_Off;
6610 procedure Set_Warnings_Off_Used (Id : E; V : B := True) is
6611 begin
6612 Set_Flag236 (Id, V);
6613 end Set_Warnings_Off_Used;
6615 procedure Set_Warnings_Off_Used_Unmodified (Id : E; V : B := True) is
6616 begin
6617 Set_Flag237 (Id, V);
6618 end Set_Warnings_Off_Used_Unmodified;
6620 procedure Set_Warnings_Off_Used_Unreferenced (Id : E; V : B := True) is
6621 begin
6622 Set_Flag238 (Id, V);
6623 end Set_Warnings_Off_Used_Unreferenced;
6625 procedure Set_Was_Hidden (Id : E; V : B := True) is
6626 begin
6627 Set_Flag196 (Id, V);
6628 end Set_Was_Hidden;
6630 procedure Set_Wrapped_Entity (Id : E; V : E) is
6631 begin
6632 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
6633 and then Is_Primitive_Wrapper (Id));
6634 Set_Node27 (Id, V);
6635 end Set_Wrapped_Entity;
6637 -----------------------------------
6638 -- Field Initialization Routines --
6639 -----------------------------------
6641 procedure Init_Alignment (Id : E) is
6642 begin
6643 Set_Uint14 (Id, Uint_0);
6644 end Init_Alignment;
6646 procedure Init_Alignment (Id : E; V : Int) is
6647 begin
6648 Set_Uint14 (Id, UI_From_Int (V));
6649 end Init_Alignment;
6651 procedure Init_Component_Bit_Offset (Id : E) is
6652 begin
6653 Set_Uint11 (Id, No_Uint);
6654 end Init_Component_Bit_Offset;
6656 procedure Init_Component_Bit_Offset (Id : E; V : Int) is
6657 begin
6658 Set_Uint11 (Id, UI_From_Int (V));
6659 end Init_Component_Bit_Offset;
6661 procedure Init_Component_Size (Id : E) is
6662 begin
6663 Set_Uint22 (Id, Uint_0);
6664 end Init_Component_Size;
6666 procedure Init_Component_Size (Id : E; V : Int) is
6667 begin
6668 Set_Uint22 (Id, UI_From_Int (V));
6669 end Init_Component_Size;
6671 procedure Init_Digits_Value (Id : E) is
6672 begin
6673 Set_Uint17 (Id, Uint_0);
6674 end Init_Digits_Value;
6676 procedure Init_Digits_Value (Id : E; V : Int) is
6677 begin
6678 Set_Uint17 (Id, UI_From_Int (V));
6679 end Init_Digits_Value;
6681 procedure Init_Esize (Id : E) is
6682 begin
6683 Set_Uint12 (Id, Uint_0);
6684 end Init_Esize;
6686 procedure Init_Esize (Id : E; V : Int) is
6687 begin
6688 Set_Uint12 (Id, UI_From_Int (V));
6689 end Init_Esize;
6691 procedure Init_Normalized_First_Bit (Id : E) is
6692 begin
6693 Set_Uint8 (Id, No_Uint);
6694 end Init_Normalized_First_Bit;
6696 procedure Init_Normalized_First_Bit (Id : E; V : Int) is
6697 begin
6698 Set_Uint8 (Id, UI_From_Int (V));
6699 end Init_Normalized_First_Bit;
6701 procedure Init_Normalized_Position (Id : E) is
6702 begin
6703 Set_Uint14 (Id, No_Uint);
6704 end Init_Normalized_Position;
6706 procedure Init_Normalized_Position (Id : E; V : Int) is
6707 begin
6708 Set_Uint14 (Id, UI_From_Int (V));
6709 end Init_Normalized_Position;
6711 procedure Init_Normalized_Position_Max (Id : E) is
6712 begin
6713 Set_Uint10 (Id, No_Uint);
6714 end Init_Normalized_Position_Max;
6716 procedure Init_Normalized_Position_Max (Id : E; V : Int) is
6717 begin
6718 Set_Uint10 (Id, UI_From_Int (V));
6719 end Init_Normalized_Position_Max;
6721 procedure Init_RM_Size (Id : E) is
6722 begin
6723 Set_Uint13 (Id, Uint_0);
6724 end Init_RM_Size;
6726 procedure Init_RM_Size (Id : E; V : Int) is
6727 begin
6728 Set_Uint13 (Id, UI_From_Int (V));
6729 end Init_RM_Size;
6731 -----------------------------
6732 -- Init_Component_Location --
6733 -----------------------------
6735 procedure Init_Component_Location (Id : E) is
6736 begin
6737 Set_Uint8 (Id, No_Uint); -- Normalized_First_Bit
6738 Set_Uint10 (Id, No_Uint); -- Normalized_Position_Max
6739 Set_Uint11 (Id, No_Uint); -- Component_Bit_Offset
6740 Set_Uint12 (Id, Uint_0); -- Esize
6741 Set_Uint14 (Id, No_Uint); -- Normalized_Position
6742 end Init_Component_Location;
6744 ----------------------------
6745 -- Init_Object_Size_Align --
6746 ----------------------------
6748 procedure Init_Object_Size_Align (Id : E) is
6749 begin
6750 Set_Uint12 (Id, Uint_0); -- Esize
6751 Set_Uint14 (Id, Uint_0); -- Alignment
6752 end Init_Object_Size_Align;
6754 ---------------
6755 -- Init_Size --
6756 ---------------
6758 procedure Init_Size (Id : E; V : Int) is
6759 begin
6760 pragma Assert (not Is_Object (Id));
6761 Set_Uint12 (Id, UI_From_Int (V)); -- Esize
6762 Set_Uint13 (Id, UI_From_Int (V)); -- RM_Size
6763 end Init_Size;
6765 ---------------------
6766 -- Init_Size_Align --
6767 ---------------------
6769 procedure Init_Size_Align (Id : E) is
6770 begin
6771 pragma Assert (not Is_Object (Id));
6772 Set_Uint12 (Id, Uint_0); -- Esize
6773 Set_Uint13 (Id, Uint_0); -- RM_Size
6774 Set_Uint14 (Id, Uint_0); -- Alignment
6775 end Init_Size_Align;
6777 ----------------------------------------------
6778 -- Type Representation Attribute Predicates --
6779 ----------------------------------------------
6781 function Known_Alignment (E : Entity_Id) return B is
6782 begin
6783 return Uint14 (E) /= Uint_0
6784 and then Uint14 (E) /= No_Uint;
6785 end Known_Alignment;
6787 function Known_Component_Bit_Offset (E : Entity_Id) return B is
6788 begin
6789 return Uint11 (E) /= No_Uint;
6790 end Known_Component_Bit_Offset;
6792 function Known_Component_Size (E : Entity_Id) return B is
6793 begin
6794 return Uint22 (Base_Type (E)) /= Uint_0
6795 and then Uint22 (Base_Type (E)) /= No_Uint;
6796 end Known_Component_Size;
6798 function Known_Esize (E : Entity_Id) return B is
6799 begin
6800 return Uint12 (E) /= Uint_0
6801 and then Uint12 (E) /= No_Uint;
6802 end Known_Esize;
6804 function Known_Normalized_First_Bit (E : Entity_Id) return B is
6805 begin
6806 return Uint8 (E) /= No_Uint;
6807 end Known_Normalized_First_Bit;
6809 function Known_Normalized_Position (E : Entity_Id) return B is
6810 begin
6811 return Uint14 (E) /= No_Uint;
6812 end Known_Normalized_Position;
6814 function Known_Normalized_Position_Max (E : Entity_Id) return B is
6815 begin
6816 return Uint10 (E) /= No_Uint;
6817 end Known_Normalized_Position_Max;
6819 function Known_RM_Size (E : Entity_Id) return B is
6820 begin
6821 return Uint13 (E) /= No_Uint
6822 and then (Uint13 (E) /= Uint_0
6823 or else Is_Discrete_Type (E)
6824 or else Is_Fixed_Point_Type (E));
6825 end Known_RM_Size;
6827 function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is
6828 begin
6829 return Uint11 (E) /= No_Uint
6830 and then Uint11 (E) >= Uint_0;
6831 end Known_Static_Component_Bit_Offset;
6833 function Known_Static_Component_Size (E : Entity_Id) return B is
6834 begin
6835 return Uint22 (Base_Type (E)) > Uint_0;
6836 end Known_Static_Component_Size;
6838 function Known_Static_Esize (E : Entity_Id) return B is
6839 begin
6840 return Uint12 (E) > Uint_0
6841 and then not Is_Generic_Type (E);
6842 end Known_Static_Esize;
6844 function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is
6845 begin
6846 return Uint8 (E) /= No_Uint
6847 and then Uint8 (E) >= Uint_0;
6848 end Known_Static_Normalized_First_Bit;
6850 function Known_Static_Normalized_Position (E : Entity_Id) return B is
6851 begin
6852 return Uint14 (E) /= No_Uint
6853 and then Uint14 (E) >= Uint_0;
6854 end Known_Static_Normalized_Position;
6856 function Known_Static_Normalized_Position_Max (E : Entity_Id) return B is
6857 begin
6858 return Uint10 (E) /= No_Uint
6859 and then Uint10 (E) >= Uint_0;
6860 end Known_Static_Normalized_Position_Max;
6862 function Known_Static_RM_Size (E : Entity_Id) return B is
6863 begin
6864 return (Uint13 (E) > Uint_0
6865 or else Is_Discrete_Type (E)
6866 or else Is_Fixed_Point_Type (E))
6867 and then not Is_Generic_Type (E);
6868 end Known_Static_RM_Size;
6870 function Unknown_Alignment (E : Entity_Id) return B is
6871 begin
6872 return Uint14 (E) = Uint_0
6873 or else Uint14 (E) = No_Uint;
6874 end Unknown_Alignment;
6876 function Unknown_Component_Bit_Offset (E : Entity_Id) return B is
6877 begin
6878 return Uint11 (E) = No_Uint;
6879 end Unknown_Component_Bit_Offset;
6881 function Unknown_Component_Size (E : Entity_Id) return B is
6882 begin
6883 return Uint22 (Base_Type (E)) = Uint_0
6884 or else
6885 Uint22 (Base_Type (E)) = No_Uint;
6886 end Unknown_Component_Size;
6888 function Unknown_Esize (E : Entity_Id) return B is
6889 begin
6890 return Uint12 (E) = No_Uint
6891 or else
6892 Uint12 (E) = Uint_0;
6893 end Unknown_Esize;
6895 function Unknown_Normalized_First_Bit (E : Entity_Id) return B is
6896 begin
6897 return Uint8 (E) = No_Uint;
6898 end Unknown_Normalized_First_Bit;
6900 function Unknown_Normalized_Position (E : Entity_Id) return B is
6901 begin
6902 return Uint14 (E) = No_Uint;
6903 end Unknown_Normalized_Position;
6905 function Unknown_Normalized_Position_Max (E : Entity_Id) return B is
6906 begin
6907 return Uint10 (E) = No_Uint;
6908 end Unknown_Normalized_Position_Max;
6910 function Unknown_RM_Size (E : Entity_Id) return B is
6911 begin
6912 return (Uint13 (E) = Uint_0
6913 and then not Is_Discrete_Type (E)
6914 and then not Is_Fixed_Point_Type (E))
6915 or else Uint13 (E) = No_Uint;
6916 end Unknown_RM_Size;
6918 --------------------
6919 -- Address_Clause --
6920 --------------------
6922 function Address_Clause (Id : E) return N is
6923 begin
6924 return Get_Attribute_Definition_Clause (Id, Attribute_Address);
6925 end Address_Clause;
6927 ---------------
6928 -- Aft_Value --
6929 ---------------
6931 function Aft_Value (Id : E) return U is
6932 Result : Nat := 1;
6933 Delta_Val : Ureal := Delta_Value (Id);
6934 begin
6935 while Delta_Val < Ureal_Tenth loop
6936 Delta_Val := Delta_Val * Ureal_10;
6937 Result := Result + 1;
6938 end loop;
6940 return UI_From_Int (Result);
6941 end Aft_Value;
6943 ----------------------
6944 -- Alignment_Clause --
6945 ----------------------
6947 function Alignment_Clause (Id : E) return N is
6948 begin
6949 return Get_Attribute_Definition_Clause (Id, Attribute_Alignment);
6950 end Alignment_Clause;
6952 -------------------
6953 -- Append_Entity --
6954 -------------------
6956 procedure Append_Entity (Id : Entity_Id; V : Entity_Id) is
6957 begin
6958 if Last_Entity (V) = Empty then
6959 Set_First_Entity (Id => V, V => Id);
6960 else
6961 Set_Next_Entity (Last_Entity (V), Id);
6962 end if;
6964 Set_Next_Entity (Id, Empty);
6965 Set_Scope (Id, V);
6966 Set_Last_Entity (Id => V, V => Id);
6967 end Append_Entity;
6969 ---------------
6970 -- Base_Type --
6971 ---------------
6973 function Base_Type (Id : E) return E is
6974 begin
6975 if Is_Base_Type (Id) then
6976 return Id;
6977 else
6978 pragma Assert (Is_Type (Id));
6979 return Etype (Id);
6980 end if;
6981 end Base_Type;
6983 -------------------------
6984 -- Component_Alignment --
6985 -------------------------
6987 -- Component Alignment is encoded using two flags, Flag128/129 as
6988 -- follows. Note that both flags False = Align_Default, so that the
6989 -- default initialization of flags to False initializes component
6990 -- alignment to the default value as required.
6992 -- Flag128 Flag129 Value
6993 -- ------- ------- -----
6994 -- False False Calign_Default
6995 -- False True Calign_Component_Size
6996 -- True False Calign_Component_Size_4
6997 -- True True Calign_Storage_Unit
6999 function Component_Alignment (Id : E) return C is
7000 BT : constant Node_Id := Base_Type (Id);
7002 begin
7003 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
7005 if Flag128 (BT) then
7006 if Flag129 (BT) then
7007 return Calign_Storage_Unit;
7008 else
7009 return Calign_Component_Size_4;
7010 end if;
7012 else
7013 if Flag129 (BT) then
7014 return Calign_Component_Size;
7015 else
7016 return Calign_Default;
7017 end if;
7018 end if;
7019 end Component_Alignment;
7021 ----------------------
7022 -- Declaration_Node --
7023 ----------------------
7025 function Declaration_Node (Id : E) return N is
7026 P : Node_Id;
7028 begin
7029 if Ekind (Id) = E_Incomplete_Type
7030 and then Present (Full_View (Id))
7031 then
7032 P := Parent (Full_View (Id));
7033 else
7034 P := Parent (Id);
7035 end if;
7037 loop
7038 if Nkind (P) /= N_Selected_Component
7039 and then Nkind (P) /= N_Expanded_Name
7040 and then
7041 not (Nkind (P) = N_Defining_Program_Unit_Name
7042 and then Is_Child_Unit (Id))
7043 then
7044 return P;
7045 else
7046 P := Parent (P);
7047 end if;
7048 end loop;
7049 end Declaration_Node;
7051 ---------------------
7052 -- Designated_Type --
7053 ---------------------
7055 function Designated_Type (Id : E) return E is
7056 Desig_Type : E;
7058 begin
7059 Desig_Type := Directly_Designated_Type (Id);
7061 if Ekind (Desig_Type) = E_Incomplete_Type
7062 and then Present (Full_View (Desig_Type))
7063 then
7064 return Full_View (Desig_Type);
7066 elsif Is_Class_Wide_Type (Desig_Type)
7067 and then Ekind (Etype (Desig_Type)) = E_Incomplete_Type
7068 and then Present (Full_View (Etype (Desig_Type)))
7069 and then Present (Class_Wide_Type (Full_View (Etype (Desig_Type))))
7070 then
7071 return Class_Wide_Type (Full_View (Etype (Desig_Type)));
7073 else
7074 return Desig_Type;
7075 end if;
7076 end Designated_Type;
7078 -------------------
7079 -- DIC_Procedure --
7080 -------------------
7082 function DIC_Procedure (Id : E) return E is
7083 Subp_Elmt : Elmt_Id;
7084 Subp_Id : Entity_Id;
7085 Subps : Elist_Id;
7087 begin
7088 pragma Assert (Is_Type (Id));
7090 Subps := Subprograms_For_Type (Base_Type (Id));
7092 if Present (Subps) then
7093 Subp_Elmt := First_Elmt (Subps);
7094 while Present (Subp_Elmt) loop
7095 Subp_Id := Node (Subp_Elmt);
7097 if Is_DIC_Procedure (Subp_Id) then
7098 return Subp_Id;
7099 end if;
7101 Next_Elmt (Subp_Elmt);
7102 end loop;
7103 end if;
7105 return Empty;
7106 end DIC_Procedure;
7108 ----------------------
7109 -- Entry_Index_Type --
7110 ----------------------
7112 function Entry_Index_Type (Id : E) return N is
7113 begin
7114 pragma Assert (Ekind (Id) = E_Entry_Family);
7115 return Etype (Discrete_Subtype_Definition (Parent (Id)));
7116 end Entry_Index_Type;
7118 ---------------------
7119 -- First_Component --
7120 ---------------------
7122 function First_Component (Id : E) return E is
7123 Comp_Id : E;
7125 begin
7126 pragma Assert
7127 (Is_Concurrent_Type (Id)
7128 or else Is_Incomplete_Or_Private_Type (Id)
7129 or else Is_Record_Type (Id));
7131 Comp_Id := First_Entity (Id);
7132 while Present (Comp_Id) loop
7133 exit when Ekind (Comp_Id) = E_Component;
7134 Comp_Id := Next_Entity (Comp_Id);
7135 end loop;
7137 return Comp_Id;
7138 end First_Component;
7140 -------------------------------------
7141 -- First_Component_Or_Discriminant --
7142 -------------------------------------
7144 function First_Component_Or_Discriminant (Id : E) return E is
7145 Comp_Id : E;
7147 begin
7148 pragma Assert
7149 (Is_Concurrent_Type (Id)
7150 or else Is_Incomplete_Or_Private_Type (Id)
7151 or else Is_Record_Type (Id)
7152 or else Has_Discriminants (Id));
7154 Comp_Id := First_Entity (Id);
7155 while Present (Comp_Id) loop
7156 exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
7157 Comp_Id := Next_Entity (Comp_Id);
7158 end loop;
7160 return Comp_Id;
7161 end First_Component_Or_Discriminant;
7163 ------------------
7164 -- First_Formal --
7165 ------------------
7167 function First_Formal (Id : E) return E is
7168 Formal : E;
7170 begin
7171 pragma Assert
7172 (Is_Generic_Subprogram (Id)
7173 or else Is_Overloadable (Id)
7174 or else Ekind_In (Id, E_Entry_Family,
7175 E_Subprogram_Body,
7176 E_Subprogram_Type));
7178 if Ekind (Id) = E_Enumeration_Literal then
7179 return Empty;
7181 else
7182 Formal := First_Entity (Id);
7184 -- Deal with the common, non-generic case first
7186 if No (Formal) or else Is_Formal (Formal) then
7187 return Formal;
7188 end if;
7190 -- The first/next entity chain of a generic subprogram contains all
7191 -- generic formal parameters, followed by the formal parameters.
7193 if Is_Generic_Subprogram (Id) then
7194 while Present (Formal) and then not Is_Formal (Formal) loop
7195 Next_Entity (Formal);
7196 end loop;
7197 return Formal;
7198 else
7199 return Empty;
7200 end if;
7201 end if;
7202 end First_Formal;
7204 ------------------------------
7205 -- First_Formal_With_Extras --
7206 ------------------------------
7208 function First_Formal_With_Extras (Id : E) return E is
7209 Formal : E;
7211 begin
7212 pragma Assert
7213 (Is_Generic_Subprogram (Id)
7214 or else Is_Overloadable (Id)
7215 or else Ekind_In (Id, E_Entry_Family,
7216 E_Subprogram_Body,
7217 E_Subprogram_Type));
7219 if Ekind (Id) = E_Enumeration_Literal then
7220 return Empty;
7222 else
7223 Formal := First_Entity (Id);
7225 -- The first/next entity chain of a generic subprogram contains all
7226 -- generic formal parameters, followed by the formal parameters. Go
7227 -- directly to the parameters by skipping the formal part.
7229 if Is_Generic_Subprogram (Id) then
7230 while Present (Formal) and then not Is_Formal (Formal) loop
7231 Next_Entity (Formal);
7232 end loop;
7233 end if;
7235 if Present (Formal) and then Is_Formal (Formal) then
7236 return Formal;
7237 else
7238 return Extra_Formals (Id); -- Empty if no extra formals
7239 end if;
7240 end if;
7241 end First_Formal_With_Extras;
7243 -------------------------------------
7244 -- Get_Attribute_Definition_Clause --
7245 -------------------------------------
7247 function Get_Attribute_Definition_Clause
7248 (E : Entity_Id;
7249 Id : Attribute_Id) return Node_Id
7251 N : Node_Id;
7253 begin
7254 N := First_Rep_Item (E);
7255 while Present (N) loop
7256 if Nkind (N) = N_Attribute_Definition_Clause
7257 and then Get_Attribute_Id (Chars (N)) = Id
7258 then
7259 return N;
7260 else
7261 Next_Rep_Item (N);
7262 end if;
7263 end loop;
7265 return Empty;
7266 end Get_Attribute_Definition_Clause;
7268 -------------------
7269 -- Get_Full_View --
7270 -------------------
7272 function Get_Full_View (T : Entity_Id) return Entity_Id is
7273 begin
7274 if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then
7275 return Full_View (T);
7277 elsif Is_Class_Wide_Type (T)
7278 and then Ekind (Root_Type (T)) = E_Incomplete_Type
7279 and then Present (Full_View (Root_Type (T)))
7280 then
7281 return Class_Wide_Type (Full_View (Root_Type (T)));
7283 else
7284 return T;
7285 end if;
7286 end Get_Full_View;
7288 ----------------
7289 -- Get_Pragma --
7290 ----------------
7292 function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is
7294 -- Classification pragmas
7296 Is_CLS : constant Boolean :=
7297 Id = Pragma_Abstract_State or else
7298 Id = Pragma_Attach_Handler or else
7299 Id = Pragma_Async_Readers or else
7300 Id = Pragma_Async_Writers or else
7301 Id = Pragma_Constant_After_Elaboration or else
7302 Id = Pragma_Depends or else
7303 Id = Pragma_Effective_Reads or else
7304 Id = Pragma_Effective_Writes or else
7305 Id = Pragma_Extensions_Visible or else
7306 Id = Pragma_Global or else
7307 Id = Pragma_Initial_Condition or else
7308 Id = Pragma_Initializes or else
7309 Id = Pragma_Interrupt_Handler or else
7310 Id = Pragma_Part_Of or else
7311 Id = Pragma_Refined_Depends or else
7312 Id = Pragma_Refined_Global or else
7313 Id = Pragma_Refined_State or else
7314 Id = Pragma_Volatile_Function;
7316 -- Contract / test case pragmas
7318 Is_CTC : constant Boolean :=
7319 Id = Pragma_Contract_Cases or else
7320 Id = Pragma_Test_Case;
7322 -- Pre / postcondition pragmas
7324 Is_PPC : constant Boolean :=
7325 Id = Pragma_Precondition or else
7326 Id = Pragma_Postcondition or else
7327 Id = Pragma_Refined_Post;
7329 In_Contract : constant Boolean := Is_CLS or Is_CTC or Is_PPC;
7331 Item : Node_Id;
7332 Items : Node_Id;
7334 begin
7335 -- Handle pragmas that appear in N_Contract nodes. Those have to be
7336 -- extracted from their specialized list.
7338 if In_Contract then
7339 Items := Contract (E);
7341 if No (Items) then
7342 return Empty;
7344 elsif Is_CLS then
7345 Item := Classifications (Items);
7347 elsif Is_CTC then
7348 Item := Contract_Test_Cases (Items);
7350 else
7351 Item := Pre_Post_Conditions (Items);
7352 end if;
7354 -- Regular pragmas
7356 else
7357 Item := First_Rep_Item (E);
7358 end if;
7360 while Present (Item) loop
7361 if Nkind (Item) = N_Pragma
7362 and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id
7363 then
7364 return Item;
7366 -- All nodes in N_Contract are chained using Next_Pragma
7368 elsif In_Contract then
7369 Item := Next_Pragma (Item);
7371 -- Regular pragmas
7373 else
7374 Next_Rep_Item (Item);
7375 end if;
7376 end loop;
7378 return Empty;
7379 end Get_Pragma;
7381 --------------------------------------
7382 -- Get_Record_Representation_Clause --
7383 --------------------------------------
7385 function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id is
7386 N : Node_Id;
7388 begin
7389 N := First_Rep_Item (E);
7390 while Present (N) loop
7391 if Nkind (N) = N_Record_Representation_Clause then
7392 return N;
7393 end if;
7395 Next_Rep_Item (N);
7396 end loop;
7398 return Empty;
7399 end Get_Record_Representation_Clause;
7401 ------------------------
7402 -- Has_Attach_Handler --
7403 ------------------------
7405 function Has_Attach_Handler (Id : E) return B is
7406 Ritem : Node_Id;
7408 begin
7409 pragma Assert (Is_Protected_Type (Id));
7411 Ritem := First_Rep_Item (Id);
7412 while Present (Ritem) loop
7413 if Nkind (Ritem) = N_Pragma
7414 and then Pragma_Name (Ritem) = Name_Attach_Handler
7415 then
7416 return True;
7417 else
7418 Next_Rep_Item (Ritem);
7419 end if;
7420 end loop;
7422 return False;
7423 end Has_Attach_Handler;
7425 -------------
7426 -- Has_DIC --
7427 -------------
7429 function Has_DIC (Id : E) return B is
7430 begin
7431 return Has_Own_DIC (Id) or else Has_Inherited_DIC (Id);
7432 end Has_DIC;
7434 -----------------
7435 -- Has_Entries --
7436 -----------------
7438 function Has_Entries (Id : E) return B is
7439 Ent : Entity_Id;
7441 begin
7442 pragma Assert (Is_Concurrent_Type (Id));
7444 Ent := First_Entity (Id);
7445 while Present (Ent) loop
7446 if Is_Entry (Ent) then
7447 return True;
7448 end if;
7450 Ent := Next_Entity (Ent);
7451 end loop;
7453 return False;
7454 end Has_Entries;
7456 ----------------------------
7457 -- Has_Foreign_Convention --
7458 ----------------------------
7460 function Has_Foreign_Convention (Id : E) return B is
7461 begin
7462 -- While regular Intrinsics such as the Standard operators fit in the
7463 -- "Ada" convention, those with an Interface_Name materialize GCC
7464 -- builtin imports for which Ada special treatments shouldn't apply.
7466 return Convention (Id) in Foreign_Convention
7467 or else (Convention (Id) = Convention_Intrinsic
7468 and then Present (Interface_Name (Id)));
7469 end Has_Foreign_Convention;
7471 ---------------------------
7472 -- Has_Interrupt_Handler --
7473 ---------------------------
7475 function Has_Interrupt_Handler (Id : E) return B is
7476 Ritem : Node_Id;
7478 begin
7479 pragma Assert (Is_Protected_Type (Id));
7481 Ritem := First_Rep_Item (Id);
7482 while Present (Ritem) loop
7483 if Nkind (Ritem) = N_Pragma
7484 and then Pragma_Name (Ritem) = Name_Interrupt_Handler
7485 then
7486 return True;
7487 else
7488 Next_Rep_Item (Ritem);
7489 end if;
7490 end loop;
7492 return False;
7493 end Has_Interrupt_Handler;
7495 --------------------
7496 -- Has_Invariants --
7497 --------------------
7499 function Has_Invariants (Id : E) return B is
7500 begin
7501 return Has_Own_Invariants (Id) or else Has_Inherited_Invariants (Id);
7502 end Has_Invariants;
7504 --------------------------
7505 -- Has_Non_Limited_View --
7506 --------------------------
7508 function Has_Non_Limited_View (Id : E) return B is
7509 begin
7510 return (Ekind (Id) in Incomplete_Kind
7511 or else Ekind (Id) in Class_Wide_Kind
7512 or else Ekind (Id) = E_Abstract_State)
7513 and then Present (Non_Limited_View (Id));
7514 end Has_Non_Limited_View;
7516 ---------------------------------
7517 -- Has_Non_Null_Abstract_State --
7518 ---------------------------------
7520 function Has_Non_Null_Abstract_State (Id : E) return B is
7521 begin
7522 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
7524 return
7525 Present (Abstract_States (Id))
7526 and then
7527 not Is_Null_State (Node (First_Elmt (Abstract_States (Id))));
7528 end Has_Non_Null_Abstract_State;
7530 -------------------------------------
7531 -- Has_Non_Null_Visible_Refinement --
7532 -------------------------------------
7534 function Has_Non_Null_Visible_Refinement (Id : E) return B is
7535 Constits : Elist_Id;
7537 begin
7538 -- "Refinement" is a concept applicable only to abstract states
7540 pragma Assert (Ekind (Id) = E_Abstract_State);
7541 Constits := Refinement_Constituents (Id);
7543 -- A partial refinement is always non-null. For a full refinement to be
7544 -- non-null, the first constituent must be anything other than null.
7546 return
7547 Has_Partial_Visible_Refinement (Id)
7548 or else (Has_Visible_Refinement (Id)
7549 and then Present (Constits)
7550 and then Nkind (Node (First_Elmt (Constits))) /= N_Null);
7551 end Has_Non_Null_Visible_Refinement;
7553 -----------------------------
7554 -- Has_Null_Abstract_State --
7555 -----------------------------
7557 function Has_Null_Abstract_State (Id : E) return B is
7558 begin
7559 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
7561 return
7562 Present (Abstract_States (Id))
7563 and then Is_Null_State (Node (First_Elmt (Abstract_States (Id))));
7564 end Has_Null_Abstract_State;
7566 ---------------------------------
7567 -- Has_Null_Visible_Refinement --
7568 ---------------------------------
7570 function Has_Null_Visible_Refinement (Id : E) return B is
7571 Constits : Elist_Id;
7573 begin
7574 -- "Refinement" is a concept applicable only to abstract states
7576 pragma Assert (Ekind (Id) = E_Abstract_State);
7577 Constits := Refinement_Constituents (Id);
7579 -- For a refinement to be null, the state's sole constituent must be a
7580 -- null.
7582 return
7583 Has_Visible_Refinement (Id)
7584 and then Present (Constits)
7585 and then Nkind (Node (First_Elmt (Constits))) = N_Null;
7586 end Has_Null_Visible_Refinement;
7588 --------------------
7589 -- Has_Unmodified --
7590 --------------------
7592 function Has_Unmodified (E : Entity_Id) return Boolean is
7593 begin
7594 if Has_Pragma_Unmodified (E) then
7595 return True;
7596 elsif Warnings_Off (E) then
7597 Set_Warnings_Off_Used_Unmodified (E);
7598 return True;
7599 else
7600 return False;
7601 end if;
7602 end Has_Unmodified;
7604 ---------------------
7605 -- Has_Unreferenced --
7606 ---------------------
7608 function Has_Unreferenced (E : Entity_Id) return Boolean is
7609 begin
7610 if Has_Pragma_Unreferenced (E) then
7611 return True;
7612 elsif Warnings_Off (E) then
7613 Set_Warnings_Off_Used_Unreferenced (E);
7614 return True;
7615 else
7616 return False;
7617 end if;
7618 end Has_Unreferenced;
7620 ----------------------
7621 -- Has_Warnings_Off --
7622 ----------------------
7624 function Has_Warnings_Off (E : Entity_Id) return Boolean is
7625 begin
7626 if Warnings_Off (E) then
7627 Set_Warnings_Off_Used (E);
7628 return True;
7629 else
7630 return False;
7631 end if;
7632 end Has_Warnings_Off;
7634 ------------------------------
7635 -- Implementation_Base_Type --
7636 ------------------------------
7638 function Implementation_Base_Type (Id : E) return E is
7639 Bastyp : Entity_Id;
7640 Imptyp : Entity_Id;
7642 begin
7643 Bastyp := Base_Type (Id);
7645 if Is_Incomplete_Or_Private_Type (Bastyp) then
7646 Imptyp := Underlying_Type (Bastyp);
7648 -- If we have an implementation type, then just return it,
7649 -- otherwise we return the Base_Type anyway. This can only
7650 -- happen in error situations and should avoid some error bombs.
7652 if Present (Imptyp) then
7653 return Base_Type (Imptyp);
7654 else
7655 return Bastyp;
7656 end if;
7658 else
7659 return Bastyp;
7660 end if;
7661 end Implementation_Base_Type;
7663 -------------------------
7664 -- Invariant_Procedure --
7665 -------------------------
7667 function Invariant_Procedure (Id : E) return E is
7668 Subp_Elmt : Elmt_Id;
7669 Subp_Id : Entity_Id;
7670 Subps : Elist_Id;
7672 begin
7673 pragma Assert (Is_Type (Id));
7675 Subps := Subprograms_For_Type (Base_Type (Id));
7677 if Present (Subps) then
7678 Subp_Elmt := First_Elmt (Subps);
7679 while Present (Subp_Elmt) loop
7680 Subp_Id := Node (Subp_Elmt);
7682 if Is_Invariant_Procedure (Subp_Id) then
7683 return Subp_Id;
7684 end if;
7686 Next_Elmt (Subp_Elmt);
7687 end loop;
7688 end if;
7690 return Empty;
7691 end Invariant_Procedure;
7693 ----------------------
7694 -- Is_Atomic_Or_VFA --
7695 ----------------------
7697 function Is_Atomic_Or_VFA (Id : E) return B is
7698 begin
7699 return Is_Atomic (Id) or else Is_Volatile_Full_Access (Id);
7700 end Is_Atomic_Or_VFA;
7702 ------------------
7703 -- Is_Base_Type --
7704 ------------------
7706 -- Global flag table allowing rapid computation of this function
7708 Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean :=
7709 (E_Enumeration_Subtype |
7710 E_Incomplete_Type |
7711 E_Signed_Integer_Subtype |
7712 E_Modular_Integer_Subtype |
7713 E_Floating_Point_Subtype |
7714 E_Ordinary_Fixed_Point_Subtype |
7715 E_Decimal_Fixed_Point_Subtype |
7716 E_Array_Subtype |
7717 E_Record_Subtype |
7718 E_Private_Subtype |
7719 E_Record_Subtype_With_Private |
7720 E_Limited_Private_Subtype |
7721 E_Access_Subtype |
7722 E_Protected_Subtype |
7723 E_Task_Subtype |
7724 E_String_Literal_Subtype |
7725 E_Class_Wide_Subtype => False,
7726 others => True);
7728 function Is_Base_Type (Id : E) return Boolean is
7729 begin
7730 return Entity_Is_Base_Type (Ekind (Id));
7731 end Is_Base_Type;
7733 ---------------------
7734 -- Is_Boolean_Type --
7735 ---------------------
7737 function Is_Boolean_Type (Id : E) return B is
7738 begin
7739 return Root_Type (Id) = Standard_Boolean;
7740 end Is_Boolean_Type;
7742 ------------------------
7743 -- Is_Constant_Object --
7744 ------------------------
7746 function Is_Constant_Object (Id : E) return B is
7747 K : constant Entity_Kind := Ekind (Id);
7748 begin
7749 return
7750 K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;
7751 end Is_Constant_Object;
7753 --------------------------
7754 -- Is_Controlled_Active --
7755 --------------------------
7757 function Is_Controlled_Active (Id : E) return B is
7758 begin
7759 return Is_Controlled (Id) and then not Disable_Controlled (Id);
7760 end Is_Controlled_Active;
7762 --------------------
7763 -- Is_Discriminal --
7764 --------------------
7766 function Is_Discriminal (Id : E) return B is
7767 begin
7768 return (Ekind_In (Id, E_Constant, E_In_Parameter)
7769 and then Present (Discriminal_Link (Id)));
7770 end Is_Discriminal;
7772 ----------------------
7773 -- Is_Dynamic_Scope --
7774 ----------------------
7776 function Is_Dynamic_Scope (Id : E) return B is
7777 begin
7778 return
7779 Ekind (Id) = E_Block
7780 or else
7781 Ekind (Id) = E_Function
7782 or else
7783 Ekind (Id) = E_Procedure
7784 or else
7785 Ekind (Id) = E_Subprogram_Body
7786 or else
7787 Ekind (Id) = E_Task_Type
7788 or else
7789 (Ekind (Id) = E_Limited_Private_Type
7790 and then Present (Full_View (Id))
7791 and then Ekind (Full_View (Id)) = E_Task_Type)
7792 or else
7793 Ekind (Id) = E_Entry
7794 or else
7795 Ekind (Id) = E_Entry_Family
7796 or else
7797 Ekind (Id) = E_Return_Statement;
7798 end Is_Dynamic_Scope;
7800 --------------------
7801 -- Is_Entity_Name --
7802 --------------------
7804 function Is_Entity_Name (N : Node_Id) return Boolean is
7805 Kind : constant Node_Kind := Nkind (N);
7807 begin
7808 -- Identifiers, operator symbols, expanded names are entity names
7810 return Kind = N_Identifier
7811 or else Kind = N_Operator_Symbol
7812 or else Kind = N_Expanded_Name
7814 -- Attribute references are entity names if they refer to an entity.
7815 -- Note that we don't do this by testing for the presence of the
7816 -- Entity field in the N_Attribute_Reference node, since it may not
7817 -- have been set yet.
7819 or else (Kind = N_Attribute_Reference
7820 and then Is_Entity_Attribute_Name (Attribute_Name (N)));
7821 end Is_Entity_Name;
7823 -----------------------
7824 -- Is_External_State --
7825 -----------------------
7827 function Is_External_State (Id : E) return B is
7828 begin
7829 return
7830 Ekind (Id) = E_Abstract_State and then Has_Option (Id, Name_External);
7831 end Is_External_State;
7833 ------------------
7834 -- Is_Finalizer --
7835 ------------------
7837 function Is_Finalizer (Id : E) return B is
7838 begin
7839 return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer;
7840 end Is_Finalizer;
7842 -------------------
7843 -- Is_Null_State --
7844 -------------------
7846 function Is_Null_State (Id : E) return B is
7847 begin
7848 return
7849 Ekind (Id) = E_Abstract_State and then Nkind (Parent (Id)) = N_Null;
7850 end Is_Null_State;
7852 ---------------------
7853 -- Is_Packed_Array --
7854 ---------------------
7856 function Is_Packed_Array (Id : E) return B is
7857 begin
7858 return Is_Array_Type (Id) and then Is_Packed (Id);
7859 end Is_Packed_Array;
7861 -----------------------------------
7862 -- Is_Package_Or_Generic_Package --
7863 -----------------------------------
7865 function Is_Package_Or_Generic_Package (Id : E) return B is
7866 begin
7867 return Ekind_In (Id, E_Generic_Package, E_Package);
7868 end Is_Package_Or_Generic_Package;
7870 ---------------
7871 -- Is_Prival --
7872 ---------------
7874 function Is_Prival (Id : E) return B is
7875 begin
7876 return (Ekind_In (Id, E_Constant, E_Variable)
7877 and then Present (Prival_Link (Id)));
7878 end Is_Prival;
7880 ----------------------------
7881 -- Is_Protected_Component --
7882 ----------------------------
7884 function Is_Protected_Component (Id : E) return B is
7885 begin
7886 return Ekind (Id) = E_Component and then Is_Protected_Type (Scope (Id));
7887 end Is_Protected_Component;
7889 ----------------------------
7890 -- Is_Protected_Interface --
7891 ----------------------------
7893 function Is_Protected_Interface (Id : E) return B is
7894 Typ : constant Entity_Id := Base_Type (Id);
7895 begin
7896 if not Is_Interface (Typ) then
7897 return False;
7898 elsif Is_Class_Wide_Type (Typ) then
7899 return Is_Protected_Interface (Etype (Typ));
7900 else
7901 return Protected_Present (Type_Definition (Parent (Typ)));
7902 end if;
7903 end Is_Protected_Interface;
7905 ------------------------------
7906 -- Is_Protected_Record_Type --
7907 ------------------------------
7909 function Is_Protected_Record_Type (Id : E) return B is
7910 begin
7911 return
7912 Is_Concurrent_Record_Type (Id)
7913 and then Is_Protected_Type (Corresponding_Concurrent_Type (Id));
7914 end Is_Protected_Record_Type;
7916 --------------------------------
7917 -- Is_Standard_Character_Type --
7918 --------------------------------
7920 function Is_Standard_Character_Type (Id : E) return B is
7921 begin
7922 if Is_Type (Id) then
7923 declare
7924 R : constant Entity_Id := Root_Type (Id);
7925 begin
7926 return
7927 R = Standard_Character
7928 or else
7929 R = Standard_Wide_Character
7930 or else
7931 R = Standard_Wide_Wide_Character;
7932 end;
7934 else
7935 return False;
7936 end if;
7937 end Is_Standard_Character_Type;
7939 -----------------------------
7940 -- Is_Standard_String_Type --
7941 -----------------------------
7943 function Is_Standard_String_Type (Id : E) return B is
7944 begin
7945 if Is_Type (Id) then
7946 declare
7947 R : constant Entity_Id := Root_Type (Id);
7948 begin
7949 return
7950 R = Standard_String
7951 or else
7952 R = Standard_Wide_String
7953 or else
7954 R = Standard_Wide_Wide_String;
7955 end;
7957 else
7958 return False;
7959 end if;
7960 end Is_Standard_String_Type;
7962 --------------------
7963 -- Is_String_Type --
7964 --------------------
7966 function Is_String_Type (Id : E) return B is
7967 begin
7968 return Is_Array_Type (Id)
7969 and then Id /= Any_Composite
7970 and then Number_Dimensions (Id) = 1
7971 and then Is_Character_Type (Component_Type (Id));
7972 end Is_String_Type;
7974 -------------------------------
7975 -- Is_Synchronized_Interface --
7976 -------------------------------
7978 function Is_Synchronized_Interface (Id : E) return B is
7979 Typ : constant Entity_Id := Base_Type (Id);
7981 begin
7982 if not Is_Interface (Typ) then
7983 return False;
7985 elsif Is_Class_Wide_Type (Typ) then
7986 return Is_Synchronized_Interface (Etype (Typ));
7988 else
7989 return Protected_Present (Type_Definition (Parent (Typ)))
7990 or else Synchronized_Present (Type_Definition (Parent (Typ)))
7991 or else Task_Present (Type_Definition (Parent (Typ)));
7992 end if;
7993 end Is_Synchronized_Interface;
7995 ---------------------------
7996 -- Is_Synchronized_State --
7997 ---------------------------
7999 function Is_Synchronized_State (Id : E) return B is
8000 begin
8001 return
8002 Ekind (Id) = E_Abstract_State
8003 and then Has_Option (Id, Name_Synchronous);
8004 end Is_Synchronized_State;
8006 -----------------------
8007 -- Is_Task_Interface --
8008 -----------------------
8010 function Is_Task_Interface (Id : E) return B is
8011 Typ : constant Entity_Id := Base_Type (Id);
8012 begin
8013 if not Is_Interface (Typ) then
8014 return False;
8015 elsif Is_Class_Wide_Type (Typ) then
8016 return Is_Task_Interface (Etype (Typ));
8017 else
8018 return Task_Present (Type_Definition (Parent (Typ)));
8019 end if;
8020 end Is_Task_Interface;
8022 -------------------------
8023 -- Is_Task_Record_Type --
8024 -------------------------
8026 function Is_Task_Record_Type (Id : E) return B is
8027 begin
8028 return
8029 Is_Concurrent_Record_Type (Id)
8030 and then Is_Task_Type (Corresponding_Concurrent_Type (Id));
8031 end Is_Task_Record_Type;
8033 ------------------------
8034 -- Is_Wrapper_Package --
8035 ------------------------
8037 function Is_Wrapper_Package (Id : E) return B is
8038 begin
8039 return (Ekind (Id) = E_Package and then Present (Related_Instance (Id)));
8040 end Is_Wrapper_Package;
8042 -----------------
8043 -- Last_Formal --
8044 -----------------
8046 function Last_Formal (Id : E) return E is
8047 Formal : E;
8049 begin
8050 pragma Assert
8051 (Is_Overloadable (Id)
8052 or else Ekind_In (Id, E_Entry_Family,
8053 E_Subprogram_Body,
8054 E_Subprogram_Type));
8056 if Ekind (Id) = E_Enumeration_Literal then
8057 return Empty;
8059 else
8060 Formal := First_Formal (Id);
8062 if Present (Formal) then
8063 while Present (Next_Formal (Formal)) loop
8064 Formal := Next_Formal (Formal);
8065 end loop;
8066 end if;
8068 return Formal;
8069 end if;
8070 end Last_Formal;
8072 function Model_Emin_Value (Id : E) return Uint is
8073 begin
8074 return Machine_Emin_Value (Id);
8075 end Model_Emin_Value;
8077 -------------------------
8078 -- Model_Epsilon_Value --
8079 -------------------------
8081 function Model_Epsilon_Value (Id : E) return Ureal is
8082 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
8083 begin
8084 return Radix ** (1 - Model_Mantissa_Value (Id));
8085 end Model_Epsilon_Value;
8087 --------------------------
8088 -- Model_Mantissa_Value --
8089 --------------------------
8091 function Model_Mantissa_Value (Id : E) return Uint is
8092 begin
8093 return Machine_Mantissa_Value (Id);
8094 end Model_Mantissa_Value;
8096 -----------------------
8097 -- Model_Small_Value --
8098 -----------------------
8100 function Model_Small_Value (Id : E) return Ureal is
8101 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
8102 begin
8103 return Radix ** (Model_Emin_Value (Id) - 1);
8104 end Model_Small_Value;
8106 ------------------------
8107 -- Machine_Emax_Value --
8108 ------------------------
8110 function Machine_Emax_Value (Id : E) return Uint is
8111 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
8113 begin
8114 case Float_Rep (Id) is
8115 when IEEE_Binary =>
8116 case Digs is
8117 when 1 .. 6 => return Uint_128;
8118 when 7 .. 15 => return 2**10;
8119 when 16 .. 33 => return 2**14;
8120 when others => return No_Uint;
8121 end case;
8123 when AAMP =>
8124 return Uint_2 ** Uint_7 - Uint_1;
8125 end case;
8126 end Machine_Emax_Value;
8128 ------------------------
8129 -- Machine_Emin_Value --
8130 ------------------------
8132 function Machine_Emin_Value (Id : E) return Uint is
8133 begin
8134 case Float_Rep (Id) is
8135 when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id);
8136 when AAMP => return -Machine_Emax_Value (Id);
8137 end case;
8138 end Machine_Emin_Value;
8140 ----------------------------
8141 -- Machine_Mantissa_Value --
8142 ----------------------------
8144 function Machine_Mantissa_Value (Id : E) return Uint is
8145 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
8147 begin
8148 case Float_Rep (Id) is
8149 when IEEE_Binary =>
8150 case Digs is
8151 when 1 .. 6 => return Uint_24;
8152 when 7 .. 15 => return UI_From_Int (53);
8153 when 16 .. 18 => return Uint_64;
8154 when 19 .. 33 => return UI_From_Int (113);
8155 when others => return No_Uint;
8156 end case;
8158 when AAMP =>
8159 case Digs is
8160 when 1 .. 6 => return Uint_24;
8161 when 7 .. 9 => return UI_From_Int (40);
8162 when others => return No_Uint;
8163 end case;
8164 end case;
8165 end Machine_Mantissa_Value;
8167 -------------------------
8168 -- Machine_Radix_Value --
8169 -------------------------
8171 function Machine_Radix_Value (Id : E) return U is
8172 begin
8173 case Float_Rep (Id) is
8174 when AAMP
8175 | IEEE_Binary
8177 return Uint_2;
8178 end case;
8179 end Machine_Radix_Value;
8181 --------------------
8182 -- Next_Component --
8183 --------------------
8185 function Next_Component (Id : E) return E is
8186 Comp_Id : E;
8188 begin
8189 Comp_Id := Next_Entity (Id);
8190 while Present (Comp_Id) loop
8191 exit when Ekind (Comp_Id) = E_Component;
8192 Comp_Id := Next_Entity (Comp_Id);
8193 end loop;
8195 return Comp_Id;
8196 end Next_Component;
8198 ------------------------------------
8199 -- Next_Component_Or_Discriminant --
8200 ------------------------------------
8202 function Next_Component_Or_Discriminant (Id : E) return E is
8203 Comp_Id : E;
8205 begin
8206 Comp_Id := Next_Entity (Id);
8207 while Present (Comp_Id) loop
8208 exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
8209 Comp_Id := Next_Entity (Comp_Id);
8210 end loop;
8212 return Comp_Id;
8213 end Next_Component_Or_Discriminant;
8215 -----------------------
8216 -- Next_Discriminant --
8217 -----------------------
8219 -- This function actually implements both Next_Discriminant and
8220 -- Next_Stored_Discriminant by making sure that the Discriminant
8221 -- returned is of the same variety as Id.
8223 function Next_Discriminant (Id : E) return E is
8225 -- Derived Tagged types with private extensions look like this...
8227 -- E_Discriminant d1
8228 -- E_Discriminant d2
8229 -- E_Component _tag
8230 -- E_Discriminant d1
8231 -- E_Discriminant d2
8232 -- ...
8234 -- so it is critical not to go past the leading discriminants
8236 D : E := Id;
8238 begin
8239 pragma Assert (Ekind (Id) = E_Discriminant);
8241 loop
8242 D := Next_Entity (D);
8243 if No (D)
8244 or else (Ekind (D) /= E_Discriminant
8245 and then not Is_Itype (D))
8246 then
8247 return Empty;
8248 end if;
8250 exit when Ekind (D) = E_Discriminant
8251 and then (Is_Completely_Hidden (D) = Is_Completely_Hidden (Id));
8252 end loop;
8254 return D;
8255 end Next_Discriminant;
8257 -----------------
8258 -- Next_Formal --
8259 -----------------
8261 function Next_Formal (Id : E) return E is
8262 P : E;
8264 begin
8265 -- Follow the chain of declared entities as long as the kind of the
8266 -- entity corresponds to a formal parameter. Skip internal entities
8267 -- that may have been created for implicit subtypes, in the process
8268 -- of analyzing default expressions.
8270 P := Id;
8271 loop
8272 Next_Entity (P);
8274 if No (P) or else Is_Formal (P) then
8275 return P;
8276 elsif not Is_Internal (P) then
8277 return Empty;
8278 end if;
8279 end loop;
8280 end Next_Formal;
8282 -----------------------------
8283 -- Next_Formal_With_Extras --
8284 -----------------------------
8286 function Next_Formal_With_Extras (Id : E) return E is
8287 begin
8288 if Present (Extra_Formal (Id)) then
8289 return Extra_Formal (Id);
8290 else
8291 return Next_Formal (Id);
8292 end if;
8293 end Next_Formal_With_Extras;
8295 ----------------
8296 -- Next_Index --
8297 ----------------
8299 function Next_Index (Id : Node_Id) return Node_Id is
8300 begin
8301 return Next (Id);
8302 end Next_Index;
8304 ------------------
8305 -- Next_Literal --
8306 ------------------
8308 function Next_Literal (Id : E) return E is
8309 begin
8310 pragma Assert (Nkind (Id) in N_Entity);
8311 return Next (Id);
8312 end Next_Literal;
8314 ------------------------------
8315 -- Next_Stored_Discriminant --
8316 ------------------------------
8318 function Next_Stored_Discriminant (Id : E) return E is
8319 begin
8320 -- See comment in Next_Discriminant
8322 return Next_Discriminant (Id);
8323 end Next_Stored_Discriminant;
8325 -----------------------
8326 -- Number_Dimensions --
8327 -----------------------
8329 function Number_Dimensions (Id : E) return Pos is
8330 N : Int;
8331 T : Node_Id;
8333 begin
8334 if Ekind (Id) = E_String_Literal_Subtype then
8335 return 1;
8337 else
8338 N := 0;
8339 T := First_Index (Id);
8340 while Present (T) loop
8341 N := N + 1;
8342 Next_Index (T);
8343 end loop;
8345 return N;
8346 end if;
8347 end Number_Dimensions;
8349 --------------------
8350 -- Number_Entries --
8351 --------------------
8353 function Number_Entries (Id : E) return Nat is
8354 N : Int;
8355 Ent : Entity_Id;
8357 begin
8358 pragma Assert (Is_Concurrent_Type (Id));
8360 N := 0;
8361 Ent := First_Entity (Id);
8362 while Present (Ent) loop
8363 if Is_Entry (Ent) then
8364 N := N + 1;
8365 end if;
8367 Ent := Next_Entity (Ent);
8368 end loop;
8370 return N;
8371 end Number_Entries;
8373 --------------------
8374 -- Number_Formals --
8375 --------------------
8377 function Number_Formals (Id : E) return Pos is
8378 N : Int;
8379 Formal : Entity_Id;
8381 begin
8382 N := 0;
8383 Formal := First_Formal (Id);
8384 while Present (Formal) loop
8385 N := N + 1;
8386 Formal := Next_Formal (Formal);
8387 end loop;
8389 return N;
8390 end Number_Formals;
8392 --------------------
8393 -- Parameter_Mode --
8394 --------------------
8396 function Parameter_Mode (Id : E) return Formal_Kind is
8397 begin
8398 return Ekind (Id);
8399 end Parameter_Mode;
8401 ---------------------------------
8402 -- Partial_Invariant_Procedure --
8403 ---------------------------------
8405 function Partial_Invariant_Procedure (Id : E) return E is
8406 Subp_Elmt : Elmt_Id;
8407 Subp_Id : Entity_Id;
8408 Subps : Elist_Id;
8410 begin
8411 pragma Assert (Is_Type (Id));
8413 Subps := Subprograms_For_Type (Base_Type (Id));
8415 if Present (Subps) then
8416 Subp_Elmt := First_Elmt (Subps);
8417 while Present (Subp_Elmt) loop
8418 Subp_Id := Node (Subp_Elmt);
8420 if Is_Partial_Invariant_Procedure (Subp_Id) then
8421 return Subp_Id;
8422 end if;
8424 Next_Elmt (Subp_Elmt);
8425 end loop;
8426 end if;
8428 return Empty;
8429 end Partial_Invariant_Procedure;
8431 -------------------------------------
8432 -- Partial_Refinement_Constituents --
8433 -------------------------------------
8435 function Partial_Refinement_Constituents (Id : E) return L is
8436 Constits : Elist_Id := No_Elist;
8438 procedure Add_Usable_Constituents (Item : E);
8439 -- Add global item Item and/or its constituents to list Constits when
8440 -- they can be used in a global refinement within the current scope. The
8441 -- criteria are:
8442 -- 1) If Item is an abstract state with full refinement visible, add
8443 -- its constituents.
8444 -- 2) If Item is an abstract state with only partial refinement
8445 -- visible, add both Item and its constituents.
8446 -- 3) If Item is an abstract state without a visible refinement, add
8447 -- it.
8448 -- 4) If Id is not an abstract state, add it.
8450 procedure Add_Usable_Constituents (List : Elist_Id);
8451 -- Apply Add_Usable_Constituents to every constituent in List
8453 -----------------------------
8454 -- Add_Usable_Constituents --
8455 -----------------------------
8457 procedure Add_Usable_Constituents (Item : E) is
8458 begin
8459 if Ekind (Item) = E_Abstract_State then
8460 if Has_Visible_Refinement (Item) then
8461 Add_Usable_Constituents (Refinement_Constituents (Item));
8463 elsif Has_Partial_Visible_Refinement (Item) then
8464 Append_New_Elmt (Item, Constits);
8465 Add_Usable_Constituents (Part_Of_Constituents (Item));
8467 else
8468 Append_New_Elmt (Item, Constits);
8469 end if;
8471 else
8472 Append_New_Elmt (Item, Constits);
8473 end if;
8474 end Add_Usable_Constituents;
8476 procedure Add_Usable_Constituents (List : Elist_Id) is
8477 Constit_Elmt : Elmt_Id;
8478 begin
8479 if Present (List) then
8480 Constit_Elmt := First_Elmt (List);
8481 while Present (Constit_Elmt) loop
8482 Add_Usable_Constituents (Node (Constit_Elmt));
8483 Next_Elmt (Constit_Elmt);
8484 end loop;
8485 end if;
8486 end Add_Usable_Constituents;
8488 -- Start of processing for Partial_Refinement_Constituents
8490 begin
8491 -- "Refinement" is a concept applicable only to abstract states
8493 pragma Assert (Ekind (Id) = E_Abstract_State);
8495 if Has_Visible_Refinement (Id) then
8496 Constits := Refinement_Constituents (Id);
8498 -- A refinement may be partially visible when objects declared in the
8499 -- private part of a package are subject to a Part_Of indicator.
8501 elsif Has_Partial_Visible_Refinement (Id) then
8502 Add_Usable_Constituents (Part_Of_Constituents (Id));
8504 -- Function should only be called when full or partial refinement is
8505 -- visible.
8507 else
8508 raise Program_Error;
8509 end if;
8511 return Constits;
8512 end Partial_Refinement_Constituents;
8514 ------------------------
8515 -- Predicate_Function --
8516 ------------------------
8518 function Predicate_Function (Id : E) return E is
8519 Subp_Elmt : Elmt_Id;
8520 Subp_Id : Entity_Id;
8521 Subps : Elist_Id;
8522 Typ : Entity_Id;
8524 begin
8525 pragma Assert (Is_Type (Id));
8527 -- If type is private and has a completion, predicate may be defined on
8528 -- the full view.
8530 if Is_Private_Type (Id)
8531 and then
8532 (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id)))
8533 and then Present (Full_View (Id))
8534 then
8535 Typ := Full_View (Id);
8537 else
8538 Typ := Id;
8539 end if;
8541 Subps := Subprograms_For_Type (Typ);
8543 if Present (Subps) then
8544 Subp_Elmt := First_Elmt (Subps);
8545 while Present (Subp_Elmt) loop
8546 Subp_Id := Node (Subp_Elmt);
8548 if Ekind (Subp_Id) = E_Function
8549 and then Is_Predicate_Function (Subp_Id)
8550 then
8551 return Subp_Id;
8552 end if;
8554 Next_Elmt (Subp_Elmt);
8555 end loop;
8556 end if;
8558 return Empty;
8559 end Predicate_Function;
8561 --------------------------
8562 -- Predicate_Function_M --
8563 --------------------------
8565 function Predicate_Function_M (Id : E) return E is
8566 Subp_Elmt : Elmt_Id;
8567 Subp_Id : Entity_Id;
8568 Subps : Elist_Id;
8569 Typ : Entity_Id;
8571 begin
8572 pragma Assert (Is_Type (Id));
8574 -- If type is private and has a completion, predicate may be defined on
8575 -- the full view.
8577 if Is_Private_Type (Id)
8578 and then
8579 (not Has_Predicates (Id) or else No (Subprograms_For_Type (Id)))
8580 and then Present (Full_View (Id))
8581 then
8582 Typ := Full_View (Id);
8584 else
8585 Typ := Id;
8586 end if;
8588 Subps := Subprograms_For_Type (Typ);
8590 if Present (Subps) then
8591 Subp_Elmt := First_Elmt (Subps);
8592 while Present (Subp_Elmt) loop
8593 Subp_Id := Node (Subp_Elmt);
8595 if Ekind (Subp_Id) = E_Function
8596 and then Is_Predicate_Function_M (Subp_Id)
8597 then
8598 return Subp_Id;
8599 end if;
8601 Next_Elmt (Subp_Elmt);
8602 end loop;
8603 end if;
8605 return Empty;
8606 end Predicate_Function_M;
8608 -------------------------
8609 -- Present_In_Rep_Item --
8610 -------------------------
8612 function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean is
8613 Ritem : Node_Id;
8615 begin
8616 Ritem := First_Rep_Item (E);
8618 while Present (Ritem) loop
8619 if Ritem = N then
8620 return True;
8621 end if;
8623 Next_Rep_Item (Ritem);
8624 end loop;
8626 return False;
8627 end Present_In_Rep_Item;
8629 --------------------------
8630 -- Primitive_Operations --
8631 --------------------------
8633 function Primitive_Operations (Id : E) return L is
8634 begin
8635 if Is_Concurrent_Type (Id) then
8636 if Present (Corresponding_Record_Type (Id)) then
8637 return Direct_Primitive_Operations
8638 (Corresponding_Record_Type (Id));
8640 -- If expansion is disabled the corresponding record type is absent,
8641 -- but if the type has ancestors it may have primitive operations.
8643 elsif Is_Tagged_Type (Id) then
8644 return Direct_Primitive_Operations (Id);
8646 else
8647 return No_Elist;
8648 end if;
8649 else
8650 return Direct_Primitive_Operations (Id);
8651 end if;
8652 end Primitive_Operations;
8654 ---------------------
8655 -- Record_Rep_Item --
8656 ---------------------
8658 procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is
8659 begin
8660 Set_Next_Rep_Item (N, First_Rep_Item (E));
8661 Set_First_Rep_Item (E, N);
8662 end Record_Rep_Item;
8664 ---------------
8665 -- Root_Type --
8666 ---------------
8668 function Root_Type (Id : E) return E is
8669 T, Etyp : E;
8671 begin
8672 pragma Assert (Nkind (Id) in N_Entity);
8674 T := Base_Type (Id);
8676 if Ekind (T) = E_Class_Wide_Type then
8677 return Etype (T);
8679 -- Other cases
8681 else
8682 loop
8683 Etyp := Etype (T);
8685 if T = Etyp then
8686 return T;
8688 -- Following test catches some error cases resulting from
8689 -- previous errors.
8691 elsif No (Etyp) then
8692 Check_Error_Detected;
8693 return T;
8695 elsif Is_Private_Type (T) and then Etyp = Full_View (T) then
8696 return T;
8698 elsif Is_Private_Type (Etyp) and then Full_View (Etyp) = T then
8699 return T;
8700 end if;
8702 T := Etyp;
8704 -- Return if there is a circularity in the inheritance chain. This
8705 -- happens in some error situations and we do not want to get
8706 -- stuck in this loop.
8708 if T = Base_Type (Id) then
8709 return T;
8710 end if;
8711 end loop;
8712 end if;
8713 end Root_Type;
8715 ---------------------
8716 -- Safe_Emax_Value --
8717 ---------------------
8719 function Safe_Emax_Value (Id : E) return Uint is
8720 begin
8721 return Machine_Emax_Value (Id);
8722 end Safe_Emax_Value;
8724 ----------------------
8725 -- Safe_First_Value --
8726 ----------------------
8728 function Safe_First_Value (Id : E) return Ureal is
8729 begin
8730 return -Safe_Last_Value (Id);
8731 end Safe_First_Value;
8733 ---------------------
8734 -- Safe_Last_Value --
8735 ---------------------
8737 function Safe_Last_Value (Id : E) return Ureal is
8738 Radix : constant Uint := Machine_Radix_Value (Id);
8739 Mantissa : constant Uint := Machine_Mantissa_Value (Id);
8740 Emax : constant Uint := Safe_Emax_Value (Id);
8741 Significand : constant Uint := Radix ** Mantissa - 1;
8742 Exponent : constant Uint := Emax - Mantissa;
8744 begin
8745 if Radix = 2 then
8746 return
8747 UR_From_Components
8748 (Num => Significand * 2 ** (Exponent mod 4),
8749 Den => -Exponent / 4,
8750 Rbase => 16);
8751 else
8752 return
8753 UR_From_Components
8754 (Num => Significand,
8755 Den => -Exponent,
8756 Rbase => 16);
8757 end if;
8758 end Safe_Last_Value;
8760 -----------------
8761 -- Scope_Depth --
8762 -----------------
8764 function Scope_Depth (Id : E) return Uint is
8765 Scop : Entity_Id;
8767 begin
8768 Scop := Id;
8769 while Is_Record_Type (Scop) loop
8770 Scop := Scope (Scop);
8771 end loop;
8773 return Scope_Depth_Value (Scop);
8774 end Scope_Depth;
8776 ---------------------
8777 -- Scope_Depth_Set --
8778 ---------------------
8780 function Scope_Depth_Set (Id : E) return B is
8781 begin
8782 return not Is_Record_Type (Id)
8783 and then Field22 (Id) /= Union_Id (Empty);
8784 end Scope_Depth_Set;
8786 -----------------------------
8787 -- Set_Component_Alignment --
8788 -----------------------------
8790 -- Component Alignment is encoded using two flags, Flag128/129 as
8791 -- follows. Note that both flags False = Align_Default, so that the
8792 -- default initialization of flags to False initializes component
8793 -- alignment to the default value as required.
8795 -- Flag128 Flag129 Value
8796 -- ------- ------- -----
8797 -- False False Calign_Default
8798 -- False True Calign_Component_Size
8799 -- True False Calign_Component_Size_4
8800 -- True True Calign_Storage_Unit
8802 procedure Set_Component_Alignment (Id : E; V : C) is
8803 begin
8804 pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id))
8805 and then Is_Base_Type (Id));
8807 case V is
8808 when Calign_Default =>
8809 Set_Flag128 (Id, False);
8810 Set_Flag129 (Id, False);
8812 when Calign_Component_Size =>
8813 Set_Flag128 (Id, False);
8814 Set_Flag129 (Id, True);
8816 when Calign_Component_Size_4 =>
8817 Set_Flag128 (Id, True);
8818 Set_Flag129 (Id, False);
8820 when Calign_Storage_Unit =>
8821 Set_Flag128 (Id, True);
8822 Set_Flag129 (Id, True);
8823 end case;
8824 end Set_Component_Alignment;
8826 -----------------------
8827 -- Set_DIC_Procedure --
8828 -----------------------
8830 procedure Set_DIC_Procedure (Id : E; V : E) is
8831 Base_Typ : Entity_Id;
8832 Subp_Elmt : Elmt_Id;
8833 Subp_Id : Entity_Id;
8834 Subps : Elist_Id;
8836 begin
8837 pragma Assert (Is_Type (Id));
8839 Base_Typ := Base_Type (Id);
8840 Subps := Subprograms_For_Type (Base_Typ);
8842 if No (Subps) then
8843 Subps := New_Elmt_List;
8844 Set_Subprograms_For_Type (Base_Typ, Subps);
8845 end if;
8847 Subp_Elmt := First_Elmt (Subps);
8848 Prepend_Elmt (V, Subps);
8850 -- Check for a duplicate default initial condition procedure
8852 while Present (Subp_Elmt) loop
8853 Subp_Id := Node (Subp_Elmt);
8855 if Is_DIC_Procedure (Subp_Id) then
8856 raise Program_Error;
8857 end if;
8859 Next_Elmt (Subp_Elmt);
8860 end loop;
8861 end Set_DIC_Procedure;
8863 -----------------------------
8864 -- Set_Invariant_Procedure --
8865 -----------------------------
8867 procedure Set_Invariant_Procedure (Id : E; V : E) is
8868 Base_Typ : Entity_Id;
8869 Subp_Elmt : Elmt_Id;
8870 Subp_Id : Entity_Id;
8871 Subps : Elist_Id;
8873 begin
8874 pragma Assert (Is_Type (Id));
8876 Base_Typ := Base_Type (Id);
8877 Subps := Subprograms_For_Type (Base_Typ);
8879 if No (Subps) then
8880 Subps := New_Elmt_List;
8881 Set_Subprograms_For_Type (Base_Typ, Subps);
8882 end if;
8884 Subp_Elmt := First_Elmt (Subps);
8885 Prepend_Elmt (V, Subps);
8887 -- Check for a duplicate invariant procedure
8889 while Present (Subp_Elmt) loop
8890 Subp_Id := Node (Subp_Elmt);
8892 if Is_Invariant_Procedure (Subp_Id) then
8893 raise Program_Error;
8894 end if;
8896 Next_Elmt (Subp_Elmt);
8897 end loop;
8898 end Set_Invariant_Procedure;
8900 -------------------------------------
8901 -- Set_Partial_Invariant_Procedure --
8902 -------------------------------------
8904 procedure Set_Partial_Invariant_Procedure (Id : E; V : E) is
8905 Base_Typ : Entity_Id;
8906 Subp_Elmt : Elmt_Id;
8907 Subp_Id : Entity_Id;
8908 Subps : Elist_Id;
8910 begin
8911 pragma Assert (Is_Type (Id));
8913 Base_Typ := Base_Type (Id);
8914 Subps := Subprograms_For_Type (Base_Typ);
8916 if No (Subps) then
8917 Subps := New_Elmt_List;
8918 Set_Subprograms_For_Type (Base_Typ, Subps);
8919 end if;
8921 Subp_Elmt := First_Elmt (Subps);
8922 Prepend_Elmt (V, Subps);
8924 -- Check for a duplicate partial invariant procedure
8926 while Present (Subp_Elmt) loop
8927 Subp_Id := Node (Subp_Elmt);
8929 if Is_Partial_Invariant_Procedure (Subp_Id) then
8930 raise Program_Error;
8931 end if;
8933 Next_Elmt (Subp_Elmt);
8934 end loop;
8935 end Set_Partial_Invariant_Procedure;
8937 ----------------------------
8938 -- Set_Predicate_Function --
8939 ----------------------------
8941 procedure Set_Predicate_Function (Id : E; V : E) is
8942 Subp_Elmt : Elmt_Id;
8943 Subp_Id : Entity_Id;
8944 Subps : Elist_Id;
8946 begin
8947 pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
8949 Subps := Subprograms_For_Type (Id);
8951 if No (Subps) then
8952 Subps := New_Elmt_List;
8953 Set_Subprograms_For_Type (Id, Subps);
8954 end if;
8956 Subp_Elmt := First_Elmt (Subps);
8957 Prepend_Elmt (V, Subps);
8959 -- Check for a duplicate predication function
8961 while Present (Subp_Elmt) loop
8962 Subp_Id := Node (Subp_Elmt);
8964 if Ekind (Subp_Id) = E_Function
8965 and then Is_Predicate_Function (Subp_Id)
8966 then
8967 raise Program_Error;
8968 end if;
8970 Next_Elmt (Subp_Elmt);
8971 end loop;
8972 end Set_Predicate_Function;
8974 ------------------------------
8975 -- Set_Predicate_Function_M --
8976 ------------------------------
8978 procedure Set_Predicate_Function_M (Id : E; V : E) is
8979 Subp_Elmt : Elmt_Id;
8980 Subp_Id : Entity_Id;
8981 Subps : Elist_Id;
8983 begin
8984 pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
8986 Subps := Subprograms_For_Type (Id);
8988 if No (Subps) then
8989 Subps := New_Elmt_List;
8990 Set_Subprograms_For_Type (Id, Subps);
8991 end if;
8993 Subp_Elmt := First_Elmt (Subps);
8994 Prepend_Elmt (V, Subps);
8996 -- Check for a duplicate predication function
8998 while Present (Subp_Elmt) loop
8999 Subp_Id := Node (Subp_Elmt);
9001 if Ekind (Subp_Id) = E_Function
9002 and then Is_Predicate_Function_M (Subp_Id)
9003 then
9004 raise Program_Error;
9005 end if;
9007 Next_Elmt (Subp_Elmt);
9008 end loop;
9009 end Set_Predicate_Function_M;
9011 -----------------
9012 -- Size_Clause --
9013 -----------------
9015 function Size_Clause (Id : E) return N is
9016 begin
9017 return Get_Attribute_Definition_Clause (Id, Attribute_Size);
9018 end Size_Clause;
9020 ------------------------
9021 -- Stream_Size_Clause --
9022 ------------------------
9024 function Stream_Size_Clause (Id : E) return N is
9025 begin
9026 return Get_Attribute_Definition_Clause (Id, Attribute_Stream_Size);
9027 end Stream_Size_Clause;
9029 ------------------
9030 -- Subtype_Kind --
9031 ------------------
9033 function Subtype_Kind (K : Entity_Kind) return Entity_Kind is
9034 Kind : Entity_Kind;
9036 begin
9037 case K is
9038 when Access_Kind =>
9039 Kind := E_Access_Subtype;
9041 when E_Array_Subtype
9042 | E_Array_Type
9044 Kind := E_Array_Subtype;
9046 when E_Class_Wide_Subtype
9047 | E_Class_Wide_Type
9049 Kind := E_Class_Wide_Subtype;
9051 when E_Decimal_Fixed_Point_Subtype
9052 | E_Decimal_Fixed_Point_Type
9054 Kind := E_Decimal_Fixed_Point_Subtype;
9056 when E_Ordinary_Fixed_Point_Subtype
9057 | E_Ordinary_Fixed_Point_Type
9059 Kind := E_Ordinary_Fixed_Point_Subtype;
9061 when E_Private_Subtype
9062 | E_Private_Type
9064 Kind := E_Private_Subtype;
9066 when E_Limited_Private_Subtype
9067 | E_Limited_Private_Type
9069 Kind := E_Limited_Private_Subtype;
9071 when E_Record_Subtype_With_Private
9072 | E_Record_Type_With_Private
9074 Kind := E_Record_Subtype_With_Private;
9076 when E_Record_Subtype
9077 | E_Record_Type
9079 Kind := E_Record_Subtype;
9081 when Enumeration_Kind =>
9082 Kind := E_Enumeration_Subtype;
9084 when Float_Kind =>
9085 Kind := E_Floating_Point_Subtype;
9087 when Signed_Integer_Kind =>
9088 Kind := E_Signed_Integer_Subtype;
9090 when Modular_Integer_Kind =>
9091 Kind := E_Modular_Integer_Subtype;
9093 when Protected_Kind =>
9094 Kind := E_Protected_Subtype;
9096 when Task_Kind =>
9097 Kind := E_Task_Subtype;
9099 when others =>
9100 Kind := E_Void;
9101 raise Program_Error;
9102 end case;
9104 return Kind;
9105 end Subtype_Kind;
9107 ---------------------
9108 -- Type_High_Bound --
9109 ---------------------
9111 function Type_High_Bound (Id : E) return Node_Id is
9112 Rng : constant Node_Id := Scalar_Range (Id);
9113 begin
9114 if Nkind (Rng) = N_Subtype_Indication then
9115 return High_Bound (Range_Expression (Constraint (Rng)));
9116 else
9117 return High_Bound (Rng);
9118 end if;
9119 end Type_High_Bound;
9121 --------------------
9122 -- Type_Low_Bound --
9123 --------------------
9125 function Type_Low_Bound (Id : E) return Node_Id is
9126 Rng : constant Node_Id := Scalar_Range (Id);
9127 begin
9128 if Nkind (Rng) = N_Subtype_Indication then
9129 return Low_Bound (Range_Expression (Constraint (Rng)));
9130 else
9131 return Low_Bound (Rng);
9132 end if;
9133 end Type_Low_Bound;
9135 ---------------------
9136 -- Underlying_Type --
9137 ---------------------
9139 function Underlying_Type (Id : E) return E is
9140 begin
9141 -- For record_with_private the underlying type is always the direct
9142 -- full view. Never try to take the full view of the parent it
9143 -- doesn't make sense.
9145 if Ekind (Id) = E_Record_Type_With_Private then
9146 return Full_View (Id);
9148 elsif Ekind (Id) in Incomplete_Or_Private_Kind then
9150 -- If we have an incomplete or private type with a full view,
9151 -- then we return the Underlying_Type of this full view.
9153 if Present (Full_View (Id)) then
9154 if Id = Full_View (Id) then
9156 -- Previous error in declaration
9158 return Empty;
9160 else
9161 return Underlying_Type (Full_View (Id));
9162 end if;
9164 -- If we have a private type with an underlying full view, then we
9165 -- return the Underlying_Type of this underlying full view.
9167 elsif Ekind (Id) in Private_Kind
9168 and then Present (Underlying_Full_View (Id))
9169 then
9170 return Underlying_Type (Underlying_Full_View (Id));
9172 -- If we have an incomplete entity that comes from the limited
9173 -- view then we return the Underlying_Type of its non-limited
9174 -- view.
9176 elsif From_Limited_With (Id)
9177 and then Present (Non_Limited_View (Id))
9178 then
9179 return Underlying_Type (Non_Limited_View (Id));
9181 -- Otherwise check for the case where we have a derived type or
9182 -- subtype, and if so get the Underlying_Type of the parent type.
9184 elsif Etype (Id) /= Id then
9185 return Underlying_Type (Etype (Id));
9187 -- Otherwise we have an incomplete or private type that has
9188 -- no full view, which means that we have not encountered the
9189 -- completion, so return Empty to indicate the underlying type
9190 -- is not yet known.
9192 else
9193 return Empty;
9194 end if;
9196 -- For non-incomplete, non-private types, return the type itself Also
9197 -- for entities that are not types at all return the entity itself.
9199 else
9200 return Id;
9201 end if;
9202 end Underlying_Type;
9204 ------------------------
9205 -- Write_Entity_Flags --
9206 ------------------------
9208 procedure Write_Entity_Flags (Id : Entity_Id; Prefix : String) is
9210 procedure W (Flag_Name : String; Flag : Boolean);
9211 -- Write out given flag if it is set
9213 -------
9214 -- W --
9215 -------
9217 procedure W (Flag_Name : String; Flag : Boolean) is
9218 begin
9219 if Flag then
9220 Write_Str (Prefix);
9221 Write_Str (Flag_Name);
9222 Write_Str (" = True");
9223 Write_Eol;
9224 end if;
9225 end W;
9227 -- Start of processing for Write_Entity_Flags
9229 begin
9230 if (Is_Array_Type (Id) or else Is_Record_Type (Id))
9231 and then Is_Base_Type (Id)
9232 then
9233 Write_Str (Prefix);
9234 Write_Str ("Component_Alignment = ");
9236 case Component_Alignment (Id) is
9237 when Calign_Default =>
9238 Write_Str ("Calign_Default");
9240 when Calign_Component_Size =>
9241 Write_Str ("Calign_Component_Size");
9243 when Calign_Component_Size_4 =>
9244 Write_Str ("Calign_Component_Size_4");
9246 when Calign_Storage_Unit =>
9247 Write_Str ("Calign_Storage_Unit");
9248 end case;
9250 Write_Eol;
9251 end if;
9253 W ("Address_Taken", Flag104 (Id));
9254 W ("Body_Needed_For_SAL", Flag40 (Id));
9255 W ("C_Pass_By_Copy", Flag125 (Id));
9256 W ("Can_Never_Be_Null", Flag38 (Id));
9257 W ("Checks_May_Be_Suppressed", Flag31 (Id));
9258 W ("Contains_Ignored_Ghost_Code", Flag279 (Id));
9259 W ("Debug_Info_Off", Flag166 (Id));
9260 W ("Default_Expressions_Processed", Flag108 (Id));
9261 W ("Delay_Cleanups", Flag114 (Id));
9262 W ("Delay_Subprogram_Descriptors", Flag50 (Id));
9263 W ("Depends_On_Private", Flag14 (Id));
9264 W ("Discard_Names", Flag88 (Id));
9265 W ("Elaboration_Entity_Required", Flag174 (Id));
9266 W ("Elaborate_Body_Desirable", Flag210 (Id));
9267 W ("Entry_Accepted", Flag152 (Id));
9268 W ("Can_Use_Internal_Rep", Flag229 (Id));
9269 W ("Finalize_Storage_Only", Flag158 (Id));
9270 W ("From_Limited_With", Flag159 (Id));
9271 W ("Has_Aliased_Components", Flag135 (Id));
9272 W ("Has_Alignment_Clause", Flag46 (Id));
9273 W ("Has_All_Calls_Remote", Flag79 (Id));
9274 W ("Has_Atomic_Components", Flag86 (Id));
9275 W ("Has_Biased_Representation", Flag139 (Id));
9276 W ("Has_Completion", Flag26 (Id));
9277 W ("Has_Completion_In_Body", Flag71 (Id));
9278 W ("Has_Complex_Representation", Flag140 (Id));
9279 W ("Has_Component_Size_Clause", Flag68 (Id));
9280 W ("Has_Contiguous_Rep", Flag181 (Id));
9281 W ("Has_Controlled_Component", Flag43 (Id));
9282 W ("Has_Controlling_Result", Flag98 (Id));
9283 W ("Has_Convention_Pragma", Flag119 (Id));
9284 W ("Has_Default_Aspect", Flag39 (Id));
9285 W ("Has_Delayed_Aspects", Flag200 (Id));
9286 W ("Has_Delayed_Freeze", Flag18 (Id));
9287 W ("Has_Delayed_Rep_Aspects", Flag261 (Id));
9288 W ("Has_Discriminants", Flag5 (Id));
9289 W ("Has_Dispatch_Table", Flag220 (Id));
9290 W ("Has_Dynamic_Predicate_Aspect", Flag258 (Id));
9291 W ("Has_Enumeration_Rep_Clause", Flag66 (Id));
9292 W ("Has_Exit", Flag47 (Id));
9293 W ("Has_Expanded_Contract", Flag240 (Id));
9294 W ("Has_Forward_Instantiation", Flag175 (Id));
9295 W ("Has_Fully_Qualified_Name", Flag173 (Id));
9296 W ("Has_Gigi_Rep_Item", Flag82 (Id));
9297 W ("Has_Homonym", Flag56 (Id));
9298 W ("Has_Implicit_Dereference", Flag251 (Id));
9299 W ("Has_Independent_Components", Flag34 (Id));
9300 W ("Has_Inheritable_Invariants", Flag248 (Id));
9301 W ("Has_Inherited_DIC", Flag133 (Id));
9302 W ("Has_Inherited_Invariants", Flag291 (Id));
9303 W ("Has_Initial_Value", Flag219 (Id));
9304 W ("Has_Loop_Entry_Attributes", Flag260 (Id));
9305 W ("Has_Machine_Radix_Clause", Flag83 (Id));
9306 W ("Has_Master_Entity", Flag21 (Id));
9307 W ("Has_Missing_Return", Flag142 (Id));
9308 W ("Has_Nested_Block_With_Handler", Flag101 (Id));
9309 W ("Has_Nested_Subprogram", Flag282 (Id));
9310 W ("Has_Non_Standard_Rep", Flag75 (Id));
9311 W ("Has_Out_Or_In_Out_Parameter", Flag110 (Id));
9312 W ("Has_Object_Size_Clause", Flag172 (Id));
9313 W ("Has_Own_DIC", Flag3 (Id));
9314 W ("Has_Own_Invariants", Flag232 (Id));
9315 W ("Has_Per_Object_Constraint", Flag154 (Id));
9316 W ("Has_Pragma_Controlled", Flag27 (Id));
9317 W ("Has_Pragma_Elaborate_Body", Flag150 (Id));
9318 W ("Has_Pragma_Inline", Flag157 (Id));
9319 W ("Has_Pragma_Inline_Always", Flag230 (Id));
9320 W ("Has_Pragma_No_Inline", Flag201 (Id));
9321 W ("Has_Pragma_Ordered", Flag198 (Id));
9322 W ("Has_Pragma_Pack", Flag121 (Id));
9323 W ("Has_Pragma_Preelab_Init", Flag221 (Id));
9324 W ("Has_Pragma_Pure", Flag203 (Id));
9325 W ("Has_Pragma_Pure_Function", Flag179 (Id));
9326 W ("Has_Pragma_Thread_Local_Storage", Flag169 (Id));
9327 W ("Has_Pragma_Unmodified", Flag233 (Id));
9328 W ("Has_Pragma_Unreferenced", Flag180 (Id));
9329 W ("Has_Pragma_Unreferenced_Objects", Flag212 (Id));
9330 W ("Has_Pragma_Unused", Flag294 (Id));
9331 W ("Has_Predicates", Flag250 (Id));
9332 W ("Has_Primitive_Operations", Flag120 (Id));
9333 W ("Has_Private_Ancestor", Flag151 (Id));
9334 W ("Has_Private_Declaration", Flag155 (Id));
9335 W ("Has_Protected", Flag271 (Id));
9336 W ("Has_Qualified_Name", Flag161 (Id));
9337 W ("Has_RACW", Flag214 (Id));
9338 W ("Has_Record_Rep_Clause", Flag65 (Id));
9339 W ("Has_Recursive_Call", Flag143 (Id));
9340 W ("Has_Shift_Operator", Flag267 (Id));
9341 W ("Has_Size_Clause", Flag29 (Id));
9342 W ("Has_Small_Clause", Flag67 (Id));
9343 W ("Has_Specified_Layout", Flag100 (Id));
9344 W ("Has_Specified_Stream_Input", Flag190 (Id));
9345 W ("Has_Specified_Stream_Output", Flag191 (Id));
9346 W ("Has_Specified_Stream_Read", Flag192 (Id));
9347 W ("Has_Specified_Stream_Write", Flag193 (Id));
9348 W ("Has_Static_Discriminants", Flag211 (Id));
9349 W ("Has_Static_Predicate", Flag269 (Id));
9350 W ("Has_Static_Predicate_Aspect", Flag259 (Id));
9351 W ("Has_Storage_Size_Clause", Flag23 (Id));
9352 W ("Has_Stream_Size_Clause", Flag184 (Id));
9353 W ("Has_Task", Flag30 (Id));
9354 W ("Has_Timing_Event", Flag289 (Id));
9355 W ("Has_Thunks", Flag228 (Id));
9356 W ("Has_Unchecked_Union", Flag123 (Id));
9357 W ("Has_Unknown_Discriminants", Flag72 (Id));
9358 W ("Has_Visible_Refinement", Flag263 (Id));
9359 W ("Has_Volatile_Components", Flag87 (Id));
9360 W ("Has_Xref_Entry", Flag182 (Id));
9361 W ("In_Package_Body", Flag48 (Id));
9362 W ("In_Private_Part", Flag45 (Id));
9363 W ("In_Use", Flag8 (Id));
9364 W ("Is_Abstract_Subprogram", Flag19 (Id));
9365 W ("Is_Abstract_Type", Flag146 (Id));
9366 W ("Is_Access_Constant", Flag69 (Id));
9367 W ("Is_Actual_Subtype", Flag293 (Id));
9368 W ("Is_Ada_2005_Only", Flag185 (Id));
9369 W ("Is_Ada_2012_Only", Flag199 (Id));
9370 W ("Is_Aliased", Flag15 (Id));
9371 W ("Is_Asynchronous", Flag81 (Id));
9372 W ("Is_Atomic", Flag85 (Id));
9373 W ("Is_Bit_Packed_Array", Flag122 (Id));
9374 W ("Is_CPP_Class", Flag74 (Id));
9375 W ("Is_Called", Flag102 (Id));
9376 W ("Is_Character_Type", Flag63 (Id));
9377 W ("Is_Checked_Ghost_Entity", Flag277 (Id));
9378 W ("Is_Child_Unit", Flag73 (Id));
9379 W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id));
9380 W ("Is_Compilation_Unit", Flag149 (Id));
9381 W ("Is_Completely_Hidden", Flag103 (Id));
9382 W ("Is_Concurrent_Record_Type", Flag20 (Id));
9383 W ("Is_Constr_Subt_For_UN_Aliased", Flag141 (Id));
9384 W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
9385 W ("Is_Constrained", Flag12 (Id));
9386 W ("Is_Constructor", Flag76 (Id));
9387 W ("Is_Controlled", Flag42 (Id));
9388 W ("Is_Controlling_Formal", Flag97 (Id));
9389 W ("Is_Descendant_Of_Address", Flag223 (Id));
9390 W ("Is_DIC_Procedure", Flag132 (Id));
9391 W ("Is_Discrim_SO_Function", Flag176 (Id));
9392 W ("Is_Discriminant_Check_Function", Flag264 (Id));
9393 W ("Is_Dispatch_Table_Entity", Flag234 (Id));
9394 W ("Is_Dispatching_Operation", Flag6 (Id));
9395 W ("Is_Eliminated", Flag124 (Id));
9396 W ("Is_Entry_Formal", Flag52 (Id));
9397 W ("Is_Exception_Handler", Flag286 (Id));
9398 W ("Is_Exported", Flag99 (Id));
9399 W ("Is_Finalized_Transient", Flag252 (Id));
9400 W ("Is_First_Subtype", Flag70 (Id));
9401 W ("Is_For_Access_Subtype", Flag118 (Id));
9402 W ("Is_Formal_Subprogram", Flag111 (Id));
9403 W ("Is_Frozen", Flag4 (Id));
9404 W ("Is_Generic_Actual_Subprogram", Flag274 (Id));
9405 W ("Is_Generic_Actual_Type", Flag94 (Id));
9406 W ("Is_Generic_Instance", Flag130 (Id));
9407 W ("Is_Generic_Type", Flag13 (Id));
9408 W ("Is_Hidden", Flag57 (Id));
9409 W ("Is_Hidden_Non_Overridden_Subpgm", Flag2 (Id));
9410 W ("Is_Hidden_Open_Scope", Flag171 (Id));
9411 W ("Is_Ignored_Ghost_Entity", Flag278 (Id));
9412 W ("Is_Ignored_Transient", Flag295 (Id));
9413 W ("Is_Immediately_Visible", Flag7 (Id));
9414 W ("Is_Implementation_Defined", Flag254 (Id));
9415 W ("Is_Imported", Flag24 (Id));
9416 W ("Is_Independent", Flag268 (Id));
9417 W ("Is_Inlined", Flag11 (Id));
9418 W ("Is_Inlined_Always", Flag1 (Id));
9419 W ("Is_Instantiated", Flag126 (Id));
9420 W ("Is_Interface", Flag186 (Id));
9421 W ("Is_Internal", Flag17 (Id));
9422 W ("Is_Interrupt_Handler", Flag89 (Id));
9423 W ("Is_Intrinsic_Subprogram", Flag64 (Id));
9424 W ("Is_Invariant_Procedure", Flag257 (Id));
9425 W ("Is_Itype", Flag91 (Id));
9426 W ("Is_Known_Non_Null", Flag37 (Id));
9427 W ("Is_Known_Null", Flag204 (Id));
9428 W ("Is_Known_Valid", Flag170 (Id));
9429 W ("Is_Limited_Composite", Flag106 (Id));
9430 W ("Is_Limited_Interface", Flag197 (Id));
9431 W ("Is_Limited_Record", Flag25 (Id));
9432 W ("Is_Local_Anonymous_Access", Flag194 (Id));
9433 W ("Is_Machine_Code_Subprogram", Flag137 (Id));
9434 W ("Is_Non_Static_Subtype", Flag109 (Id));
9435 W ("Is_Null_Init_Proc", Flag178 (Id));
9436 W ("Is_Obsolescent", Flag153 (Id));
9437 W ("Is_Only_Out_Parameter", Flag226 (Id));
9438 W ("Is_Package_Body_Entity", Flag160 (Id));
9439 W ("Is_Packed", Flag51 (Id));
9440 W ("Is_Packed_Array_Impl_Type", Flag138 (Id));
9441 W ("Is_Param_Block_Component_Type", Flag215 (Id));
9442 W ("Is_Partial_Invariant_Procedure", Flag292 (Id));
9443 W ("Is_Potentially_Use_Visible", Flag9 (Id));
9444 W ("Is_Predicate_Function", Flag255 (Id));
9445 W ("Is_Predicate_Function_M", Flag256 (Id));
9446 W ("Is_Preelaborated", Flag59 (Id));
9447 W ("Is_Primitive", Flag218 (Id));
9448 W ("Is_Primitive_Wrapper", Flag195 (Id));
9449 W ("Is_Private_Composite", Flag107 (Id));
9450 W ("Is_Private_Descendant", Flag53 (Id));
9451 W ("Is_Private_Primitive", Flag245 (Id));
9452 W ("Is_Public", Flag10 (Id));
9453 W ("Is_Pure", Flag44 (Id));
9454 W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
9455 W ("Is_RACW_Stub_Type", Flag244 (Id));
9456 W ("Is_Raised", Flag224 (Id));
9457 W ("Is_Remote_Call_Interface", Flag62 (Id));
9458 W ("Is_Remote_Types", Flag61 (Id));
9459 W ("Is_Renaming_Of_Object", Flag112 (Id));
9460 W ("Is_Return_Object", Flag209 (Id));
9461 W ("Is_Safe_To_Reevaluate", Flag249 (Id));
9462 W ("Is_Shared_Passive", Flag60 (Id));
9463 W ("Is_Static_Type", Flag281 (Id));
9464 W ("Is_Statically_Allocated", Flag28 (Id));
9465 W ("Is_Tag", Flag78 (Id));
9466 W ("Is_Tagged_Type", Flag55 (Id));
9467 W ("Is_Thunk", Flag225 (Id));
9468 W ("Is_Trivial_Subprogram", Flag235 (Id));
9469 W ("Is_True_Constant", Flag163 (Id));
9470 W ("Is_Unchecked_Union", Flag117 (Id));
9471 W ("Is_Underlying_Full_View", Flag298 (Id));
9472 W ("Is_Underlying_Record_View", Flag246 (Id));
9473 W ("Is_Unimplemented", Flag284 (Id));
9474 W ("Is_Unsigned_Type", Flag144 (Id));
9475 W ("Is_Uplevel_Referenced_Entity", Flag283 (Id));
9476 W ("Is_Valued_Procedure", Flag127 (Id));
9477 W ("Is_Visible_Formal", Flag206 (Id));
9478 W ("Is_Visible_Lib_Unit", Flag116 (Id));
9479 W ("Is_Volatile", Flag16 (Id));
9480 W ("Is_Volatile_Full_Access", Flag285 (Id));
9481 W ("Itype_Printed", Flag202 (Id));
9482 W ("Kill_Elaboration_Checks", Flag32 (Id));
9483 W ("Kill_Range_Checks", Flag33 (Id));
9484 W ("Known_To_Have_Preelab_Init", Flag207 (Id));
9485 W ("Low_Bound_Tested", Flag205 (Id));
9486 W ("Machine_Radix_10", Flag84 (Id));
9487 W ("Materialize_Entity", Flag168 (Id));
9488 W ("May_Inherit_Delayed_Rep_Aspects", Flag262 (Id));
9489 W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
9490 W ("Must_Have_Preelab_Init", Flag208 (Id));
9491 W ("Needs_Debug_Info", Flag147 (Id));
9492 W ("Needs_No_Actuals", Flag22 (Id));
9493 W ("Never_Set_In_Source", Flag115 (Id));
9494 W ("No_Dynamic_Predicate_On_actual", Flag276 (Id));
9495 W ("No_Pool_Assigned", Flag131 (Id));
9496 W ("No_Predicate_On_actual", Flag275 (Id));
9497 W ("No_Return", Flag113 (Id));
9498 W ("No_Strict_Aliasing", Flag136 (Id));
9499 W ("Non_Binary_Modulus", Flag58 (Id));
9500 W ("Nonzero_Is_True", Flag162 (Id));
9501 W ("OK_To_Rename", Flag247 (Id));
9502 W ("OK_To_Reorder_Components", Flag239 (Id));
9503 W ("Optimize_Alignment_Space", Flag241 (Id));
9504 W ("Optimize_Alignment_Time", Flag242 (Id));
9505 W ("Overlays_Constant", Flag243 (Id));
9506 W ("Partial_View_Has_Unknown_Discr", Flag280 (Id));
9507 W ("Reachable", Flag49 (Id));
9508 W ("Referenced", Flag156 (Id));
9509 W ("Referenced_As_LHS", Flag36 (Id));
9510 W ("Referenced_As_Out_Parameter", Flag227 (Id));
9511 W ("Renamed_In_Spec", Flag231 (Id));
9512 W ("Requires_Overriding", Flag213 (Id));
9513 W ("Return_Present", Flag54 (Id));
9514 W ("Returns_By_Ref", Flag90 (Id));
9515 W ("Reverse_Bit_Order", Flag164 (Id));
9516 W ("Reverse_Storage_Order", Flag93 (Id));
9517 W ("Rewritten_For_C", Flag287 (Id));
9518 W ("Predicates_Ignored", Flag288 (Id));
9519 W ("Sec_Stack_Needed_For_Return", Flag167 (Id));
9520 W ("Size_Depends_On_Discriminant", Flag177 (Id));
9521 W ("Size_Known_At_Compile_Time", Flag92 (Id));
9522 W ("SPARK_Aux_Pragma_Inherited", Flag266 (Id));
9523 W ("SPARK_Pragma_Inherited", Flag265 (Id));
9524 W ("SSO_Set_High_By_Default", Flag273 (Id));
9525 W ("SSO_Set_Low_By_Default", Flag272 (Id));
9526 W ("Static_Elaboration_Desired", Flag77 (Id));
9527 W ("Stores_Attribute_Old_Prefix", Flag270 (Id));
9528 W ("Strict_Alignment", Flag145 (Id));
9529 W ("Suppress_Elaboration_Warnings", Flag148 (Id));
9530 W ("Suppress_Initialization", Flag105 (Id));
9531 W ("Suppress_Style_Checks", Flag165 (Id));
9532 W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
9533 W ("Treat_As_Volatile", Flag41 (Id));
9534 W ("Universal_Aliasing", Flag216 (Id));
9535 W ("Used_As_Generic_Actual", Flag222 (Id));
9536 W ("Uses_Sec_Stack", Flag95 (Id));
9537 W ("Warnings_Off", Flag96 (Id));
9538 W ("Warnings_Off_Used", Flag236 (Id));
9539 W ("Warnings_Off_Used_Unmodified", Flag237 (Id));
9540 W ("Warnings_Off_Used_Unreferenced", Flag238 (Id));
9541 W ("Was_Hidden", Flag196 (Id));
9542 end Write_Entity_Flags;
9544 -----------------------
9545 -- Write_Entity_Info --
9546 -----------------------
9548 procedure Write_Entity_Info (Id : Entity_Id; Prefix : String) is
9550 procedure Write_Attribute (Which : String; Nam : E);
9551 -- Write attribute value with given string name
9553 procedure Write_Kind (Id : Entity_Id);
9554 -- Write Ekind field of entity
9556 ---------------------
9557 -- Write_Attribute --
9558 ---------------------
9560 procedure Write_Attribute (Which : String; Nam : E) is
9561 begin
9562 Write_Str (Prefix);
9563 Write_Str (Which);
9564 Write_Int (Int (Nam));
9565 Write_Str (" ");
9566 Write_Name (Chars (Nam));
9567 Write_Str (" ");
9568 end Write_Attribute;
9570 ----------------
9571 -- Write_Kind --
9572 ----------------
9574 procedure Write_Kind (Id : Entity_Id) is
9575 K : constant String := Entity_Kind'Image (Ekind (Id));
9577 begin
9578 Write_Str (Prefix);
9579 Write_Str (" Kind ");
9581 if Is_Type (Id) and then Is_Tagged_Type (Id) then
9582 Write_Str ("TAGGED ");
9583 end if;
9585 Write_Str (K (3 .. K'Length));
9586 Write_Str (" ");
9588 if Is_Type (Id) and then Depends_On_Private (Id) then
9589 Write_Str ("Depends_On_Private ");
9590 end if;
9591 end Write_Kind;
9593 -- Start of processing for Write_Entity_Info
9595 begin
9596 Write_Eol;
9597 Write_Attribute ("Name ", Id);
9598 Write_Int (Int (Id));
9599 Write_Eol;
9600 Write_Kind (Id);
9601 Write_Eol;
9602 Write_Attribute (" Type ", Etype (Id));
9603 Write_Eol;
9604 Write_Attribute (" Scope ", Scope (Id));
9605 Write_Eol;
9607 case Ekind (Id) is
9608 when Discrete_Kind =>
9609 Write_Str ("Bounds: Id = ");
9611 if Present (Scalar_Range (Id)) then
9612 Write_Int (Int (Type_Low_Bound (Id)));
9613 Write_Str (" .. Id = ");
9614 Write_Int (Int (Type_High_Bound (Id)));
9615 else
9616 Write_Str ("Empty");
9617 end if;
9619 Write_Eol;
9621 when Array_Kind =>
9622 declare
9623 Index : E;
9625 begin
9626 Write_Attribute
9627 (" Component Type ", Component_Type (Id));
9628 Write_Eol;
9629 Write_Str (Prefix);
9630 Write_Str (" Indexes ");
9632 Index := First_Index (Id);
9633 while Present (Index) loop
9634 Write_Attribute (" ", Etype (Index));
9635 Index := Next_Index (Index);
9636 end loop;
9638 Write_Eol;
9639 end;
9641 when Access_Kind =>
9642 Write_Attribute
9643 (" Directly Designated Type ",
9644 Directly_Designated_Type (Id));
9645 Write_Eol;
9647 when Overloadable_Kind =>
9648 if Present (Homonym (Id)) then
9649 Write_Str (" Homonym ");
9650 Write_Name (Chars (Homonym (Id)));
9651 Write_Str (" ");
9652 Write_Int (Int (Homonym (Id)));
9653 Write_Eol;
9654 end if;
9656 Write_Eol;
9658 when E_Component =>
9659 if Ekind (Scope (Id)) in Record_Kind then
9660 Write_Attribute (
9661 " Original_Record_Component ",
9662 Original_Record_Component (Id));
9663 Write_Int (Int (Original_Record_Component (Id)));
9664 Write_Eol;
9665 end if;
9667 when others =>
9668 null;
9669 end case;
9670 end Write_Entity_Info;
9672 -----------------------
9673 -- Write_Field6_Name --
9674 -----------------------
9676 procedure Write_Field6_Name (Id : Entity_Id) is
9677 pragma Unreferenced (Id);
9678 begin
9679 Write_Str ("First_Rep_Item");
9680 end Write_Field6_Name;
9682 -----------------------
9683 -- Write_Field7_Name --
9684 -----------------------
9686 procedure Write_Field7_Name (Id : Entity_Id) is
9687 pragma Unreferenced (Id);
9688 begin
9689 Write_Str ("Freeze_Node");
9690 end Write_Field7_Name;
9692 -----------------------
9693 -- Write_Field8_Name --
9694 -----------------------
9696 procedure Write_Field8_Name (Id : Entity_Id) is
9697 begin
9698 case Ekind (Id) is
9699 when Type_Kind =>
9700 Write_Str ("Associated_Node_For_Itype");
9702 when E_Package =>
9703 Write_Str ("Dependent_Instances");
9705 when E_Loop =>
9706 Write_Str ("First_Exit_Statement");
9708 when E_Variable =>
9709 Write_Str ("Hiding_Loop_Variable");
9711 when Formal_Kind
9712 | E_Function
9713 | E_Subprogram_Body
9715 Write_Str ("Mechanism");
9717 when E_Component
9718 | E_Discriminant
9720 Write_Str ("Normalized_First_Bit");
9722 when E_Abstract_State =>
9723 Write_Str ("Refinement_Constituents");
9725 when E_Return_Statement =>
9726 Write_Str ("Return_Applies_To");
9728 when others =>
9729 Write_Str ("Field8??");
9730 end case;
9731 end Write_Field8_Name;
9733 -----------------------
9734 -- Write_Field9_Name --
9735 -----------------------
9737 procedure Write_Field9_Name (Id : Entity_Id) is
9738 begin
9739 case Ekind (Id) is
9740 when Type_Kind =>
9741 Write_Str ("Class_Wide_Type");
9743 when Object_Kind =>
9744 Write_Str ("Current_Value");
9746 when E_Function
9747 | E_Generic_Function
9748 | E_Generic_Package
9749 | E_Generic_Procedure
9750 | E_Package
9751 | E_Procedure
9753 Write_Str ("Renaming_Map");
9755 when others =>
9756 Write_Str ("Field9??");
9757 end case;
9758 end Write_Field9_Name;
9760 ------------------------
9761 -- Write_Field10_Name --
9762 ------------------------
9764 procedure Write_Field10_Name (Id : Entity_Id) is
9765 begin
9766 case Ekind (Id) is
9767 when Class_Wide_Kind
9768 | Incomplete_Kind
9769 | E_Record_Type
9770 | E_Record_Subtype
9771 | Private_Kind
9772 | Concurrent_Kind
9774 Write_Str ("Direct_Primitive_Operations");
9776 when E_Constant
9777 | E_In_Parameter
9779 Write_Str ("Discriminal_Link");
9781 when Float_Kind =>
9782 Write_Str ("Float_Rep");
9784 when E_Function
9785 | E_Package
9786 | E_Package_Body
9787 | E_Procedure
9789 Write_Str ("Handler_Records");
9791 when E_Component
9792 | E_Discriminant
9794 Write_Str ("Normalized_Position_Max");
9796 when E_Abstract_State
9797 | E_Variable
9799 Write_Str ("Part_Of_Constituents");
9801 when others =>
9802 Write_Str ("Field10??");
9803 end case;
9804 end Write_Field10_Name;
9806 ------------------------
9807 -- Write_Field11_Name --
9808 ------------------------
9810 procedure Write_Field11_Name (Id : Entity_Id) is
9811 begin
9812 case Ekind (Id) is
9813 when E_Block =>
9814 Write_Str ("Block_Node");
9816 when E_Component
9817 | E_Discriminant
9819 Write_Str ("Component_Bit_Offset");
9821 when Formal_Kind =>
9822 Write_Str ("Entry_Component");
9824 when E_Enumeration_Literal =>
9825 Write_Str ("Enumeration_Pos");
9827 when Type_Kind
9828 | E_Constant
9830 Write_Str ("Full_View");
9832 when E_Generic_Package =>
9833 Write_Str ("Generic_Homonym");
9835 when E_Variable =>
9836 Write_Str ("Part_Of_References");
9838 when E_Entry
9839 | E_Entry_Family
9840 | E_Function
9841 | E_Procedure
9843 Write_Str ("Protected_Body_Subprogram");
9845 when others =>
9846 Write_Str ("Field11??");
9847 end case;
9848 end Write_Field11_Name;
9850 ------------------------
9851 -- Write_Field12_Name --
9852 ------------------------
9854 procedure Write_Field12_Name (Id : Entity_Id) is
9855 begin
9856 case Ekind (Id) is
9857 when E_Package =>
9858 Write_Str ("Associated_Formal_Package");
9860 when Entry_Kind =>
9861 Write_Str ("Barrier_Function");
9863 when E_Enumeration_Literal =>
9864 Write_Str ("Enumeration_Rep");
9866 when Type_Kind
9867 | E_Component
9868 | E_Constant
9869 | E_Discriminant
9870 | E_Exception
9871 | E_In_Parameter
9872 | E_In_Out_Parameter
9873 | E_Out_Parameter
9874 | E_Loop_Parameter
9875 | E_Variable
9877 Write_Str ("Esize");
9879 when E_Function
9880 | E_Procedure
9882 Write_Str ("Next_Inlined_Subprogram");
9884 when others =>
9885 Write_Str ("Field12??");
9886 end case;
9887 end Write_Field12_Name;
9889 ------------------------
9890 -- Write_Field13_Name --
9891 ------------------------
9893 procedure Write_Field13_Name (Id : Entity_Id) is
9894 begin
9895 case Ekind (Id) is
9896 when E_Component
9897 | E_Discriminant
9899 Write_Str ("Component_Clause");
9901 when E_Function
9902 | E_Procedure
9903 | E_Package
9904 | Generic_Unit_Kind
9906 Write_Str ("Elaboration_Entity");
9908 when Formal_Kind
9909 | E_Variable
9911 Write_Str ("Extra_Accessibility");
9913 when Type_Kind =>
9914 Write_Str ("RM_Size");
9916 when others =>
9917 Write_Str ("Field13??");
9918 end case;
9919 end Write_Field13_Name;
9921 -----------------------
9922 -- Write_Field14_Name --
9923 -----------------------
9925 procedure Write_Field14_Name (Id : Entity_Id) is
9926 begin
9927 case Ekind (Id) is
9928 when Type_Kind
9929 | Formal_Kind
9930 | E_Constant
9931 | E_Exception
9932 | E_Loop_Parameter
9933 | E_Variable
9935 Write_Str ("Alignment");
9937 when E_Component
9938 | E_Discriminant
9940 Write_Str ("Normalized_Position");
9942 when E_Entry
9943 | E_Entry_Family
9944 | E_Function
9945 | E_Procedure
9947 Write_Str ("Postconditions_Proc");
9949 when E_Generic_Package
9950 | E_Package
9952 Write_Str ("Shadow_Entities");
9954 when others =>
9955 Write_Str ("Field14??");
9956 end case;
9957 end Write_Field14_Name;
9959 ------------------------
9960 -- Write_Field15_Name --
9961 ------------------------
9963 procedure Write_Field15_Name (Id : Entity_Id) is
9964 begin
9965 case Ekind (Id) is
9966 when E_Discriminant =>
9967 Write_Str ("Discriminant_Number");
9969 when E_Component =>
9970 Write_Str ("DT_Entry_Count");
9972 when E_Function
9973 | E_Procedure
9975 Write_Str ("DT_Position");
9977 when Entry_Kind =>
9978 Write_Str ("Entry_Parameters_Type");
9980 when Formal_Kind =>
9981 Write_Str ("Extra_Formal");
9983 when Type_Kind =>
9984 Write_Str ("Pending_Access_Types");
9986 when E_Package
9987 | E_Package_Body
9989 Write_Str ("Related_Instance");
9991 when E_Constant
9992 | E_Variable
9994 Write_Str ("Status_Flag_Or_Transient_Decl");
9996 when others =>
9997 Write_Str ("Field15??");
9998 end case;
9999 end Write_Field15_Name;
10001 ------------------------
10002 -- Write_Field16_Name --
10003 ------------------------
10005 procedure Write_Field16_Name (Id : Entity_Id) is
10006 begin
10007 case Ekind (Id) is
10008 when E_Record_Type
10009 | E_Record_Type_With_Private
10011 Write_Str ("Access_Disp_Table");
10013 when E_Abstract_State =>
10014 Write_Str ("Body_References");
10016 when E_Class_Wide_Subtype
10017 | E_Record_Subtype
10019 Write_Str ("Cloned_Subtype");
10021 when E_Function
10022 | E_Procedure
10024 Write_Str ("DTC_Entity");
10026 when E_Component =>
10027 Write_Str ("Entry_Formal");
10029 when Concurrent_Kind
10030 | E_Generic_Package
10031 | E_Package
10033 Write_Str ("First_Private_Entity");
10035 when Enumeration_Kind =>
10036 Write_Str ("Lit_Strings");
10038 when Decimal_Fixed_Point_Kind =>
10039 Write_Str ("Scale_Value");
10041 when E_String_Literal_Subtype =>
10042 Write_Str ("String_Literal_Length");
10044 when E_Out_Parameter
10045 | E_Variable
10047 Write_Str ("Unset_Reference");
10049 when others =>
10050 Write_Str ("Field16??");
10051 end case;
10052 end Write_Field16_Name;
10054 ------------------------
10055 -- Write_Field17_Name --
10056 ------------------------
10058 procedure Write_Field17_Name (Id : Entity_Id) is
10059 begin
10060 case Ekind (Id) is
10061 when Formal_Kind
10062 | E_Constant
10063 | E_Generic_In_Out_Parameter
10064 | E_Variable
10066 Write_Str ("Actual_Subtype");
10068 when Digits_Kind =>
10069 Write_Str ("Digits_Value");
10071 when E_Discriminant =>
10072 Write_Str ("Discriminal");
10074 when Class_Wide_Kind
10075 | Concurrent_Kind
10076 | Private_Kind
10077 | E_Block
10078 | E_Entry
10079 | E_Entry_Family
10080 | E_Function
10081 | E_Generic_Function
10082 | E_Generic_Package
10083 | E_Generic_Procedure
10084 | E_Loop
10085 | E_Operator
10086 | E_Package
10087 | E_Package_Body
10088 | E_Procedure
10089 | E_Record_Type
10090 | E_Record_Subtype
10091 | E_Return_Statement
10092 | E_Subprogram_Body
10093 | E_Subprogram_Type
10095 Write_Str ("First_Entity");
10097 when Array_Kind =>
10098 Write_Str ("First_Index");
10100 when Enumeration_Kind =>
10101 Write_Str ("First_Literal");
10103 when Access_Kind =>
10104 Write_Str ("Master_Id");
10106 when Modular_Integer_Kind =>
10107 Write_Str ("Modulus");
10109 when E_Component =>
10110 Write_Str ("Prival");
10112 when others =>
10113 Write_Str ("Field17??");
10114 end case;
10115 end Write_Field17_Name;
10117 ------------------------
10118 -- Write_Field18_Name --
10119 ------------------------
10121 procedure Write_Field18_Name (Id : Entity_Id) is
10122 begin
10123 case Ekind (Id) is
10124 when E_Enumeration_Literal
10125 | E_Function
10126 | E_Operator
10127 | E_Procedure
10129 Write_Str ("Alias");
10131 when E_Record_Type =>
10132 Write_Str ("Corresponding_Concurrent_Type");
10134 when E_Subprogram_Body =>
10135 Write_Str ("Corresponding_Protected_Entry");
10137 when Concurrent_Kind =>
10138 Write_Str ("Corresponding_Record_Type");
10140 when E_Block
10141 | E_Label
10142 | E_Loop
10144 Write_Str ("Enclosing_Scope");
10146 when E_Entry_Index_Parameter =>
10147 Write_Str ("Entry_Index_Constant");
10149 when E_Access_Protected_Subprogram_Type
10150 | E_Access_Subprogram_Type
10151 | E_Anonymous_Access_Protected_Subprogram_Type
10152 | E_Exception_Type
10153 | E_Class_Wide_Subtype
10155 Write_Str ("Equivalent_Type");
10157 when Fixed_Point_Kind =>
10158 Write_Str ("Delta_Value");
10160 when Enumeration_Kind =>
10161 Write_Str ("Lit_Indexes");
10163 when Incomplete_Or_Private_Kind
10164 | E_Record_Subtype
10166 Write_Str ("Private_Dependents");
10168 when E_Exception
10169 | E_Generic_Function
10170 | E_Generic_Package
10171 | E_Generic_Procedure
10172 | E_Package
10174 Write_Str ("Renamed_Entity");
10176 when Object_Kind =>
10177 Write_Str ("Renamed_Object");
10179 when E_String_Literal_Subtype =>
10180 Write_Str ("String_Literal_Low_Bound");
10182 when others =>
10183 Write_Str ("Field18??");
10184 end case;
10185 end Write_Field18_Name;
10187 -----------------------
10188 -- Write_Field19_Name --
10189 -----------------------
10191 procedure Write_Field19_Name (Id : Entity_Id) is
10192 begin
10193 case Ekind (Id) is
10194 when E_Generic_Package
10195 | E_Package
10197 Write_Str ("Body_Entity");
10199 when E_Discriminant =>
10200 Write_Str ("Corresponding_Discriminant");
10202 when Scalar_Kind =>
10203 Write_Str ("Default_Aspect_Value");
10205 when E_Array_Type =>
10206 Write_Str ("Default_Component_Value");
10208 when E_Protected_Type =>
10209 Write_Str ("Entry_Bodies_Array");
10211 when E_Function
10212 | E_Operator
10213 | E_Subprogram_Type
10215 Write_Str ("Extra_Accessibility_Of_Result");
10217 when E_Abstract_State
10218 | E_Class_Wide_Type
10219 | E_Incomplete_Type
10221 Write_Str ("Non_Limited_View");
10223 when E_Incomplete_Subtype =>
10224 if From_Limited_With (Id) then
10225 Write_Str ("Non_Limited_View");
10226 end if;
10228 when E_Record_Type =>
10229 Write_Str ("Parent_Subtype");
10231 when E_Constant
10232 | E_Variable
10234 Write_Str ("Size_Check_Code");
10236 when Formal_Kind
10237 | E_Package_Body
10239 Write_Str ("Spec_Entity");
10241 when Private_Kind =>
10242 Write_Str ("Underlying_Full_View");
10244 when others =>
10245 Write_Str ("Field19??");
10246 end case;
10247 end Write_Field19_Name;
10249 -----------------------
10250 -- Write_Field20_Name --
10251 -----------------------
10253 procedure Write_Field20_Name (Id : Entity_Id) is
10254 begin
10255 case Ekind (Id) is
10256 when Array_Kind =>
10257 Write_Str ("Component_Type");
10259 when E_Generic_In_Parameter
10260 | E_In_Parameter
10262 Write_Str ("Default_Value");
10264 when Access_Kind =>
10265 Write_Str ("Directly_Designated_Type");
10267 when E_Component =>
10268 Write_Str ("Discriminant_Checking_Func");
10270 when E_Discriminant =>
10271 Write_Str ("Discriminant_Default_Value");
10273 when Class_Wide_Kind
10274 | Concurrent_Kind
10275 | Private_Kind
10276 | E_Block
10277 | E_Entry
10278 | E_Entry_Family
10279 | E_Function
10280 | E_Generic_Function
10281 | E_Generic_Package
10282 | E_Generic_Procedure
10283 | E_Loop
10284 | E_Operator
10285 | E_Package
10286 | E_Package_Body
10287 | E_Procedure
10288 | E_Record_Type
10289 | E_Record_Subtype
10290 | E_Return_Statement
10291 | E_Subprogram_Body
10292 | E_Subprogram_Type
10294 Write_Str ("Last_Entity");
10296 when E_Constant
10297 | E_Variable
10299 Write_Str ("Prival_Link");
10301 when E_Exception =>
10302 Write_Str ("Register_Exception_Call");
10304 when Scalar_Kind =>
10305 Write_Str ("Scalar_Range");
10307 when others =>
10308 Write_Str ("Field20??");
10309 end case;
10310 end Write_Field20_Name;
10312 -----------------------
10313 -- Write_Field21_Name --
10314 -----------------------
10316 procedure Write_Field21_Name (Id : Entity_Id) is
10317 begin
10318 case Ekind (Id) is
10319 when Entry_Kind =>
10320 Write_Str ("Accept_Address");
10322 when E_In_Parameter =>
10323 Write_Str ("Default_Expr_Function");
10325 when Concurrent_Kind
10326 | Incomplete_Or_Private_Kind
10327 | Class_Wide_Kind
10328 | E_Record_Type
10329 | E_Record_Subtype
10331 Write_Str ("Discriminant_Constraint");
10333 when E_Constant
10334 | E_Exception
10335 | E_Function
10336 | E_Generic_Function
10337 | E_Generic_Procedure
10338 | E_Procedure
10339 | E_Variable
10341 Write_Str ("Interface_Name");
10343 when Array_Kind
10344 | Modular_Integer_Kind
10346 Write_Str ("Original_Array_Type");
10348 when Fixed_Point_Kind =>
10349 Write_Str ("Small_Value");
10351 when others =>
10352 Write_Str ("Field21??");
10353 end case;
10354 end Write_Field21_Name;
10356 -----------------------
10357 -- Write_Field22_Name --
10358 -----------------------
10360 procedure Write_Field22_Name (Id : Entity_Id) is
10361 begin
10362 case Ekind (Id) is
10363 when Access_Kind =>
10364 Write_Str ("Associated_Storage_Pool");
10366 when Array_Kind =>
10367 Write_Str ("Component_Size");
10369 when E_Record_Type =>
10370 Write_Str ("Corresponding_Remote_Type");
10372 when E_Component
10373 | E_Discriminant
10375 Write_Str ("Original_Record_Component");
10377 when E_Enumeration_Literal =>
10378 Write_Str ("Enumeration_Rep_Expr");
10380 when E_Limited_Private_Subtype
10381 | E_Limited_Private_Type
10382 | E_Private_Subtype
10383 | E_Private_Type
10384 | E_Record_Subtype_With_Private
10385 | E_Record_Type_With_Private
10387 Write_Str ("Private_View");
10389 when Formal_Kind =>
10390 Write_Str ("Protected_Formal");
10392 when E_Block
10393 | E_Entry
10394 | E_Entry_Family
10395 | E_Function
10396 | E_Generic_Function
10397 | E_Generic_Package
10398 | E_Generic_Procedure
10399 | E_Loop
10400 | E_Package
10401 | E_Package_Body
10402 | E_Procedure
10403 | E_Protected_Type
10404 | E_Return_Statement
10405 | E_Subprogram_Body
10406 | E_Task_Type
10408 Write_Str ("Scope_Depth_Value");
10410 when E_Variable =>
10411 Write_Str ("Shared_Var_Procs_Instance");
10413 when others =>
10414 Write_Str ("Field22??");
10415 end case;
10416 end Write_Field22_Name;
10418 ------------------------
10419 -- Write_Field23_Name --
10420 ------------------------
10422 procedure Write_Field23_Name (Id : Entity_Id) is
10423 begin
10424 case Ekind (Id) is
10425 when E_Discriminant =>
10426 Write_Str ("CR_Discriminant");
10428 when E_Block =>
10429 Write_Str ("Entry_Cancel_Parameter");
10431 when E_Enumeration_Type =>
10432 Write_Str ("Enum_Pos_To_Rep");
10434 when Formal_Kind
10435 | E_Variable
10437 Write_Str ("Extra_Constrained");
10439 when Access_Kind =>
10440 Write_Str ("Finalization_Master");
10442 when E_Generic_Function
10443 | E_Generic_Package
10444 | E_Generic_Procedure
10446 Write_Str ("Inner_Instances");
10448 when Array_Kind =>
10449 Write_Str ("Packed_Array_Impl_Type");
10451 when Entry_Kind =>
10452 Write_Str ("Protection_Object");
10454 when Class_Wide_Kind
10455 | Concurrent_Kind
10456 | Incomplete_Or_Private_Kind
10457 | E_Record_Type
10458 | E_Record_Subtype
10460 Write_Str ("Stored_Constraint");
10462 when E_Function
10463 | E_Procedure
10465 if Present (Scope (Id))
10466 and then Is_Protected_Type (Scope (Id))
10467 then
10468 Write_Str ("Protection_Object");
10469 else
10470 Write_Str ("Generic_Renamings");
10471 end if;
10473 when E_Package =>
10474 if Is_Generic_Instance (Id) then
10475 Write_Str ("Generic_Renamings");
10476 else
10477 Write_Str ("Limited_View");
10478 end if;
10480 when others =>
10481 Write_Str ("Field23??");
10482 end case;
10483 end Write_Field23_Name;
10485 ------------------------
10486 -- Write_Field24_Name --
10487 ------------------------
10489 procedure Write_Field24_Name (Id : Entity_Id) is
10490 begin
10491 case Ekind (Id) is
10492 when Type_Kind
10493 | E_Constant
10494 | E_Variable
10496 Write_Str ("Related_Expression");
10498 when E_Function
10499 | E_Operator
10500 | E_Procedure
10502 Write_Str ("Subps_Index");
10504 when E_Package =>
10505 Write_Str ("Incomplete_Actuals");
10507 when others =>
10508 Write_Str ("Field24???");
10509 end case;
10510 end Write_Field24_Name;
10512 ------------------------
10513 -- Write_Field25_Name --
10514 ------------------------
10516 procedure Write_Field25_Name (Id : Entity_Id) is
10517 begin
10518 case Ekind (Id) is
10519 when E_Generic_Package
10520 | E_Package
10522 Write_Str ("Abstract_States");
10524 when E_Entry
10525 | E_Entry_Family
10527 Write_Str ("Contract_Wrapper");
10529 when E_Variable =>
10530 Write_Str ("Debug_Renaming_Link");
10532 when E_Component =>
10533 Write_Str ("DT_Offset_To_Top_Func");
10535 when E_Function
10536 | E_Procedure
10538 Write_Str ("Interface_Alias");
10540 when E_Record_Subtype
10541 | E_Record_Subtype_With_Private
10542 | E_Record_Type
10543 | E_Record_Type_With_Private
10545 Write_Str ("Interfaces");
10547 when E_Array_Subtype
10548 | E_Array_Type
10550 Write_Str ("Related_Array_Object");
10552 when Discrete_Kind =>
10553 Write_Str ("Static_Discrete_Predicate");
10555 when Real_Kind =>
10556 Write_Str ("Static_Real_Or_String_Predicate");
10558 when Task_Kind =>
10559 Write_Str ("Task_Body_Procedure");
10561 when others =>
10562 Write_Str ("Field25??");
10563 end case;
10564 end Write_Field25_Name;
10566 ------------------------
10567 -- Write_Field26_Name --
10568 ------------------------
10570 procedure Write_Field26_Name (Id : Entity_Id) is
10571 begin
10572 case Ekind (Id) is
10573 when E_Record_Type
10574 | E_Record_Type_With_Private
10576 Write_Str ("Dispatch_Table_Wrappers");
10578 when E_In_Out_Parameter
10579 | E_Out_Parameter
10580 | E_Variable
10582 Write_Str ("Last_Assignment");
10584 when E_Function
10585 | E_Procedure
10587 Write_Str ("Overridden_Operation");
10589 when E_Generic_Package
10590 | E_Package
10592 Write_Str ("Package_Instantiation");
10594 when E_Component
10595 | E_Constant
10597 Write_Str ("Related_Type");
10599 when Access_Kind
10600 | Task_Kind
10602 Write_Str ("Storage_Size_Variable");
10604 when others =>
10605 Write_Str ("Field26??");
10606 end case;
10607 end Write_Field26_Name;
10609 ------------------------
10610 -- Write_Field27_Name --
10611 ------------------------
10613 procedure Write_Field27_Name (Id : Entity_Id) is
10614 begin
10615 case Ekind (Id) is
10616 when Type_Kind
10617 | E_Package
10619 Write_Str ("Current_Use_Clause");
10621 when E_Component
10622 | E_Constant
10623 | E_Variable
10625 Write_Str ("Related_Type");
10627 when E_Function
10628 | E_Procedure
10630 Write_Str ("Wrapped_Entity");
10632 when others =>
10633 Write_Str ("Field27??");
10634 end case;
10635 end Write_Field27_Name;
10637 ------------------------
10638 -- Write_Field28_Name --
10639 ------------------------
10641 procedure Write_Field28_Name (Id : Entity_Id) is
10642 begin
10643 case Ekind (Id) is
10644 when E_Entry
10645 | E_Entry_Family
10646 | E_Function
10647 | E_Procedure
10648 | E_Subprogram_Body
10649 | E_Subprogram_Type
10651 Write_Str ("Extra_Formals");
10653 when E_Package
10654 | E_Package_Body
10656 Write_Str ("Finalizer");
10658 when E_Constant
10659 | E_Variable
10661 Write_Str ("Initialization_Statements");
10663 when E_Access_Subprogram_Type =>
10664 Write_Str ("Original_Access_Type");
10666 when Task_Kind =>
10667 Write_Str ("Relative_Deadline_Variable");
10669 when E_Record_Type =>
10670 Write_Str ("Underlying_Record_View");
10672 when others =>
10673 Write_Str ("Field28??");
10674 end case;
10675 end Write_Field28_Name;
10677 ------------------------
10678 -- Write_Field29_Name --
10679 ------------------------
10681 procedure Write_Field29_Name (Id : Entity_Id) is
10682 begin
10683 case Ekind (Id) is
10684 when E_Function
10685 | E_Package
10686 | E_Procedure
10687 | E_Subprogram_Body
10689 Write_Str ("Anonymous_Masters");
10691 when E_Constant
10692 | E_Variable
10694 Write_Str ("BIP_Initialization_Call");
10696 when Type_Kind =>
10697 Write_Str ("Subprograms_For_Type");
10699 when others =>
10700 Write_Str ("Field29??");
10701 end case;
10702 end Write_Field29_Name;
10704 ------------------------
10705 -- Write_Field30_Name --
10706 ------------------------
10708 procedure Write_Field30_Name (Id : Entity_Id) is
10709 begin
10710 case Ekind (Id) is
10711 when E_Protected_Type
10712 | E_Task_Type
10714 Write_Str ("Anonymous_Object");
10716 when E_Function =>
10717 Write_Str ("Corresponding_Equality");
10719 when E_Constant
10720 | E_Variable
10722 Write_Str ("Last_Aggregate_Assignment");
10724 when E_Procedure =>
10725 Write_Str ("Static_Initialization");
10727 when others =>
10728 Write_Str ("Field30??");
10729 end case;
10730 end Write_Field30_Name;
10732 ------------------------
10733 -- Write_Field31_Name --
10734 ------------------------
10736 procedure Write_Field31_Name (Id : Entity_Id) is
10737 begin
10738 case Ekind (Id) is
10739 when E_Constant
10740 | E_In_Parameter
10741 | E_In_Out_Parameter
10742 | E_Loop_Parameter
10743 | E_Out_Parameter
10744 | E_Variable
10746 Write_Str ("Activation_Record_Component");
10748 when Type_Kind =>
10749 Write_Str ("Derived_Type_Link");
10751 when E_Function
10752 | E_Procedure
10754 Write_Str ("Thunk_Entity");
10756 when others =>
10757 Write_Str ("Field31??");
10758 end case;
10759 end Write_Field31_Name;
10761 ------------------------
10762 -- Write_Field32_Name --
10763 ------------------------
10765 procedure Write_Field32_Name (Id : Entity_Id) is
10766 begin
10767 case Ekind (Id) is
10768 when E_Procedure =>
10769 Write_Str ("Corresponding_Function");
10771 when E_Function =>
10772 Write_Str ("Corresponding_Procedure");
10774 when E_Abstract_State
10775 | E_Constant
10776 | E_Variable
10778 Write_Str ("Encapsulating_State");
10780 when Type_Kind =>
10781 Write_Str ("No_Tagged_Streams_Pragma");
10783 when others =>
10784 Write_Str ("Field32??");
10785 end case;
10786 end Write_Field32_Name;
10788 ------------------------
10789 -- Write_Field33_Name --
10790 ------------------------
10792 procedure Write_Field33_Name (Id : Entity_Id) is
10793 begin
10794 case Ekind (Id) is
10795 when Subprogram_Kind
10796 | Type_Kind
10797 | E_Constant
10798 | E_Variable
10800 Write_Str ("Linker_Section_Pragma");
10802 when others =>
10803 Write_Str ("Field33??");
10804 end case;
10805 end Write_Field33_Name;
10807 ------------------------
10808 -- Write_Field34_Name --
10809 ------------------------
10811 procedure Write_Field34_Name (Id : Entity_Id) is
10812 begin
10813 case Ekind (Id) is
10814 when E_Constant
10815 | E_Entry
10816 | E_Entry_Family
10817 | E_Function
10818 | E_Generic_Function
10819 | E_Generic_Package
10820 | E_Generic_Procedure
10821 | E_Operator
10822 | E_Package
10823 | E_Package_Body
10824 | E_Procedure
10825 | E_Protected_Type
10826 | E_Subprogram_Body
10827 | E_Task_Body
10828 | E_Task_Type
10829 | E_Variable
10830 | E_Void
10832 Write_Str ("Contract");
10834 when others =>
10835 Write_Str ("Field34??");
10836 end case;
10837 end Write_Field34_Name;
10839 ------------------------
10840 -- Write_Field35_Name --
10841 ------------------------
10843 procedure Write_Field35_Name (Id : Entity_Id) is
10844 begin
10845 case Ekind (Id) is
10846 when E_Variable =>
10847 Write_Str ("Anonymous_Designated_Type");
10849 when E_Entry
10850 | E_Entry_Family
10852 Write_Str ("Entry_Max_Queue_Lenghts_Array");
10854 when Subprogram_Kind =>
10855 Write_Str ("Import_Pragma");
10857 when others =>
10858 Write_Str ("Field35??");
10859 end case;
10860 end Write_Field35_Name;
10862 ------------------------
10863 -- Write_Field36_Name --
10864 ------------------------
10866 procedure Write_Field36_Name (Id : Entity_Id) is
10867 pragma Unreferenced (Id);
10868 begin
10869 Write_Str ("Field36??");
10870 end Write_Field36_Name;
10872 ------------------------
10873 -- Write_Field37_Name --
10874 ------------------------
10876 procedure Write_Field37_Name (Id : Entity_Id) is
10877 pragma Unreferenced (Id);
10878 begin
10879 Write_Str ("Associated_Entity");
10880 end Write_Field37_Name;
10882 ------------------------
10883 -- Write_Field38_Name --
10884 ------------------------
10886 procedure Write_Field38_Name (Id : Entity_Id) is
10887 begin
10888 case Ekind (Id) is
10889 when E_Function
10890 | E_Procedure
10892 Write_Str ("Class_Wide_Preconditions");
10894 when others =>
10895 Write_Str ("Field38??");
10896 end case;
10897 end Write_Field38_Name;
10899 ------------------------
10900 -- Write_Field39_Name --
10901 ------------------------
10903 procedure Write_Field39_Name (Id : Entity_Id) is
10904 begin
10905 case Ekind (Id) is
10906 when E_Function
10907 | E_Procedure
10909 Write_Str ("Class_Wide_Postcondition");
10911 when others =>
10912 Write_Str ("Field39??");
10913 end case;
10914 end Write_Field39_Name;
10916 ------------------------
10917 -- Write_Field40_Name --
10918 ------------------------
10920 procedure Write_Field40_Name (Id : Entity_Id) is
10921 begin
10922 case Ekind (Id) is
10923 when E_Entry
10924 | E_Entry_Family
10925 | E_Function
10926 | E_Generic_Function
10927 | E_Generic_Package
10928 | E_Generic_Procedure
10929 | E_Operator
10930 | E_Package
10931 | E_Package_Body
10932 | E_Procedure
10933 | E_Protected_Body
10934 | E_Protected_Type
10935 | E_Subprogram_Body
10936 | E_Task_Body
10937 | E_Task_Type
10938 | E_Variable
10940 Write_Str ("SPARK_Pragma");
10942 when others =>
10943 Write_Str ("Field40??");
10944 end case;
10945 end Write_Field40_Name;
10947 ------------------------
10948 -- Write_Field41_Name --
10949 ------------------------
10951 procedure Write_Field41_Name (Id : Entity_Id) is
10952 begin
10953 case Ekind (Id) is
10954 when E_Function
10955 | E_Procedure
10957 Write_Str ("Original_Protected_Subprogram");
10959 when E_Generic_Package
10960 | E_Package
10961 | E_Package_Body
10962 | E_Protected_Type
10963 | E_Task_Type
10965 Write_Str ("SPARK_Aux_Pragma");
10967 when others =>
10968 Write_Str ("Field41??");
10969 end case;
10970 end Write_Field41_Name;
10972 -------------------------
10973 -- Iterator Procedures --
10974 -------------------------
10976 procedure Proc_Next_Component (N : in out Node_Id) is
10977 begin
10978 N := Next_Component (N);
10979 end Proc_Next_Component;
10981 procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id) is
10982 begin
10983 N := Next_Entity (N);
10984 while Present (N) loop
10985 exit when Ekind_In (N, E_Component, E_Discriminant);
10986 N := Next_Entity (N);
10987 end loop;
10988 end Proc_Next_Component_Or_Discriminant;
10990 procedure Proc_Next_Discriminant (N : in out Node_Id) is
10991 begin
10992 N := Next_Discriminant (N);
10993 end Proc_Next_Discriminant;
10995 procedure Proc_Next_Formal (N : in out Node_Id) is
10996 begin
10997 N := Next_Formal (N);
10998 end Proc_Next_Formal;
11000 procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is
11001 begin
11002 N := Next_Formal_With_Extras (N);
11003 end Proc_Next_Formal_With_Extras;
11005 procedure Proc_Next_Index (N : in out Node_Id) is
11006 begin
11007 N := Next_Index (N);
11008 end Proc_Next_Index;
11010 procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is
11011 begin
11012 N := Next_Inlined_Subprogram (N);
11013 end Proc_Next_Inlined_Subprogram;
11015 procedure Proc_Next_Literal (N : in out Node_Id) is
11016 begin
11017 N := Next_Literal (N);
11018 end Proc_Next_Literal;
11020 procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is
11021 begin
11022 N := Next_Stored_Discriminant (N);
11023 end Proc_Next_Stored_Discriminant;
11025 end Einfo;