[multiple changes]
[gcc.git] / gcc / ada / einfo.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E I N F O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2015, 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 ------------------------------------------------------------------------------
31
32 pragma Style_Checks (All_Checks);
33 -- Turn off subprogram ordering, not used for this unit
34
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;
42
43 package body Einfo is
44
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.
49
50 ----------------------------------------------
51 -- Usage of Fields in Defining Entity Nodes --
52 ----------------------------------------------
53
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.
60
61 -- Chars Name1
62 -- Next_Entity Node2
63 -- Scope Node3
64 -- Etype Node5
65
66 -- Remaining fields are present only in extended nodes (i.e. entities)
67
68 -- The following fields are present in all entities
69
70 -- Homonym Node4
71 -- First_Rep_Item Node6
72 -- Freeze_Node Node7
73
74 -- The usage of other fields (and the entity kinds to which it applies)
75 -- depends on the particular field (see Einfo spec for details).
76
77 -- Associated_Node_For_Itype Node8
78 -- Dependent_Instances Elist8
79 -- Hiding_Loop_Variable Node8
80 -- Mechanism Uint8 (but returns Mechanism_Type)
81 -- Normalized_First_Bit Uint8
82 -- Refinement_Constituents Elist8
83 -- Return_Applies_To Node8
84 -- First_Exit_Statement Node8
85
86 -- Class_Wide_Type Node9
87 -- Current_Value Node9
88 -- Part_Of_Constituents Elist9
89 -- Renaming_Map Uint9
90
91 -- Encapsulating_State Node10
92 -- Direct_Primitive_Operations Elist10
93 -- Discriminal_Link Node10
94 -- Float_Rep Uint10 (but returns Float_Rep_Kind)
95 -- Handler_Records List10
96 -- Normalized_Position_Max Uint10
97
98 -- Component_Bit_Offset Uint11
99 -- Full_View Node11
100 -- Entry_Component Node11
101 -- Enumeration_Pos Uint11
102 -- Generic_Homonym Node11
103 -- Protected_Body_Subprogram Node11
104 -- Block_Node Node11
105
106 -- Barrier_Function Node12
107 -- Enumeration_Rep Uint12
108 -- Esize Uint12
109 -- Next_Inlined_Subprogram Node12
110
111 -- Component_Clause Node13
112 -- Elaboration_Entity Node13
113 -- Extra_Accessibility Node13
114 -- RM_Size Uint13
115
116 -- Alignment Uint14
117 -- Normalized_Position Uint14
118 -- Postconditions_Proc Node14
119 -- Shadow_Entities List14
120
121 -- Discriminant_Number Uint15
122 -- DT_Position Uint15
123 -- DT_Entry_Count Uint15
124 -- Entry_Parameters_Type Node15
125 -- Extra_Formal Node15
126 -- Pending_Access_Types Elist15
127 -- Related_Instance Node15
128 -- Status_Flag_Or_Transient_Decl Node15
129
130 -- Access_Disp_Table Elist16
131 -- Body_References Elist16
132 -- Cloned_Subtype Node16
133 -- DTC_Entity Node16
134 -- Entry_Formal Node16
135 -- First_Private_Entity Node16
136 -- Lit_Strings Node16
137 -- Scale_Value Uint16
138 -- String_Literal_Length Uint16
139 -- Unset_Reference Node16
140
141 -- Actual_Subtype Node17
142 -- Digits_Value Uint17
143 -- Discriminal Node17
144 -- First_Entity Node17
145 -- First_Index Node17
146 -- First_Literal Node17
147 -- Master_Id Node17
148 -- Modulus Uint17
149 -- Non_Limited_View Node17
150 -- Prival Node17
151
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
164
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 -- Parent_Subtype Node19
172 -- Size_Check_Code Node19
173 -- Spec_Entity Node19
174 -- Underlying_Full_View Node19
175
176 -- Component_Type Node20
177 -- Default_Value Node20
178 -- Directly_Designated_Type Node20
179 -- Discriminant_Checking_Func Node20
180 -- Discriminant_Default_Value Node20
181 -- Last_Entity Node20
182 -- Prival_Link Node20
183 -- Register_Exception_Call Node20
184 -- Scalar_Range Node20
185
186 -- Accept_Address Elist21
187 -- Default_Expr_Function Node21
188 -- Discriminant_Constraint Elist21
189 -- Interface_Name Node21
190 -- Original_Array_Type Node21
191 -- Small_Value Ureal21
192
193 -- Associated_Storage_Pool Node22
194 -- Component_Size Uint22
195 -- Corresponding_Remote_Type Node22
196 -- Enumeration_Rep_Expr Node22
197 -- Original_Record_Component Node22
198 -- Private_View Node22
199 -- Protected_Formal Node22
200 -- Scope_Depth_Value Uint22
201 -- Shared_Var_Procs_Instance Node22
202
203 -- CR_Discriminant Node23
204 -- Entry_Cancel_Parameter Node23
205 -- Enum_Pos_To_Rep Node23
206 -- Extra_Constrained Node23
207 -- Finalization_Master Node23
208 -- Generic_Renamings Elist23
209 -- Inner_Instances Elist23
210 -- Limited_View Node23
211 -- Packed_Array_Impl_Type Node23
212 -- Protection_Object Node23
213 -- Stored_Constraint Elist23
214
215 -- Related_Expression Node24
216 -- Uplevel_References Elist24
217 -- Subps_Index Uint24
218
219 -- Interface_Alias Node25
220 -- Interfaces Elist25
221 -- Debug_Renaming_Link Node25
222 -- DT_Offset_To_Top_Func Node25
223 -- PPC_Wrapper Node25
224 -- Related_Array_Object Node25
225 -- Static_Discrete_Predicate List25
226 -- Static_Real_Or_String_Predicate Node25
227 -- Task_Body_Procedure Node25
228
229 -- Dispatch_Table_Wrappers Elist26
230 -- Last_Assignment Node26
231 -- Overridden_Operation Node26
232 -- Package_Instantiation Node26
233 -- Storage_Size_Variable Node26
234
235 -- Current_Use_Clause Node27
236 -- Related_Type Node27
237 -- Wrapped_Entity Node27
238
239 -- Extra_Formals Node28
240 -- Finalizer Node28
241 -- Initialization_Statements Node28
242 -- Original_Access_Type Node28
243 -- Relative_Deadline_Variable Node28
244 -- Underlying_Record_View Node28
245
246 -- BIP_Initialization_Call Node29
247 -- Subprograms_For_Type Node29
248
249 -- Corresponding_Equality Node30
250 -- Last_Aggregate_Assignment Node30
251 -- Static_Initialization Node30
252
253 -- Derived_Type_Link Node31
254 -- Thunk_Entity Node31
255 -- Activation_Record_Component Node31
256
257 -- SPARK_Pragma Node32
258 -- No_Tagged_Streams_Pragma Node32
259
260 -- Linker_Section_Pragma Node33
261 -- SPARK_Aux_Pragma Node33
262
263 -- Contract Node34
264
265 -- Import_Pragma Node35
266
267 ---------------------------------------------
268 -- Usage of Flags in Defining Entity Nodes --
269 ---------------------------------------------
270
271 -- All flags are unique, there is no overlaying, so each flag is physically
272 -- present in every entity. However, for many of the flags, it only makes
273 -- sense for them to be set true for certain subsets of entity kinds. See
274 -- the spec of Einfo for further details.
275
276 -- Is_Inlined_Always Flag1
277 -- Is_Hidden_Non_Overridden_Subpgm Flag2
278 -- Has_Default_Init_Cond Flag3
279 -- Is_Frozen Flag4
280 -- Has_Discriminants Flag5
281 -- Is_Dispatching_Operation Flag6
282 -- Is_Immediately_Visible Flag7
283 -- In_Use Flag8
284 -- Is_Potentially_Use_Visible Flag9
285 -- Is_Public Flag10
286
287 -- Is_Inlined Flag11
288 -- Is_Constrained Flag12
289 -- Is_Generic_Type Flag13
290 -- Depends_On_Private Flag14
291 -- Is_Aliased Flag15
292 -- Is_Volatile Flag16
293 -- Is_Internal Flag17
294 -- Has_Delayed_Freeze Flag18
295 -- Is_Abstract_Subprogram Flag19
296 -- Is_Concurrent_Record_Type Flag20
297
298 -- Has_Master_Entity Flag21
299 -- Needs_No_Actuals Flag22
300 -- Has_Storage_Size_Clause Flag23
301 -- Is_Imported Flag24
302 -- Is_Limited_Record Flag25
303 -- Has_Completion Flag26
304 -- Has_Pragma_Controlled Flag27
305 -- Is_Statically_Allocated Flag28
306 -- Has_Size_Clause Flag29
307 -- Has_Task Flag30
308
309 -- Checks_May_Be_Suppressed Flag31
310 -- Kill_Elaboration_Checks Flag32
311 -- Kill_Range_Checks Flag33
312 -- Has_Independent_Components Flag34
313 -- Is_Class_Wide_Equivalent_Type Flag35
314 -- Referenced_As_LHS Flag36
315 -- Is_Known_Non_Null Flag37
316 -- Can_Never_Be_Null Flag38
317 -- Has_Default_Aspect Flag39
318 -- Body_Needed_For_SAL Flag40
319
320 -- Treat_As_Volatile Flag41
321 -- Is_Controlled Flag42
322 -- Has_Controlled_Component Flag43
323 -- Is_Pure Flag44
324 -- In_Private_Part Flag45
325 -- Has_Alignment_Clause Flag46
326 -- Has_Exit Flag47
327 -- In_Package_Body Flag48
328 -- Reachable Flag49
329 -- Delay_Subprogram_Descriptors Flag50
330
331 -- Is_Packed Flag51
332 -- Is_Entry_Formal Flag52
333 -- Is_Private_Descendant Flag53
334 -- Return_Present Flag54
335 -- Is_Tagged_Type Flag55
336 -- Has_Homonym Flag56
337 -- Is_Hidden Flag57
338 -- Non_Binary_Modulus Flag58
339 -- Is_Preelaborated Flag59
340 -- Is_Shared_Passive Flag60
341
342 -- Is_Remote_Types Flag61
343 -- Is_Remote_Call_Interface Flag62
344 -- Is_Character_Type Flag63
345 -- Is_Intrinsic_Subprogram Flag64
346 -- Has_Record_Rep_Clause Flag65
347 -- Has_Enumeration_Rep_Clause Flag66
348 -- Has_Small_Clause Flag67
349 -- Has_Component_Size_Clause Flag68
350 -- Is_Access_Constant Flag69
351 -- Is_First_Subtype Flag70
352
353 -- Has_Completion_In_Body Flag71
354 -- Has_Unknown_Discriminants Flag72
355 -- Is_Child_Unit Flag73
356 -- Is_CPP_Class Flag74
357 -- Has_Non_Standard_Rep Flag75
358 -- Is_Constructor Flag76
359 -- Static_Elaboration_Desired Flag77
360 -- Is_Tag Flag78
361 -- Has_All_Calls_Remote Flag79
362 -- Is_Constr_Subt_For_U_Nominal Flag80
363
364 -- Is_Asynchronous Flag81
365 -- Has_Gigi_Rep_Item Flag82
366 -- Has_Machine_Radix_Clause Flag83
367 -- Machine_Radix_10 Flag84
368 -- Is_Atomic Flag85
369 -- Has_Atomic_Components Flag86
370 -- Has_Volatile_Components Flag87
371 -- Discard_Names Flag88
372 -- Is_Interrupt_Handler Flag89
373 -- Returns_By_Ref Flag90
374
375 -- Is_Itype Flag91
376 -- Size_Known_At_Compile_Time Flag92
377 -- Reverse_Storage_Order Flag93
378 -- Is_Generic_Actual_Type Flag94
379 -- Uses_Sec_Stack Flag95
380 -- Warnings_Off Flag96
381 -- Is_Controlling_Formal Flag97
382 -- Has_Controlling_Result Flag98
383 -- Is_Exported Flag99
384 -- Has_Specified_Layout Flag100
385
386 -- Has_Nested_Block_With_Handler Flag101
387 -- Is_Called Flag102
388 -- Is_Completely_Hidden Flag103
389 -- Address_Taken Flag104
390 -- Suppress_Initialization Flag105
391 -- Is_Limited_Composite Flag106
392 -- Is_Private_Composite Flag107
393 -- Default_Expressions_Processed Flag108
394 -- Is_Non_Static_Subtype Flag109
395 -- Has_Out_Or_In_Out_Parameter Flag110
396
397 -- Is_Formal_Subprogram Flag111
398 -- Is_Renaming_Of_Object Flag112
399 -- No_Return Flag113
400 -- Delay_Cleanups Flag114
401 -- Never_Set_In_Source Flag115
402 -- Is_Visible_Lib_Unit Flag116
403 -- Is_Unchecked_Union Flag117
404 -- Is_For_Access_Subtype Flag118
405 -- Has_Convention_Pragma Flag119
406 -- Has_Primitive_Operations Flag120
407
408 -- Has_Pragma_Pack Flag121
409 -- Is_Bit_Packed_Array Flag122
410 -- Has_Unchecked_Union Flag123
411 -- Is_Eliminated Flag124
412 -- C_Pass_By_Copy Flag125
413 -- Is_Instantiated Flag126
414 -- Is_Valued_Procedure Flag127
415 -- (used for Component_Alignment) Flag128
416 -- (used for Component_Alignment) Flag129
417 -- Is_Generic_Instance Flag130
418
419 -- No_Pool_Assigned Flag131
420 -- Is_Default_Init_Cond_Procedure Flag132
421 -- Has_Inherited_Default_Init_Cond Flag133
422 -- Returns_Limited_View Flag134
423 -- Has_Aliased_Components Flag135
424 -- No_Strict_Aliasing Flag136
425 -- Is_Machine_Code_Subprogram Flag137
426 -- Is_Packed_Array_Impl_Type Flag138
427 -- Has_Biased_Representation Flag139
428 -- Has_Complex_Representation Flag140
429
430 -- Is_Constr_Subt_For_UN_Aliased Flag141
431 -- Has_Missing_Return Flag142
432 -- Has_Recursive_Call Flag143
433 -- Is_Unsigned_Type Flag144
434 -- Strict_Alignment Flag145
435 -- Is_Abstract_Type Flag146
436 -- Needs_Debug_Info Flag147
437 -- Suppress_Elaboration_Warnings Flag148
438 -- Is_Compilation_Unit Flag149
439 -- Has_Pragma_Elaborate_Body Flag150
440
441 -- Has_Private_Ancestor Flag151
442 -- Entry_Accepted Flag152
443 -- Is_Obsolescent Flag153
444 -- Has_Per_Object_Constraint Flag154
445 -- Has_Private_Declaration Flag155
446 -- Referenced Flag156
447 -- Has_Pragma_Inline Flag157
448 -- Finalize_Storage_Only Flag158
449 -- From_Limited_With Flag159
450 -- Is_Package_Body_Entity Flag160
451
452 -- Has_Qualified_Name Flag161
453 -- Nonzero_Is_True Flag162
454 -- Is_True_Constant Flag163
455 -- Reverse_Bit_Order Flag164
456 -- Suppress_Style_Checks Flag165
457 -- Debug_Info_Off Flag166
458 -- Sec_Stack_Needed_For_Return Flag167
459 -- Materialize_Entity Flag168
460 -- Has_Pragma_Thread_Local_Storage Flag169
461 -- Is_Known_Valid Flag170
462
463 -- Is_Hidden_Open_Scope Flag171
464 -- Has_Object_Size_Clause Flag172
465 -- Has_Fully_Qualified_Name Flag173
466 -- Elaboration_Entity_Required Flag174
467 -- Has_Forward_Instantiation Flag175
468 -- Is_Discrim_SO_Function Flag176
469 -- Size_Depends_On_Discriminant Flag177
470 -- Is_Null_Init_Proc Flag178
471 -- Has_Pragma_Pure_Function Flag179
472 -- Has_Pragma_Unreferenced Flag180
473
474 -- Has_Contiguous_Rep Flag181
475 -- Has_Xref_Entry Flag182
476 -- Must_Be_On_Byte_Boundary Flag183
477 -- Has_Stream_Size_Clause Flag184
478 -- Is_Ada_2005_Only Flag185
479 -- Is_Interface Flag186
480 -- Has_Constrained_Partial_View Flag187
481 -- Uses_Lock_Free Flag188
482 -- Is_Pure_Unit_Access_Type Flag189
483 -- Has_Specified_Stream_Input Flag190
484
485 -- Has_Specified_Stream_Output Flag191
486 -- Has_Specified_Stream_Read Flag192
487 -- Has_Specified_Stream_Write Flag193
488 -- Is_Local_Anonymous_Access Flag194
489 -- Is_Primitive_Wrapper Flag195
490 -- Was_Hidden Flag196
491 -- Is_Limited_Interface Flag197
492 -- Has_Pragma_Ordered Flag198
493 -- Is_Ada_2012_Only Flag199
494
495 -- Has_Delayed_Aspects Flag200
496 -- Has_Pragma_No_Inline Flag201
497 -- Itype_Printed Flag202
498 -- Has_Pragma_Pure Flag203
499 -- Is_Known_Null Flag204
500 -- Low_Bound_Tested Flag205
501 -- Is_Visible_Formal Flag206
502 -- Known_To_Have_Preelab_Init Flag207
503 -- Must_Have_Preelab_Init Flag208
504 -- Is_Return_Object Flag209
505 -- Elaborate_Body_Desirable Flag210
506
507 -- Has_Static_Discriminants Flag211
508 -- Has_Pragma_Unreferenced_Objects Flag212
509 -- Requires_Overriding Flag213
510 -- Has_RACW Flag214
511 -- Has_Uplevel_Reference Flag215
512 -- Universal_Aliasing Flag216
513 -- Suppress_Value_Tracking_On_Call Flag217
514 -- Is_Primitive Flag218
515 -- Has_Initial_Value Flag219
516 -- Has_Dispatch_Table Flag220
517
518 -- Has_Pragma_Preelab_Init Flag221
519 -- Used_As_Generic_Actual Flag222
520 -- Is_Descendent_Of_Address Flag223
521 -- Is_Raised Flag224
522 -- Is_Thunk Flag225
523 -- Is_Only_Out_Parameter Flag226
524 -- Referenced_As_Out_Parameter Flag227
525 -- Has_Thunks Flag228
526 -- Can_Use_Internal_Rep Flag229
527 -- Has_Pragma_Inline_Always Flag230
528
529 -- Renamed_In_Spec Flag231
530 -- Has_Invariants Flag232
531 -- Has_Pragma_Unmodified Flag233
532 -- Is_Dispatch_Table_Entity Flag234
533 -- Is_Trivial_Subprogram Flag235
534 -- Warnings_Off_Used Flag236
535 -- Warnings_Off_Used_Unmodified Flag237
536 -- Warnings_Off_Used_Unreferenced Flag238
537 -- OK_To_Reorder_Components Flag239
538 -- Has_Expanded_Contract Flag240
539
540 -- Optimize_Alignment_Space Flag241
541 -- Optimize_Alignment_Time Flag242
542 -- Overlays_Constant Flag243
543 -- Is_RACW_Stub_Type Flag244
544 -- Is_Private_Primitive Flag245
545 -- Is_Underlying_Record_View Flag246
546 -- OK_To_Rename Flag247
547 -- Has_Inheritable_Invariants Flag248
548 -- Is_Safe_To_Reevaluate Flag249
549 -- Has_Predicates Flag250
550
551 -- Has_Implicit_Dereference Flag251
552 -- Is_Processed_Transient Flag252
553 -- Has_Anonymous_Master Flag253
554 -- Is_Implementation_Defined Flag254
555 -- Is_Predicate_Function Flag255
556 -- Is_Predicate_Function_M Flag256
557 -- Is_Invariant_Procedure Flag257
558 -- Has_Dynamic_Predicate_Aspect Flag258
559 -- Has_Static_Predicate_Aspect Flag259
560 -- Has_Loop_Entry_Attributes Flag260
561
562 -- Has_Delayed_Rep_Aspects Flag261
563 -- May_Inherit_Delayed_Rep_Aspects Flag262
564 -- Has_Visible_Refinement Flag263
565 -- Is_Discriminant_Check_Function Flag264
566 -- SPARK_Pragma_Inherited Flag265
567 -- SPARK_Aux_Pragma_Inherited Flag266
568 -- Has_Shift_Operator Flag267
569 -- Is_Independent Flag268
570 -- Has_Static_Predicate Flag269
571 -- Stores_Attribute_Old_Prefix Flag270
572
573 -- Has_Protected Flag271
574 -- SSO_Set_Low_By_Default Flag272
575 -- SSO_Set_High_By_Default Flag273
576 -- Is_Generic_Actual_Subprogram Flag274
577 -- No_Predicate_On_Actual Flag275
578 -- No_Dynamic_Predicate_On_Actual Flag276
579 -- Is_Checked_Ghost_Entity Flag277
580 -- Is_Ignored_Ghost_Entity Flag278
581 -- Contains_Ignored_Ghost_Code Flag279
582 -- Partial_View_Has_Unknown_Discr Flag280
583
584 -- Is_Static_Type Flag281
585 -- Has_Nested_Subprogram Flag282
586 -- Uplevel_Reference_Noted Flag283
587
588 -- Is_ARECnF_Entity Flag284
589 -- (unused) Flag285
590 -- (unused) Flag286
591
592 -- Note: Flag287-317 are defined in atree.ads/adb, but not yet in atree.h
593
594 -----------------------
595 -- Local subprograms --
596 -----------------------
597
598 function Has_Option
599 (State_Id : Entity_Id;
600 Option_Nam : Name_Id) return Boolean;
601 -- Determine whether abstract state State_Id has particular option denoted
602 -- by the name Option_Nam.
603
604 ---------------
605 -- Float_Rep --
606 ---------------
607
608 function Float_Rep (Id : E) return F is
609 pragma Assert (Is_Floating_Point_Type (Id));
610 begin
611 return F'Val (UI_To_Int (Uint10 (Base_Type (Id))));
612 end Float_Rep;
613
614 ----------------
615 -- Has_Option --
616 ----------------
617
618 function Has_Option
619 (State_Id : Entity_Id;
620 Option_Nam : Name_Id) return Boolean
621 is
622 Decl : constant Node_Id := Parent (State_Id);
623 Opt : Node_Id;
624 Opt_Nam : Node_Id;
625
626 begin
627 pragma Assert (Ekind (State_Id) = E_Abstract_State);
628
629 -- The declaration of abstract states with options appear as an
630 -- extension aggregate. If this is not the case, the option is not
631 -- available.
632
633 if Nkind (Decl) /= N_Extension_Aggregate then
634 return False;
635 end if;
636
637 -- Simple options
638
639 Opt := First (Expressions (Decl));
640 while Present (Opt) loop
641
642 -- Currently the only simple option allowed is External
643
644 if Nkind (Opt) = N_Identifier
645 and then Chars (Opt) = Name_External
646 and then Chars (Opt) = Option_Nam
647 then
648 return True;
649 end if;
650
651 Next (Opt);
652 end loop;
653
654 -- Complex options with various specifiers
655
656 Opt := First (Component_Associations (Decl));
657 while Present (Opt) loop
658 Opt_Nam := First (Choices (Opt));
659
660 if Nkind (Opt_Nam) = N_Identifier
661 and then Chars (Opt_Nam) = Option_Nam
662 then
663 return True;
664 end if;
665
666 Next (Opt);
667 end loop;
668
669 return False;
670 end Has_Option;
671
672 --------------------------------
673 -- Attribute Access Functions --
674 --------------------------------
675
676 function Abstract_States (Id : E) return L is
677 begin
678 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
679 return Elist25 (Id);
680 end Abstract_States;
681
682 function Accept_Address (Id : E) return L is
683 begin
684 return Elist21 (Id);
685 end Accept_Address;
686
687 function Access_Disp_Table (Id : E) return L is
688 begin
689 pragma Assert (Ekind_In (Id, E_Record_Type,
690 E_Record_Subtype));
691 return Elist16 (Implementation_Base_Type (Id));
692 end Access_Disp_Table;
693
694 function Activation_Record_Component (Id : E) return E is
695 begin
696 pragma Assert (Ekind_In (Id, E_Constant,
697 E_In_Parameter,
698 E_In_Out_Parameter,
699 E_Loop_Parameter,
700 E_Out_Parameter,
701 E_Variable));
702 return Node31 (Id);
703 end Activation_Record_Component;
704
705 function Actual_Subtype (Id : E) return E is
706 begin
707 pragma Assert
708 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
709 or else Is_Formal (Id));
710 return Node17 (Id);
711 end Actual_Subtype;
712
713 function Address_Taken (Id : E) return B is
714 begin
715 return Flag104 (Id);
716 end Address_Taken;
717
718 function Alias (Id : E) return E is
719 begin
720 pragma Assert
721 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
722 return Node18 (Id);
723 end Alias;
724
725 function Alignment (Id : E) return U is
726 begin
727 pragma Assert (Is_Type (Id)
728 or else Is_Formal (Id)
729 or else Ekind_In (Id, E_Loop_Parameter,
730 E_Constant,
731 E_Exception,
732 E_Variable));
733 return Uint14 (Id);
734 end Alignment;
735
736 function Associated_Formal_Package (Id : E) return E is
737 begin
738 pragma Assert (Ekind (Id) = E_Package);
739 return Node12 (Id);
740 end Associated_Formal_Package;
741
742 function Associated_Node_For_Itype (Id : E) return N is
743 begin
744 return Node8 (Id);
745 end Associated_Node_For_Itype;
746
747 function Associated_Storage_Pool (Id : E) return E is
748 begin
749 pragma Assert (Is_Access_Type (Id));
750 return Node22 (Root_Type (Id));
751 end Associated_Storage_Pool;
752
753 function Barrier_Function (Id : E) return N is
754 begin
755 pragma Assert (Is_Entry (Id));
756 return Node12 (Id);
757 end Barrier_Function;
758
759 function Block_Node (Id : E) return N is
760 begin
761 pragma Assert (Ekind (Id) = E_Block);
762 return Node11 (Id);
763 end Block_Node;
764
765 function Body_Entity (Id : E) return E is
766 begin
767 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
768 return Node19 (Id);
769 end Body_Entity;
770
771 function Body_Needed_For_SAL (Id : E) return B is
772 begin
773 pragma Assert
774 (Ekind (Id) = E_Package
775 or else Is_Subprogram (Id)
776 or else Is_Generic_Unit (Id));
777 return Flag40 (Id);
778 end Body_Needed_For_SAL;
779
780 function Body_References (Id : E) return L is
781 begin
782 pragma Assert (Ekind (Id) = E_Abstract_State);
783 return Elist16 (Id);
784 end Body_References;
785
786 function BIP_Initialization_Call (Id : E) return N is
787 begin
788 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
789 return Node29 (Id);
790 end BIP_Initialization_Call;
791
792 function C_Pass_By_Copy (Id : E) return B is
793 begin
794 pragma Assert (Is_Record_Type (Id));
795 return Flag125 (Implementation_Base_Type (Id));
796 end C_Pass_By_Copy;
797
798 function Can_Never_Be_Null (Id : E) return B is
799 begin
800 return Flag38 (Id);
801 end Can_Never_Be_Null;
802
803 function Checks_May_Be_Suppressed (Id : E) return B is
804 begin
805 return Flag31 (Id);
806 end Checks_May_Be_Suppressed;
807
808 function Class_Wide_Type (Id : E) return E is
809 begin
810 pragma Assert (Is_Type (Id));
811 return Node9 (Id);
812 end Class_Wide_Type;
813
814 function Cloned_Subtype (Id : E) return E is
815 begin
816 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
817 return Node16 (Id);
818 end Cloned_Subtype;
819
820 function Component_Bit_Offset (Id : E) return U is
821 begin
822 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
823 return Uint11 (Id);
824 end Component_Bit_Offset;
825
826 function Component_Clause (Id : E) return N is
827 begin
828 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
829 return Node13 (Id);
830 end Component_Clause;
831
832 function Component_Size (Id : E) return U is
833 begin
834 pragma Assert (Is_Array_Type (Id));
835 return Uint22 (Implementation_Base_Type (Id));
836 end Component_Size;
837
838 function Component_Type (Id : E) return E is
839 begin
840 pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
841 return Node20 (Implementation_Base_Type (Id));
842 end Component_Type;
843
844 function Corresponding_Concurrent_Type (Id : E) return E is
845 begin
846 pragma Assert (Ekind (Id) = E_Record_Type);
847 return Node18 (Id);
848 end Corresponding_Concurrent_Type;
849
850 function Corresponding_Discriminant (Id : E) return E is
851 begin
852 pragma Assert (Ekind (Id) = E_Discriminant);
853 return Node19 (Id);
854 end Corresponding_Discriminant;
855
856 function Corresponding_Equality (Id : E) return E is
857 begin
858 pragma Assert
859 (Ekind (Id) = E_Function
860 and then not Comes_From_Source (Id)
861 and then Chars (Id) = Name_Op_Ne);
862 return Node30 (Id);
863 end Corresponding_Equality;
864
865 function Corresponding_Protected_Entry (Id : E) return E is
866 begin
867 pragma Assert (Ekind (Id) = E_Subprogram_Body);
868 return Node18 (Id);
869 end Corresponding_Protected_Entry;
870
871 function Corresponding_Record_Type (Id : E) return E is
872 begin
873 pragma Assert (Is_Concurrent_Type (Id));
874 return Node18 (Id);
875 end Corresponding_Record_Type;
876
877 function Corresponding_Remote_Type (Id : E) return E is
878 begin
879 return Node22 (Id);
880 end Corresponding_Remote_Type;
881
882 function Current_Use_Clause (Id : E) return E is
883 begin
884 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
885 return Node27 (Id);
886 end Current_Use_Clause;
887
888 function Current_Value (Id : E) return N is
889 begin
890 pragma Assert (Ekind (Id) in Object_Kind);
891 return Node9 (Id);
892 end Current_Value;
893
894 function CR_Discriminant (Id : E) return E is
895 begin
896 return Node23 (Id);
897 end CR_Discriminant;
898
899 function Debug_Info_Off (Id : E) return B is
900 begin
901 return Flag166 (Id);
902 end Debug_Info_Off;
903
904 function Debug_Renaming_Link (Id : E) return E is
905 begin
906 return Node25 (Id);
907 end Debug_Renaming_Link;
908
909 function Default_Aspect_Component_Value (Id : E) return N is
910 begin
911 pragma Assert (Is_Array_Type (Id));
912 return Node19 (Base_Type (Id));
913 end Default_Aspect_Component_Value;
914
915 function Default_Aspect_Value (Id : E) return N is
916 begin
917 pragma Assert (Is_Scalar_Type (Id));
918 return Node19 (Base_Type (Id));
919 end Default_Aspect_Value;
920
921 function Default_Expr_Function (Id : E) return E is
922 begin
923 pragma Assert (Is_Formal (Id));
924 return Node21 (Id);
925 end Default_Expr_Function;
926
927 function Default_Expressions_Processed (Id : E) return B is
928 begin
929 return Flag108 (Id);
930 end Default_Expressions_Processed;
931
932 function Default_Value (Id : E) return N is
933 begin
934 pragma Assert (Is_Formal (Id));
935 return Node20 (Id);
936 end Default_Value;
937
938 function Delay_Cleanups (Id : E) return B is
939 begin
940 return Flag114 (Id);
941 end Delay_Cleanups;
942
943 function Delay_Subprogram_Descriptors (Id : E) return B is
944 begin
945 return Flag50 (Id);
946 end Delay_Subprogram_Descriptors;
947
948 function Delta_Value (Id : E) return R is
949 begin
950 pragma Assert (Is_Fixed_Point_Type (Id));
951 return Ureal18 (Id);
952 end Delta_Value;
953
954 function Dependent_Instances (Id : E) return L is
955 begin
956 pragma Assert (Is_Generic_Instance (Id));
957 return Elist8 (Id);
958 end Dependent_Instances;
959
960 function Depends_On_Private (Id : E) return B is
961 begin
962 pragma Assert (Nkind (Id) in N_Entity);
963 return Flag14 (Id);
964 end Depends_On_Private;
965
966 function Derived_Type_Link (Id : E) return E is
967 begin
968 pragma Assert (Is_Type (Id));
969 return Node31 (Base_Type (Id));
970 end Derived_Type_Link;
971
972 function Digits_Value (Id : E) return U is
973 begin
974 pragma Assert
975 (Is_Floating_Point_Type (Id)
976 or else Is_Decimal_Fixed_Point_Type (Id));
977 return Uint17 (Id);
978 end Digits_Value;
979
980 function Direct_Primitive_Operations (Id : E) return L is
981 begin
982 pragma Assert (Is_Tagged_Type (Id));
983 return Elist10 (Id);
984 end Direct_Primitive_Operations;
985
986 function Directly_Designated_Type (Id : E) return E is
987 begin
988 pragma Assert (Is_Access_Type (Id));
989 return Node20 (Id);
990 end Directly_Designated_Type;
991
992 function Discard_Names (Id : E) return B is
993 begin
994 return Flag88 (Id);
995 end Discard_Names;
996
997 function Discriminal (Id : E) return E is
998 begin
999 pragma Assert (Ekind (Id) = E_Discriminant);
1000 return Node17 (Id);
1001 end Discriminal;
1002
1003 function Discriminal_Link (Id : E) return N is
1004 begin
1005 return Node10 (Id);
1006 end Discriminal_Link;
1007
1008 function Discriminant_Checking_Func (Id : E) return E is
1009 begin
1010 pragma Assert (Ekind (Id) = E_Component);
1011 return Node20 (Id);
1012 end Discriminant_Checking_Func;
1013
1014 function Discriminant_Constraint (Id : E) return L is
1015 begin
1016 pragma Assert (Is_Composite_Type (Id) and then Has_Discriminants (Id));
1017 return Elist21 (Id);
1018 end Discriminant_Constraint;
1019
1020 function Discriminant_Default_Value (Id : E) return N is
1021 begin
1022 pragma Assert (Ekind (Id) = E_Discriminant);
1023 return Node20 (Id);
1024 end Discriminant_Default_Value;
1025
1026 function Discriminant_Number (Id : E) return U is
1027 begin
1028 pragma Assert (Ekind (Id) = E_Discriminant);
1029 return Uint15 (Id);
1030 end Discriminant_Number;
1031
1032 function Dispatch_Table_Wrappers (Id : E) return L is
1033 begin
1034 pragma Assert (Ekind_In (Id, E_Record_Type,
1035 E_Record_Subtype));
1036 return Elist26 (Implementation_Base_Type (Id));
1037 end Dispatch_Table_Wrappers;
1038
1039 function DT_Entry_Count (Id : E) return U is
1040 begin
1041 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
1042 return Uint15 (Id);
1043 end DT_Entry_Count;
1044
1045 function DT_Offset_To_Top_Func (Id : E) return E is
1046 begin
1047 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
1048 return Node25 (Id);
1049 end DT_Offset_To_Top_Func;
1050
1051 function DT_Position (Id : E) return U is
1052 begin
1053 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
1054 and then Present (DTC_Entity (Id)));
1055 return Uint15 (Id);
1056 end DT_Position;
1057
1058 function DTC_Entity (Id : E) return E is
1059 begin
1060 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
1061 return Node16 (Id);
1062 end DTC_Entity;
1063
1064 function Elaborate_Body_Desirable (Id : E) return B is
1065 begin
1066 pragma Assert (Ekind (Id) = E_Package);
1067 return Flag210 (Id);
1068 end Elaborate_Body_Desirable;
1069
1070 function Elaboration_Entity (Id : E) return E is
1071 begin
1072 pragma Assert
1073 (Is_Subprogram (Id)
1074 or else
1075 Ekind (Id) = E_Package
1076 or else
1077 Is_Generic_Unit (Id));
1078 return Node13 (Id);
1079 end Elaboration_Entity;
1080
1081 function Elaboration_Entity_Required (Id : E) return B is
1082 begin
1083 pragma Assert
1084 (Is_Subprogram (Id)
1085 or else
1086 Ekind (Id) = E_Package
1087 or else
1088 Is_Generic_Unit (Id));
1089 return Flag174 (Id);
1090 end Elaboration_Entity_Required;
1091
1092 function Encapsulating_State (Id : E) return N is
1093 begin
1094 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
1095 return Node10 (Id);
1096 end Encapsulating_State;
1097
1098 function Enclosing_Scope (Id : E) return E is
1099 begin
1100 return Node18 (Id);
1101 end Enclosing_Scope;
1102
1103 function Entry_Accepted (Id : E) return B is
1104 begin
1105 pragma Assert (Is_Entry (Id));
1106 return Flag152 (Id);
1107 end Entry_Accepted;
1108
1109 function Entry_Bodies_Array (Id : E) return E is
1110 begin
1111 return Node19 (Id);
1112 end Entry_Bodies_Array;
1113
1114 function Entry_Cancel_Parameter (Id : E) return E is
1115 begin
1116 return Node23 (Id);
1117 end Entry_Cancel_Parameter;
1118
1119 function Entry_Component (Id : E) return E is
1120 begin
1121 return Node11 (Id);
1122 end Entry_Component;
1123
1124 function Entry_Formal (Id : E) return E is
1125 begin
1126 return Node16 (Id);
1127 end Entry_Formal;
1128
1129 function Entry_Index_Constant (Id : E) return N is
1130 begin
1131 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
1132 return Node18 (Id);
1133 end Entry_Index_Constant;
1134
1135 function Contains_Ignored_Ghost_Code (Id : E) return B is
1136 begin
1137 pragma Assert
1138 (Ekind_In (Id, E_Block,
1139 E_Function,
1140 E_Generic_Function,
1141 E_Generic_Package,
1142 E_Generic_Procedure,
1143 E_Package,
1144 E_Package_Body,
1145 E_Procedure,
1146 E_Subprogram_Body));
1147 return Flag279 (Id);
1148 end Contains_Ignored_Ghost_Code;
1149
1150 function Contract (Id : E) return N is
1151 begin
1152 pragma Assert
1153 (Ekind_In (Id, E_Entry,
1154 E_Entry_Family,
1155 E_Generic_Package,
1156 E_Package,
1157 E_Package_Body,
1158 E_Subprogram_Body,
1159 E_Variable)
1160 or else Is_Subprogram_Or_Generic_Subprogram (Id));
1161 return Node34 (Id);
1162 end Contract;
1163
1164 function Entry_Parameters_Type (Id : E) return E is
1165 begin
1166 return Node15 (Id);
1167 end Entry_Parameters_Type;
1168
1169 function Enum_Pos_To_Rep (Id : E) return E is
1170 begin
1171 pragma Assert (Ekind (Id) = E_Enumeration_Type);
1172 return Node23 (Id);
1173 end Enum_Pos_To_Rep;
1174
1175 function Enumeration_Pos (Id : E) return Uint is
1176 begin
1177 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1178 return Uint11 (Id);
1179 end Enumeration_Pos;
1180
1181 function Enumeration_Rep (Id : E) return U is
1182 begin
1183 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1184 return Uint12 (Id);
1185 end Enumeration_Rep;
1186
1187 function Enumeration_Rep_Expr (Id : E) return N is
1188 begin
1189 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
1190 return Node22 (Id);
1191 end Enumeration_Rep_Expr;
1192
1193 function Equivalent_Type (Id : E) return E is
1194 begin
1195 pragma Assert
1196 (Ekind_In (Id, E_Class_Wide_Type,
1197 E_Class_Wide_Subtype,
1198 E_Access_Subprogram_Type,
1199 E_Access_Protected_Subprogram_Type,
1200 E_Anonymous_Access_Protected_Subprogram_Type,
1201 E_Access_Subprogram_Type,
1202 E_Exception_Type));
1203 return Node18 (Id);
1204 end Equivalent_Type;
1205
1206 function Esize (Id : E) return Uint is
1207 begin
1208 return Uint12 (Id);
1209 end Esize;
1210
1211 function Extra_Accessibility (Id : E) return E is
1212 begin
1213 pragma Assert
1214 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
1215 return Node13 (Id);
1216 end Extra_Accessibility;
1217
1218 function Extra_Accessibility_Of_Result (Id : E) return E is
1219 begin
1220 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
1221 return Node19 (Id);
1222 end Extra_Accessibility_Of_Result;
1223
1224 function Extra_Constrained (Id : E) return E is
1225 begin
1226 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
1227 return Node23 (Id);
1228 end Extra_Constrained;
1229
1230 function Extra_Formal (Id : E) return E is
1231 begin
1232 return Node15 (Id);
1233 end Extra_Formal;
1234
1235 function Extra_Formals (Id : E) return E is
1236 begin
1237 pragma Assert
1238 (Is_Overloadable (Id)
1239 or else Ekind_In (Id, E_Entry_Family,
1240 E_Subprogram_Body,
1241 E_Subprogram_Type));
1242 return Node28 (Id);
1243 end Extra_Formals;
1244
1245 function Can_Use_Internal_Rep (Id : E) return B is
1246 begin
1247 pragma Assert (Is_Access_Subprogram_Type (Base_Type (Id)));
1248 return Flag229 (Base_Type (Id));
1249 end Can_Use_Internal_Rep;
1250
1251 function Finalization_Master (Id : E) return E is
1252 begin
1253 pragma Assert (Is_Access_Type (Id));
1254 return Node23 (Root_Type (Id));
1255 end Finalization_Master;
1256
1257 function Finalize_Storage_Only (Id : E) return B is
1258 begin
1259 pragma Assert (Is_Type (Id));
1260 return Flag158 (Base_Type (Id));
1261 end Finalize_Storage_Only;
1262
1263 function Finalizer (Id : E) return E is
1264 begin
1265 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
1266 return Node28 (Id);
1267 end Finalizer;
1268
1269 function First_Entity (Id : E) return E is
1270 begin
1271 return Node17 (Id);
1272 end First_Entity;
1273
1274 function First_Exit_Statement (Id : E) return N is
1275 begin
1276 pragma Assert (Ekind (Id) = E_Loop);
1277 return Node8 (Id);
1278 end First_Exit_Statement;
1279
1280 function First_Index (Id : E) return N is
1281 begin
1282 pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
1283 return Node17 (Id);
1284 end First_Index;
1285
1286 function First_Literal (Id : E) return E is
1287 begin
1288 pragma Assert (Is_Enumeration_Type (Id));
1289 return Node17 (Id);
1290 end First_Literal;
1291
1292 function First_Private_Entity (Id : E) return E is
1293 begin
1294 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
1295 or else Ekind (Id) in Concurrent_Kind);
1296 return Node16 (Id);
1297 end First_Private_Entity;
1298
1299 function First_Rep_Item (Id : E) return E is
1300 begin
1301 return Node6 (Id);
1302 end First_Rep_Item;
1303
1304 function Freeze_Node (Id : E) return N is
1305 begin
1306 return Node7 (Id);
1307 end Freeze_Node;
1308
1309 function From_Limited_With (Id : E) return B is
1310 begin
1311 return Flag159 (Id);
1312 end From_Limited_With;
1313
1314 function Full_View (Id : E) return E is
1315 begin
1316 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
1317 return Node11 (Id);
1318 end Full_View;
1319
1320 function Generic_Homonym (Id : E) return E is
1321 begin
1322 pragma Assert (Ekind (Id) = E_Generic_Package);
1323 return Node11 (Id);
1324 end Generic_Homonym;
1325
1326 function Generic_Renamings (Id : E) return L is
1327 begin
1328 return Elist23 (Id);
1329 end Generic_Renamings;
1330
1331 function Handler_Records (Id : E) return S is
1332 begin
1333 return List10 (Id);
1334 end Handler_Records;
1335
1336 function Has_Aliased_Components (Id : E) return B is
1337 begin
1338 return Flag135 (Implementation_Base_Type (Id));
1339 end Has_Aliased_Components;
1340
1341 function Has_Alignment_Clause (Id : E) return B is
1342 begin
1343 return Flag46 (Id);
1344 end Has_Alignment_Clause;
1345
1346 function Has_All_Calls_Remote (Id : E) return B is
1347 begin
1348 return Flag79 (Id);
1349 end Has_All_Calls_Remote;
1350
1351 function Has_Anonymous_Master (Id : E) return B is
1352 begin
1353 pragma Assert
1354 (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
1355 return Flag253 (Id);
1356 end Has_Anonymous_Master;
1357
1358 function Has_Atomic_Components (Id : E) return B is
1359 begin
1360 return Flag86 (Implementation_Base_Type (Id));
1361 end Has_Atomic_Components;
1362
1363 function Has_Biased_Representation (Id : E) return B is
1364 begin
1365 return Flag139 (Id);
1366 end Has_Biased_Representation;
1367
1368 function Has_Completion (Id : E) return B is
1369 begin
1370 return Flag26 (Id);
1371 end Has_Completion;
1372
1373 function Has_Completion_In_Body (Id : E) return B is
1374 begin
1375 pragma Assert (Is_Type (Id));
1376 return Flag71 (Id);
1377 end Has_Completion_In_Body;
1378
1379 function Has_Complex_Representation (Id : E) return B is
1380 begin
1381 pragma Assert (Is_Type (Id));
1382 return Flag140 (Implementation_Base_Type (Id));
1383 end Has_Complex_Representation;
1384
1385 function Has_Component_Size_Clause (Id : E) return B is
1386 begin
1387 pragma Assert (Is_Array_Type (Id));
1388 return Flag68 (Implementation_Base_Type (Id));
1389 end Has_Component_Size_Clause;
1390
1391 function Has_Constrained_Partial_View (Id : E) return B is
1392 begin
1393 pragma Assert (Is_Type (Id));
1394 return Flag187 (Id);
1395 end Has_Constrained_Partial_View;
1396
1397 function Has_Controlled_Component (Id : E) return B is
1398 begin
1399 return Flag43 (Base_Type (Id));
1400 end Has_Controlled_Component;
1401
1402 function Has_Contiguous_Rep (Id : E) return B is
1403 begin
1404 return Flag181 (Id);
1405 end Has_Contiguous_Rep;
1406
1407 function Has_Controlling_Result (Id : E) return B is
1408 begin
1409 return Flag98 (Id);
1410 end Has_Controlling_Result;
1411
1412 function Has_Convention_Pragma (Id : E) return B is
1413 begin
1414 return Flag119 (Id);
1415 end Has_Convention_Pragma;
1416
1417 function Has_Default_Aspect (Id : E) return B is
1418 begin
1419 return Flag39 (Base_Type (Id));
1420 end Has_Default_Aspect;
1421
1422 function Has_Default_Init_Cond (Id : E) return B is
1423 begin
1424 return Flag3 (Id);
1425 end Has_Default_Init_Cond;
1426
1427 function Has_Delayed_Aspects (Id : E) return B is
1428 begin
1429 pragma Assert (Nkind (Id) in N_Entity);
1430 return Flag200 (Id);
1431 end Has_Delayed_Aspects;
1432
1433 function Has_Delayed_Freeze (Id : E) return B is
1434 begin
1435 pragma Assert (Nkind (Id) in N_Entity);
1436 return Flag18 (Id);
1437 end Has_Delayed_Freeze;
1438
1439 function Has_Delayed_Rep_Aspects (Id : E) return B is
1440 begin
1441 pragma Assert (Nkind (Id) in N_Entity);
1442 return Flag261 (Id);
1443 end Has_Delayed_Rep_Aspects;
1444
1445 function Has_Discriminants (Id : E) return B is
1446 begin
1447 pragma Assert (Nkind (Id) in N_Entity);
1448 return Flag5 (Id);
1449 end Has_Discriminants;
1450
1451 function Has_Dispatch_Table (Id : E) return B is
1452 begin
1453 pragma Assert (Is_Tagged_Type (Id));
1454 return Flag220 (Id);
1455 end Has_Dispatch_Table;
1456
1457 function Has_Dynamic_Predicate_Aspect (Id : E) return B is
1458 begin
1459 pragma Assert (Is_Type (Id));
1460 return Flag258 (Id);
1461 end Has_Dynamic_Predicate_Aspect;
1462
1463 function Has_Enumeration_Rep_Clause (Id : E) return B is
1464 begin
1465 pragma Assert (Is_Enumeration_Type (Id));
1466 return Flag66 (Id);
1467 end Has_Enumeration_Rep_Clause;
1468
1469 function Has_Exit (Id : E) return B is
1470 begin
1471 return Flag47 (Id);
1472 end Has_Exit;
1473
1474 function Has_Expanded_Contract (Id : E) return B is
1475 begin
1476 pragma Assert (Is_Subprogram (Id));
1477 return Flag240 (Id);
1478 end Has_Expanded_Contract;
1479
1480 function Has_Forward_Instantiation (Id : E) return B is
1481 begin
1482 return Flag175 (Id);
1483 end Has_Forward_Instantiation;
1484
1485 function Has_Fully_Qualified_Name (Id : E) return B is
1486 begin
1487 return Flag173 (Id);
1488 end Has_Fully_Qualified_Name;
1489
1490 function Has_Gigi_Rep_Item (Id : E) return B is
1491 begin
1492 return Flag82 (Id);
1493 end Has_Gigi_Rep_Item;
1494
1495 function Has_Homonym (Id : E) return B is
1496 begin
1497 return Flag56 (Id);
1498 end Has_Homonym;
1499
1500 function Has_Implicit_Dereference (Id : E) return B is
1501 begin
1502 return Flag251 (Id);
1503 end Has_Implicit_Dereference;
1504
1505 function Has_Independent_Components (Id : E) return B is
1506 begin
1507 return Flag34 (Implementation_Base_Type (Id));
1508 end Has_Independent_Components;
1509
1510 function Has_Inheritable_Invariants (Id : E) return B is
1511 begin
1512 pragma Assert (Is_Type (Id));
1513 return Flag248 (Id);
1514 end Has_Inheritable_Invariants;
1515
1516 function Has_Inherited_Default_Init_Cond (Id : E) return B is
1517 begin
1518 pragma Assert (Is_Type (Id));
1519 return Flag133 (Id);
1520 end Has_Inherited_Default_Init_Cond;
1521
1522 function Has_Initial_Value (Id : E) return B is
1523 begin
1524 pragma Assert (Ekind (Id) = E_Variable or else Is_Formal (Id));
1525 return Flag219 (Id);
1526 end Has_Initial_Value;
1527
1528 function Has_Invariants (Id : E) return B is
1529 begin
1530 pragma Assert (Is_Type (Id));
1531 return Flag232 (Id);
1532 end Has_Invariants;
1533
1534 function Has_Loop_Entry_Attributes (Id : E) return B is
1535 begin
1536 pragma Assert (Ekind (Id) = E_Loop);
1537 return Flag260 (Id);
1538 end Has_Loop_Entry_Attributes;
1539
1540 function Has_Machine_Radix_Clause (Id : E) return B is
1541 begin
1542 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
1543 return Flag83 (Id);
1544 end Has_Machine_Radix_Clause;
1545
1546 function Has_Master_Entity (Id : E) return B is
1547 begin
1548 return Flag21 (Id);
1549 end Has_Master_Entity;
1550
1551 function Has_Missing_Return (Id : E) return B is
1552 begin
1553 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
1554 return Flag142 (Id);
1555 end Has_Missing_Return;
1556
1557 function Has_Nested_Block_With_Handler (Id : E) return B is
1558 begin
1559 return Flag101 (Id);
1560 end Has_Nested_Block_With_Handler;
1561
1562 function Has_Nested_Subprogram (Id : E) return B is
1563 begin
1564 pragma Assert (Is_Subprogram (Id));
1565 return Flag282 (Id);
1566 end Has_Nested_Subprogram;
1567
1568 function Has_Non_Standard_Rep (Id : E) return B is
1569 begin
1570 return Flag75 (Implementation_Base_Type (Id));
1571 end Has_Non_Standard_Rep;
1572
1573 function Has_Object_Size_Clause (Id : E) return B is
1574 begin
1575 pragma Assert (Is_Type (Id));
1576 return Flag172 (Id);
1577 end Has_Object_Size_Clause;
1578
1579 function Has_Out_Or_In_Out_Parameter (Id : E) return B is
1580 begin
1581 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
1582 return Flag110 (Id);
1583 end Has_Out_Or_In_Out_Parameter;
1584
1585 function Has_Per_Object_Constraint (Id : E) return B is
1586 begin
1587 return Flag154 (Id);
1588 end Has_Per_Object_Constraint;
1589
1590 function Has_Pragma_Controlled (Id : E) return B is
1591 begin
1592 pragma Assert (Is_Access_Type (Id));
1593 return Flag27 (Implementation_Base_Type (Id));
1594 end Has_Pragma_Controlled;
1595
1596 function Has_Pragma_Elaborate_Body (Id : E) return B is
1597 begin
1598 return Flag150 (Id);
1599 end Has_Pragma_Elaborate_Body;
1600
1601 function Has_Pragma_Inline (Id : E) return B is
1602 begin
1603 return Flag157 (Id);
1604 end Has_Pragma_Inline;
1605
1606 function Has_Pragma_Inline_Always (Id : E) return B is
1607 begin
1608 return Flag230 (Id);
1609 end Has_Pragma_Inline_Always;
1610
1611 function Has_Pragma_No_Inline (Id : E) return B is
1612 begin
1613 return Flag201 (Id);
1614 end Has_Pragma_No_Inline;
1615
1616 function Has_Pragma_Ordered (Id : E) return B is
1617 begin
1618 pragma Assert (Is_Enumeration_Type (Id));
1619 return Flag198 (Implementation_Base_Type (Id));
1620 end Has_Pragma_Ordered;
1621
1622 function Has_Pragma_Pack (Id : E) return B is
1623 begin
1624 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
1625 return Flag121 (Implementation_Base_Type (Id));
1626 end Has_Pragma_Pack;
1627
1628 function Has_Pragma_Preelab_Init (Id : E) return B is
1629 begin
1630 return Flag221 (Id);
1631 end Has_Pragma_Preelab_Init;
1632
1633 function Has_Pragma_Pure (Id : E) return B is
1634 begin
1635 return Flag203 (Id);
1636 end Has_Pragma_Pure;
1637
1638 function Has_Pragma_Pure_Function (Id : E) return B is
1639 begin
1640 return Flag179 (Id);
1641 end Has_Pragma_Pure_Function;
1642
1643 function Has_Pragma_Thread_Local_Storage (Id : E) return B is
1644 begin
1645 return Flag169 (Id);
1646 end Has_Pragma_Thread_Local_Storage;
1647
1648 function Has_Pragma_Unmodified (Id : E) return B is
1649 begin
1650 return Flag233 (Id);
1651 end Has_Pragma_Unmodified;
1652
1653 function Has_Pragma_Unreferenced (Id : E) return B is
1654 begin
1655 return Flag180 (Id);
1656 end Has_Pragma_Unreferenced;
1657
1658 function Has_Pragma_Unreferenced_Objects (Id : E) return B is
1659 begin
1660 pragma Assert (Is_Type (Id));
1661 return Flag212 (Id);
1662 end Has_Pragma_Unreferenced_Objects;
1663
1664 function Has_Predicates (Id : E) return B is
1665 begin
1666 pragma Assert (Is_Type (Id));
1667 return Flag250 (Id);
1668 end Has_Predicates;
1669
1670 function Has_Primitive_Operations (Id : E) return B is
1671 begin
1672 pragma Assert (Is_Type (Id));
1673 return Flag120 (Base_Type (Id));
1674 end Has_Primitive_Operations;
1675
1676 function Has_Private_Ancestor (Id : E) return B is
1677 begin
1678 return Flag151 (Id);
1679 end Has_Private_Ancestor;
1680
1681 function Has_Private_Declaration (Id : E) return B is
1682 begin
1683 return Flag155 (Id);
1684 end Has_Private_Declaration;
1685
1686 function Has_Protected (Id : E) return B is
1687 begin
1688 return Flag271 (Base_Type (Id));
1689 end Has_Protected;
1690
1691 function Has_Qualified_Name (Id : E) return B is
1692 begin
1693 return Flag161 (Id);
1694 end Has_Qualified_Name;
1695
1696 function Has_RACW (Id : E) return B is
1697 begin
1698 pragma Assert (Ekind (Id) = E_Package);
1699 return Flag214 (Id);
1700 end Has_RACW;
1701
1702 function Has_Record_Rep_Clause (Id : E) return B is
1703 begin
1704 pragma Assert (Is_Record_Type (Id));
1705 return Flag65 (Implementation_Base_Type (Id));
1706 end Has_Record_Rep_Clause;
1707
1708 function Has_Recursive_Call (Id : E) return B is
1709 begin
1710 pragma Assert (Is_Subprogram (Id));
1711 return Flag143 (Id);
1712 end Has_Recursive_Call;
1713
1714 function Has_Shift_Operator (Id : E) return B is
1715 begin
1716 pragma Assert (Is_Integer_Type (Id));
1717 return Flag267 (Base_Type (Id));
1718 end Has_Shift_Operator;
1719
1720 function Has_Size_Clause (Id : E) return B is
1721 begin
1722 return Flag29 (Id);
1723 end Has_Size_Clause;
1724
1725 function Has_Small_Clause (Id : E) return B is
1726 begin
1727 return Flag67 (Id);
1728 end Has_Small_Clause;
1729
1730 function Has_Specified_Layout (Id : E) return B is
1731 begin
1732 pragma Assert (Is_Type (Id));
1733 return Flag100 (Implementation_Base_Type (Id));
1734 end Has_Specified_Layout;
1735
1736 function Has_Specified_Stream_Input (Id : E) return B is
1737 begin
1738 pragma Assert (Is_Type (Id));
1739 return Flag190 (Id);
1740 end Has_Specified_Stream_Input;
1741
1742 function Has_Specified_Stream_Output (Id : E) return B is
1743 begin
1744 pragma Assert (Is_Type (Id));
1745 return Flag191 (Id);
1746 end Has_Specified_Stream_Output;
1747
1748 function Has_Specified_Stream_Read (Id : E) return B is
1749 begin
1750 pragma Assert (Is_Type (Id));
1751 return Flag192 (Id);
1752 end Has_Specified_Stream_Read;
1753
1754 function Has_Specified_Stream_Write (Id : E) return B is
1755 begin
1756 pragma Assert (Is_Type (Id));
1757 return Flag193 (Id);
1758 end Has_Specified_Stream_Write;
1759
1760 function Has_Static_Discriminants (Id : E) return B is
1761 begin
1762 pragma Assert (Is_Type (Id));
1763 return Flag211 (Id);
1764 end Has_Static_Discriminants;
1765
1766 function Has_Static_Predicate (Id : E) return B is
1767 begin
1768 pragma Assert (Is_Type (Id));
1769 return Flag269 (Id);
1770 end Has_Static_Predicate;
1771
1772 function Has_Static_Predicate_Aspect (Id : E) return B is
1773 begin
1774 pragma Assert (Is_Type (Id));
1775 return Flag259 (Id);
1776 end Has_Static_Predicate_Aspect;
1777
1778 function Has_Storage_Size_Clause (Id : E) return B is
1779 begin
1780 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
1781 return Flag23 (Implementation_Base_Type (Id));
1782 end Has_Storage_Size_Clause;
1783
1784 function Has_Stream_Size_Clause (Id : E) return B is
1785 begin
1786 return Flag184 (Id);
1787 end Has_Stream_Size_Clause;
1788
1789 function Has_Task (Id : E) return B is
1790 begin
1791 return Flag30 (Base_Type (Id));
1792 end Has_Task;
1793
1794 function Has_Thunks (Id : E) return B is
1795 begin
1796 return Flag228 (Id);
1797 end Has_Thunks;
1798
1799 function Has_Unchecked_Union (Id : E) return B is
1800 begin
1801 return Flag123 (Base_Type (Id));
1802 end Has_Unchecked_Union;
1803
1804 function Has_Unknown_Discriminants (Id : E) return B is
1805 begin
1806 pragma Assert (Is_Type (Id));
1807 return Flag72 (Id);
1808 end Has_Unknown_Discriminants;
1809
1810 function Has_Uplevel_Reference (Id : E) return B is
1811 begin
1812 return Flag215 (Id);
1813 end Has_Uplevel_Reference;
1814
1815 function Has_Visible_Refinement (Id : E) return B is
1816 begin
1817 pragma Assert (Ekind (Id) = E_Abstract_State);
1818 return Flag263 (Id);
1819 end Has_Visible_Refinement;
1820
1821 function Has_Volatile_Components (Id : E) return B is
1822 begin
1823 return Flag87 (Implementation_Base_Type (Id));
1824 end Has_Volatile_Components;
1825
1826 function Has_Xref_Entry (Id : E) return B is
1827 begin
1828 return Flag182 (Id);
1829 end Has_Xref_Entry;
1830
1831 function Hiding_Loop_Variable (Id : E) return E is
1832 begin
1833 pragma Assert (Ekind (Id) = E_Variable);
1834 return Node8 (Id);
1835 end Hiding_Loop_Variable;
1836
1837 function Homonym (Id : E) return E is
1838 begin
1839 return Node4 (Id);
1840 end Homonym;
1841
1842 function Import_Pragma (Id : E) return E is
1843 begin
1844 pragma Assert (Is_Subprogram (Id));
1845 return Node35 (Id);
1846 end Import_Pragma;
1847
1848 function Interface_Alias (Id : E) return E is
1849 begin
1850 pragma Assert (Is_Subprogram (Id));
1851 return Node25 (Id);
1852 end Interface_Alias;
1853
1854 function Interfaces (Id : E) return L is
1855 begin
1856 pragma Assert (Is_Record_Type (Id));
1857 return Elist25 (Id);
1858 end Interfaces;
1859
1860 function In_Package_Body (Id : E) return B is
1861 begin
1862 return Flag48 (Id);
1863 end In_Package_Body;
1864
1865 function In_Private_Part (Id : E) return B is
1866 begin
1867 return Flag45 (Id);
1868 end In_Private_Part;
1869
1870 function In_Use (Id : E) return B is
1871 begin
1872 pragma Assert (Nkind (Id) in N_Entity);
1873 return Flag8 (Id);
1874 end In_Use;
1875
1876 function Initialization_Statements (Id : E) return N is
1877 begin
1878 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
1879 return Node28 (Id);
1880 end Initialization_Statements;
1881
1882 function Inner_Instances (Id : E) return L is
1883 begin
1884 return Elist23 (Id);
1885 end Inner_Instances;
1886
1887 function Interface_Name (Id : E) return N is
1888 begin
1889 return Node21 (Id);
1890 end Interface_Name;
1891
1892 function Is_Abstract_Subprogram (Id : E) return B is
1893 begin
1894 pragma Assert (Is_Overloadable (Id));
1895 return Flag19 (Id);
1896 end Is_Abstract_Subprogram;
1897
1898 function Is_Abstract_Type (Id : E) return B is
1899 begin
1900 pragma Assert (Is_Type (Id));
1901 return Flag146 (Id);
1902 end Is_Abstract_Type;
1903
1904 function Is_ARECnF_Entity (Id : E) return B is
1905 begin
1906 return Flag284 (Id);
1907 end Is_ARECnF_Entity;
1908
1909 function Is_Local_Anonymous_Access (Id : E) return B is
1910 begin
1911 pragma Assert (Is_Access_Type (Id));
1912 return Flag194 (Id);
1913 end Is_Local_Anonymous_Access;
1914
1915 function Is_Access_Constant (Id : E) return B is
1916 begin
1917 pragma Assert (Is_Access_Type (Id));
1918 return Flag69 (Id);
1919 end Is_Access_Constant;
1920
1921 function Is_Ada_2005_Only (Id : E) return B is
1922 begin
1923 return Flag185 (Id);
1924 end Is_Ada_2005_Only;
1925
1926 function Is_Ada_2012_Only (Id : E) return B is
1927 begin
1928 return Flag199 (Id);
1929 end Is_Ada_2012_Only;
1930
1931 function Is_Aliased (Id : E) return B is
1932 begin
1933 pragma Assert (Nkind (Id) in N_Entity);
1934 return Flag15 (Id);
1935 end Is_Aliased;
1936
1937 function Is_Asynchronous (Id : E) return B is
1938 begin
1939 pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id));
1940 return Flag81 (Id);
1941 end Is_Asynchronous;
1942
1943 function Is_Atomic (Id : E) return B is
1944 begin
1945 return Flag85 (Id);
1946 end Is_Atomic;
1947
1948 function Is_Bit_Packed_Array (Id : E) return B is
1949 begin
1950 return Flag122 (Implementation_Base_Type (Id));
1951 end Is_Bit_Packed_Array;
1952
1953 function Is_Called (Id : E) return B is
1954 begin
1955 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
1956 return Flag102 (Id);
1957 end Is_Called;
1958
1959 function Is_Character_Type (Id : E) return B is
1960 begin
1961 return Flag63 (Id);
1962 end Is_Character_Type;
1963
1964 function Is_Checked_Ghost_Entity (Id : E) return B is
1965 begin
1966 pragma Assert (Nkind (Id) in N_Entity);
1967 return Flag277 (Id);
1968 end Is_Checked_Ghost_Entity;
1969
1970 function Is_Child_Unit (Id : E) return B is
1971 begin
1972 return Flag73 (Id);
1973 end Is_Child_Unit;
1974
1975 function Is_Class_Wide_Equivalent_Type (Id : E) return B is
1976 begin
1977 return Flag35 (Id);
1978 end Is_Class_Wide_Equivalent_Type;
1979
1980 function Is_Compilation_Unit (Id : E) return B is
1981 begin
1982 return Flag149 (Id);
1983 end Is_Compilation_Unit;
1984
1985 function Is_Completely_Hidden (Id : E) return B is
1986 begin
1987 pragma Assert (Ekind (Id) = E_Discriminant);
1988 return Flag103 (Id);
1989 end Is_Completely_Hidden;
1990
1991 function Is_Constr_Subt_For_U_Nominal (Id : E) return B is
1992 begin
1993 return Flag80 (Id);
1994 end Is_Constr_Subt_For_U_Nominal;
1995
1996 function Is_Constr_Subt_For_UN_Aliased (Id : E) return B is
1997 begin
1998 return Flag141 (Id);
1999 end Is_Constr_Subt_For_UN_Aliased;
2000
2001 function Is_Constrained (Id : E) return B is
2002 begin
2003 pragma Assert (Nkind (Id) in N_Entity);
2004 return Flag12 (Id);
2005 end Is_Constrained;
2006
2007 function Is_Constructor (Id : E) return B is
2008 begin
2009 return Flag76 (Id);
2010 end Is_Constructor;
2011
2012 function Is_Controlled (Id : E) return B is
2013 begin
2014 return Flag42 (Base_Type (Id));
2015 end Is_Controlled;
2016
2017 function Is_Controlling_Formal (Id : E) return B is
2018 begin
2019 pragma Assert (Is_Formal (Id));
2020 return Flag97 (Id);
2021 end Is_Controlling_Formal;
2022
2023 function Is_CPP_Class (Id : E) return B is
2024 begin
2025 return Flag74 (Id);
2026 end Is_CPP_Class;
2027
2028 function Is_Default_Init_Cond_Procedure (Id : E) return B is
2029 begin
2030 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2031 return Flag132 (Id);
2032 end Is_Default_Init_Cond_Procedure;
2033
2034 function Is_Descendent_Of_Address (Id : E) return B is
2035 begin
2036 return Flag223 (Id);
2037 end Is_Descendent_Of_Address;
2038
2039 function Is_Discrim_SO_Function (Id : E) return B is
2040 begin
2041 return Flag176 (Id);
2042 end Is_Discrim_SO_Function;
2043
2044 function Is_Discriminant_Check_Function (Id : E) return B is
2045 begin
2046 return Flag264 (Id);
2047 end Is_Discriminant_Check_Function;
2048
2049 function Is_Dispatch_Table_Entity (Id : E) return B is
2050 begin
2051 return Flag234 (Id);
2052 end Is_Dispatch_Table_Entity;
2053
2054 function Is_Dispatching_Operation (Id : E) return B is
2055 begin
2056 pragma Assert (Nkind (Id) in N_Entity);
2057 return Flag6 (Id);
2058 end Is_Dispatching_Operation;
2059
2060 function Is_Eliminated (Id : E) return B is
2061 begin
2062 return Flag124 (Id);
2063 end Is_Eliminated;
2064
2065 function Is_Entry_Formal (Id : E) return B is
2066 begin
2067 return Flag52 (Id);
2068 end Is_Entry_Formal;
2069
2070 function Is_Exported (Id : E) return B is
2071 begin
2072 return Flag99 (Id);
2073 end Is_Exported;
2074
2075 function Is_First_Subtype (Id : E) return B is
2076 begin
2077 return Flag70 (Id);
2078 end Is_First_Subtype;
2079
2080 function Is_For_Access_Subtype (Id : E) return B is
2081 begin
2082 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
2083 return Flag118 (Id);
2084 end Is_For_Access_Subtype;
2085
2086 function Is_Formal_Subprogram (Id : E) return B is
2087 begin
2088 return Flag111 (Id);
2089 end Is_Formal_Subprogram;
2090
2091 function Is_Frozen (Id : E) return B is
2092 begin
2093 return Flag4 (Id);
2094 end Is_Frozen;
2095
2096 function Is_Generic_Actual_Subprogram (Id : E) return B is
2097 begin
2098 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2099 return Flag274 (Id);
2100 end Is_Generic_Actual_Subprogram;
2101
2102 function Is_Generic_Actual_Type (Id : E) return B is
2103 begin
2104 pragma Assert (Is_Type (Id));
2105 return Flag94 (Id);
2106 end Is_Generic_Actual_Type;
2107
2108 function Is_Generic_Instance (Id : E) return B is
2109 begin
2110 return Flag130 (Id);
2111 end Is_Generic_Instance;
2112
2113 function Is_Generic_Type (Id : E) return B is
2114 begin
2115 pragma Assert (Nkind (Id) in N_Entity);
2116 return Flag13 (Id);
2117 end Is_Generic_Type;
2118
2119 function Is_Hidden (Id : E) return B is
2120 begin
2121 return Flag57 (Id);
2122 end Is_Hidden;
2123
2124 function Is_Hidden_Non_Overridden_Subpgm (Id : E) return B is
2125 begin
2126 return Flag2 (Id);
2127 end Is_Hidden_Non_Overridden_Subpgm;
2128
2129 function Is_Hidden_Open_Scope (Id : E) return B is
2130 begin
2131 return Flag171 (Id);
2132 end Is_Hidden_Open_Scope;
2133
2134 function Is_Ignored_Ghost_Entity (Id : E) return B is
2135 begin
2136 pragma Assert (Nkind (Id) in N_Entity);
2137 return Flag278 (Id);
2138 end Is_Ignored_Ghost_Entity;
2139
2140 function Is_Immediately_Visible (Id : E) return B is
2141 begin
2142 pragma Assert (Nkind (Id) in N_Entity);
2143 return Flag7 (Id);
2144 end Is_Immediately_Visible;
2145
2146 function Is_Implementation_Defined (Id : E) return B is
2147 begin
2148 return Flag254 (Id);
2149 end Is_Implementation_Defined;
2150
2151 function Is_Imported (Id : E) return B is
2152 begin
2153 return Flag24 (Id);
2154 end Is_Imported;
2155
2156 function Is_Independent (Id : E) return B is
2157 begin
2158 return Flag268 (Id);
2159 end Is_Independent;
2160
2161 function Is_Inlined (Id : E) return B is
2162 begin
2163 return Flag11 (Id);
2164 end Is_Inlined;
2165
2166 function Is_Inlined_Always (Id : E) return B is
2167 begin
2168 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2169 return Flag1 (Id);
2170 end Is_Inlined_Always;
2171
2172 function Is_Interface (Id : E) return B is
2173 begin
2174 return Flag186 (Id);
2175 end Is_Interface;
2176
2177 function Is_Instantiated (Id : E) return B is
2178 begin
2179 return Flag126 (Id);
2180 end Is_Instantiated;
2181
2182 function Is_Internal (Id : E) return B is
2183 begin
2184 pragma Assert (Nkind (Id) in N_Entity);
2185 return Flag17 (Id);
2186 end Is_Internal;
2187
2188 function Is_Interrupt_Handler (Id : E) return B is
2189 begin
2190 pragma Assert (Nkind (Id) in N_Entity);
2191 return Flag89 (Id);
2192 end Is_Interrupt_Handler;
2193
2194 function Is_Intrinsic_Subprogram (Id : E) return B is
2195 begin
2196 return Flag64 (Id);
2197 end Is_Intrinsic_Subprogram;
2198
2199 function Is_Invariant_Procedure (Id : E) return B is
2200 begin
2201 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2202 return Flag257 (Id);
2203 end Is_Invariant_Procedure;
2204
2205 function Is_Itype (Id : E) return B is
2206 begin
2207 return Flag91 (Id);
2208 end Is_Itype;
2209
2210 function Is_Known_Non_Null (Id : E) return B is
2211 begin
2212 return Flag37 (Id);
2213 end Is_Known_Non_Null;
2214
2215 function Is_Known_Null (Id : E) return B is
2216 begin
2217 return Flag204 (Id);
2218 end Is_Known_Null;
2219
2220 function Is_Known_Valid (Id : E) return B is
2221 begin
2222 return Flag170 (Id);
2223 end Is_Known_Valid;
2224
2225 function Is_Limited_Composite (Id : E) return B is
2226 begin
2227 return Flag106 (Id);
2228 end Is_Limited_Composite;
2229
2230 function Is_Limited_Interface (Id : E) return B is
2231 begin
2232 return Flag197 (Id);
2233 end Is_Limited_Interface;
2234
2235 function Is_Limited_Record (Id : E) return B is
2236 begin
2237 return Flag25 (Id);
2238 end Is_Limited_Record;
2239
2240 function Is_Machine_Code_Subprogram (Id : E) return B is
2241 begin
2242 pragma Assert (Is_Subprogram (Id));
2243 return Flag137 (Id);
2244 end Is_Machine_Code_Subprogram;
2245
2246 function Is_Non_Static_Subtype (Id : E) return B is
2247 begin
2248 pragma Assert (Is_Type (Id));
2249 return Flag109 (Id);
2250 end Is_Non_Static_Subtype;
2251
2252 function Is_Null_Init_Proc (Id : E) return B is
2253 begin
2254 pragma Assert (Ekind (Id) = E_Procedure);
2255 return Flag178 (Id);
2256 end Is_Null_Init_Proc;
2257
2258 function Is_Obsolescent (Id : E) return B is
2259 begin
2260 return Flag153 (Id);
2261 end Is_Obsolescent;
2262
2263 function Is_Only_Out_Parameter (Id : E) return B is
2264 begin
2265 pragma Assert (Is_Formal (Id));
2266 return Flag226 (Id);
2267 end Is_Only_Out_Parameter;
2268
2269 function Is_Package_Body_Entity (Id : E) return B is
2270 begin
2271 return Flag160 (Id);
2272 end Is_Package_Body_Entity;
2273
2274 function Is_Packed (Id : E) return B is
2275 begin
2276 return Flag51 (Implementation_Base_Type (Id));
2277 end Is_Packed;
2278
2279 function Is_Packed_Array_Impl_Type (Id : E) return B is
2280 begin
2281 return Flag138 (Id);
2282 end Is_Packed_Array_Impl_Type;
2283
2284 function Is_Potentially_Use_Visible (Id : E) return B is
2285 begin
2286 pragma Assert (Nkind (Id) in N_Entity);
2287 return Flag9 (Id);
2288 end Is_Potentially_Use_Visible;
2289
2290 function Is_Predicate_Function (Id : E) return B is
2291 begin
2292 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2293 return Flag255 (Id);
2294 end Is_Predicate_Function;
2295
2296 function Is_Predicate_Function_M (Id : E) return B is
2297 begin
2298 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
2299 return Flag256 (Id);
2300 end Is_Predicate_Function_M;
2301
2302 function Is_Preelaborated (Id : E) return B is
2303 begin
2304 return Flag59 (Id);
2305 end Is_Preelaborated;
2306
2307 function Is_Primitive (Id : E) return B is
2308 begin
2309 pragma Assert
2310 (Is_Overloadable (Id)
2311 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
2312 return Flag218 (Id);
2313 end Is_Primitive;
2314
2315 function Is_Primitive_Wrapper (Id : E) return B is
2316 begin
2317 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2318 return Flag195 (Id);
2319 end Is_Primitive_Wrapper;
2320
2321 function Is_Private_Composite (Id : E) return B is
2322 begin
2323 pragma Assert (Is_Type (Id));
2324 return Flag107 (Id);
2325 end Is_Private_Composite;
2326
2327 function Is_Private_Descendant (Id : E) return B is
2328 begin
2329 return Flag53 (Id);
2330 end Is_Private_Descendant;
2331
2332 function Is_Private_Primitive (Id : E) return B is
2333 begin
2334 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
2335 return Flag245 (Id);
2336 end Is_Private_Primitive;
2337
2338 function Is_Processed_Transient (Id : E) return B is
2339 begin
2340 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
2341 return Flag252 (Id);
2342 end Is_Processed_Transient;
2343
2344 function Is_Public (Id : E) return B is
2345 begin
2346 pragma Assert (Nkind (Id) in N_Entity);
2347 return Flag10 (Id);
2348 end Is_Public;
2349
2350 function Is_Pure (Id : E) return B is
2351 begin
2352 return Flag44 (Id);
2353 end Is_Pure;
2354
2355 function Is_Pure_Unit_Access_Type (Id : E) return B is
2356 begin
2357 pragma Assert (Is_Access_Type (Id));
2358 return Flag189 (Id);
2359 end Is_Pure_Unit_Access_Type;
2360
2361 function Is_RACW_Stub_Type (Id : E) return B is
2362 begin
2363 pragma Assert (Is_Type (Id));
2364 return Flag244 (Id);
2365 end Is_RACW_Stub_Type;
2366
2367 function Is_Raised (Id : E) return B is
2368 begin
2369 pragma Assert (Ekind (Id) = E_Exception);
2370 return Flag224 (Id);
2371 end Is_Raised;
2372
2373 function Is_Remote_Call_Interface (Id : E) return B is
2374 begin
2375 return Flag62 (Id);
2376 end Is_Remote_Call_Interface;
2377
2378 function Is_Remote_Types (Id : E) return B is
2379 begin
2380 return Flag61 (Id);
2381 end Is_Remote_Types;
2382
2383 function Is_Renaming_Of_Object (Id : E) return B is
2384 begin
2385 return Flag112 (Id);
2386 end Is_Renaming_Of_Object;
2387
2388 function Is_Return_Object (Id : E) return B is
2389 begin
2390 return Flag209 (Id);
2391 end Is_Return_Object;
2392
2393 function Is_Safe_To_Reevaluate (Id : E) return B is
2394 begin
2395 return Flag249 (Id);
2396 end Is_Safe_To_Reevaluate;
2397
2398 function Is_Shared_Passive (Id : E) return B is
2399 begin
2400 return Flag60 (Id);
2401 end Is_Shared_Passive;
2402
2403 function Is_Static_Type (Id : E) return B is
2404 begin
2405 pragma Assert (Is_Type (Id));
2406 return Flag281 (Id);
2407 end Is_Static_Type;
2408
2409 function Is_Statically_Allocated (Id : E) return B is
2410 begin
2411 return Flag28 (Id);
2412 end Is_Statically_Allocated;
2413
2414 function Is_Tag (Id : E) return B is
2415 begin
2416 pragma Assert (Nkind (Id) in N_Entity);
2417 return Flag78 (Id);
2418 end Is_Tag;
2419
2420 function Is_Tagged_Type (Id : E) return B is
2421 begin
2422 return Flag55 (Id);
2423 end Is_Tagged_Type;
2424
2425 function Is_Thunk (Id : E) return B is
2426 begin
2427 return Flag225 (Id);
2428 end Is_Thunk;
2429
2430 function Is_Trivial_Subprogram (Id : E) return B is
2431 begin
2432 return Flag235 (Id);
2433 end Is_Trivial_Subprogram;
2434
2435 function Is_True_Constant (Id : E) return B is
2436 begin
2437 return Flag163 (Id);
2438 end Is_True_Constant;
2439
2440 function Is_Unchecked_Union (Id : E) return B is
2441 begin
2442 return Flag117 (Implementation_Base_Type (Id));
2443 end Is_Unchecked_Union;
2444
2445 function Is_Underlying_Record_View (Id : E) return B is
2446 begin
2447 return Flag246 (Id);
2448 end Is_Underlying_Record_View;
2449
2450 function Is_Unsigned_Type (Id : E) return B is
2451 begin
2452 pragma Assert (Is_Type (Id));
2453 return Flag144 (Id);
2454 end Is_Unsigned_Type;
2455
2456 function Is_Valued_Procedure (Id : E) return B is
2457 begin
2458 pragma Assert (Ekind (Id) = E_Procedure);
2459 return Flag127 (Id);
2460 end Is_Valued_Procedure;
2461
2462 function Is_Visible_Formal (Id : E) return B is
2463 begin
2464 return Flag206 (Id);
2465 end Is_Visible_Formal;
2466
2467 function Is_Visible_Lib_Unit (Id : E) return B is
2468 begin
2469 return Flag116 (Id);
2470 end Is_Visible_Lib_Unit;
2471
2472 function Is_Volatile (Id : E) return B is
2473 begin
2474 pragma Assert (Nkind (Id) in N_Entity);
2475
2476 if Is_Type (Id) then
2477 return Flag16 (Base_Type (Id));
2478 else
2479 return Flag16 (Id);
2480 end if;
2481 end Is_Volatile;
2482
2483 function Itype_Printed (Id : E) return B is
2484 begin
2485 pragma Assert (Is_Itype (Id));
2486 return Flag202 (Id);
2487 end Itype_Printed;
2488
2489 function Kill_Elaboration_Checks (Id : E) return B is
2490 begin
2491 return Flag32 (Id);
2492 end Kill_Elaboration_Checks;
2493
2494 function Kill_Range_Checks (Id : E) return B is
2495 begin
2496 return Flag33 (Id);
2497 end Kill_Range_Checks;
2498
2499 function Known_To_Have_Preelab_Init (Id : E) return B is
2500 begin
2501 pragma Assert (Is_Type (Id));
2502 return Flag207 (Id);
2503 end Known_To_Have_Preelab_Init;
2504
2505 function Last_Aggregate_Assignment (Id : E) return N is
2506 begin
2507 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2508 return Node30 (Id);
2509 end Last_Aggregate_Assignment;
2510
2511 function Last_Assignment (Id : E) return N is
2512 begin
2513 pragma Assert (Is_Assignable (Id));
2514 return Node26 (Id);
2515 end Last_Assignment;
2516
2517 function Last_Entity (Id : E) return E is
2518 begin
2519 return Node20 (Id);
2520 end Last_Entity;
2521
2522 function Limited_View (Id : E) return E is
2523 begin
2524 pragma Assert (Ekind (Id) = E_Package);
2525 return Node23 (Id);
2526 end Limited_View;
2527
2528 function Linker_Section_Pragma (Id : E) return N is
2529 begin
2530 pragma Assert
2531 (Is_Type (Id) or else Is_Object (Id) or else Is_Subprogram (Id));
2532 return Node33 (Id);
2533 end Linker_Section_Pragma;
2534
2535 function Lit_Indexes (Id : E) return E is
2536 begin
2537 pragma Assert (Is_Enumeration_Type (Id));
2538 return Node18 (Id);
2539 end Lit_Indexes;
2540
2541 function Lit_Strings (Id : E) return E is
2542 begin
2543 pragma Assert (Is_Enumeration_Type (Id));
2544 return Node16 (Id);
2545 end Lit_Strings;
2546
2547 function Low_Bound_Tested (Id : E) return B is
2548 begin
2549 return Flag205 (Id);
2550 end Low_Bound_Tested;
2551
2552 function Machine_Radix_10 (Id : E) return B is
2553 begin
2554 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
2555 return Flag84 (Id);
2556 end Machine_Radix_10;
2557
2558 function Master_Id (Id : E) return E is
2559 begin
2560 pragma Assert (Is_Access_Type (Id));
2561 return Node17 (Id);
2562 end Master_Id;
2563
2564 function Materialize_Entity (Id : E) return B is
2565 begin
2566 return Flag168 (Id);
2567 end Materialize_Entity;
2568
2569 function May_Inherit_Delayed_Rep_Aspects (Id : E) return B is
2570 begin
2571 return Flag262 (Id);
2572 end May_Inherit_Delayed_Rep_Aspects;
2573
2574 function Mechanism (Id : E) return M is
2575 begin
2576 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
2577 return UI_To_Int (Uint8 (Id));
2578 end Mechanism;
2579
2580 function Modulus (Id : E) return Uint is
2581 begin
2582 pragma Assert (Is_Modular_Integer_Type (Id));
2583 return Uint17 (Base_Type (Id));
2584 end Modulus;
2585
2586 function Must_Be_On_Byte_Boundary (Id : E) return B is
2587 begin
2588 pragma Assert (Is_Type (Id));
2589 return Flag183 (Id);
2590 end Must_Be_On_Byte_Boundary;
2591
2592 function Must_Have_Preelab_Init (Id : E) return B is
2593 begin
2594 pragma Assert (Is_Type (Id));
2595 return Flag208 (Id);
2596 end Must_Have_Preelab_Init;
2597
2598 function Needs_Debug_Info (Id : E) return B is
2599 begin
2600 return Flag147 (Id);
2601 end Needs_Debug_Info;
2602
2603 function Needs_No_Actuals (Id : E) return B is
2604 begin
2605 pragma Assert
2606 (Is_Overloadable (Id)
2607 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
2608 return Flag22 (Id);
2609 end Needs_No_Actuals;
2610
2611 function Never_Set_In_Source (Id : E) return B is
2612 begin
2613 return Flag115 (Id);
2614 end Never_Set_In_Source;
2615
2616 function Next_Inlined_Subprogram (Id : E) return E is
2617 begin
2618 return Node12 (Id);
2619 end Next_Inlined_Subprogram;
2620
2621 function No_Dynamic_Predicate_On_Actual (Id : E) return Boolean is
2622 begin
2623 pragma Assert (Is_Discrete_Type (Id));
2624 return Flag276 (Id);
2625 end No_Dynamic_Predicate_On_Actual;
2626
2627 function No_Pool_Assigned (Id : E) return B is
2628 begin
2629 pragma Assert (Is_Access_Type (Id));
2630 return Flag131 (Root_Type (Id));
2631 end No_Pool_Assigned;
2632
2633 function No_Predicate_On_Actual (Id : E) return Boolean is
2634 begin
2635 pragma Assert (Is_Discrete_Type (Id));
2636 return Flag275 (Id);
2637 end No_Predicate_On_Actual;
2638
2639 function No_Return (Id : E) return B is
2640 begin
2641 return Flag113 (Id);
2642 end No_Return;
2643
2644 function No_Strict_Aliasing (Id : E) return B is
2645 begin
2646 pragma Assert (Is_Access_Type (Id));
2647 return Flag136 (Base_Type (Id));
2648 end No_Strict_Aliasing;
2649
2650 function No_Tagged_Streams_Pragma (Id : E) return N is
2651 begin
2652 pragma Assert (Is_Tagged_Type (Id));
2653 return Node32 (Id);
2654 end No_Tagged_Streams_Pragma;
2655
2656 function Non_Binary_Modulus (Id : E) return B is
2657 begin
2658 pragma Assert (Is_Type (Id));
2659 return Flag58 (Base_Type (Id));
2660 end Non_Binary_Modulus;
2661
2662 function Non_Limited_View (Id : E) return E is
2663 begin
2664 pragma Assert
2665 (Ekind (Id) in Incomplete_Kind or else Ekind (Id) = E_Abstract_State);
2666 return Node17 (Id);
2667 end Non_Limited_View;
2668
2669 function Nonzero_Is_True (Id : E) return B is
2670 begin
2671 pragma Assert (Root_Type (Id) = Standard_Boolean);
2672 return Flag162 (Base_Type (Id));
2673 end Nonzero_Is_True;
2674
2675 function Normalized_First_Bit (Id : E) return U is
2676 begin
2677 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2678 return Uint8 (Id);
2679 end Normalized_First_Bit;
2680
2681 function Normalized_Position (Id : E) return U is
2682 begin
2683 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2684 return Uint14 (Id);
2685 end Normalized_Position;
2686
2687 function Normalized_Position_Max (Id : E) return U is
2688 begin
2689 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
2690 return Uint10 (Id);
2691 end Normalized_Position_Max;
2692
2693 function OK_To_Rename (Id : E) return B is
2694 begin
2695 pragma Assert (Ekind (Id) = E_Variable);
2696 return Flag247 (Id);
2697 end OK_To_Rename;
2698
2699 function OK_To_Reorder_Components (Id : E) return B is
2700 begin
2701 pragma Assert (Is_Record_Type (Id));
2702 return Flag239 (Base_Type (Id));
2703 end OK_To_Reorder_Components;
2704
2705 function Optimize_Alignment_Space (Id : E) return B is
2706 begin
2707 pragma Assert
2708 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2709 return Flag241 (Id);
2710 end Optimize_Alignment_Space;
2711
2712 function Optimize_Alignment_Time (Id : E) return B is
2713 begin
2714 pragma Assert
2715 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
2716 return Flag242 (Id);
2717 end Optimize_Alignment_Time;
2718
2719 function Original_Access_Type (Id : E) return E is
2720 begin
2721 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
2722 return Node28 (Id);
2723 end Original_Access_Type;
2724
2725 function Original_Array_Type (Id : E) return E is
2726 begin
2727 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
2728 return Node21 (Id);
2729 end Original_Array_Type;
2730
2731 function Original_Record_Component (Id : E) return E is
2732 begin
2733 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
2734 return Node22 (Id);
2735 end Original_Record_Component;
2736
2737 function Overlays_Constant (Id : E) return B is
2738 begin
2739 return Flag243 (Id);
2740 end Overlays_Constant;
2741
2742 function Overridden_Operation (Id : E) return E is
2743 begin
2744 return Node26 (Id);
2745 end Overridden_Operation;
2746
2747 function Package_Instantiation (Id : E) return N is
2748 begin
2749 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
2750 return Node26 (Id);
2751 end Package_Instantiation;
2752
2753 function Packed_Array_Impl_Type (Id : E) return E is
2754 begin
2755 pragma Assert (Is_Array_Type (Id));
2756 return Node23 (Id);
2757 end Packed_Array_Impl_Type;
2758
2759 function Parent_Subtype (Id : E) return E is
2760 begin
2761 pragma Assert (Is_Record_Type (Id));
2762 return Node19 (Base_Type (Id));
2763 end Parent_Subtype;
2764
2765 function Part_Of_Constituents (Id : E) return L is
2766 begin
2767 pragma Assert (Ekind (Id) = E_Abstract_State);
2768 return Elist9 (Id);
2769 end Part_Of_Constituents;
2770
2771 function Partial_View_Has_Unknown_Discr (Id : E) return B is
2772 begin
2773 pragma Assert (Is_Type (Id));
2774 return Flag280 (Id);
2775 end Partial_View_Has_Unknown_Discr;
2776
2777 function Pending_Access_Types (Id : E) return L is
2778 begin
2779 pragma Assert (Is_Type (Id));
2780 return Elist15 (Id);
2781 end Pending_Access_Types;
2782
2783 function Postconditions_Proc (Id : E) return E is
2784 begin
2785 pragma Assert (Ekind_In (Id, E_Entry,
2786 E_Entry_Family,
2787 E_Function,
2788 E_Procedure));
2789 return Node14 (Id);
2790 end Postconditions_Proc;
2791
2792 function PPC_Wrapper (Id : E) return E is
2793 begin
2794 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
2795 return Node25 (Id);
2796 end PPC_Wrapper;
2797
2798 function Prival (Id : E) return E is
2799 begin
2800 pragma Assert (Is_Protected_Component (Id));
2801 return Node17 (Id);
2802 end Prival;
2803
2804 function Prival_Link (Id : E) return E is
2805 begin
2806 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
2807 return Node20 (Id);
2808 end Prival_Link;
2809
2810 function Private_Dependents (Id : E) return L is
2811 begin
2812 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
2813 return Elist18 (Id);
2814 end Private_Dependents;
2815
2816 function Private_View (Id : E) return N is
2817 begin
2818 pragma Assert (Is_Private_Type (Id));
2819 return Node22 (Id);
2820 end Private_View;
2821
2822 function Protected_Body_Subprogram (Id : E) return E is
2823 begin
2824 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
2825 return Node11 (Id);
2826 end Protected_Body_Subprogram;
2827
2828 function Protected_Formal (Id : E) return E is
2829 begin
2830 pragma Assert (Is_Formal (Id));
2831 return Node22 (Id);
2832 end Protected_Formal;
2833
2834 function Protection_Object (Id : E) return E is
2835 begin
2836 pragma Assert
2837 (Ekind_In (Id, E_Entry, E_Entry_Family, E_Function, E_Procedure));
2838 return Node23 (Id);
2839 end Protection_Object;
2840
2841 function Reachable (Id : E) return B is
2842 begin
2843 return Flag49 (Id);
2844 end Reachable;
2845
2846 function Referenced (Id : E) return B is
2847 begin
2848 return Flag156 (Id);
2849 end Referenced;
2850
2851 function Referenced_As_LHS (Id : E) return B is
2852 begin
2853 return Flag36 (Id);
2854 end Referenced_As_LHS;
2855
2856 function Referenced_As_Out_Parameter (Id : E) return B is
2857 begin
2858 return Flag227 (Id);
2859 end Referenced_As_Out_Parameter;
2860
2861 function Refinement_Constituents (Id : E) return L is
2862 begin
2863 pragma Assert (Ekind (Id) = E_Abstract_State);
2864 return Elist8 (Id);
2865 end Refinement_Constituents;
2866
2867 function Register_Exception_Call (Id : E) return N is
2868 begin
2869 pragma Assert (Ekind (Id) = E_Exception);
2870 return Node20 (Id);
2871 end Register_Exception_Call;
2872
2873 function Related_Array_Object (Id : E) return E is
2874 begin
2875 pragma Assert (Is_Array_Type (Id));
2876 return Node25 (Id);
2877 end Related_Array_Object;
2878
2879 function Related_Expression (Id : E) return N is
2880 begin
2881 pragma Assert (Ekind (Id) in Type_Kind
2882 or else Ekind_In (Id, E_Constant, E_Variable));
2883 return Node24 (Id);
2884 end Related_Expression;
2885
2886 function Related_Instance (Id : E) return E is
2887 begin
2888 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
2889 return Node15 (Id);
2890 end Related_Instance;
2891
2892 function Related_Type (Id : E) return E is
2893 begin
2894 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
2895 return Node27 (Id);
2896 end Related_Type;
2897
2898 function Relative_Deadline_Variable (Id : E) return E is
2899 begin
2900 pragma Assert (Is_Task_Type (Id));
2901 return Node28 (Implementation_Base_Type (Id));
2902 end Relative_Deadline_Variable;
2903
2904 function Renamed_Entity (Id : E) return N is
2905 begin
2906 return Node18 (Id);
2907 end Renamed_Entity;
2908
2909 function Renamed_In_Spec (Id : E) return B is
2910 begin
2911 pragma Assert (Ekind (Id) = E_Package);
2912 return Flag231 (Id);
2913 end Renamed_In_Spec;
2914
2915 function Renamed_Object (Id : E) return N is
2916 begin
2917 return Node18 (Id);
2918 end Renamed_Object;
2919
2920 function Renaming_Map (Id : E) return U is
2921 begin
2922 return Uint9 (Id);
2923 end Renaming_Map;
2924
2925 function Requires_Overriding (Id : E) return B is
2926 begin
2927 pragma Assert (Is_Overloadable (Id));
2928 return Flag213 (Id);
2929 end Requires_Overriding;
2930
2931 function Return_Present (Id : E) return B is
2932 begin
2933 return Flag54 (Id);
2934 end Return_Present;
2935
2936 function Return_Applies_To (Id : E) return N is
2937 begin
2938 return Node8 (Id);
2939 end Return_Applies_To;
2940
2941 function Returns_By_Ref (Id : E) return B is
2942 begin
2943 return Flag90 (Id);
2944 end Returns_By_Ref;
2945
2946 function Returns_Limited_View (Id : E) return B is
2947 begin
2948 pragma Assert (Ekind (Id) = E_Function);
2949 return Flag134 (Id);
2950 end Returns_Limited_View;
2951
2952 function Reverse_Bit_Order (Id : E) return B is
2953 begin
2954 pragma Assert (Is_Record_Type (Id));
2955 return Flag164 (Base_Type (Id));
2956 end Reverse_Bit_Order;
2957
2958 function Reverse_Storage_Order (Id : E) return B is
2959 begin
2960 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
2961 return Flag93 (Base_Type (Id));
2962 end Reverse_Storage_Order;
2963
2964 function RM_Size (Id : E) return U is
2965 begin
2966 pragma Assert (Is_Type (Id));
2967 return Uint13 (Id);
2968 end RM_Size;
2969
2970 function Scalar_Range (Id : E) return N is
2971 begin
2972 return Node20 (Id);
2973 end Scalar_Range;
2974
2975 function Scale_Value (Id : E) return U is
2976 begin
2977 return Uint16 (Id);
2978 end Scale_Value;
2979
2980 function Scope_Depth_Value (Id : E) return U is
2981 begin
2982 return Uint22 (Id);
2983 end Scope_Depth_Value;
2984
2985 function Sec_Stack_Needed_For_Return (Id : E) return B is
2986 begin
2987 return Flag167 (Id);
2988 end Sec_Stack_Needed_For_Return;
2989
2990 function Shadow_Entities (Id : E) return S is
2991 begin
2992 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
2993 return List14 (Id);
2994 end Shadow_Entities;
2995
2996 function Shared_Var_Procs_Instance (Id : E) return E is
2997 begin
2998 pragma Assert (Ekind (Id) = E_Variable);
2999 return Node22 (Id);
3000 end Shared_Var_Procs_Instance;
3001
3002 function Size_Check_Code (Id : E) return N is
3003 begin
3004 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
3005 return Node19 (Id);
3006 end Size_Check_Code;
3007
3008 function Size_Depends_On_Discriminant (Id : E) return B is
3009 begin
3010 return Flag177 (Id);
3011 end Size_Depends_On_Discriminant;
3012
3013 function Size_Known_At_Compile_Time (Id : E) return B is
3014 begin
3015 return Flag92 (Id);
3016 end Size_Known_At_Compile_Time;
3017
3018 function Small_Value (Id : E) return R is
3019 begin
3020 pragma Assert (Is_Fixed_Point_Type (Id));
3021 return Ureal21 (Id);
3022 end Small_Value;
3023
3024 function SPARK_Aux_Pragma (Id : E) return N is
3025 begin
3026 pragma Assert
3027 (Ekind_In (Id, E_Generic_Package, -- package variants
3028 E_Package,
3029 E_Package_Body));
3030 return Node33 (Id);
3031 end SPARK_Aux_Pragma;
3032
3033 function SPARK_Aux_Pragma_Inherited (Id : E) return B is
3034 begin
3035 pragma Assert
3036 (Ekind_In (Id, E_Generic_Package, -- package variants
3037 E_Package,
3038 E_Package_Body));
3039 return Flag266 (Id);
3040 end SPARK_Aux_Pragma_Inherited;
3041
3042 function SPARK_Pragma (Id : E) return N is
3043 begin
3044 pragma Assert
3045 (Ekind_In (Id, E_Function, -- subprogram variants
3046 E_Generic_Function,
3047 E_Generic_Procedure,
3048 E_Procedure,
3049 E_Subprogram_Body)
3050 or else
3051 Ekind_In (Id, E_Generic_Package, -- package variants
3052 E_Package,
3053 E_Package_Body));
3054 return Node32 (Id);
3055 end SPARK_Pragma;
3056
3057 function SPARK_Pragma_Inherited (Id : E) return B is
3058 begin
3059 pragma Assert
3060 (Ekind_In (Id, E_Function, -- subprogram variants
3061 E_Generic_Function,
3062 E_Generic_Procedure,
3063 E_Procedure,
3064 E_Subprogram_Body)
3065 or else
3066 Ekind_In (Id, E_Generic_Package, -- package variants
3067 E_Package,
3068 E_Package_Body));
3069 return Flag265 (Id);
3070 end SPARK_Pragma_Inherited;
3071
3072 function Spec_Entity (Id : E) return E is
3073 begin
3074 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
3075 return Node19 (Id);
3076 end Spec_Entity;
3077
3078 function SSO_Set_High_By_Default (Id : E) return B is
3079 begin
3080 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
3081 return Flag273 (Base_Type (Id));
3082 end SSO_Set_High_By_Default;
3083
3084 function SSO_Set_Low_By_Default (Id : E) return B is
3085 begin
3086 pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
3087 return Flag272 (Base_Type (Id));
3088 end SSO_Set_Low_By_Default;
3089
3090 function Static_Discrete_Predicate (Id : E) return S is
3091 begin
3092 pragma Assert (Is_Discrete_Type (Id));
3093 return List25 (Id);
3094 end Static_Discrete_Predicate;
3095
3096 function Static_Real_Or_String_Predicate (Id : E) return N is
3097 begin
3098 pragma Assert (Is_Real_Type (Id) or else Is_String_Type (Id));
3099 return Node25 (Id);
3100 end Static_Real_Or_String_Predicate;
3101
3102 function Status_Flag_Or_Transient_Decl (Id : E) return N is
3103 begin
3104 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
3105 return Node15 (Id);
3106 end Status_Flag_Or_Transient_Decl;
3107
3108 function Storage_Size_Variable (Id : E) return E is
3109 begin
3110 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
3111 return Node26 (Implementation_Base_Type (Id));
3112 end Storage_Size_Variable;
3113
3114 function Static_Elaboration_Desired (Id : E) return B is
3115 begin
3116 pragma Assert (Ekind (Id) = E_Package);
3117 return Flag77 (Id);
3118 end Static_Elaboration_Desired;
3119
3120 function Static_Initialization (Id : E) return N is
3121 begin
3122 pragma Assert
3123 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
3124 return Node30 (Id);
3125 end Static_Initialization;
3126
3127 function Stored_Constraint (Id : E) return L is
3128 begin
3129 pragma Assert
3130 (Is_Composite_Type (Id) and then not Is_Array_Type (Id));
3131 return Elist23 (Id);
3132 end Stored_Constraint;
3133
3134 function Stores_Attribute_Old_Prefix (Id : E) return B is
3135 begin
3136 return Flag270 (Id);
3137 end Stores_Attribute_Old_Prefix;
3138
3139 function Strict_Alignment (Id : E) return B is
3140 begin
3141 return Flag145 (Implementation_Base_Type (Id));
3142 end Strict_Alignment;
3143
3144 function String_Literal_Length (Id : E) return U is
3145 begin
3146 return Uint16 (Id);
3147 end String_Literal_Length;
3148
3149 function String_Literal_Low_Bound (Id : E) return N is
3150 begin
3151 return Node18 (Id);
3152 end String_Literal_Low_Bound;
3153
3154 function Subprograms_For_Type (Id : E) return E is
3155 begin
3156 pragma Assert (Is_Type (Id) or else Is_Subprogram (Id));
3157 return Node29 (Id);
3158 end Subprograms_For_Type;
3159
3160 function Subps_Index (Id : E) return U is
3161 begin
3162 pragma Assert (Is_Subprogram (Id));
3163 return Uint24 (Id);
3164 end Subps_Index;
3165
3166 function Suppress_Elaboration_Warnings (Id : E) return B is
3167 begin
3168 return Flag148 (Id);
3169 end Suppress_Elaboration_Warnings;
3170
3171 function Suppress_Initialization (Id : E) return B is
3172 begin
3173 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
3174 return Flag105 (Id);
3175 end Suppress_Initialization;
3176
3177 function Suppress_Style_Checks (Id : E) return B is
3178 begin
3179 return Flag165 (Id);
3180 end Suppress_Style_Checks;
3181
3182 function Suppress_Value_Tracking_On_Call (Id : E) return B is
3183 begin
3184 return Flag217 (Id);
3185 end Suppress_Value_Tracking_On_Call;
3186
3187 function Task_Body_Procedure (Id : E) return N is
3188 begin
3189 pragma Assert (Ekind (Id) in Task_Kind);
3190 return Node25 (Id);
3191 end Task_Body_Procedure;
3192
3193 function Thunk_Entity (Id : E) return E is
3194 begin
3195 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
3196 and then Is_Thunk (Id));
3197 return Node31 (Id);
3198 end Thunk_Entity;
3199
3200 function Treat_As_Volatile (Id : E) return B is
3201 begin
3202 return Flag41 (Id);
3203 end Treat_As_Volatile;
3204
3205 function Underlying_Full_View (Id : E) return E is
3206 begin
3207 pragma Assert (Ekind (Id) in Private_Kind);
3208 return Node19 (Id);
3209 end Underlying_Full_View;
3210
3211 function Underlying_Record_View (Id : E) return E is
3212 begin
3213 return Node28 (Id);
3214 end Underlying_Record_View;
3215
3216 function Universal_Aliasing (Id : E) return B is
3217 begin
3218 pragma Assert (Is_Type (Id));
3219 return Flag216 (Implementation_Base_Type (Id));
3220 end Universal_Aliasing;
3221
3222 function Unset_Reference (Id : E) return N is
3223 begin
3224 return Node16 (Id);
3225 end Unset_Reference;
3226
3227 function Uplevel_Reference_Noted (Id : E) return B is
3228 begin
3229 return Flag283 (Id);
3230 end Uplevel_Reference_Noted;
3231
3232 function Uplevel_References (Id : E) return L is
3233 begin
3234 pragma Assert (Is_Subprogram (Id));
3235 return Elist24 (Id);
3236 end Uplevel_References;
3237
3238 function Used_As_Generic_Actual (Id : E) return B is
3239 begin
3240 return Flag222 (Id);
3241 end Used_As_Generic_Actual;
3242
3243 function Uses_Lock_Free (Id : E) return B is
3244 begin
3245 pragma Assert (Is_Protected_Type (Id));
3246 return Flag188 (Id);
3247 end Uses_Lock_Free;
3248
3249 function Uses_Sec_Stack (Id : E) return B is
3250 begin
3251 return Flag95 (Id);
3252 end Uses_Sec_Stack;
3253
3254 function Warnings_Off (Id : E) return B is
3255 begin
3256 return Flag96 (Id);
3257 end Warnings_Off;
3258
3259 function Warnings_Off_Used (Id : E) return B is
3260 begin
3261 return Flag236 (Id);
3262 end Warnings_Off_Used;
3263
3264 function Warnings_Off_Used_Unmodified (Id : E) return B is
3265 begin
3266 return Flag237 (Id);
3267 end Warnings_Off_Used_Unmodified;
3268
3269 function Warnings_Off_Used_Unreferenced (Id : E) return B is
3270 begin
3271 return Flag238 (Id);
3272 end Warnings_Off_Used_Unreferenced;
3273
3274 function Wrapped_Entity (Id : E) return E is
3275 begin
3276 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
3277 and then Is_Primitive_Wrapper (Id));
3278 return Node27 (Id);
3279 end Wrapped_Entity;
3280
3281 function Was_Hidden (Id : E) return B is
3282 begin
3283 return Flag196 (Id);
3284 end Was_Hidden;
3285
3286 ------------------------------
3287 -- Classification Functions --
3288 ------------------------------
3289
3290 function Is_Access_Type (Id : E) return B is
3291 begin
3292 return Ekind (Id) in Access_Kind;
3293 end Is_Access_Type;
3294
3295 function Is_Access_Protected_Subprogram_Type (Id : E) return B is
3296 begin
3297 return Ekind (Id) in Access_Protected_Kind;
3298 end Is_Access_Protected_Subprogram_Type;
3299
3300 function Is_Access_Subprogram_Type (Id : E) return B is
3301 begin
3302 return Ekind (Id) in Access_Subprogram_Kind;
3303 end Is_Access_Subprogram_Type;
3304
3305 function Is_Aggregate_Type (Id : E) return B is
3306 begin
3307 return Ekind (Id) in Aggregate_Kind;
3308 end Is_Aggregate_Type;
3309
3310 function Is_Array_Type (Id : E) return B is
3311 begin
3312 return Ekind (Id) in Array_Kind;
3313 end Is_Array_Type;
3314
3315 function Is_Assignable (Id : E) return B is
3316 begin
3317 return Ekind (Id) in Assignable_Kind;
3318 end Is_Assignable;
3319
3320 function Is_Class_Wide_Type (Id : E) return B is
3321 begin
3322 return Ekind (Id) in Class_Wide_Kind;
3323 end Is_Class_Wide_Type;
3324
3325 function Is_Composite_Type (Id : E) return B is
3326 begin
3327 return Ekind (Id) in Composite_Kind;
3328 end Is_Composite_Type;
3329
3330 function Is_Concurrent_Body (Id : E) return B is
3331 begin
3332 return Ekind (Id) in
3333 Concurrent_Body_Kind;
3334 end Is_Concurrent_Body;
3335
3336 function Is_Concurrent_Record_Type (Id : E) return B is
3337 begin
3338 return Flag20 (Id);
3339 end Is_Concurrent_Record_Type;
3340
3341 function Is_Concurrent_Type (Id : E) return B is
3342 begin
3343 return Ekind (Id) in Concurrent_Kind;
3344 end Is_Concurrent_Type;
3345
3346 function Is_Decimal_Fixed_Point_Type (Id : E) return B is
3347 begin
3348 return Ekind (Id) in
3349 Decimal_Fixed_Point_Kind;
3350 end Is_Decimal_Fixed_Point_Type;
3351
3352 function Is_Digits_Type (Id : E) return B is
3353 begin
3354 return Ekind (Id) in Digits_Kind;
3355 end Is_Digits_Type;
3356
3357 function Is_Discrete_Or_Fixed_Point_Type (Id : E) return B is
3358 begin
3359 return Ekind (Id) in Discrete_Or_Fixed_Point_Kind;
3360 end Is_Discrete_Or_Fixed_Point_Type;
3361
3362 function Is_Discrete_Type (Id : E) return B is
3363 begin
3364 return Ekind (Id) in Discrete_Kind;
3365 end Is_Discrete_Type;
3366
3367 function Is_Elementary_Type (Id : E) return B is
3368 begin
3369 return Ekind (Id) in Elementary_Kind;
3370 end Is_Elementary_Type;
3371
3372 function Is_Entry (Id : E) return B is
3373 begin
3374 return Ekind (Id) in Entry_Kind;
3375 end Is_Entry;
3376
3377 function Is_Enumeration_Type (Id : E) return B is
3378 begin
3379 return Ekind (Id) in
3380 Enumeration_Kind;
3381 end Is_Enumeration_Type;
3382
3383 function Is_Fixed_Point_Type (Id : E) return B is
3384 begin
3385 return Ekind (Id) in
3386 Fixed_Point_Kind;
3387 end Is_Fixed_Point_Type;
3388
3389 function Is_Floating_Point_Type (Id : E) return B is
3390 begin
3391 return Ekind (Id) in Float_Kind;
3392 end Is_Floating_Point_Type;
3393
3394 function Is_Formal (Id : E) return B is
3395 begin
3396 return Ekind (Id) in Formal_Kind;
3397 end Is_Formal;
3398
3399 function Is_Formal_Object (Id : E) return B is
3400 begin
3401 return Ekind (Id) in Formal_Object_Kind;
3402 end Is_Formal_Object;
3403
3404 function Is_Generic_Subprogram (Id : E) return B is
3405 begin
3406 return Ekind (Id) in Generic_Subprogram_Kind;
3407 end Is_Generic_Subprogram;
3408
3409 function Is_Generic_Unit (Id : E) return B is
3410 begin
3411 return Ekind (Id) in Generic_Unit_Kind;
3412 end Is_Generic_Unit;
3413
3414 function Is_Incomplete_Or_Private_Type (Id : E) return B is
3415 begin
3416 return Ekind (Id) in
3417 Incomplete_Or_Private_Kind;
3418 end Is_Incomplete_Or_Private_Type;
3419
3420 function Is_Incomplete_Type (Id : E) return B is
3421 begin
3422 return Ekind (Id) in
3423 Incomplete_Kind;
3424 end Is_Incomplete_Type;
3425
3426 function Is_Integer_Type (Id : E) return B is
3427 begin
3428 return Ekind (Id) in Integer_Kind;
3429 end Is_Integer_Type;
3430
3431 function Is_Modular_Integer_Type (Id : E) return B is
3432 begin
3433 return Ekind (Id) in
3434 Modular_Integer_Kind;
3435 end Is_Modular_Integer_Type;
3436
3437 function Is_Named_Number (Id : E) return B is
3438 begin
3439 return Ekind (Id) in Named_Kind;
3440 end Is_Named_Number;
3441
3442 function Is_Numeric_Type (Id : E) return B is
3443 begin
3444 return Ekind (Id) in Numeric_Kind;
3445 end Is_Numeric_Type;
3446
3447 function Is_Object (Id : E) return B is
3448 begin
3449 return Ekind (Id) in Object_Kind;
3450 end Is_Object;
3451
3452 function Is_Ordinary_Fixed_Point_Type (Id : E) return B is
3453 begin
3454 return Ekind (Id) in
3455 Ordinary_Fixed_Point_Kind;
3456 end Is_Ordinary_Fixed_Point_Type;
3457
3458 function Is_Overloadable (Id : E) return B is
3459 begin
3460 return Ekind (Id) in Overloadable_Kind;
3461 end Is_Overloadable;
3462
3463 function Is_Private_Type (Id : E) return B is
3464 begin
3465 return Ekind (Id) in Private_Kind;
3466 end Is_Private_Type;
3467
3468 function Is_Protected_Type (Id : E) return B is
3469 begin
3470 return Ekind (Id) in Protected_Kind;
3471 end Is_Protected_Type;
3472
3473 function Is_Real_Type (Id : E) return B is
3474 begin
3475 return Ekind (Id) in Real_Kind;
3476 end Is_Real_Type;
3477
3478 function Is_Record_Type (Id : E) return B is
3479 begin
3480 return Ekind (Id) in Record_Kind;
3481 end Is_Record_Type;
3482
3483 function Is_Scalar_Type (Id : E) return B is
3484 begin
3485 return Ekind (Id) in Scalar_Kind;
3486 end Is_Scalar_Type;
3487
3488 function Is_Signed_Integer_Type (Id : E) return B is
3489 begin
3490 return Ekind (Id) in Signed_Integer_Kind;
3491 end Is_Signed_Integer_Type;
3492
3493 function Is_Subprogram (Id : E) return B is
3494 begin
3495 return Ekind (Id) in Subprogram_Kind;
3496 end Is_Subprogram;
3497
3498 function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B is
3499 begin
3500 return Ekind (Id) in Subprogram_Kind
3501 or else
3502 Ekind (Id) in Generic_Subprogram_Kind;
3503 end Is_Subprogram_Or_Generic_Subprogram;
3504
3505 function Is_Task_Type (Id : E) return B is
3506 begin
3507 return Ekind (Id) in Task_Kind;
3508 end Is_Task_Type;
3509
3510 function Is_Type (Id : E) return B is
3511 begin
3512 return Ekind (Id) in Type_Kind;
3513 end Is_Type;
3514
3515 ------------------------------
3516 -- Attribute Set Procedures --
3517 ------------------------------
3518
3519 -- Note: in many of these set procedures an "obvious" assertion is missing.
3520 -- The reason for this is that in many cases, a field is set before the
3521 -- Ekind field is set, so that the field is set when Ekind = E_Void. It
3522 -- it is possible to add assertions that specifically include the E_Void
3523 -- possibility, but in some cases, we just omit the assertions.
3524
3525 procedure Set_Abstract_States (Id : E; V : L) is
3526 begin
3527 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
3528 Set_Elist25 (Id, V);
3529 end Set_Abstract_States;
3530
3531 procedure Set_Accept_Address (Id : E; V : L) is
3532 begin
3533 Set_Elist21 (Id, V);
3534 end Set_Accept_Address;
3535
3536 procedure Set_Access_Disp_Table (Id : E; V : L) is
3537 begin
3538 pragma Assert (Ekind (Id) = E_Record_Type
3539 and then Id = Implementation_Base_Type (Id));
3540 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
3541 Set_Elist16 (Id, V);
3542 end Set_Access_Disp_Table;
3543
3544 procedure Set_Associated_Formal_Package (Id : E; V : E) is
3545 begin
3546 Set_Node12 (Id, V);
3547 end Set_Associated_Formal_Package;
3548
3549 procedure Set_Associated_Node_For_Itype (Id : E; V : E) is
3550 begin
3551 Set_Node8 (Id, V);
3552 end Set_Associated_Node_For_Itype;
3553
3554 procedure Set_Associated_Storage_Pool (Id : E; V : E) is
3555 begin
3556 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
3557 Set_Node22 (Id, V);
3558 end Set_Associated_Storage_Pool;
3559
3560 procedure Set_Activation_Record_Component (Id : E; V : E) is
3561 begin
3562 pragma Assert (Ekind_In (Id, E_Constant,
3563 E_In_Parameter,
3564 E_In_Out_Parameter,
3565 E_Loop_Parameter,
3566 E_Out_Parameter,
3567 E_Variable));
3568 Set_Node31 (Id, V);
3569 end Set_Activation_Record_Component;
3570
3571 procedure Set_Actual_Subtype (Id : E; V : E) is
3572 begin
3573 pragma Assert
3574 (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
3575 or else Is_Formal (Id));
3576 Set_Node17 (Id, V);
3577 end Set_Actual_Subtype;
3578
3579 procedure Set_Address_Taken (Id : E; V : B := True) is
3580 begin
3581 Set_Flag104 (Id, V);
3582 end Set_Address_Taken;
3583
3584 procedure Set_Alias (Id : E; V : E) is
3585 begin
3586 pragma Assert
3587 (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);
3588 Set_Node18 (Id, V);
3589 end Set_Alias;
3590
3591 procedure Set_Alignment (Id : E; V : U) is
3592 begin
3593 pragma Assert (Is_Type (Id)
3594 or else Is_Formal (Id)
3595 or else Ekind_In (Id, E_Loop_Parameter,
3596 E_Constant,
3597 E_Exception,
3598 E_Variable));
3599 Set_Uint14 (Id, V);
3600 end Set_Alignment;
3601
3602 procedure Set_Barrier_Function (Id : E; V : N) is
3603 begin
3604 pragma Assert (Is_Entry (Id));
3605 Set_Node12 (Id, V);
3606 end Set_Barrier_Function;
3607
3608 procedure Set_Block_Node (Id : E; V : N) is
3609 begin
3610 pragma Assert (Ekind (Id) = E_Block);
3611 Set_Node11 (Id, V);
3612 end Set_Block_Node;
3613
3614 procedure Set_Body_Entity (Id : E; V : E) is
3615 begin
3616 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
3617 Set_Node19 (Id, V);
3618 end Set_Body_Entity;
3619
3620 procedure Set_Body_Needed_For_SAL (Id : E; V : B := True) is
3621 begin
3622 pragma Assert
3623 (Ekind (Id) = E_Package
3624 or else Is_Subprogram (Id)
3625 or else Is_Generic_Unit (Id));
3626 Set_Flag40 (Id, V);
3627 end Set_Body_Needed_For_SAL;
3628
3629 procedure Set_Body_References (Id : E; V : L) is
3630 begin
3631 pragma Assert (Ekind (Id) = E_Abstract_State);
3632 Set_Elist16 (Id, V);
3633 end Set_Body_References;
3634
3635 procedure Set_BIP_Initialization_Call (Id : E; V : N) is
3636 begin
3637 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
3638 Set_Node29 (Id, V);
3639 end Set_BIP_Initialization_Call;
3640
3641 procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is
3642 begin
3643 pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id));
3644 Set_Flag125 (Id, V);
3645 end Set_C_Pass_By_Copy;
3646
3647 procedure Set_Can_Never_Be_Null (Id : E; V : B := True) is
3648 begin
3649 Set_Flag38 (Id, V);
3650 end Set_Can_Never_Be_Null;
3651
3652 procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
3653 begin
3654 pragma Assert
3655 (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
3656 Set_Flag229 (Id, V);
3657 end Set_Can_Use_Internal_Rep;
3658
3659 procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is
3660 begin
3661 Set_Flag31 (Id, V);
3662 end Set_Checks_May_Be_Suppressed;
3663
3664 procedure Set_Class_Wide_Type (Id : E; V : E) is
3665 begin
3666 pragma Assert (Is_Type (Id));
3667 Set_Node9 (Id, V);
3668 end Set_Class_Wide_Type;
3669
3670 procedure Set_Cloned_Subtype (Id : E; V : E) is
3671 begin
3672 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
3673 Set_Node16 (Id, V);
3674 end Set_Cloned_Subtype;
3675
3676 procedure Set_Component_Bit_Offset (Id : E; V : U) is
3677 begin
3678 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
3679 Set_Uint11 (Id, V);
3680 end Set_Component_Bit_Offset;
3681
3682 procedure Set_Component_Clause (Id : E; V : N) is
3683 begin
3684 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
3685 Set_Node13 (Id, V);
3686 end Set_Component_Clause;
3687
3688 procedure Set_Component_Size (Id : E; V : U) is
3689 begin
3690 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
3691 Set_Uint22 (Id, V);
3692 end Set_Component_Size;
3693
3694 procedure Set_Component_Type (Id : E; V : E) is
3695 begin
3696 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
3697 Set_Node20 (Id, V);
3698 end Set_Component_Type;
3699
3700 procedure Set_Contains_Ignored_Ghost_Code (Id : E; V : B := True) is
3701 begin
3702 pragma Assert
3703 (Ekind_In (Id, E_Block,
3704 E_Function,
3705 E_Generic_Function,
3706 E_Generic_Package,
3707 E_Generic_Procedure,
3708 E_Package,
3709 E_Package_Body,
3710 E_Procedure,
3711 E_Subprogram_Body));
3712 Set_Flag279 (Id, V);
3713 end Set_Contains_Ignored_Ghost_Code;
3714
3715 procedure Set_Contract (Id : E; V : N) is
3716 begin
3717 pragma Assert
3718 (Ekind_In (Id, E_Entry,
3719 E_Entry_Family,
3720 E_Generic_Package,
3721 E_Package,
3722 E_Package_Body,
3723 E_Subprogram_Body,
3724 E_Variable,
3725 E_Void)
3726 or else Is_Subprogram_Or_Generic_Subprogram (Id));
3727 Set_Node34 (Id, V);
3728 end Set_Contract;
3729
3730 procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is
3731 begin
3732 pragma Assert
3733 (Ekind (Id) = E_Record_Type and then Is_Concurrent_Type (V));
3734 Set_Node18 (Id, V);
3735 end Set_Corresponding_Concurrent_Type;
3736
3737 procedure Set_Corresponding_Discriminant (Id : E; V : E) is
3738 begin
3739 pragma Assert (Ekind (Id) = E_Discriminant);
3740 Set_Node19 (Id, V);
3741 end Set_Corresponding_Discriminant;
3742
3743 procedure Set_Corresponding_Equality (Id : E; V : E) is
3744 begin
3745 pragma Assert
3746 (Ekind (Id) = E_Function
3747 and then not Comes_From_Source (Id)
3748 and then Chars (Id) = Name_Op_Ne);
3749 Set_Node30 (Id, V);
3750 end Set_Corresponding_Equality;
3751
3752 procedure Set_Corresponding_Protected_Entry (Id : E; V : E) is
3753 begin
3754 pragma Assert (Ekind_In (Id, E_Void, E_Subprogram_Body));
3755 Set_Node18 (Id, V);
3756 end Set_Corresponding_Protected_Entry;
3757
3758 procedure Set_Corresponding_Record_Type (Id : E; V : E) is
3759 begin
3760 pragma Assert (Is_Concurrent_Type (Id));
3761 Set_Node18 (Id, V);
3762 end Set_Corresponding_Record_Type;
3763
3764 procedure Set_Corresponding_Remote_Type (Id : E; V : E) is
3765 begin
3766 Set_Node22 (Id, V);
3767 end Set_Corresponding_Remote_Type;
3768
3769 procedure Set_Current_Use_Clause (Id : E; V : E) is
3770 begin
3771 pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));
3772 Set_Node27 (Id, V);
3773 end Set_Current_Use_Clause;
3774
3775 procedure Set_Current_Value (Id : E; V : N) is
3776 begin
3777 pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void);
3778 Set_Node9 (Id, V);
3779 end Set_Current_Value;
3780
3781 procedure Set_CR_Discriminant (Id : E; V : E) is
3782 begin
3783 Set_Node23 (Id, V);
3784 end Set_CR_Discriminant;
3785
3786 procedure Set_Debug_Info_Off (Id : E; V : B := True) is
3787 begin
3788 Set_Flag166 (Id, V);
3789 end Set_Debug_Info_Off;
3790
3791 procedure Set_Debug_Renaming_Link (Id : E; V : E) is
3792 begin
3793 Set_Node25 (Id, V);
3794 end Set_Debug_Renaming_Link;
3795
3796 procedure Set_Default_Aspect_Component_Value (Id : E; V : E) is
3797 begin
3798 pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id));
3799 Set_Node19 (Id, V);
3800 end Set_Default_Aspect_Component_Value;
3801
3802 procedure Set_Default_Aspect_Value (Id : E; V : E) is
3803 begin
3804 pragma Assert (Is_Scalar_Type (Id) and then Is_Base_Type (Id));
3805 Set_Node19 (Id, V);
3806 end Set_Default_Aspect_Value;
3807
3808 procedure Set_Default_Expr_Function (Id : E; V : E) is
3809 begin
3810 pragma Assert (Is_Formal (Id));
3811 Set_Node21 (Id, V);
3812 end Set_Default_Expr_Function;
3813
3814 procedure Set_Default_Expressions_Processed (Id : E; V : B := True) is
3815 begin
3816 Set_Flag108 (Id, V);
3817 end Set_Default_Expressions_Processed;
3818
3819 procedure Set_Default_Value (Id : E; V : N) is
3820 begin
3821 pragma Assert (Is_Formal (Id));
3822 Set_Node20 (Id, V);
3823 end Set_Default_Value;
3824
3825 procedure Set_Delay_Cleanups (Id : E; V : B := True) is
3826 begin
3827 pragma Assert
3828 (Is_Subprogram (Id)
3829 or else Is_Task_Type (Id)
3830 or else Ekind (Id) = E_Block);
3831 Set_Flag114 (Id, V);
3832 end Set_Delay_Cleanups;
3833
3834 procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True) is
3835 begin
3836 pragma Assert
3837 (Is_Subprogram (Id) or else Ekind_In (Id, E_Package, E_Package_Body));
3838
3839 Set_Flag50 (Id, V);
3840 end Set_Delay_Subprogram_Descriptors;
3841
3842 procedure Set_Delta_Value (Id : E; V : R) is
3843 begin
3844 pragma Assert (Is_Fixed_Point_Type (Id));
3845 Set_Ureal18 (Id, V);
3846 end Set_Delta_Value;
3847
3848 procedure Set_Dependent_Instances (Id : E; V : L) is
3849 begin
3850 pragma Assert (Is_Generic_Instance (Id));
3851 Set_Elist8 (Id, V);
3852 end Set_Dependent_Instances;
3853
3854 procedure Set_Depends_On_Private (Id : E; V : B := True) is
3855 begin
3856 pragma Assert (Nkind (Id) in N_Entity);
3857 Set_Flag14 (Id, V);
3858 end Set_Depends_On_Private;
3859
3860 procedure Set_Derived_Type_Link (Id : E; V : E) is
3861 begin
3862 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
3863 Set_Node31 (Id, V);
3864 end Set_Derived_Type_Link;
3865
3866 procedure Set_Digits_Value (Id : E; V : U) is
3867 begin
3868 pragma Assert
3869 (Is_Floating_Point_Type (Id)
3870 or else Is_Decimal_Fixed_Point_Type (Id));
3871 Set_Uint17 (Id, V);
3872 end Set_Digits_Value;
3873
3874 procedure Set_Directly_Designated_Type (Id : E; V : E) is
3875 begin
3876 Set_Node20 (Id, V);
3877 end Set_Directly_Designated_Type;
3878
3879 procedure Set_Discard_Names (Id : E; V : B := True) is
3880 begin
3881 Set_Flag88 (Id, V);
3882 end Set_Discard_Names;
3883
3884 procedure Set_Discriminal (Id : E; V : E) is
3885 begin
3886 pragma Assert (Ekind (Id) = E_Discriminant);
3887 Set_Node17 (Id, V);
3888 end Set_Discriminal;
3889
3890 procedure Set_Discriminal_Link (Id : E; V : E) is
3891 begin
3892 Set_Node10 (Id, V);
3893 end Set_Discriminal_Link;
3894
3895 procedure Set_Discriminant_Checking_Func (Id : E; V : E) is
3896 begin
3897 pragma Assert (Ekind (Id) = E_Component);
3898 Set_Node20 (Id, V);
3899 end Set_Discriminant_Checking_Func;
3900
3901 procedure Set_Discriminant_Constraint (Id : E; V : L) is
3902 begin
3903 pragma Assert (Nkind (Id) in N_Entity);
3904 Set_Elist21 (Id, V);
3905 end Set_Discriminant_Constraint;
3906
3907 procedure Set_Discriminant_Default_Value (Id : E; V : N) is
3908 begin
3909 Set_Node20 (Id, V);
3910 end Set_Discriminant_Default_Value;
3911
3912 procedure Set_Discriminant_Number (Id : E; V : U) is
3913 begin
3914 Set_Uint15 (Id, V);
3915 end Set_Discriminant_Number;
3916
3917 procedure Set_Dispatch_Table_Wrappers (Id : E; V : L) is
3918 begin
3919 pragma Assert (Ekind (Id) = E_Record_Type
3920 and then Id = Implementation_Base_Type (Id));
3921 pragma Assert (V = No_Elist or else Is_Tagged_Type (Id));
3922 Set_Elist26 (Id, V);
3923 end Set_Dispatch_Table_Wrappers;
3924
3925 procedure Set_DT_Entry_Count (Id : E; V : U) is
3926 begin
3927 pragma Assert (Ekind (Id) = E_Component);
3928 Set_Uint15 (Id, V);
3929 end Set_DT_Entry_Count;
3930
3931 procedure Set_DT_Offset_To_Top_Func (Id : E; V : E) is
3932 begin
3933 pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
3934 Set_Node25 (Id, V);
3935 end Set_DT_Offset_To_Top_Func;
3936
3937 procedure Set_DT_Position (Id : E; V : U) is
3938 begin
3939 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
3940 Set_Uint15 (Id, V);
3941 end Set_DT_Position;
3942
3943 procedure Set_DTC_Entity (Id : E; V : E) is
3944 begin
3945 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
3946 Set_Node16 (Id, V);
3947 end Set_DTC_Entity;
3948
3949 procedure Set_Elaborate_Body_Desirable (Id : E; V : B := True) is
3950 begin
3951 pragma Assert (Ekind (Id) = E_Package);
3952 Set_Flag210 (Id, V);
3953 end Set_Elaborate_Body_Desirable;
3954
3955 procedure Set_Elaboration_Entity (Id : E; V : E) is
3956 begin
3957 pragma Assert
3958 (Is_Subprogram (Id)
3959 or else
3960 Ekind (Id) = E_Package
3961 or else
3962 Is_Generic_Unit (Id));
3963 Set_Node13 (Id, V);
3964 end Set_Elaboration_Entity;
3965
3966 procedure Set_Elaboration_Entity_Required (Id : E; V : B := True) is
3967 begin
3968 pragma Assert
3969 (Is_Subprogram (Id)
3970 or else
3971 Ekind (Id) = E_Package
3972 or else
3973 Is_Generic_Unit (Id));
3974 Set_Flag174 (Id, V);
3975 end Set_Elaboration_Entity_Required;
3976
3977 procedure Set_Encapsulating_State (Id : E; V : E) is
3978 begin
3979 pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
3980 Set_Node10 (Id, V);
3981 end Set_Encapsulating_State;
3982
3983 procedure Set_Enclosing_Scope (Id : E; V : E) is
3984 begin
3985 Set_Node18 (Id, V);
3986 end Set_Enclosing_Scope;
3987
3988 procedure Set_Entry_Accepted (Id : E; V : B := True) is
3989 begin
3990 pragma Assert (Is_Entry (Id));
3991 Set_Flag152 (Id, V);
3992 end Set_Entry_Accepted;
3993
3994 procedure Set_Entry_Bodies_Array (Id : E; V : E) is
3995 begin
3996 Set_Node19 (Id, V);
3997 end Set_Entry_Bodies_Array;
3998
3999 procedure Set_Entry_Cancel_Parameter (Id : E; V : E) is
4000 begin
4001 Set_Node23 (Id, V);
4002 end Set_Entry_Cancel_Parameter;
4003
4004 procedure Set_Entry_Component (Id : E; V : E) is
4005 begin
4006 Set_Node11 (Id, V);
4007 end Set_Entry_Component;
4008
4009 procedure Set_Entry_Formal (Id : E; V : E) is
4010 begin
4011 Set_Node16 (Id, V);
4012 end Set_Entry_Formal;
4013
4014 procedure Set_Entry_Index_Constant (Id : E; V : E) is
4015 begin
4016 pragma Assert (Ekind (Id) = E_Entry_Index_Parameter);
4017 Set_Node18 (Id, V);
4018 end Set_Entry_Index_Constant;
4019
4020 procedure Set_Entry_Parameters_Type (Id : E; V : E) is
4021 begin
4022 Set_Node15 (Id, V);
4023 end Set_Entry_Parameters_Type;
4024
4025 procedure Set_Enum_Pos_To_Rep (Id : E; V : E) is
4026 begin
4027 pragma Assert (Ekind (Id) = E_Enumeration_Type);
4028 Set_Node23 (Id, V);
4029 end Set_Enum_Pos_To_Rep;
4030
4031 procedure Set_Enumeration_Pos (Id : E; V : U) is
4032 begin
4033 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
4034 Set_Uint11 (Id, V);
4035 end Set_Enumeration_Pos;
4036
4037 procedure Set_Enumeration_Rep (Id : E; V : U) is
4038 begin
4039 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
4040 Set_Uint12 (Id, V);
4041 end Set_Enumeration_Rep;
4042
4043 procedure Set_Enumeration_Rep_Expr (Id : E; V : N) is
4044 begin
4045 pragma Assert (Ekind (Id) = E_Enumeration_Literal);
4046 Set_Node22 (Id, V);
4047 end Set_Enumeration_Rep_Expr;
4048
4049 procedure Set_Equivalent_Type (Id : E; V : E) is
4050 begin
4051 pragma Assert
4052 (Ekind_In (Id, E_Class_Wide_Type,
4053 E_Class_Wide_Subtype,
4054 E_Access_Protected_Subprogram_Type,
4055 E_Anonymous_Access_Protected_Subprogram_Type,
4056 E_Access_Subprogram_Type,
4057 E_Exception_Type));
4058 Set_Node18 (Id, V);
4059 end Set_Equivalent_Type;
4060
4061 procedure Set_Esize (Id : E; V : U) is
4062 begin
4063 Set_Uint12 (Id, V);
4064 end Set_Esize;
4065
4066 procedure Set_Extra_Accessibility (Id : E; V : E) is
4067 begin
4068 pragma Assert
4069 (Is_Formal (Id) or else Ekind_In (Id, E_Variable, E_Constant));
4070 Set_Node13 (Id, V);
4071 end Set_Extra_Accessibility;
4072
4073 procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E) is
4074 begin
4075 pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type));
4076 Set_Node19 (Id, V);
4077 end Set_Extra_Accessibility_Of_Result;
4078
4079 procedure Set_Extra_Constrained (Id : E; V : E) is
4080 begin
4081 pragma Assert (Is_Formal (Id) or else Ekind (Id) = E_Variable);
4082 Set_Node23 (Id, V);
4083 end Set_Extra_Constrained;
4084
4085 procedure Set_Extra_Formal (Id : E; V : E) is
4086 begin
4087 Set_Node15 (Id, V);
4088 end Set_Extra_Formal;
4089
4090 procedure Set_Extra_Formals (Id : E; V : E) is
4091 begin
4092 pragma Assert
4093 (Is_Overloadable (Id)
4094 or else Ekind_In (Id, E_Entry_Family,
4095 E_Subprogram_Body,
4096 E_Subprogram_Type));
4097 Set_Node28 (Id, V);
4098 end Set_Extra_Formals;
4099
4100 procedure Set_Finalization_Master (Id : E; V : E) is
4101 begin
4102 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
4103 Set_Node23 (Id, V);
4104 end Set_Finalization_Master;
4105
4106 procedure Set_Finalize_Storage_Only (Id : E; V : B := True) is
4107 begin
4108 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
4109 Set_Flag158 (Id, V);
4110 end Set_Finalize_Storage_Only;
4111
4112 procedure Set_Finalizer (Id : E; V : E) is
4113 begin
4114 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
4115 Set_Node28 (Id, V);
4116 end Set_Finalizer;
4117
4118 procedure Set_First_Entity (Id : E; V : E) is
4119 begin
4120 Set_Node17 (Id, V);
4121 end Set_First_Entity;
4122
4123 procedure Set_First_Exit_Statement (Id : E; V : N) is
4124 begin
4125 pragma Assert (Ekind (Id) = E_Loop);
4126 Set_Node8 (Id, V);
4127 end Set_First_Exit_Statement;
4128
4129 procedure Set_First_Index (Id : E; V : N) is
4130 begin
4131 pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
4132 Set_Node17 (Id, V);
4133 end Set_First_Index;
4134
4135 procedure Set_First_Literal (Id : E; V : E) is
4136 begin
4137 pragma Assert (Is_Enumeration_Type (Id));
4138 Set_Node17 (Id, V);
4139 end Set_First_Literal;
4140
4141 procedure Set_First_Private_Entity (Id : E; V : E) is
4142 begin
4143 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
4144 or else Ekind (Id) in Concurrent_Kind);
4145 Set_Node16 (Id, V);
4146 end Set_First_Private_Entity;
4147
4148 procedure Set_First_Rep_Item (Id : E; V : N) is
4149 begin
4150 Set_Node6 (Id, V);
4151 end Set_First_Rep_Item;
4152
4153 procedure Set_Float_Rep (Id : E; V : F) is
4154 pragma Assert (Ekind (Id) = E_Floating_Point_Type);
4155 begin
4156 Set_Uint10 (Id, UI_From_Int (F'Pos (V)));
4157 end Set_Float_Rep;
4158
4159 procedure Set_Freeze_Node (Id : E; V : N) is
4160 begin
4161 Set_Node7 (Id, V);
4162 end Set_Freeze_Node;
4163
4164 procedure Set_From_Limited_With (Id : E; V : B := True) is
4165 begin
4166 pragma Assert
4167 (Is_Type (Id) or else Ekind_In (Id, E_Abstract_State, E_Package));
4168 Set_Flag159 (Id, V);
4169 end Set_From_Limited_With;
4170
4171 procedure Set_Full_View (Id : E; V : E) is
4172 begin
4173 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Constant);
4174 Set_Node11 (Id, V);
4175 end Set_Full_View;
4176
4177 procedure Set_Generic_Homonym (Id : E; V : E) is
4178 begin
4179 Set_Node11 (Id, V);
4180 end Set_Generic_Homonym;
4181
4182 procedure Set_Generic_Renamings (Id : E; V : L) is
4183 begin
4184 Set_Elist23 (Id, V);
4185 end Set_Generic_Renamings;
4186
4187 procedure Set_Handler_Records (Id : E; V : S) is
4188 begin
4189 Set_List10 (Id, V);
4190 end Set_Handler_Records;
4191
4192 procedure Set_Has_Aliased_Components (Id : E; V : B := True) is
4193 begin
4194 pragma Assert (Id = Base_Type (Id));
4195 Set_Flag135 (Id, V);
4196 end Set_Has_Aliased_Components;
4197
4198 procedure Set_Has_Alignment_Clause (Id : E; V : B := True) is
4199 begin
4200 Set_Flag46 (Id, V);
4201 end Set_Has_Alignment_Clause;
4202
4203 procedure Set_Has_All_Calls_Remote (Id : E; V : B := True) is
4204 begin
4205 Set_Flag79 (Id, V);
4206 end Set_Has_All_Calls_Remote;
4207
4208 procedure Set_Has_Anonymous_Master (Id : E; V : B := True) is
4209 begin
4210 pragma Assert
4211 (Ekind_In (Id, E_Function, E_Package, E_Package_Body, E_Procedure));
4212 Set_Flag253 (Id, V);
4213 end Set_Has_Anonymous_Master;
4214
4215 procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
4216 begin
4217 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
4218 Set_Flag86 (Id, V);
4219 end Set_Has_Atomic_Components;
4220
4221 procedure Set_Has_Biased_Representation (Id : E; V : B := True) is
4222 begin
4223 pragma Assert
4224 ((V = False) or else (Is_Discrete_Type (Id) or else Is_Object (Id)));
4225 Set_Flag139 (Id, V);
4226 end Set_Has_Biased_Representation;
4227
4228 procedure Set_Has_Completion (Id : E; V : B := True) is
4229 begin
4230 Set_Flag26 (Id, V);
4231 end Set_Has_Completion;
4232
4233 procedure Set_Has_Completion_In_Body (Id : E; V : B := True) is
4234 begin
4235 pragma Assert (Is_Type (Id));
4236 Set_Flag71 (Id, V);
4237 end Set_Has_Completion_In_Body;
4238
4239 procedure Set_Has_Complex_Representation (Id : E; V : B := True) is
4240 begin
4241 pragma Assert (Ekind (Id) = E_Record_Type);
4242 Set_Flag140 (Id, V);
4243 end Set_Has_Complex_Representation;
4244
4245 procedure Set_Has_Component_Size_Clause (Id : E; V : B := True) is
4246 begin
4247 pragma Assert (Ekind (Id) = E_Array_Type);
4248 Set_Flag68 (Id, V);
4249 end Set_Has_Component_Size_Clause;
4250
4251 procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True) is
4252 begin
4253 pragma Assert (Is_Type (Id));
4254 Set_Flag187 (Id, V);
4255 end Set_Has_Constrained_Partial_View;
4256
4257 procedure Set_Has_Contiguous_Rep (Id : E; V : B := True) is
4258 begin
4259 Set_Flag181 (Id, V);
4260 end Set_Has_Contiguous_Rep;
4261
4262 procedure Set_Has_Controlled_Component (Id : E; V : B := True) is
4263 begin
4264 pragma Assert (Id = Base_Type (Id));
4265 Set_Flag43 (Id, V);
4266 end Set_Has_Controlled_Component;
4267
4268 procedure Set_Has_Controlling_Result (Id : E; V : B := True) is
4269 begin
4270 Set_Flag98 (Id, V);
4271 end Set_Has_Controlling_Result;
4272
4273 procedure Set_Has_Convention_Pragma (Id : E; V : B := True) is
4274 begin
4275 Set_Flag119 (Id, V);
4276 end Set_Has_Convention_Pragma;
4277
4278 procedure Set_Has_Default_Aspect (Id : E; V : B := True) is
4279 begin
4280 pragma Assert
4281 ((Is_Scalar_Type (Id) or else Is_Array_Type (Id))
4282 and then Is_Base_Type (Id));
4283 Set_Flag39 (Id, V);
4284 end Set_Has_Default_Aspect;
4285
4286 procedure Set_Has_Default_Init_Cond (Id : E; V : B := True) is
4287 begin
4288 pragma Assert (Is_Type (Id));
4289 Set_Flag3 (Id, V);
4290 end Set_Has_Default_Init_Cond;
4291
4292 procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is
4293 begin
4294 pragma Assert (Nkind (Id) in N_Entity);
4295 Set_Flag200 (Id, V);
4296 end Set_Has_Delayed_Aspects;
4297
4298 procedure Set_Has_Delayed_Freeze (Id : E; V : B := True) is
4299 begin
4300 pragma Assert (Nkind (Id) in N_Entity);
4301 Set_Flag18 (Id, V);
4302 end Set_Has_Delayed_Freeze;
4303
4304 procedure Set_Has_Delayed_Rep_Aspects (Id : E; V : B := True) is
4305 begin
4306 pragma Assert (Nkind (Id) in N_Entity);
4307 Set_Flag261 (Id, V);
4308 end Set_Has_Delayed_Rep_Aspects;
4309
4310 procedure Set_Has_Discriminants (Id : E; V : B := True) is
4311 begin
4312 pragma Assert (Nkind (Id) in N_Entity);
4313 Set_Flag5 (Id, V);
4314 end Set_Has_Discriminants;
4315
4316 procedure Set_Has_Dispatch_Table (Id : E; V : B := True) is
4317 begin
4318 pragma Assert (Ekind (Id) = E_Record_Type
4319 and then Is_Tagged_Type (Id));
4320 Set_Flag220 (Id, V);
4321 end Set_Has_Dispatch_Table;
4322
4323 procedure Set_Has_Dynamic_Predicate_Aspect (Id : E; V : B := True) is
4324 begin
4325 pragma Assert (Is_Type (Id));
4326 Set_Flag258 (Id, V);
4327 end Set_Has_Dynamic_Predicate_Aspect;
4328
4329 procedure Set_Has_Enumeration_Rep_Clause (Id : E; V : B := True) is
4330 begin
4331 pragma Assert (Is_Enumeration_Type (Id));
4332 Set_Flag66 (Id, V);
4333 end Set_Has_Enumeration_Rep_Clause;
4334
4335 procedure Set_Has_Exit (Id : E; V : B := True) is
4336 begin
4337 Set_Flag47 (Id, V);
4338 end Set_Has_Exit;
4339
4340 procedure Set_Has_Expanded_Contract (Id : E; V : B := True) is
4341 begin
4342 pragma Assert (Ekind_In (Id, E_Entry,
4343 E_Entry_Family,
4344 E_Function,
4345 E_Procedure));
4346 Set_Flag240 (Id, V);
4347 end Set_Has_Expanded_Contract;
4348
4349 procedure Set_Has_Forward_Instantiation (Id : E; V : B := True) is
4350 begin
4351 Set_Flag175 (Id, V);
4352 end Set_Has_Forward_Instantiation;
4353
4354 procedure Set_Has_Fully_Qualified_Name (Id : E; V : B := True) is
4355 begin
4356 Set_Flag173 (Id, V);
4357 end Set_Has_Fully_Qualified_Name;
4358
4359 procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True) is
4360 begin
4361 Set_Flag82 (Id, V);
4362 end Set_Has_Gigi_Rep_Item;
4363
4364 procedure Set_Has_Homonym (Id : E; V : B := True) is
4365 begin
4366 Set_Flag56 (Id, V);
4367 end Set_Has_Homonym;
4368
4369 procedure Set_Has_Implicit_Dereference (Id : E; V : B := True) is
4370 begin
4371 Set_Flag251 (Id, V);
4372 end Set_Has_Implicit_Dereference;
4373
4374 procedure Set_Has_Independent_Components (Id : E; V : B := True) is
4375 begin
4376 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
4377 Set_Flag34 (Id, V);
4378 end Set_Has_Independent_Components;
4379
4380 procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True) is
4381 begin
4382 pragma Assert (Is_Type (Id));
4383 Set_Flag248 (Id, V);
4384 end Set_Has_Inheritable_Invariants;
4385
4386 procedure Set_Has_Inherited_Default_Init_Cond (Id : E; V : B := True) is
4387 begin
4388 pragma Assert (Is_Type (Id));
4389 Set_Flag133 (Id, V);
4390 end Set_Has_Inherited_Default_Init_Cond;
4391
4392 procedure Set_Has_Initial_Value (Id : E; V : B := True) is
4393 begin
4394 pragma Assert (Ekind_In (Id, E_Variable, E_Out_Parameter));
4395 Set_Flag219 (Id, V);
4396 end Set_Has_Initial_Value;
4397
4398 procedure Set_Has_Invariants (Id : E; V : B := True) is
4399 begin
4400 pragma Assert (Is_Type (Id));
4401 Set_Flag232 (Id, V);
4402 end Set_Has_Invariants;
4403
4404 procedure Set_Has_Loop_Entry_Attributes (Id : E; V : B := True) is
4405 begin
4406 pragma Assert (Ekind (Id) = E_Loop);
4407 Set_Flag260 (Id, V);
4408 end Set_Has_Loop_Entry_Attributes;
4409
4410 procedure Set_Has_Machine_Radix_Clause (Id : E; V : B := True) is
4411 begin
4412 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
4413 Set_Flag83 (Id, V);
4414 end Set_Has_Machine_Radix_Clause;
4415
4416 procedure Set_Has_Master_Entity (Id : E; V : B := True) is
4417 begin
4418 Set_Flag21 (Id, V);
4419 end Set_Has_Master_Entity;
4420
4421 procedure Set_Has_Missing_Return (Id : E; V : B := True) is
4422 begin
4423 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
4424 Set_Flag142 (Id, V);
4425 end Set_Has_Missing_Return;
4426
4427 procedure Set_Has_Nested_Block_With_Handler (Id : E; V : B := True) is
4428 begin
4429 Set_Flag101 (Id, V);
4430 end Set_Has_Nested_Block_With_Handler;
4431
4432 procedure Set_Has_Nested_Subprogram (Id : E; V : B := True) is
4433 begin
4434 pragma Assert (Is_Subprogram (Id));
4435 Set_Flag282 (Id, V);
4436 end Set_Has_Nested_Subprogram;
4437
4438 procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
4439 begin
4440 Set_Flag215 (Id, V);
4441 end Set_Has_Uplevel_Reference;
4442
4443 procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
4444 begin
4445 pragma Assert (Id = Base_Type (Id));
4446 Set_Flag75 (Id, V);
4447 end Set_Has_Non_Standard_Rep;
4448
4449 procedure Set_Has_Object_Size_Clause (Id : E; V : B := True) is
4450 begin
4451 pragma Assert (Is_Type (Id));
4452 Set_Flag172 (Id, V);
4453 end Set_Has_Object_Size_Clause;
4454
4455 procedure Set_Has_Out_Or_In_Out_Parameter (Id : E; V : B := True) is
4456 begin
4457 pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
4458 Set_Flag110 (Id, V);
4459 end Set_Has_Out_Or_In_Out_Parameter;
4460
4461 procedure Set_Has_Per_Object_Constraint (Id : E; V : B := True) is
4462 begin
4463 Set_Flag154 (Id, V);
4464 end Set_Has_Per_Object_Constraint;
4465
4466 procedure Set_Has_Pragma_Controlled (Id : E; V : B := True) is
4467 begin
4468 pragma Assert (Is_Access_Type (Id));
4469 Set_Flag27 (Base_Type (Id), V);
4470 end Set_Has_Pragma_Controlled;
4471
4472 procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True) is
4473 begin
4474 Set_Flag150 (Id, V);
4475 end Set_Has_Pragma_Elaborate_Body;
4476
4477 procedure Set_Has_Pragma_Inline (Id : E; V : B := True) is
4478 begin
4479 Set_Flag157 (Id, V);
4480 end Set_Has_Pragma_Inline;
4481
4482 procedure Set_Has_Pragma_Inline_Always (Id : E; V : B := True) is
4483 begin
4484 Set_Flag230 (Id, V);
4485 end Set_Has_Pragma_Inline_Always;
4486
4487 procedure Set_Has_Pragma_No_Inline (Id : E; V : B := True) is
4488 begin
4489 Set_Flag201 (Id, V);
4490 end Set_Has_Pragma_No_Inline;
4491
4492 procedure Set_Has_Pragma_Ordered (Id : E; V : B := True) is
4493 begin
4494 pragma Assert (Is_Enumeration_Type (Id));
4495 pragma Assert (Id = Base_Type (Id));
4496 Set_Flag198 (Id, V);
4497 end Set_Has_Pragma_Ordered;
4498
4499 procedure Set_Has_Pragma_Pack (Id : E; V : B := True) is
4500 begin
4501 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
4502 pragma Assert (Id = Base_Type (Id));
4503 Set_Flag121 (Id, V);
4504 end Set_Has_Pragma_Pack;
4505
4506 procedure Set_Has_Pragma_Preelab_Init (Id : E; V : B := True) is
4507 begin
4508 Set_Flag221 (Id, V);
4509 end Set_Has_Pragma_Preelab_Init;
4510
4511 procedure Set_Has_Pragma_Pure (Id : E; V : B := True) is
4512 begin
4513 Set_Flag203 (Id, V);
4514 end Set_Has_Pragma_Pure;
4515
4516 procedure Set_Has_Pragma_Pure_Function (Id : E; V : B := True) is
4517 begin
4518 Set_Flag179 (Id, V);
4519 end Set_Has_Pragma_Pure_Function;
4520
4521 procedure Set_Has_Pragma_Thread_Local_Storage (Id : E; V : B := True) is
4522 begin
4523 Set_Flag169 (Id, V);
4524 end Set_Has_Pragma_Thread_Local_Storage;
4525
4526 procedure Set_Has_Pragma_Unmodified (Id : E; V : B := True) is
4527 begin
4528 Set_Flag233 (Id, V);
4529 end Set_Has_Pragma_Unmodified;
4530
4531 procedure Set_Has_Pragma_Unreferenced (Id : E; V : B := True) is
4532 begin
4533 Set_Flag180 (Id, V);
4534 end Set_Has_Pragma_Unreferenced;
4535
4536 procedure Set_Has_Pragma_Unreferenced_Objects (Id : E; V : B := True) is
4537 begin
4538 pragma Assert (Is_Type (Id));
4539 Set_Flag212 (Id, V);
4540 end Set_Has_Pragma_Unreferenced_Objects;
4541
4542 procedure Set_Has_Predicates (Id : E; V : B := True) is
4543 begin
4544 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Void);
4545 Set_Flag250 (Id, V);
4546 end Set_Has_Predicates;
4547
4548 procedure Set_Has_Primitive_Operations (Id : E; V : B := True) is
4549 begin
4550 pragma Assert (Id = Base_Type (Id));
4551 Set_Flag120 (Id, V);
4552 end Set_Has_Primitive_Operations;
4553
4554 procedure Set_Has_Private_Ancestor (Id : E; V : B := True) is
4555 begin
4556 pragma Assert (Is_Type (Id));
4557 Set_Flag151 (Id, V);
4558 end Set_Has_Private_Ancestor;
4559
4560 procedure Set_Has_Private_Declaration (Id : E; V : B := True) is
4561 begin
4562 Set_Flag155 (Id, V);
4563 end Set_Has_Private_Declaration;
4564
4565 procedure Set_Has_Protected (Id : E; V : B := True) is
4566 begin
4567 Set_Flag271 (Id, V);
4568 end Set_Has_Protected;
4569
4570 procedure Set_Has_Qualified_Name (Id : E; V : B := True) is
4571 begin
4572 Set_Flag161 (Id, V);
4573 end Set_Has_Qualified_Name;
4574
4575 procedure Set_Has_RACW (Id : E; V : B := True) is
4576 begin
4577 pragma Assert (Ekind (Id) = E_Package);
4578 Set_Flag214 (Id, V);
4579 end Set_Has_RACW;
4580
4581 procedure Set_Has_Record_Rep_Clause (Id : E; V : B := True) is
4582 begin
4583 pragma Assert (Id = Base_Type (Id));
4584 Set_Flag65 (Id, V);
4585 end Set_Has_Record_Rep_Clause;
4586
4587 procedure Set_Has_Recursive_Call (Id : E; V : B := True) is
4588 begin
4589 pragma Assert (Is_Subprogram (Id));
4590 Set_Flag143 (Id, V);
4591 end Set_Has_Recursive_Call;
4592
4593 procedure Set_Has_Shift_Operator (Id : E; V : B := True) is
4594 begin
4595 pragma Assert (Is_Integer_Type (Id) and then Is_Base_Type (Id));
4596 Set_Flag267 (Id, V);
4597 end Set_Has_Shift_Operator;
4598
4599 procedure Set_Has_Size_Clause (Id : E; V : B := True) is
4600 begin
4601 Set_Flag29 (Id, V);
4602 end Set_Has_Size_Clause;
4603
4604 procedure Set_Has_Small_Clause (Id : E; V : B := True) is
4605 begin
4606 Set_Flag67 (Id, V);
4607 end Set_Has_Small_Clause;
4608
4609 procedure Set_Has_Specified_Layout (Id : E; V : B := True) is
4610 begin
4611 pragma Assert (Id = Base_Type (Id));
4612 Set_Flag100 (Id, V);
4613 end Set_Has_Specified_Layout;
4614
4615 procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True) is
4616 begin
4617 pragma Assert (Is_Type (Id));
4618 Set_Flag190 (Id, V);
4619 end Set_Has_Specified_Stream_Input;
4620
4621 procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True) is
4622 begin
4623 pragma Assert (Is_Type (Id));
4624 Set_Flag191 (Id, V);
4625 end Set_Has_Specified_Stream_Output;
4626
4627 procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True) is
4628 begin
4629 pragma Assert (Is_Type (Id));
4630 Set_Flag192 (Id, V);
4631 end Set_Has_Specified_Stream_Read;
4632
4633 procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True) is
4634 begin
4635 pragma Assert (Is_Type (Id));
4636 Set_Flag193 (Id, V);
4637 end Set_Has_Specified_Stream_Write;
4638
4639 procedure Set_Has_Static_Discriminants (Id : E; V : B := True) is
4640 begin
4641 Set_Flag211 (Id, V);
4642 end Set_Has_Static_Discriminants;
4643
4644 procedure Set_Has_Static_Predicate (Id : E; V : B := True) is
4645 begin
4646 pragma Assert (Is_Type (Id));
4647 Set_Flag269 (Id, V);
4648 end Set_Has_Static_Predicate;
4649
4650 procedure Set_Has_Static_Predicate_Aspect (Id : E; V : B := True) is
4651 begin
4652 pragma Assert (Is_Type (Id));
4653 Set_Flag259 (Id, V);
4654 end Set_Has_Static_Predicate_Aspect;
4655
4656 procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True) is
4657 begin
4658 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
4659 pragma Assert (Id = Base_Type (Id));
4660 Set_Flag23 (Id, V);
4661 end Set_Has_Storage_Size_Clause;
4662
4663 procedure Set_Has_Stream_Size_Clause (Id : E; V : B := True) is
4664 begin
4665 pragma Assert (Is_Elementary_Type (Id));
4666 Set_Flag184 (Id, V);
4667 end Set_Has_Stream_Size_Clause;
4668
4669 procedure Set_Has_Task (Id : E; V : B := True) is
4670 begin
4671 pragma Assert (Id = Base_Type (Id));
4672 Set_Flag30 (Id, V);
4673 end Set_Has_Task;
4674
4675 procedure Set_Has_Thunks (Id : E; V : B := True) is
4676 begin
4677 pragma Assert (Is_Tag (Id));
4678 Set_Flag228 (Id, V);
4679 end Set_Has_Thunks;
4680
4681 procedure Set_Has_Unchecked_Union (Id : E; V : B := True) is
4682 begin
4683 pragma Assert (Id = Base_Type (Id));
4684 Set_Flag123 (Id, V);
4685 end Set_Has_Unchecked_Union;
4686
4687 procedure Set_Has_Unknown_Discriminants (Id : E; V : B := True) is
4688 begin
4689 pragma Assert (Is_Type (Id));
4690 Set_Flag72 (Id, V);
4691 end Set_Has_Unknown_Discriminants;
4692
4693 procedure Set_Has_Visible_Refinement (Id : E; V : B := True) is
4694 begin
4695 pragma Assert (Ekind (Id) = E_Abstract_State);
4696 Set_Flag263 (Id, V);
4697 end Set_Has_Visible_Refinement;
4698
4699 procedure Set_Has_Volatile_Components (Id : E; V : B := True) is
4700 begin
4701 pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
4702 Set_Flag87 (Id, V);
4703 end Set_Has_Volatile_Components;
4704
4705 procedure Set_Has_Xref_Entry (Id : E; V : B := True) is
4706 begin
4707 Set_Flag182 (Id, V);
4708 end Set_Has_Xref_Entry;
4709
4710 procedure Set_Hiding_Loop_Variable (Id : E; V : E) is
4711 begin
4712 pragma Assert (Ekind (Id) = E_Variable);
4713 Set_Node8 (Id, V);
4714 end Set_Hiding_Loop_Variable;
4715
4716 procedure Set_Homonym (Id : E; V : E) is
4717 begin
4718 pragma Assert (Id /= V);
4719 Set_Node4 (Id, V);
4720 end Set_Homonym;
4721
4722 procedure Set_Import_Pragma (Id : E; V : E) is
4723 begin
4724 pragma Assert (Is_Subprogram (Id));
4725 Set_Node35 (Id, V);
4726 end Set_Import_Pragma;
4727
4728 procedure Set_Interface_Alias (Id : E; V : E) is
4729 begin
4730 pragma Assert
4731 (Is_Internal (Id)
4732 and then Is_Hidden (Id)
4733 and then (Ekind_In (Id, E_Procedure, E_Function)));
4734 Set_Node25 (Id, V);
4735 end Set_Interface_Alias;
4736
4737 procedure Set_Interfaces (Id : E; V : L) is
4738 begin
4739 pragma Assert (Is_Record_Type (Id));
4740 Set_Elist25 (Id, V);
4741 end Set_Interfaces;
4742
4743 procedure Set_In_Package_Body (Id : E; V : B := True) is
4744 begin
4745 Set_Flag48 (Id, V);
4746 end Set_In_Package_Body;
4747
4748 procedure Set_In_Private_Part (Id : E; V : B := True) is
4749 begin
4750 Set_Flag45 (Id, V);
4751 end Set_In_Private_Part;
4752
4753 procedure Set_In_Use (Id : E; V : B := True) is
4754 begin
4755 pragma Assert (Nkind (Id) in N_Entity);
4756 Set_Flag8 (Id, V);
4757 end Set_In_Use;
4758
4759 procedure Set_Initialization_Statements (Id : E; V : N) is
4760 begin
4761 -- Tolerate an E_Void entity since this can be called while resolving
4762 -- an aggregate used as the initialization expression for an object
4763 -- declaration, and this occurs before the Ekind for the object is set.
4764
4765 pragma Assert (Ekind_In (Id, E_Void, E_Constant, E_Variable));
4766 Set_Node28 (Id, V);
4767 end Set_Initialization_Statements;
4768
4769 procedure Set_Inner_Instances (Id : E; V : L) is
4770 begin
4771 Set_Elist23 (Id, V);
4772 end Set_Inner_Instances;
4773
4774 procedure Set_Interface_Name (Id : E; V : N) is
4775 begin
4776 Set_Node21 (Id, V);
4777 end Set_Interface_Name;
4778
4779 procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True) is
4780 begin
4781 pragma Assert (Is_Overloadable (Id));
4782 Set_Flag19 (Id, V);
4783 end Set_Is_Abstract_Subprogram;
4784
4785 procedure Set_Is_Abstract_Type (Id : E; V : B := True) is
4786 begin
4787 pragma Assert (Is_Type (Id));
4788 Set_Flag146 (Id, V);
4789 end Set_Is_Abstract_Type;
4790
4791 procedure Set_Is_ARECnF_Entity (Id : E; V : B := True) is
4792 begin
4793 Set_Flag284 (Id, V);
4794 end Set_Is_ARECnF_Entity;
4795
4796 procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
4797 begin
4798 pragma Assert (Is_Access_Type (Id));
4799 Set_Flag194 (Id, V);
4800 end Set_Is_Local_Anonymous_Access;
4801
4802 procedure Set_Is_Access_Constant (Id : E; V : B := True) is
4803 begin
4804 pragma Assert (Is_Access_Type (Id));
4805 Set_Flag69 (Id, V);
4806 end Set_Is_Access_Constant;
4807
4808 procedure Set_Is_Ada_2005_Only (Id : E; V : B := True) is
4809 begin
4810 Set_Flag185 (Id, V);
4811 end Set_Is_Ada_2005_Only;
4812
4813 procedure Set_Is_Ada_2012_Only (Id : E; V : B := True) is
4814 begin
4815 Set_Flag199 (Id, V);
4816 end Set_Is_Ada_2012_Only;
4817
4818 procedure Set_Is_Aliased (Id : E; V : B := True) is
4819 begin
4820 pragma Assert (Nkind (Id) in N_Entity);
4821 Set_Flag15 (Id, V);
4822 end Set_Is_Aliased;
4823
4824 procedure Set_Is_Asynchronous (Id : E; V : B := True) is
4825 begin
4826 pragma Assert
4827 (Ekind (Id) = E_Procedure or else Is_Type (Id));
4828 Set_Flag81 (Id, V);
4829 end Set_Is_Asynchronous;
4830
4831 procedure Set_Is_Atomic (Id : E; V : B := True) is
4832 begin
4833 Set_Flag85 (Id, V);
4834 end Set_Is_Atomic;
4835
4836 procedure Set_Is_Bit_Packed_Array (Id : E; V : B := True) is
4837 begin
4838 pragma Assert ((not V)
4839 or else (Is_Array_Type (Id) and then Is_Base_Type (Id)));
4840 Set_Flag122 (Id, V);
4841 end Set_Is_Bit_Packed_Array;
4842
4843 procedure Set_Is_Called (Id : E; V : B := True) is
4844 begin
4845 pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
4846 Set_Flag102 (Id, V);
4847 end Set_Is_Called;
4848
4849 procedure Set_Is_Character_Type (Id : E; V : B := True) is
4850 begin
4851 Set_Flag63 (Id, V);
4852 end Set_Is_Character_Type;
4853
4854 procedure Set_Is_Checked_Ghost_Entity (Id : E; V : B := True) is
4855 begin
4856 pragma Assert (Is_Formal (Id)
4857 or else Is_Object (Id)
4858 or else Is_Package_Or_Generic_Package (Id)
4859 or else Is_Subprogram_Or_Generic_Subprogram (Id)
4860 or else Is_Type (Id)
4861 or else Ekind (Id) = E_Abstract_State
4862 or else Ekind (Id) = E_Component
4863 or else Ekind (Id) = E_Discriminant
4864 or else Ekind (Id) = E_Exception
4865 or else Ekind (Id) = E_Package_Body
4866 or else Ekind (Id) = E_Subprogram_Body
4867
4868 -- Allow this attribute to appear on non-analyzed entities
4869
4870 or else Ekind (Id) = E_Void);
4871 Set_Flag277 (Id, V);
4872 end Set_Is_Checked_Ghost_Entity;
4873
4874 procedure Set_Is_Child_Unit (Id : E; V : B := True) is
4875 begin
4876 Set_Flag73 (Id, V);
4877 end Set_Is_Child_Unit;
4878
4879 procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True) is
4880 begin
4881 Set_Flag35 (Id, V);
4882 end Set_Is_Class_Wide_Equivalent_Type;
4883
4884 procedure Set_Is_Compilation_Unit (Id : E; V : B := True) is
4885 begin
4886 Set_Flag149 (Id, V);
4887 end Set_Is_Compilation_Unit;
4888
4889 procedure Set_Is_Completely_Hidden (Id : E; V : B := True) is
4890 begin
4891 pragma Assert (Ekind (Id) = E_Discriminant);
4892 Set_Flag103 (Id, V);
4893 end Set_Is_Completely_Hidden;
4894
4895 procedure Set_Is_Concurrent_Record_Type (Id : E; V : B := True) is
4896 begin
4897 Set_Flag20 (Id, V);
4898 end Set_Is_Concurrent_Record_Type;
4899
4900 procedure Set_Is_Constr_Subt_For_U_Nominal (Id : E; V : B := True) is
4901 begin
4902 Set_Flag80 (Id, V);
4903 end Set_Is_Constr_Subt_For_U_Nominal;
4904
4905 procedure Set_Is_Constr_Subt_For_UN_Aliased (Id : E; V : B := True) is
4906 begin
4907 Set_Flag141 (Id, V);
4908 end Set_Is_Constr_Subt_For_UN_Aliased;
4909
4910 procedure Set_Is_Constrained (Id : E; V : B := True) is
4911 begin
4912 pragma Assert (Nkind (Id) in N_Entity);
4913 Set_Flag12 (Id, V);
4914 end Set_Is_Constrained;
4915
4916 procedure Set_Is_Constructor (Id : E; V : B := True) is
4917 begin
4918 Set_Flag76 (Id, V);
4919 end Set_Is_Constructor;
4920
4921 procedure Set_Is_Controlled (Id : E; V : B := True) is
4922 begin
4923 pragma Assert (Id = Base_Type (Id));
4924 Set_Flag42 (Id, V);
4925 end Set_Is_Controlled;
4926
4927 procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is
4928 begin
4929 pragma Assert (Is_Formal (Id));
4930 Set_Flag97 (Id, V);
4931 end Set_Is_Controlling_Formal;
4932
4933 procedure Set_Is_CPP_Class (Id : E; V : B := True) is
4934 begin
4935 Set_Flag74 (Id, V);
4936 end Set_Is_CPP_Class;
4937
4938 procedure Set_Is_Default_Init_Cond_Procedure (Id : E; V : B := True) is
4939 begin
4940 pragma Assert (Ekind (Id) = E_Procedure);
4941 Set_Flag132 (Id, V);
4942 end Set_Is_Default_Init_Cond_Procedure;
4943
4944 procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True) is
4945 begin
4946 pragma Assert (Is_Type (Id));
4947 Set_Flag223 (Id, V);
4948 end Set_Is_Descendent_Of_Address;
4949
4950 procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True) is
4951 begin
4952 Set_Flag176 (Id, V);
4953 end Set_Is_Discrim_SO_Function;
4954
4955 procedure Set_Is_Discriminant_Check_Function (Id : E; V : B := True) is
4956 begin
4957 Set_Flag264 (Id, V);
4958 end Set_Is_Discriminant_Check_Function;
4959
4960 procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True) is
4961 begin
4962 Set_Flag234 (Id, V);
4963 end Set_Is_Dispatch_Table_Entity;
4964
4965 procedure Set_Is_Dispatching_Operation (Id : E; V : B := True) is
4966 begin
4967 pragma Assert
4968 (V = False
4969 or else
4970 Is_Overloadable (Id)
4971 or else
4972 Ekind (Id) = E_Subprogram_Type);
4973
4974 Set_Flag6 (Id, V);
4975 end Set_Is_Dispatching_Operation;
4976
4977 procedure Set_Is_Eliminated (Id : E; V : B := True) is
4978 begin
4979 Set_Flag124 (Id, V);
4980 end Set_Is_Eliminated;
4981
4982 procedure Set_Is_Entry_Formal (Id : E; V : B := True) is
4983 begin
4984 Set_Flag52 (Id, V);
4985 end Set_Is_Entry_Formal;
4986
4987 procedure Set_Is_Exported (Id : E; V : B := True) is
4988 begin
4989 Set_Flag99 (Id, V);
4990 end Set_Is_Exported;
4991
4992 procedure Set_Is_First_Subtype (Id : E; V : B := True) is
4993 begin
4994 Set_Flag70 (Id, V);
4995 end Set_Is_First_Subtype;
4996
4997 procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is
4998 begin
4999 pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
5000 Set_Flag118 (Id, V);
5001 end Set_Is_For_Access_Subtype;
5002
5003 procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is
5004 begin
5005 Set_Flag111 (Id, V);
5006 end Set_Is_Formal_Subprogram;
5007
5008 procedure Set_Is_Frozen (Id : E; V : B := True) is
5009 begin
5010 pragma Assert (Nkind (Id) in N_Entity);
5011 Set_Flag4 (Id, V);
5012 end Set_Is_Frozen;
5013
5014 procedure Set_Is_Generic_Actual_Subprogram (Id : E; V : B := True) is
5015 begin
5016 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5017 Set_Flag274 (Id, V);
5018 end Set_Is_Generic_Actual_Subprogram;
5019
5020 procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True) is
5021 begin
5022 pragma Assert (Is_Type (Id));
5023 Set_Flag94 (Id, V);
5024 end Set_Is_Generic_Actual_Type;
5025
5026 procedure Set_Is_Generic_Instance (Id : E; V : B := True) is
5027 begin
5028 Set_Flag130 (Id, V);
5029 end Set_Is_Generic_Instance;
5030
5031 procedure Set_Is_Generic_Type (Id : E; V : B := True) is
5032 begin
5033 pragma Assert (Nkind (Id) in N_Entity);
5034 Set_Flag13 (Id, V);
5035 end Set_Is_Generic_Type;
5036
5037 procedure Set_Is_Hidden (Id : E; V : B := True) is
5038 begin
5039 Set_Flag57 (Id, V);
5040 end Set_Is_Hidden;
5041
5042 procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True) is
5043 begin
5044 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5045 Set_Flag2 (Id, V);
5046 end Set_Is_Hidden_Non_Overridden_Subpgm;
5047
5048 procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True) is
5049 begin
5050 Set_Flag171 (Id, V);
5051 end Set_Is_Hidden_Open_Scope;
5052
5053 procedure Set_Is_Ignored_Ghost_Entity (Id : E; V : B := True) is
5054 begin
5055 pragma Assert (Is_Formal (Id)
5056 or else Is_Object (Id)
5057 or else Is_Package_Or_Generic_Package (Id)
5058 or else Is_Subprogram_Or_Generic_Subprogram (Id)
5059 or else Is_Type (Id)
5060 or else Ekind (Id) = E_Abstract_State
5061 or else Ekind (Id) = E_Component
5062 or else Ekind (Id) = E_Discriminant
5063 or else Ekind (Id) = E_Exception
5064 or else Ekind (Id) = E_Package_Body
5065 or else Ekind (Id) = E_Subprogram_Body
5066
5067 -- Allow this attribute to appear on non-analyzed entities
5068
5069 or else Ekind (Id) = E_Void);
5070 Set_Flag278 (Id, V);
5071 end Set_Is_Ignored_Ghost_Entity;
5072
5073 procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is
5074 begin
5075 pragma Assert (Nkind (Id) in N_Entity);
5076 Set_Flag7 (Id, V);
5077 end Set_Is_Immediately_Visible;
5078
5079 procedure Set_Is_Implementation_Defined (Id : E; V : B := True) is
5080 begin
5081 Set_Flag254 (Id, V);
5082 end Set_Is_Implementation_Defined;
5083
5084 procedure Set_Is_Imported (Id : E; V : B := True) is
5085 begin
5086 Set_Flag24 (Id, V);
5087 end Set_Is_Imported;
5088
5089 procedure Set_Is_Independent (Id : E; V : B := True) is
5090 begin
5091 Set_Flag268 (Id, V);
5092 end Set_Is_Independent;
5093
5094 procedure Set_Is_Inlined (Id : E; V : B := True) is
5095 begin
5096 Set_Flag11 (Id, V);
5097 end Set_Is_Inlined;
5098
5099 procedure Set_Is_Inlined_Always (Id : E; V : B := True) is
5100 begin
5101 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
5102 Set_Flag1 (Id, V);
5103 end Set_Is_Inlined_Always;
5104
5105 procedure Set_Is_Interface (Id : E; V : B := True) is
5106 begin
5107 pragma Assert (Is_Record_Type (Id));
5108 Set_Flag186 (Id, V);
5109 end Set_Is_Interface;
5110
5111 procedure Set_Is_Instantiated (Id : E; V : B := True) is
5112 begin
5113 Set_Flag126 (Id, V);
5114 end Set_Is_Instantiated;
5115
5116 procedure Set_Is_Internal (Id : E; V : B := True) is
5117 begin
5118 pragma Assert (Nkind (Id) in N_Entity);
5119 Set_Flag17 (Id, V);
5120 end Set_Is_Internal;
5121
5122 procedure Set_Is_Interrupt_Handler (Id : E; V : B := True) is
5123 begin
5124 pragma Assert (Nkind (Id) in N_Entity);
5125 Set_Flag89 (Id, V);
5126 end Set_Is_Interrupt_Handler;
5127
5128 procedure Set_Is_Intrinsic_Subprogram (Id : E; V : B := True) is
5129 begin
5130 Set_Flag64 (Id, V);
5131 end Set_Is_Intrinsic_Subprogram;
5132
5133 procedure Set_Is_Invariant_Procedure (Id : E; V : B := True) is
5134 begin
5135 pragma Assert (Ekind (Id) = E_Procedure);
5136 Set_Flag257 (Id, V);
5137 end Set_Is_Invariant_Procedure;
5138
5139 procedure Set_Is_Itype (Id : E; V : B := True) is
5140 begin
5141 Set_Flag91 (Id, V);
5142 end Set_Is_Itype;
5143
5144 procedure Set_Is_Known_Non_Null (Id : E; V : B := True) is
5145 begin
5146 Set_Flag37 (Id, V);
5147 end Set_Is_Known_Non_Null;
5148
5149 procedure Set_Is_Known_Null (Id : E; V : B := True) is
5150 begin
5151 Set_Flag204 (Id, V);
5152 end Set_Is_Known_Null;
5153
5154 procedure Set_Is_Known_Valid (Id : E; V : B := True) is
5155 begin
5156 Set_Flag170 (Id, V);
5157 end Set_Is_Known_Valid;
5158
5159 procedure Set_Is_Limited_Composite (Id : E; V : B := True) is
5160 begin
5161 pragma Assert (Is_Type (Id));
5162 Set_Flag106 (Id, V);
5163 end Set_Is_Limited_Composite;
5164
5165 procedure Set_Is_Limited_Interface (Id : E; V : B := True) is
5166 begin
5167 pragma Assert (Is_Interface (Id));
5168 Set_Flag197 (Id, V);
5169 end Set_Is_Limited_Interface;
5170
5171 procedure Set_Is_Limited_Record (Id : E; V : B := True) is
5172 begin
5173 Set_Flag25 (Id, V);
5174 end Set_Is_Limited_Record;
5175
5176 procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is
5177 begin
5178 pragma Assert (Is_Subprogram (Id));
5179 Set_Flag137 (Id, V);
5180 end Set_Is_Machine_Code_Subprogram;
5181
5182 procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True) is
5183 begin
5184 pragma Assert (Is_Type (Id));
5185 Set_Flag109 (Id, V);
5186 end Set_Is_Non_Static_Subtype;
5187
5188 procedure Set_Is_Null_Init_Proc (Id : E; V : B := True) is
5189 begin
5190 pragma Assert (Ekind (Id) = E_Procedure);
5191 Set_Flag178 (Id, V);
5192 end Set_Is_Null_Init_Proc;
5193
5194 procedure Set_Is_Obsolescent (Id : E; V : B := True) is
5195 begin
5196 Set_Flag153 (Id, V);
5197 end Set_Is_Obsolescent;
5198
5199 procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True) is
5200 begin
5201 pragma Assert (Ekind (Id) = E_Out_Parameter);
5202 Set_Flag226 (Id, V);
5203 end Set_Is_Only_Out_Parameter;
5204
5205 procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is
5206 begin
5207 Set_Flag160 (Id, V);
5208 end Set_Is_Package_Body_Entity;
5209
5210 procedure Set_Is_Packed (Id : E; V : B := True) is
5211 begin
5212 pragma Assert (Id = Base_Type (Id));
5213 Set_Flag51 (Id, V);
5214 end Set_Is_Packed;
5215
5216 procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True) is
5217 begin
5218 Set_Flag138 (Id, V);
5219 end Set_Is_Packed_Array_Impl_Type;
5220
5221 procedure Set_Is_Potentially_Use_Visible (Id : E; V : B := True) is
5222 begin
5223 pragma Assert (Nkind (Id) in N_Entity);
5224 Set_Flag9 (Id, V);
5225 end Set_Is_Potentially_Use_Visible;
5226
5227 procedure Set_Is_Predicate_Function (Id : E; V : B := True) is
5228 begin
5229 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
5230 Set_Flag255 (Id, V);
5231 end Set_Is_Predicate_Function;
5232
5233 procedure Set_Is_Predicate_Function_M (Id : E; V : B := True) is
5234 begin
5235 pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
5236 Set_Flag256 (Id, V);
5237 end Set_Is_Predicate_Function_M;
5238
5239 procedure Set_Is_Preelaborated (Id : E; V : B := True) is
5240 begin
5241 Set_Flag59 (Id, V);
5242 end Set_Is_Preelaborated;
5243
5244 procedure Set_Is_Primitive (Id : E; V : B := True) is
5245 begin
5246 pragma Assert
5247 (Is_Overloadable (Id)
5248 or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
5249 Set_Flag218 (Id, V);
5250 end Set_Is_Primitive;
5251
5252 procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is
5253 begin
5254 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5255 Set_Flag195 (Id, V);
5256 end Set_Is_Primitive_Wrapper;
5257
5258 procedure Set_Is_Private_Composite (Id : E; V : B := True) is
5259 begin
5260 pragma Assert (Is_Type (Id));
5261 Set_Flag107 (Id, V);
5262 end Set_Is_Private_Composite;
5263
5264 procedure Set_Is_Private_Descendant (Id : E; V : B := True) is
5265 begin
5266 Set_Flag53 (Id, V);
5267 end Set_Is_Private_Descendant;
5268
5269 procedure Set_Is_Private_Primitive (Id : E; V : B := True) is
5270 begin
5271 pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
5272 Set_Flag245 (Id, V);
5273 end Set_Is_Private_Primitive;
5274
5275 procedure Set_Is_Processed_Transient (Id : E; V : B := True) is
5276 begin
5277 pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
5278 Set_Flag252 (Id, V);
5279 end Set_Is_Processed_Transient;
5280
5281 procedure Set_Is_Public (Id : E; V : B := True) is
5282 begin
5283 pragma Assert (Nkind (Id) in N_Entity);
5284 Set_Flag10 (Id, V);
5285 end Set_Is_Public;
5286
5287 procedure Set_Is_Pure (Id : E; V : B := True) is
5288 begin
5289 Set_Flag44 (Id, V);
5290 end Set_Is_Pure;
5291
5292 procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True) is
5293 begin
5294 pragma Assert (Is_Access_Type (Id));
5295 Set_Flag189 (Id, V);
5296 end Set_Is_Pure_Unit_Access_Type;
5297
5298 procedure Set_Is_RACW_Stub_Type (Id : E; V : B := True) is
5299 begin
5300 pragma Assert (Is_Type (Id));
5301 Set_Flag244 (Id, V);
5302 end Set_Is_RACW_Stub_Type;
5303
5304 procedure Set_Is_Raised (Id : E; V : B := True) is
5305 begin
5306 pragma Assert (Ekind (Id) = E_Exception);
5307 Set_Flag224 (Id, V);
5308 end Set_Is_Raised;
5309
5310 procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True) is
5311 begin
5312 Set_Flag62 (Id, V);
5313 end Set_Is_Remote_Call_Interface;
5314
5315 procedure Set_Is_Remote_Types (Id : E; V : B := True) is
5316 begin
5317 Set_Flag61 (Id, V);
5318 end Set_Is_Remote_Types;
5319
5320 procedure Set_Is_Renaming_Of_Object (Id : E; V : B := True) is
5321 begin
5322 Set_Flag112 (Id, V);
5323 end Set_Is_Renaming_Of_Object;
5324
5325 procedure Set_Is_Return_Object (Id : E; V : B := True) is
5326 begin
5327 Set_Flag209 (Id, V);
5328 end Set_Is_Return_Object;
5329
5330 procedure Set_Is_Safe_To_Reevaluate (Id : E; V : B := True) is
5331 begin
5332 pragma Assert (Ekind (Id) = E_Variable);
5333 Set_Flag249 (Id, V);
5334 end Set_Is_Safe_To_Reevaluate;
5335
5336 procedure Set_Is_Shared_Passive (Id : E; V : B := True) is
5337 begin
5338 Set_Flag60 (Id, V);
5339 end Set_Is_Shared_Passive;
5340
5341 procedure Set_Is_Static_Type (Id : E; V : B := True) is
5342 begin
5343 pragma Assert (Is_Type (Id));
5344 Set_Flag281 (Id, V);
5345 end Set_Is_Static_Type;
5346
5347 procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is
5348 begin
5349 pragma Assert
5350 (Is_Type (Id)
5351 or else Ekind_In (Id, E_Exception,
5352 E_Variable,
5353 E_Constant,
5354 E_Void));
5355 Set_Flag28 (Id, V);
5356 end Set_Is_Statically_Allocated;
5357
5358 procedure Set_Is_Tag (Id : E; V : B := True) is
5359 begin
5360 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
5361 Set_Flag78 (Id, V);
5362 end Set_Is_Tag;
5363
5364 procedure Set_Is_Tagged_Type (Id : E; V : B := True) is
5365 begin
5366 Set_Flag55 (Id, V);
5367 end Set_Is_Tagged_Type;
5368
5369 procedure Set_Is_Thunk (Id : E; V : B := True) is
5370 begin
5371 pragma Assert (Is_Subprogram (Id));
5372 Set_Flag225 (Id, V);
5373 end Set_Is_Thunk;
5374
5375 procedure Set_Is_Trivial_Subprogram (Id : E; V : B := True) is
5376 begin
5377 Set_Flag235 (Id, V);
5378 end Set_Is_Trivial_Subprogram;
5379
5380 procedure Set_Is_True_Constant (Id : E; V : B := True) is
5381 begin
5382 Set_Flag163 (Id, V);
5383 end Set_Is_True_Constant;
5384
5385 procedure Set_Is_Unchecked_Union (Id : E; V : B := True) is
5386 begin
5387 pragma Assert (Id = Base_Type (Id));
5388 Set_Flag117 (Id, V);
5389 end Set_Is_Unchecked_Union;
5390
5391 procedure Set_Is_Underlying_Record_View (Id : E; V : B := True) is
5392 begin
5393 pragma Assert (Ekind (Id) = E_Record_Type);
5394 Set_Flag246 (Id, V);
5395 end Set_Is_Underlying_Record_View;
5396
5397 procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
5398 begin
5399 pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
5400 Set_Flag144 (Id, V);
5401 end Set_Is_Unsigned_Type;
5402
5403 procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
5404 begin
5405 pragma Assert (Ekind (Id) = E_Procedure);
5406 Set_Flag127 (Id, V);
5407 end Set_Is_Valued_Procedure;
5408
5409 procedure Set_Is_Visible_Formal (Id : E; V : B := True) is
5410 begin
5411 Set_Flag206 (Id, V);
5412 end Set_Is_Visible_Formal;
5413
5414 procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True) is
5415 begin
5416 Set_Flag116 (Id, V);
5417 end Set_Is_Visible_Lib_Unit;
5418
5419 procedure Set_Is_Volatile (Id : E; V : B := True) is
5420 begin
5421 pragma Assert (Nkind (Id) in N_Entity);
5422 Set_Flag16 (Id, V);
5423 end Set_Is_Volatile;
5424
5425 procedure Set_Itype_Printed (Id : E; V : B := True) is
5426 begin
5427 pragma Assert (Is_Itype (Id));
5428 Set_Flag202 (Id, V);
5429 end Set_Itype_Printed;
5430
5431 procedure Set_Kill_Elaboration_Checks (Id : E; V : B := True) is
5432 begin
5433 Set_Flag32 (Id, V);
5434 end Set_Kill_Elaboration_Checks;
5435
5436 procedure Set_Kill_Range_Checks (Id : E; V : B := True) is
5437 begin
5438 Set_Flag33 (Id, V);
5439 end Set_Kill_Range_Checks;
5440
5441 procedure Set_Known_To_Have_Preelab_Init (Id : E; V : B := True) is
5442 begin
5443 pragma Assert (Is_Type (Id));
5444 Set_Flag207 (Id, V);
5445 end Set_Known_To_Have_Preelab_Init;
5446
5447 procedure Set_Last_Aggregate_Assignment (Id : E; V : N) is
5448 begin
5449 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5450 Set_Node30 (Id, V);
5451 end Set_Last_Aggregate_Assignment;
5452
5453 procedure Set_Last_Assignment (Id : E; V : N) is
5454 begin
5455 pragma Assert (Is_Assignable (Id));
5456 Set_Node26 (Id, V);
5457 end Set_Last_Assignment;
5458
5459 procedure Set_Last_Entity (Id : E; V : E) is
5460 begin
5461 Set_Node20 (Id, V);
5462 end Set_Last_Entity;
5463
5464 procedure Set_Limited_View (Id : E; V : E) is
5465 begin
5466 pragma Assert (Ekind (Id) = E_Package);
5467 Set_Node23 (Id, V);
5468 end Set_Limited_View;
5469
5470 procedure Set_Linker_Section_Pragma (Id : E; V : N) is
5471 begin
5472 pragma Assert (Is_Type (Id)
5473 or else Ekind_In (Id, E_Constant, E_Variable)
5474 or else Is_Subprogram (Id));
5475 Set_Node33 (Id, V);
5476 end Set_Linker_Section_Pragma;
5477
5478 procedure Set_Lit_Indexes (Id : E; V : E) is
5479 begin
5480 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
5481 Set_Node18 (Id, V);
5482 end Set_Lit_Indexes;
5483
5484 procedure Set_Lit_Strings (Id : E; V : E) is
5485 begin
5486 pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
5487 Set_Node16 (Id, V);
5488 end Set_Lit_Strings;
5489
5490 procedure Set_Low_Bound_Tested (Id : E; V : B := True) is
5491 begin
5492 pragma Assert (Is_Formal (Id));
5493 Set_Flag205 (Id, V);
5494 end Set_Low_Bound_Tested;
5495
5496 procedure Set_Machine_Radix_10 (Id : E; V : B := True) is
5497 begin
5498 pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
5499 Set_Flag84 (Id, V);
5500 end Set_Machine_Radix_10;
5501
5502 procedure Set_Master_Id (Id : E; V : E) is
5503 begin
5504 pragma Assert (Is_Access_Type (Id));
5505 Set_Node17 (Id, V);
5506 end Set_Master_Id;
5507
5508 procedure Set_Materialize_Entity (Id : E; V : B := True) is
5509 begin
5510 Set_Flag168 (Id, V);
5511 end Set_Materialize_Entity;
5512
5513 procedure Set_May_Inherit_Delayed_Rep_Aspects (Id : E; V : B := True) is
5514 begin
5515 Set_Flag262 (Id, V);
5516 end Set_May_Inherit_Delayed_Rep_Aspects;
5517
5518 procedure Set_Mechanism (Id : E; V : M) is
5519 begin
5520 pragma Assert (Ekind (Id) = E_Function or else Is_Formal (Id));
5521 Set_Uint8 (Id, UI_From_Int (V));
5522 end Set_Mechanism;
5523
5524 procedure Set_Modulus (Id : E; V : U) is
5525 begin
5526 pragma Assert (Ekind (Id) = E_Modular_Integer_Type);
5527 Set_Uint17 (Id, V);
5528 end Set_Modulus;
5529
5530 procedure Set_Must_Be_On_Byte_Boundary (Id : E; V : B := True) is
5531 begin
5532 pragma Assert (Is_Type (Id));
5533 Set_Flag183 (Id, V);
5534 end Set_Must_Be_On_Byte_Boundary;
5535
5536 procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True) is
5537 begin
5538 pragma Assert (Is_Type (Id));
5539 Set_Flag208 (Id, V);
5540 end Set_Must_Have_Preelab_Init;
5541
5542 procedure Set_Needs_Debug_Info (Id : E; V : B := True) is
5543 begin
5544 Set_Flag147 (Id, V);
5545 end Set_Needs_Debug_Info;
5546
5547 procedure Set_Needs_No_Actuals (Id : E; V : B := True) is
5548 begin
5549 pragma Assert
5550 (Is_Overloadable (Id)
5551 or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
5552 Set_Flag22 (Id, V);
5553 end Set_Needs_No_Actuals;
5554
5555 procedure Set_Never_Set_In_Source (Id : E; V : B := True) is
5556 begin
5557 Set_Flag115 (Id, V);
5558 end Set_Never_Set_In_Source;
5559
5560 procedure Set_Next_Inlined_Subprogram (Id : E; V : E) is
5561 begin
5562 Set_Node12 (Id, V);
5563 end Set_Next_Inlined_Subprogram;
5564
5565 procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True) is
5566 begin
5567 pragma Assert (Is_Discrete_Type (Id));
5568 Set_Flag276 (Id, V);
5569 end Set_No_Dynamic_Predicate_On_Actual;
5570
5571 procedure Set_No_Pool_Assigned (Id : E; V : B := True) is
5572 begin
5573 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
5574 Set_Flag131 (Id, V);
5575 end Set_No_Pool_Assigned;
5576
5577 procedure Set_No_Predicate_On_Actual (Id : E; V : B := True) is
5578 begin
5579 pragma Assert (Is_Discrete_Type (Id));
5580 Set_Flag275 (Id, V);
5581 end Set_No_Predicate_On_Actual;
5582
5583 procedure Set_No_Return (Id : E; V : B := True) is
5584 begin
5585 pragma Assert
5586 (V = False or else Ekind_In (Id, E_Procedure, E_Generic_Procedure));
5587 Set_Flag113 (Id, V);
5588 end Set_No_Return;
5589
5590 procedure Set_No_Strict_Aliasing (Id : E; V : B := True) is
5591 begin
5592 pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
5593 Set_Flag136 (Id, V);
5594 end Set_No_Strict_Aliasing;
5595
5596 procedure Set_No_Tagged_Streams_Pragma (Id : E; V : E) is
5597 begin
5598 pragma Assert (Is_Tagged_Type (Id));
5599 Set_Node32 (Id, V);
5600 end Set_No_Tagged_Streams_Pragma;
5601
5602 procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
5603 begin
5604 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
5605 Set_Flag58 (Id, V);
5606 end Set_Non_Binary_Modulus;
5607
5608 procedure Set_Non_Limited_View (Id : E; V : E) is
5609 begin
5610 pragma Assert
5611 (Ekind (Id) in Incomplete_Kind or else Ekind (Id) = E_Abstract_State);
5612 Set_Node17 (Id, V);
5613 end Set_Non_Limited_View;
5614
5615 procedure Set_Nonzero_Is_True (Id : E; V : B := True) is
5616 begin
5617 pragma Assert
5618 (Root_Type (Id) = Standard_Boolean
5619 and then Ekind (Id) = E_Enumeration_Type);
5620 Set_Flag162 (Id, V);
5621 end Set_Nonzero_Is_True;
5622
5623 procedure Set_Normalized_First_Bit (Id : E; V : U) is
5624 begin
5625 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
5626 Set_Uint8 (Id, V);
5627 end Set_Normalized_First_Bit;
5628
5629 procedure Set_Normalized_Position (Id : E; V : U) is
5630 begin
5631 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
5632 Set_Uint14 (Id, V);
5633 end Set_Normalized_Position;
5634
5635 procedure Set_Normalized_Position_Max (Id : E; V : U) is
5636 begin
5637 pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
5638 Set_Uint10 (Id, V);
5639 end Set_Normalized_Position_Max;
5640
5641 procedure Set_OK_To_Rename (Id : E; V : B := True) is
5642 begin
5643 pragma Assert (Ekind (Id) = E_Variable);
5644 Set_Flag247 (Id, V);
5645 end Set_OK_To_Rename;
5646
5647 procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is
5648 begin
5649 pragma Assert
5650 (Is_Record_Type (Id) and then Is_Base_Type (Id));
5651 Set_Flag239 (Id, V);
5652 end Set_OK_To_Reorder_Components;
5653
5654 procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is
5655 begin
5656 pragma Assert
5657 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
5658 Set_Flag241 (Id, V);
5659 end Set_Optimize_Alignment_Space;
5660
5661 procedure Set_Optimize_Alignment_Time (Id : E; V : B := True) is
5662 begin
5663 pragma Assert
5664 (Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
5665 Set_Flag242 (Id, V);
5666 end Set_Optimize_Alignment_Time;
5667
5668 procedure Set_Original_Access_Type (Id : E; V : E) is
5669 begin
5670 pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
5671 Set_Node28 (Id, V);
5672 end Set_Original_Access_Type;
5673
5674 procedure Set_Original_Array_Type (Id : E; V : E) is
5675 begin
5676 pragma Assert (Is_Array_Type (Id) or else Is_Modular_Integer_Type (Id));
5677 Set_Node21 (Id, V);
5678 end Set_Original_Array_Type;
5679
5680 procedure Set_Original_Record_Component (Id : E; V : E) is
5681 begin
5682 pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
5683 Set_Node22 (Id, V);
5684 end Set_Original_Record_Component;
5685
5686 procedure Set_Overlays_Constant (Id : E; V : B := True) is
5687 begin
5688 Set_Flag243 (Id, V);
5689 end Set_Overlays_Constant;
5690
5691 procedure Set_Overridden_Operation (Id : E; V : E) is
5692 begin
5693 Set_Node26 (Id, V);
5694 end Set_Overridden_Operation;
5695
5696 procedure Set_Package_Instantiation (Id : E; V : N) is
5697 begin
5698 pragma Assert (Ekind_In (Id, E_Void, E_Generic_Package, E_Package));
5699 Set_Node26 (Id, V);
5700 end Set_Package_Instantiation;
5701
5702 procedure Set_Packed_Array_Impl_Type (Id : E; V : E) is
5703 begin
5704 pragma Assert (Is_Array_Type (Id));
5705 Set_Node23 (Id, V);
5706 end Set_Packed_Array_Impl_Type;
5707
5708 procedure Set_Parent_Subtype (Id : E; V : E) is
5709 begin
5710 pragma Assert (Ekind (Id) = E_Record_Type);
5711 Set_Node19 (Id, V);
5712 end Set_Parent_Subtype;
5713
5714 procedure Set_Part_Of_Constituents (Id : E; V : L) is
5715 begin
5716 pragma Assert (Ekind (Id) = E_Abstract_State);
5717 Set_Elist9 (Id, V);
5718 end Set_Part_Of_Constituents;
5719
5720 procedure Set_Partial_View_Has_Unknown_Discr (Id : E; V : B := True) is
5721 begin
5722 pragma Assert (Is_Type (Id));
5723 Set_Flag280 (Id, V);
5724 end Set_Partial_View_Has_Unknown_Discr;
5725
5726 procedure Set_Pending_Access_Types (Id : E; V : L) is
5727 begin
5728 pragma Assert (Is_Type (Id));
5729 Set_Elist15 (Id, V);
5730 end Set_Pending_Access_Types;
5731
5732 procedure Set_Postconditions_Proc (Id : E; V : E) is
5733 begin
5734 pragma Assert (Ekind_In (Id, E_Entry,
5735 E_Entry_Family,
5736 E_Function,
5737 E_Procedure));
5738 Set_Node14 (Id, V);
5739 end Set_Postconditions_Proc;
5740
5741 procedure Set_PPC_Wrapper (Id : E; V : E) is
5742 begin
5743 pragma Assert (Ekind_In (Id, E_Entry, E_Entry_Family));
5744 Set_Node25 (Id, V);
5745 end Set_PPC_Wrapper;
5746
5747 procedure Set_Direct_Primitive_Operations (Id : E; V : L) is
5748 begin
5749 pragma Assert (Is_Tagged_Type (Id));
5750 Set_Elist10 (Id, V);
5751 end Set_Direct_Primitive_Operations;
5752
5753 procedure Set_Prival (Id : E; V : E) is
5754 begin
5755 pragma Assert (Is_Protected_Component (Id));
5756 Set_Node17 (Id, V);
5757 end Set_Prival;
5758
5759 procedure Set_Prival_Link (Id : E; V : E) is
5760 begin
5761 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5762 Set_Node20 (Id, V);
5763 end Set_Prival_Link;
5764
5765 procedure Set_Private_Dependents (Id : E; V : L) is
5766 begin
5767 pragma Assert (Is_Incomplete_Or_Private_Type (Id));
5768 Set_Elist18 (Id, V);
5769 end Set_Private_Dependents;
5770
5771 procedure Set_Private_View (Id : E; V : N) is
5772 begin
5773 pragma Assert (Is_Private_Type (Id));
5774 Set_Node22 (Id, V);
5775 end Set_Private_View;
5776
5777 procedure Set_Protected_Body_Subprogram (Id : E; V : E) is
5778 begin
5779 pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
5780 Set_Node11 (Id, V);
5781 end Set_Protected_Body_Subprogram;
5782
5783 procedure Set_Protected_Formal (Id : E; V : E) is
5784 begin
5785 pragma Assert (Is_Formal (Id));
5786 Set_Node22 (Id, V);
5787 end Set_Protected_Formal;
5788
5789 procedure Set_Protection_Object (Id : E; V : E) is
5790 begin
5791 pragma Assert (Ekind_In (Id, E_Entry,
5792 E_Entry_Family,
5793 E_Function,
5794 E_Procedure));
5795 Set_Node23 (Id, V);
5796 end Set_Protection_Object;
5797
5798 procedure Set_Reachable (Id : E; V : B := True) is
5799 begin
5800 Set_Flag49 (Id, V);
5801 end Set_Reachable;
5802
5803 procedure Set_Referenced (Id : E; V : B := True) is
5804 begin
5805 Set_Flag156 (Id, V);
5806 end Set_Referenced;
5807
5808 procedure Set_Referenced_As_LHS (Id : E; V : B := True) is
5809 begin
5810 Set_Flag36 (Id, V);
5811 end Set_Referenced_As_LHS;
5812
5813 procedure Set_Referenced_As_Out_Parameter (Id : E; V : B := True) is
5814 begin
5815 Set_Flag227 (Id, V);
5816 end Set_Referenced_As_Out_Parameter;
5817
5818 procedure Set_Refinement_Constituents (Id : E; V : L) is
5819 begin
5820 pragma Assert (Ekind (Id) = E_Abstract_State);
5821 Set_Elist8 (Id, V);
5822 end Set_Refinement_Constituents;
5823
5824 procedure Set_Register_Exception_Call (Id : E; V : N) is
5825 begin
5826 pragma Assert (Ekind (Id) = E_Exception);
5827 Set_Node20 (Id, V);
5828 end Set_Register_Exception_Call;
5829
5830 procedure Set_Related_Array_Object (Id : E; V : E) is
5831 begin
5832 pragma Assert (Is_Array_Type (Id));
5833 Set_Node25 (Id, V);
5834 end Set_Related_Array_Object;
5835
5836 procedure Set_Related_Expression (Id : E; V : N) is
5837 begin
5838 pragma Assert (Ekind (Id) in Type_Kind
5839 or else Ekind_In (Id, E_Constant, E_Variable, E_Void));
5840 Set_Node24 (Id, V);
5841 end Set_Related_Expression;
5842
5843 procedure Set_Related_Instance (Id : E; V : E) is
5844 begin
5845 pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
5846 Set_Node15 (Id, V);
5847 end Set_Related_Instance;
5848
5849 procedure Set_Related_Type (Id : E; V : E) is
5850 begin
5851 pragma Assert (Ekind_In (Id, E_Component, E_Constant, E_Variable));
5852 Set_Node27 (Id, V);
5853 end Set_Related_Type;
5854
5855 procedure Set_Relative_Deadline_Variable (Id : E; V : E) is
5856 begin
5857 pragma Assert (Is_Task_Type (Id) and then Is_Base_Type (Id));
5858 Set_Node28 (Id, V);
5859 end Set_Relative_Deadline_Variable;
5860
5861 procedure Set_Renamed_Entity (Id : E; V : N) is
5862 begin
5863 Set_Node18 (Id, V);
5864 end Set_Renamed_Entity;
5865
5866 procedure Set_Renamed_In_Spec (Id : E; V : B := True) is
5867 begin
5868 pragma Assert (Ekind (Id) = E_Package);
5869 Set_Flag231 (Id, V);
5870 end Set_Renamed_In_Spec;
5871
5872 procedure Set_Renamed_Object (Id : E; V : N) is
5873 begin
5874 Set_Node18 (Id, V);
5875 end Set_Renamed_Object;
5876
5877 procedure Set_Renaming_Map (Id : E; V : U) is
5878 begin
5879 Set_Uint9 (Id, V);
5880 end Set_Renaming_Map;
5881
5882 procedure Set_Requires_Overriding (Id : E; V : B := True) is
5883 begin
5884 pragma Assert (Is_Overloadable (Id));
5885 Set_Flag213 (Id, V);
5886 end Set_Requires_Overriding;
5887
5888 procedure Set_Return_Present (Id : E; V : B := True) is
5889 begin
5890 Set_Flag54 (Id, V);
5891 end Set_Return_Present;
5892
5893 procedure Set_Return_Applies_To (Id : E; V : N) is
5894 begin
5895 Set_Node8 (Id, V);
5896 end Set_Return_Applies_To;
5897
5898 procedure Set_Returns_By_Ref (Id : E; V : B := True) is
5899 begin
5900 Set_Flag90 (Id, V);
5901 end Set_Returns_By_Ref;
5902
5903 procedure Set_Returns_Limited_View (Id : E; V : B := True) is
5904 begin
5905 pragma Assert (Ekind (Id) = E_Function);
5906 Set_Flag134 (Id, V);
5907 end Set_Returns_Limited_View;
5908
5909 procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
5910 begin
5911 pragma Assert
5912 (Is_Record_Type (Id) and then Is_Base_Type (Id));
5913 Set_Flag164 (Id, V);
5914 end Set_Reverse_Bit_Order;
5915
5916 procedure Set_Reverse_Storage_Order (Id : E; V : B := True) is
5917 begin
5918 pragma Assert
5919 (Is_Base_Type (Id)
5920 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
5921 Set_Flag93 (Id, V);
5922 end Set_Reverse_Storage_Order;
5923
5924 procedure Set_RM_Size (Id : E; V : U) is
5925 begin
5926 pragma Assert (Is_Type (Id));
5927 Set_Uint13 (Id, V);
5928 end Set_RM_Size;
5929
5930 procedure Set_Scalar_Range (Id : E; V : N) is
5931 begin
5932 Set_Node20 (Id, V);
5933 end Set_Scalar_Range;
5934
5935 procedure Set_Scale_Value (Id : E; V : U) is
5936 begin
5937 Set_Uint16 (Id, V);
5938 end Set_Scale_Value;
5939
5940 procedure Set_Scope_Depth_Value (Id : E; V : U) is
5941 begin
5942 pragma Assert (not Is_Record_Type (Id));
5943 Set_Uint22 (Id, V);
5944 end Set_Scope_Depth_Value;
5945
5946 procedure Set_Sec_Stack_Needed_For_Return (Id : E; V : B := True) is
5947 begin
5948 Set_Flag167 (Id, V);
5949 end Set_Sec_Stack_Needed_For_Return;
5950
5951 procedure Set_Shadow_Entities (Id : E; V : S) is
5952 begin
5953 pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
5954 Set_List14 (Id, V);
5955 end Set_Shadow_Entities;
5956
5957 procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is
5958 begin
5959 pragma Assert (Ekind (Id) = E_Variable);
5960 Set_Node22 (Id, V);
5961 end Set_Shared_Var_Procs_Instance;
5962
5963 procedure Set_Size_Check_Code (Id : E; V : N) is
5964 begin
5965 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
5966 Set_Node19 (Id, V);
5967 end Set_Size_Check_Code;
5968
5969 procedure Set_Size_Depends_On_Discriminant (Id : E; V : B := True) is
5970 begin
5971 Set_Flag177 (Id, V);
5972 end Set_Size_Depends_On_Discriminant;
5973
5974 procedure Set_Size_Known_At_Compile_Time (Id : E; V : B := True) is
5975 begin
5976 Set_Flag92 (Id, V);
5977 end Set_Size_Known_At_Compile_Time;
5978
5979 procedure Set_Small_Value (Id : E; V : R) is
5980 begin
5981 pragma Assert (Is_Fixed_Point_Type (Id));
5982 Set_Ureal21 (Id, V);
5983 end Set_Small_Value;
5984
5985 procedure Set_SPARK_Aux_Pragma (Id : E; V : N) is
5986 begin
5987 pragma Assert
5988 (Ekind_In (Id, E_Generic_Package, -- package variants
5989 E_Package,
5990 E_Package_Body));
5991
5992 Set_Node33 (Id, V);
5993 end Set_SPARK_Aux_Pragma;
5994
5995 procedure Set_SPARK_Aux_Pragma_Inherited (Id : E; V : B := True) is
5996 begin
5997 pragma Assert
5998 (Ekind_In (Id, E_Generic_Package, -- package variants
5999 E_Package,
6000 E_Package_Body));
6001
6002 Set_Flag266 (Id, V);
6003 end Set_SPARK_Aux_Pragma_Inherited;
6004
6005 procedure Set_SPARK_Pragma (Id : E; V : N) is
6006 begin
6007 pragma Assert
6008 (Ekind_In (Id, E_Function, -- subprogram variants
6009 E_Generic_Function,
6010 E_Generic_Procedure,
6011 E_Procedure,
6012 E_Subprogram_Body)
6013 or else
6014 Ekind_In (Id, E_Generic_Package, -- package variants
6015 E_Package,
6016 E_Package_Body));
6017
6018 Set_Node32 (Id, V);
6019 end Set_SPARK_Pragma;
6020
6021 procedure Set_SPARK_Pragma_Inherited (Id : E; V : B := True) is
6022 begin
6023 pragma Assert
6024 (Ekind_In (Id, E_Function, -- subprogram variants
6025 E_Generic_Function,
6026 E_Generic_Procedure,
6027 E_Procedure,
6028 E_Subprogram_Body)
6029 or else
6030 Ekind_In (Id, E_Generic_Package, -- package variants
6031 E_Package,
6032 E_Package_Body));
6033
6034 Set_Flag265 (Id, V);
6035 end Set_SPARK_Pragma_Inherited;
6036
6037 procedure Set_Spec_Entity (Id : E; V : E) is
6038 begin
6039 pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
6040 Set_Node19 (Id, V);
6041 end Set_Spec_Entity;
6042
6043 procedure Set_SSO_Set_High_By_Default (Id : E; V : B := True) is
6044 begin
6045 pragma Assert
6046 (Is_Base_Type (Id)
6047 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
6048 Set_Flag273 (Id, V);
6049 end Set_SSO_Set_High_By_Default;
6050
6051 procedure Set_SSO_Set_Low_By_Default (Id : E; V : B := True) is
6052 begin
6053 pragma Assert
6054 (Is_Base_Type (Id)
6055 and then (Is_Record_Type (Id) or else Is_Array_Type (Id)));
6056 Set_Flag272 (Id, V);
6057 end Set_SSO_Set_Low_By_Default;
6058
6059 procedure Set_Static_Discrete_Predicate (Id : E; V : S) is
6060 begin
6061 pragma Assert (Is_Discrete_Type (Id) and then Has_Predicates (Id));
6062 Set_List25 (Id, V);
6063 end Set_Static_Discrete_Predicate;
6064
6065 procedure Set_Static_Real_Or_String_Predicate (Id : E; V : N) is
6066 begin
6067 pragma Assert ((Is_Real_Type (Id) or else Is_String_Type (Id))
6068 and then Has_Predicates (Id));
6069 Set_Node25 (Id, V);
6070 end Set_Static_Real_Or_String_Predicate;
6071
6072 procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E) is
6073 begin
6074 pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
6075 Set_Node15 (Id, V);
6076 end Set_Status_Flag_Or_Transient_Decl;
6077
6078 procedure Set_Storage_Size_Variable (Id : E; V : E) is
6079 begin
6080 pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
6081 pragma Assert (Id = Base_Type (Id));
6082 Set_Node26 (Id, V);
6083 end Set_Storage_Size_Variable;
6084
6085 procedure Set_Static_Elaboration_Desired (Id : E; V : B) is
6086 begin
6087 pragma Assert (Ekind (Id) = E_Package);
6088 Set_Flag77 (Id, V);
6089 end Set_Static_Elaboration_Desired;
6090
6091 procedure Set_Static_Initialization (Id : E; V : N) is
6092 begin
6093 pragma Assert
6094 (Ekind (Id) = E_Procedure and then not Is_Dispatching_Operation (Id));
6095 Set_Node30 (Id, V);
6096 end Set_Static_Initialization;
6097
6098 procedure Set_Stored_Constraint (Id : E; V : L) is
6099 begin
6100 pragma Assert (Nkind (Id) in N_Entity);
6101 Set_Elist23 (Id, V);
6102 end Set_Stored_Constraint;
6103
6104 procedure Set_Stores_Attribute_Old_Prefix (Id : E; V : B := True) is
6105 begin
6106 pragma Assert (Ekind (Id) = E_Constant);
6107 Set_Flag270 (Id, V);
6108 end Set_Stores_Attribute_Old_Prefix;
6109
6110 procedure Set_Strict_Alignment (Id : E; V : B := True) is
6111 begin
6112 pragma Assert (Id = Base_Type (Id));
6113 Set_Flag145 (Id, V);
6114 end Set_Strict_Alignment;
6115
6116 procedure Set_String_Literal_Length (Id : E; V : U) is
6117 begin
6118 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
6119 Set_Uint16 (Id, V);
6120 end Set_String_Literal_Length;
6121
6122 procedure Set_String_Literal_Low_Bound (Id : E; V : N) is
6123 begin
6124 pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
6125 Set_Node18 (Id, V);
6126 end Set_String_Literal_Low_Bound;
6127
6128 procedure Set_Subprograms_For_Type (Id : E; V : E) is
6129 begin
6130 pragma Assert (Is_Type (Id) or else Is_Subprogram (Id));
6131 Set_Node29 (Id, V);
6132 end Set_Subprograms_For_Type;
6133
6134 procedure Set_Subps_Index (Id : E; V : U) is
6135 begin
6136 pragma Assert (Is_Subprogram (Id));
6137 Set_Uint24 (Id, V);
6138 end Set_Subps_Index;
6139
6140 procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is
6141 begin
6142 Set_Flag148 (Id, V);
6143 end Set_Suppress_Elaboration_Warnings;
6144
6145 procedure Set_Suppress_Initialization (Id : E; V : B := True) is
6146 begin
6147 pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
6148 Set_Flag105 (Id, V);
6149 end Set_Suppress_Initialization;
6150
6151 procedure Set_Suppress_Style_Checks (Id : E; V : B := True) is
6152 begin
6153 Set_Flag165 (Id, V);
6154 end Set_Suppress_Style_Checks;
6155
6156 procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True) is
6157 begin
6158 Set_Flag217 (Id, V);
6159 end Set_Suppress_Value_Tracking_On_Call;
6160
6161 procedure Set_Task_Body_Procedure (Id : E; V : N) is
6162 begin
6163 pragma Assert (Ekind (Id) in Task_Kind);
6164 Set_Node25 (Id, V);
6165 end Set_Task_Body_Procedure;
6166
6167 procedure Set_Thunk_Entity (Id : E; V : E) is
6168 begin
6169 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
6170 and then Is_Thunk (Id));
6171 Set_Node31 (Id, V);
6172 end Set_Thunk_Entity;
6173
6174 procedure Set_Treat_As_Volatile (Id : E; V : B := True) is
6175 begin
6176 Set_Flag41 (Id, V);
6177 end Set_Treat_As_Volatile;
6178
6179 procedure Set_Underlying_Full_View (Id : E; V : E) is
6180 begin
6181 pragma Assert (Ekind (Id) in Private_Kind);
6182 Set_Node19 (Id, V);
6183 end Set_Underlying_Full_View;
6184
6185 procedure Set_Underlying_Record_View (Id : E; V : E) is
6186 begin
6187 pragma Assert (Ekind (Id) = E_Record_Type);
6188 Set_Node28 (Id, V);
6189 end Set_Underlying_Record_View;
6190
6191 procedure Set_Universal_Aliasing (Id : E; V : B := True) is
6192 begin
6193 pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
6194 Set_Flag216 (Id, V);
6195 end Set_Universal_Aliasing;
6196
6197 procedure Set_Unset_Reference (Id : E; V : N) is
6198 begin
6199 Set_Node16 (Id, V);
6200 end Set_Unset_Reference;
6201
6202 procedure Set_Uplevel_Reference_Noted (Id : E; V : B := True) is
6203 begin
6204 Set_Flag283 (Id, V);
6205 end Set_Uplevel_Reference_Noted;
6206
6207 procedure Set_Uplevel_References (Id : E; V : L) is
6208 begin
6209 pragma Assert (Is_Subprogram (Id));
6210 Set_Elist24 (Id, V);
6211 end Set_Uplevel_References;
6212
6213 procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
6214 begin
6215 Set_Flag222 (Id, V);
6216 end Set_Used_As_Generic_Actual;
6217
6218 procedure Set_Uses_Lock_Free (Id : E; V : B := True) is
6219 begin
6220 pragma Assert (Ekind (Id) = E_Protected_Type);
6221 Set_Flag188 (Id, V);
6222 end Set_Uses_Lock_Free;
6223
6224 procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
6225 begin
6226 Set_Flag95 (Id, V);
6227 end Set_Uses_Sec_Stack;
6228
6229 procedure Set_Warnings_Off (Id : E; V : B := True) is
6230 begin
6231 Set_Flag96 (Id, V);
6232 end Set_Warnings_Off;
6233
6234 procedure Set_Warnings_Off_Used (Id : E; V : B := True) is
6235 begin
6236 Set_Flag236 (Id, V);
6237 end Set_Warnings_Off_Used;
6238
6239 procedure Set_Warnings_Off_Used_Unmodified (Id : E; V : B := True) is
6240 begin
6241 Set_Flag237 (Id, V);
6242 end Set_Warnings_Off_Used_Unmodified;
6243
6244 procedure Set_Warnings_Off_Used_Unreferenced (Id : E; V : B := True) is
6245 begin
6246 Set_Flag238 (Id, V);
6247 end Set_Warnings_Off_Used_Unreferenced;
6248
6249 procedure Set_Was_Hidden (Id : E; V : B := True) is
6250 begin
6251 Set_Flag196 (Id, V);
6252 end Set_Was_Hidden;
6253
6254 procedure Set_Wrapped_Entity (Id : E; V : E) is
6255 begin
6256 pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
6257 and then Is_Primitive_Wrapper (Id));
6258 Set_Node27 (Id, V);
6259 end Set_Wrapped_Entity;
6260
6261 -----------------------------------
6262 -- Field Initialization Routines --
6263 -----------------------------------
6264
6265 procedure Init_Alignment (Id : E) is
6266 begin
6267 Set_Uint14 (Id, Uint_0);
6268 end Init_Alignment;
6269
6270 procedure Init_Alignment (Id : E; V : Int) is
6271 begin
6272 Set_Uint14 (Id, UI_From_Int (V));
6273 end Init_Alignment;
6274
6275 procedure Init_Component_Bit_Offset (Id : E) is
6276 begin
6277 Set_Uint11 (Id, No_Uint);
6278 end Init_Component_Bit_Offset;
6279
6280 procedure Init_Component_Bit_Offset (Id : E; V : Int) is
6281 begin
6282 Set_Uint11 (Id, UI_From_Int (V));
6283 end Init_Component_Bit_Offset;
6284
6285 procedure Init_Component_Size (Id : E) is
6286 begin
6287 Set_Uint22 (Id, Uint_0);
6288 end Init_Component_Size;
6289
6290 procedure Init_Component_Size (Id : E; V : Int) is
6291 begin
6292 Set_Uint22 (Id, UI_From_Int (V));
6293 end Init_Component_Size;
6294
6295 procedure Init_Digits_Value (Id : E) is
6296 begin
6297 Set_Uint17 (Id, Uint_0);
6298 end Init_Digits_Value;
6299
6300 procedure Init_Digits_Value (Id : E; V : Int) is
6301 begin
6302 Set_Uint17 (Id, UI_From_Int (V));
6303 end Init_Digits_Value;
6304
6305 procedure Init_Esize (Id : E) is
6306 begin
6307 Set_Uint12 (Id, Uint_0);
6308 end Init_Esize;
6309
6310 procedure Init_Esize (Id : E; V : Int) is
6311 begin
6312 Set_Uint12 (Id, UI_From_Int (V));
6313 end Init_Esize;
6314
6315 procedure Init_Normalized_First_Bit (Id : E) is
6316 begin
6317 Set_Uint8 (Id, No_Uint);
6318 end Init_Normalized_First_Bit;
6319
6320 procedure Init_Normalized_First_Bit (Id : E; V : Int) is
6321 begin
6322 Set_Uint8 (Id, UI_From_Int (V));
6323 end Init_Normalized_First_Bit;
6324
6325 procedure Init_Normalized_Position (Id : E) is
6326 begin
6327 Set_Uint14 (Id, No_Uint);
6328 end Init_Normalized_Position;
6329
6330 procedure Init_Normalized_Position (Id : E; V : Int) is
6331 begin
6332 Set_Uint14 (Id, UI_From_Int (V));
6333 end Init_Normalized_Position;
6334
6335 procedure Init_Normalized_Position_Max (Id : E) is
6336 begin
6337 Set_Uint10 (Id, No_Uint);
6338 end Init_Normalized_Position_Max;
6339
6340 procedure Init_Normalized_Position_Max (Id : E; V : Int) is
6341 begin
6342 Set_Uint10 (Id, UI_From_Int (V));
6343 end Init_Normalized_Position_Max;
6344
6345 procedure Init_RM_Size (Id : E) is
6346 begin
6347 Set_Uint13 (Id, Uint_0);
6348 end Init_RM_Size;
6349
6350 procedure Init_RM_Size (Id : E; V : Int) is
6351 begin
6352 Set_Uint13 (Id, UI_From_Int (V));
6353 end Init_RM_Size;
6354
6355 -----------------------------
6356 -- Init_Component_Location --
6357 -----------------------------
6358
6359 procedure Init_Component_Location (Id : E) is
6360 begin
6361 Set_Uint8 (Id, No_Uint); -- Normalized_First_Bit
6362 Set_Uint10 (Id, No_Uint); -- Normalized_Position_Max
6363 Set_Uint11 (Id, No_Uint); -- Component_Bit_Offset
6364 Set_Uint12 (Id, Uint_0); -- Esize
6365 Set_Uint14 (Id, No_Uint); -- Normalized_Position
6366 end Init_Component_Location;
6367
6368 ----------------------------
6369 -- Init_Object_Size_Align --
6370 ----------------------------
6371
6372 procedure Init_Object_Size_Align (Id : E) is
6373 begin
6374 Set_Uint12 (Id, Uint_0); -- Esize
6375 Set_Uint14 (Id, Uint_0); -- Alignment
6376 end Init_Object_Size_Align;
6377
6378 ---------------
6379 -- Init_Size --
6380 ---------------
6381
6382 procedure Init_Size (Id : E; V : Int) is
6383 begin
6384 pragma Assert (not Is_Object (Id));
6385 Set_Uint12 (Id, UI_From_Int (V)); -- Esize
6386 Set_Uint13 (Id, UI_From_Int (V)); -- RM_Size
6387 end Init_Size;
6388
6389 ---------------------
6390 -- Init_Size_Align --
6391 ---------------------
6392
6393 procedure Init_Size_Align (Id : E) is
6394 begin
6395 pragma Assert (not Is_Object (Id));
6396 Set_Uint12 (Id, Uint_0); -- Esize
6397 Set_Uint13 (Id, Uint_0); -- RM_Size
6398 Set_Uint14 (Id, Uint_0); -- Alignment
6399 end Init_Size_Align;
6400
6401 ----------------------------------------------
6402 -- Type Representation Attribute Predicates --
6403 ----------------------------------------------
6404
6405 function Known_Alignment (E : Entity_Id) return B is
6406 begin
6407 return Uint14 (E) /= Uint_0
6408 and then Uint14 (E) /= No_Uint;
6409 end Known_Alignment;
6410
6411 function Known_Component_Bit_Offset (E : Entity_Id) return B is
6412 begin
6413 return Uint11 (E) /= No_Uint;
6414 end Known_Component_Bit_Offset;
6415
6416 function Known_Component_Size (E : Entity_Id) return B is
6417 begin
6418 return Uint22 (Base_Type (E)) /= Uint_0
6419 and then Uint22 (Base_Type (E)) /= No_Uint;
6420 end Known_Component_Size;
6421
6422 function Known_Esize (E : Entity_Id) return B is
6423 begin
6424 return Uint12 (E) /= Uint_0
6425 and then Uint12 (E) /= No_Uint;
6426 end Known_Esize;
6427
6428 function Known_Normalized_First_Bit (E : Entity_Id) return B is
6429 begin
6430 return Uint8 (E) /= No_Uint;
6431 end Known_Normalized_First_Bit;
6432
6433 function Known_Normalized_Position (E : Entity_Id) return B is
6434 begin
6435 return Uint14 (E) /= No_Uint;
6436 end Known_Normalized_Position;
6437
6438 function Known_Normalized_Position_Max (E : Entity_Id) return B is
6439 begin
6440 return Uint10 (E) /= No_Uint;
6441 end Known_Normalized_Position_Max;
6442
6443 function Known_RM_Size (E : Entity_Id) return B is
6444 begin
6445 return Uint13 (E) /= No_Uint
6446 and then (Uint13 (E) /= Uint_0
6447 or else Is_Discrete_Type (E)
6448 or else Is_Fixed_Point_Type (E));
6449 end Known_RM_Size;
6450
6451 function Known_Static_Component_Bit_Offset (E : Entity_Id) return B is
6452 begin
6453 return Uint11 (E) /= No_Uint
6454 and then Uint11 (E) >= Uint_0;
6455 end Known_Static_Component_Bit_Offset;
6456
6457 function Known_Static_Component_Size (E : Entity_Id) return B is
6458 begin
6459 return Uint22 (Base_Type (E)) > Uint_0;
6460 end Known_Static_Component_Size;
6461
6462 function Known_Static_Esize (E : Entity_Id) return B is
6463 begin
6464 return Uint12 (E) > Uint_0
6465 and then not Is_Generic_Type (E);
6466 end Known_Static_Esize;
6467
6468 function Known_Static_Normalized_First_Bit (E : Entity_Id) return B is
6469 begin
6470 return Uint8 (E) /= No_Uint
6471 and then Uint8 (E) >= Uint_0;
6472 end Known_Static_Normalized_First_Bit;
6473
6474 function Known_Static_Normalized_Position (E : Entity_Id) return B is
6475 begin
6476 return Uint14 (E) /= No_Uint
6477 and then Uint14 (E) >= Uint_0;
6478 end Known_Static_Normalized_Position;
6479
6480 function Known_Static_Normalized_Position_Max (E : Entity_Id) return B is
6481 begin
6482 return Uint10 (E) /= No_Uint
6483 and then Uint10 (E) >= Uint_0;
6484 end Known_Static_Normalized_Position_Max;
6485
6486 function Known_Static_RM_Size (E : Entity_Id) return B is
6487 begin
6488 return (Uint13 (E) > Uint_0
6489 or else Is_Discrete_Type (E)
6490 or else Is_Fixed_Point_Type (E))
6491 and then not Is_Generic_Type (E);
6492 end Known_Static_RM_Size;
6493
6494 function Unknown_Alignment (E : Entity_Id) return B is
6495 begin
6496 return Uint14 (E) = Uint_0
6497 or else Uint14 (E) = No_Uint;
6498 end Unknown_Alignment;
6499
6500 function Unknown_Component_Bit_Offset (E : Entity_Id) return B is
6501 begin
6502 return Uint11 (E) = No_Uint;
6503 end Unknown_Component_Bit_Offset;
6504
6505 function Unknown_Component_Size (E : Entity_Id) return B is
6506 begin
6507 return Uint22 (Base_Type (E)) = Uint_0
6508 or else
6509 Uint22 (Base_Type (E)) = No_Uint;
6510 end Unknown_Component_Size;
6511
6512 function Unknown_Esize (E : Entity_Id) return B is
6513 begin
6514 return Uint12 (E) = No_Uint
6515 or else
6516 Uint12 (E) = Uint_0;
6517 end Unknown_Esize;
6518
6519 function Unknown_Normalized_First_Bit (E : Entity_Id) return B is
6520 begin
6521 return Uint8 (E) = No_Uint;
6522 end Unknown_Normalized_First_Bit;
6523
6524 function Unknown_Normalized_Position (E : Entity_Id) return B is
6525 begin
6526 return Uint14 (E) = No_Uint;
6527 end Unknown_Normalized_Position;
6528
6529 function Unknown_Normalized_Position_Max (E : Entity_Id) return B is
6530 begin
6531 return Uint10 (E) = No_Uint;
6532 end Unknown_Normalized_Position_Max;
6533
6534 function Unknown_RM_Size (E : Entity_Id) return B is
6535 begin
6536 return (Uint13 (E) = Uint_0
6537 and then not Is_Discrete_Type (E)
6538 and then not Is_Fixed_Point_Type (E))
6539 or else Uint13 (E) = No_Uint;
6540 end Unknown_RM_Size;
6541
6542 --------------------
6543 -- Address_Clause --
6544 --------------------
6545
6546 function Address_Clause (Id : E) return N is
6547 begin
6548 return Get_Attribute_Definition_Clause (Id, Attribute_Address);
6549 end Address_Clause;
6550
6551 ---------------
6552 -- Aft_Value --
6553 ---------------
6554
6555 function Aft_Value (Id : E) return U is
6556 Result : Nat := 1;
6557 Delta_Val : Ureal := Delta_Value (Id);
6558 begin
6559 while Delta_Val < Ureal_Tenth loop
6560 Delta_Val := Delta_Val * Ureal_10;
6561 Result := Result + 1;
6562 end loop;
6563
6564 return UI_From_Int (Result);
6565 end Aft_Value;
6566
6567 ----------------------
6568 -- Alignment_Clause --
6569 ----------------------
6570
6571 function Alignment_Clause (Id : E) return N is
6572 begin
6573 return Get_Attribute_Definition_Clause (Id, Attribute_Alignment);
6574 end Alignment_Clause;
6575
6576 -------------------
6577 -- Append_Entity --
6578 -------------------
6579
6580 procedure Append_Entity (Id : Entity_Id; V : Entity_Id) is
6581 begin
6582 if Last_Entity (V) = Empty then
6583 Set_First_Entity (Id => V, V => Id);
6584 else
6585 Set_Next_Entity (Last_Entity (V), Id);
6586 end if;
6587
6588 Set_Next_Entity (Id, Empty);
6589 Set_Scope (Id, V);
6590 Set_Last_Entity (Id => V, V => Id);
6591 end Append_Entity;
6592
6593 ---------------
6594 -- Base_Type --
6595 ---------------
6596
6597 function Base_Type (Id : E) return E is
6598 begin
6599 if Is_Base_Type (Id) then
6600 return Id;
6601 else
6602 pragma Assert (Is_Type (Id));
6603 return Etype (Id);
6604 end if;
6605 end Base_Type;
6606
6607 -------------------------
6608 -- Component_Alignment --
6609 -------------------------
6610
6611 -- Component Alignment is encoded using two flags, Flag128/129 as
6612 -- follows. Note that both flags False = Align_Default, so that the
6613 -- default initialization of flags to False initializes component
6614 -- alignment to the default value as required.
6615
6616 -- Flag128 Flag129 Value
6617 -- ------- ------- -----
6618 -- False False Calign_Default
6619 -- False True Calign_Component_Size
6620 -- True False Calign_Component_Size_4
6621 -- True True Calign_Storage_Unit
6622
6623 function Component_Alignment (Id : E) return C is
6624 BT : constant Node_Id := Base_Type (Id);
6625
6626 begin
6627 pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
6628
6629 if Flag128 (BT) then
6630 if Flag129 (BT) then
6631 return Calign_Storage_Unit;
6632 else
6633 return Calign_Component_Size_4;
6634 end if;
6635
6636 else
6637 if Flag129 (BT) then
6638 return Calign_Component_Size;
6639 else
6640 return Calign_Default;
6641 end if;
6642 end if;
6643 end Component_Alignment;
6644
6645 ----------------------
6646 -- Declaration_Node --
6647 ----------------------
6648
6649 function Declaration_Node (Id : E) return N is
6650 P : Node_Id;
6651
6652 begin
6653 if Ekind (Id) = E_Incomplete_Type
6654 and then Present (Full_View (Id))
6655 then
6656 P := Parent (Full_View (Id));
6657 else
6658 P := Parent (Id);
6659 end if;
6660
6661 loop
6662 if Nkind (P) /= N_Selected_Component
6663 and then Nkind (P) /= N_Expanded_Name
6664 and then
6665 not (Nkind (P) = N_Defining_Program_Unit_Name
6666 and then Is_Child_Unit (Id))
6667 then
6668 return P;
6669 else
6670 P := Parent (P);
6671 end if;
6672 end loop;
6673 end Declaration_Node;
6674
6675 ---------------------------------
6676 -- Default_Init_Cond_Procedure --
6677 ---------------------------------
6678
6679 function Default_Init_Cond_Procedure (Id : E) return E is
6680 S : Entity_Id;
6681
6682 begin
6683 pragma Assert
6684 (Is_Type (Id)
6685 and then (Has_Default_Init_Cond (Id)
6686 or Has_Inherited_Default_Init_Cond (Id)));
6687
6688 S := Subprograms_For_Type (Id);
6689 while Present (S) loop
6690 if Is_Default_Init_Cond_Procedure (S) then
6691 return S;
6692 end if;
6693
6694 S := Subprograms_For_Type (S);
6695 end loop;
6696
6697 return Empty;
6698 end Default_Init_Cond_Procedure;
6699
6700 ---------------------
6701 -- Designated_Type --
6702 ---------------------
6703
6704 function Designated_Type (Id : E) return E is
6705 Desig_Type : E;
6706
6707 begin
6708 Desig_Type := Directly_Designated_Type (Id);
6709
6710 if Ekind (Desig_Type) = E_Incomplete_Type
6711 and then Present (Full_View (Desig_Type))
6712 then
6713 return Full_View (Desig_Type);
6714
6715 elsif Is_Class_Wide_Type (Desig_Type)
6716 and then Ekind (Etype (Desig_Type)) = E_Incomplete_Type
6717 and then Present (Full_View (Etype (Desig_Type)))
6718 and then Present (Class_Wide_Type (Full_View (Etype (Desig_Type))))
6719 then
6720 return Class_Wide_Type (Full_View (Etype (Desig_Type)));
6721
6722 else
6723 return Desig_Type;
6724 end if;
6725 end Designated_Type;
6726
6727 ----------------------
6728 -- Entry_Index_Type --
6729 ----------------------
6730
6731 function Entry_Index_Type (Id : E) return N is
6732 begin
6733 pragma Assert (Ekind (Id) = E_Entry_Family);
6734 return Etype (Discrete_Subtype_Definition (Parent (Id)));
6735 end Entry_Index_Type;
6736
6737 ---------------------
6738 -- First_Component --
6739 ---------------------
6740
6741 function First_Component (Id : E) return E is
6742 Comp_Id : E;
6743
6744 begin
6745 pragma Assert
6746 (Is_Record_Type (Id) or else Is_Incomplete_Or_Private_Type (Id));
6747
6748 Comp_Id := First_Entity (Id);
6749 while Present (Comp_Id) loop
6750 exit when Ekind (Comp_Id) = E_Component;
6751 Comp_Id := Next_Entity (Comp_Id);
6752 end loop;
6753
6754 return Comp_Id;
6755 end First_Component;
6756
6757 -------------------------------------
6758 -- First_Component_Or_Discriminant --
6759 -------------------------------------
6760
6761 function First_Component_Or_Discriminant (Id : E) return E is
6762 Comp_Id : E;
6763
6764 begin
6765 pragma Assert
6766 (Is_Record_Type (Id)
6767 or else Is_Incomplete_Or_Private_Type (Id)
6768 or else Has_Discriminants (Id));
6769
6770 Comp_Id := First_Entity (Id);
6771 while Present (Comp_Id) loop
6772 exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
6773 Comp_Id := Next_Entity (Comp_Id);
6774 end loop;
6775
6776 return Comp_Id;
6777 end First_Component_Or_Discriminant;
6778
6779 ------------------
6780 -- First_Formal --
6781 ------------------
6782
6783 function First_Formal (Id : E) return E is
6784 Formal : E;
6785
6786 begin
6787 pragma Assert
6788 (Is_Generic_Subprogram (Id)
6789 or else Is_Overloadable (Id)
6790 or else Ekind_In (Id, E_Entry_Family,
6791 E_Subprogram_Body,
6792 E_Subprogram_Type));
6793
6794 if Ekind (Id) = E_Enumeration_Literal then
6795 return Empty;
6796
6797 else
6798 Formal := First_Entity (Id);
6799
6800 -- The first/next entity chain of a generic subprogram contains all
6801 -- generic formal parameters, followed by the formal parameters. Go
6802 -- directly to the parameters by skipping the formal part.
6803
6804 if Is_Generic_Subprogram (Id) then
6805 while Present (Formal) and then not Is_Formal (Formal) loop
6806 Next_Entity (Formal);
6807 end loop;
6808 end if;
6809
6810 if Present (Formal) and then Is_Formal (Formal) then
6811 return Formal;
6812 else
6813 return Empty;
6814 end if;
6815 end if;
6816 end First_Formal;
6817
6818 ------------------------------
6819 -- First_Formal_With_Extras --
6820 ------------------------------
6821
6822 function First_Formal_With_Extras (Id : E) return E is
6823 Formal : E;
6824
6825 begin
6826 pragma Assert
6827 (Is_Generic_Subprogram (Id)
6828 or else Is_Overloadable (Id)
6829 or else Ekind_In (Id, E_Entry_Family,
6830 E_Subprogram_Body,
6831 E_Subprogram_Type));
6832
6833 if Ekind (Id) = E_Enumeration_Literal then
6834 return Empty;
6835
6836 else
6837 Formal := First_Entity (Id);
6838
6839 -- The first/next entity chain of a generic subprogram contains all
6840 -- generic formal parameters, followed by the formal parameters. Go
6841 -- directly to the parameters by skipping the formal part.
6842
6843 if Is_Generic_Subprogram (Id) then
6844 while Present (Formal) and then not Is_Formal (Formal) loop
6845 Next_Entity (Formal);
6846 end loop;
6847 end if;
6848
6849 if Present (Formal) and then Is_Formal (Formal) then
6850 return Formal;
6851 else
6852 return Extra_Formals (Id); -- Empty if no extra formals
6853 end if;
6854 end if;
6855 end First_Formal_With_Extras;
6856
6857 -------------------------------------
6858 -- Get_Attribute_Definition_Clause --
6859 -------------------------------------
6860
6861 function Get_Attribute_Definition_Clause
6862 (E : Entity_Id;
6863 Id : Attribute_Id) return Node_Id
6864 is
6865 N : Node_Id;
6866
6867 begin
6868 N := First_Rep_Item (E);
6869 while Present (N) loop
6870 if Nkind (N) = N_Attribute_Definition_Clause
6871 and then Get_Attribute_Id (Chars (N)) = Id
6872 then
6873 return N;
6874 else
6875 Next_Rep_Item (N);
6876 end if;
6877 end loop;
6878
6879 return Empty;
6880 end Get_Attribute_Definition_Clause;
6881
6882 -------------------
6883 -- Get_Full_View --
6884 -------------------
6885
6886 function Get_Full_View (T : Entity_Id) return Entity_Id is
6887 begin
6888 if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then
6889 return Full_View (T);
6890
6891 elsif Is_Class_Wide_Type (T)
6892 and then Ekind (Root_Type (T)) = E_Incomplete_Type
6893 and then Present (Full_View (Root_Type (T)))
6894 then
6895 return Class_Wide_Type (Full_View (Root_Type (T)));
6896
6897 else
6898 return T;
6899 end if;
6900 end Get_Full_View;
6901
6902 ----------------
6903 -- Get_Pragma --
6904 ----------------
6905
6906 function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is
6907 Is_CDG : constant Boolean :=
6908 Id = Pragma_Abstract_State or else
6909 Id = Pragma_Async_Readers or else
6910 Id = Pragma_Async_Writers or else
6911 Id = Pragma_Depends or else
6912 Id = Pragma_Effective_Reads or else
6913 Id = Pragma_Effective_Writes or else
6914 Id = Pragma_Extensions_Visible or else
6915 Id = Pragma_Global or else
6916 Id = Pragma_Initial_Condition or else
6917 Id = Pragma_Initializes or else
6918 Id = Pragma_Part_Of or else
6919 Id = Pragma_Refined_Depends or else
6920 Id = Pragma_Refined_Global or else
6921 Id = Pragma_Refined_State;
6922 Is_CTC : constant Boolean :=
6923 Id = Pragma_Contract_Cases or else
6924 Id = Pragma_Test_Case;
6925 Is_PPC : constant Boolean :=
6926 Id = Pragma_Precondition or else
6927 Id = Pragma_Postcondition or else
6928 Id = Pragma_Refined_Post;
6929
6930 In_Contract : constant Boolean := Is_CDG or Is_CTC or Is_PPC;
6931
6932 Item : Node_Id;
6933 Items : Node_Id;
6934
6935 begin
6936 -- Handle pragmas that appear in N_Contract nodes. Those have to be
6937 -- extracted from their specialized list.
6938
6939 if In_Contract then
6940 Items := Contract (E);
6941
6942 if No (Items) then
6943 return Empty;
6944
6945 elsif Is_CDG then
6946 Item := Classifications (Items);
6947
6948 elsif Is_CTC then
6949 Item := Contract_Test_Cases (Items);
6950
6951 else
6952 Item := Pre_Post_Conditions (Items);
6953 end if;
6954
6955 -- Regular pragmas
6956
6957 else
6958 Item := First_Rep_Item (E);
6959 end if;
6960
6961 while Present (Item) loop
6962 if Nkind (Item) = N_Pragma
6963 and then Get_Pragma_Id (Pragma_Name (Item)) = Id
6964 then
6965 return Item;
6966
6967 -- All nodes in N_Contract are chained using Next_Pragma
6968
6969 elsif In_Contract then
6970 Item := Next_Pragma (Item);
6971
6972 -- Regular pragmas
6973
6974 else
6975 Next_Rep_Item (Item);
6976 end if;
6977 end loop;
6978
6979 return Empty;
6980 end Get_Pragma;
6981
6982 --------------------------------------
6983 -- Get_Record_Representation_Clause --
6984 --------------------------------------
6985
6986 function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id is
6987 N : Node_Id;
6988
6989 begin
6990 N := First_Rep_Item (E);
6991 while Present (N) loop
6992 if Nkind (N) = N_Record_Representation_Clause then
6993 return N;
6994 end if;
6995
6996 Next_Rep_Item (N);
6997 end loop;
6998
6999 return Empty;
7000 end Get_Record_Representation_Clause;
7001
7002 ------------------------
7003 -- Has_Attach_Handler --
7004 ------------------------
7005
7006 function Has_Attach_Handler (Id : E) return B is
7007 Ritem : Node_Id;
7008
7009 begin
7010 pragma Assert (Is_Protected_Type (Id));
7011
7012 Ritem := First_Rep_Item (Id);
7013 while Present (Ritem) loop
7014 if Nkind (Ritem) = N_Pragma
7015 and then Pragma_Name (Ritem) = Name_Attach_Handler
7016 then
7017 return True;
7018 else
7019 Next_Rep_Item (Ritem);
7020 end if;
7021 end loop;
7022
7023 return False;
7024 end Has_Attach_Handler;
7025
7026 -----------------
7027 -- Has_Entries --
7028 -----------------
7029
7030 function Has_Entries (Id : E) return B is
7031 Ent : Entity_Id;
7032
7033 begin
7034 pragma Assert (Is_Concurrent_Type (Id));
7035
7036 Ent := First_Entity (Id);
7037 while Present (Ent) loop
7038 if Is_Entry (Ent) then
7039 return True;
7040 end if;
7041
7042 Ent := Next_Entity (Ent);
7043 end loop;
7044
7045 return False;
7046 end Has_Entries;
7047
7048 ----------------------------
7049 -- Has_Foreign_Convention --
7050 ----------------------------
7051
7052 function Has_Foreign_Convention (Id : E) return B is
7053 begin
7054 -- While regular Intrinsics such as the Standard operators fit in the
7055 -- "Ada" convention, those with an Interface_Name materialize GCC
7056 -- builtin imports for which Ada special treatments shouldn't apply.
7057
7058 return Convention (Id) in Foreign_Convention
7059 or else (Convention (Id) = Convention_Intrinsic
7060 and then Present (Interface_Name (Id)));
7061 end Has_Foreign_Convention;
7062
7063 ---------------------------
7064 -- Has_Interrupt_Handler --
7065 ---------------------------
7066
7067 function Has_Interrupt_Handler (Id : E) return B is
7068 Ritem : Node_Id;
7069
7070 begin
7071 pragma Assert (Is_Protected_Type (Id));
7072
7073 Ritem := First_Rep_Item (Id);
7074 while Present (Ritem) loop
7075 if Nkind (Ritem) = N_Pragma
7076 and then Pragma_Name (Ritem) = Name_Interrupt_Handler
7077 then
7078 return True;
7079 else
7080 Next_Rep_Item (Ritem);
7081 end if;
7082 end loop;
7083
7084 return False;
7085 end Has_Interrupt_Handler;
7086
7087 -----------------------------
7088 -- Has_Non_Null_Refinement --
7089 -----------------------------
7090
7091 function Has_Non_Null_Refinement (Id : E) return B is
7092 begin
7093 -- "Refinement" is a concept applicable only to abstract states
7094
7095 pragma Assert (Ekind (Id) = E_Abstract_State);
7096
7097 if Has_Visible_Refinement (Id) then
7098 pragma Assert (Present (Refinement_Constituents (Id)));
7099
7100 -- For a refinement to be non-null, the first constituent must be
7101 -- anything other than null.
7102
7103 return
7104 Nkind (Node (First_Elmt (Refinement_Constituents (Id)))) /= N_Null;
7105 end if;
7106
7107 return False;
7108 end Has_Non_Null_Refinement;
7109
7110 -----------------------------
7111 -- Has_Null_Abstract_State --
7112 -----------------------------
7113
7114 function Has_Null_Abstract_State (Id : E) return B is
7115 begin
7116 pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
7117
7118 return
7119 Present (Abstract_States (Id))
7120 and then Is_Null_State (Node (First_Elmt (Abstract_States (Id))));
7121 end Has_Null_Abstract_State;
7122
7123 -------------------------
7124 -- Has_Null_Refinement --
7125 -------------------------
7126
7127 function Has_Null_Refinement (Id : E) return B is
7128 begin
7129 -- "Refinement" is a concept applicable only to abstract states
7130
7131 pragma Assert (Ekind (Id) = E_Abstract_State);
7132
7133 if Has_Visible_Refinement (Id) then
7134 pragma Assert (Present (Refinement_Constituents (Id)));
7135
7136 -- For a refinement to be null, the state's sole constituent must be
7137 -- a null.
7138
7139 return
7140 Nkind (Node (First_Elmt (Refinement_Constituents (Id)))) = N_Null;
7141 end if;
7142
7143 return False;
7144 end Has_Null_Refinement;
7145
7146 --------------------
7147 -- Has_Unmodified --
7148 --------------------
7149
7150 function Has_Unmodified (E : Entity_Id) return Boolean is
7151 begin
7152 if Has_Pragma_Unmodified (E) then
7153 return True;
7154 elsif Warnings_Off (E) then
7155 Set_Warnings_Off_Used_Unmodified (E);
7156 return True;
7157 else
7158 return False;
7159 end if;
7160 end Has_Unmodified;
7161
7162 ---------------------
7163 -- Has_Unreferenced --
7164 ---------------------
7165
7166 function Has_Unreferenced (E : Entity_Id) return Boolean is
7167 begin
7168 if Has_Pragma_Unreferenced (E) then
7169 return True;
7170 elsif Warnings_Off (E) then
7171 Set_Warnings_Off_Used_Unreferenced (E);
7172 return True;
7173 else
7174 return False;
7175 end if;
7176 end Has_Unreferenced;
7177
7178 ----------------------
7179 -- Has_Warnings_Off --
7180 ----------------------
7181
7182 function Has_Warnings_Off (E : Entity_Id) return Boolean is
7183 begin
7184 if Warnings_Off (E) then
7185 Set_Warnings_Off_Used (E);
7186 return True;
7187 else
7188 return False;
7189 end if;
7190 end Has_Warnings_Off;
7191
7192 ------------------------------
7193 -- Implementation_Base_Type --
7194 ------------------------------
7195
7196 function Implementation_Base_Type (Id : E) return E is
7197 Bastyp : Entity_Id;
7198 Imptyp : Entity_Id;
7199
7200 begin
7201 Bastyp := Base_Type (Id);
7202
7203 if Is_Incomplete_Or_Private_Type (Bastyp) then
7204 Imptyp := Underlying_Type (Bastyp);
7205
7206 -- If we have an implementation type, then just return it,
7207 -- otherwise we return the Base_Type anyway. This can only
7208 -- happen in error situations and should avoid some error bombs.
7209
7210 if Present (Imptyp) then
7211 return Base_Type (Imptyp);
7212 else
7213 return Bastyp;
7214 end if;
7215
7216 else
7217 return Bastyp;
7218 end if;
7219 end Implementation_Base_Type;
7220
7221 -------------------------
7222 -- Invariant_Procedure --
7223 -------------------------
7224
7225 function Invariant_Procedure (Id : E) return E is
7226 S : Entity_Id;
7227
7228 begin
7229 pragma Assert (Is_Type (Id) and then Has_Invariants (Id));
7230
7231 if No (Subprograms_For_Type (Id)) then
7232 return Empty;
7233
7234 else
7235 S := Subprograms_For_Type (Id);
7236 while Present (S) loop
7237 if Is_Invariant_Procedure (S) then
7238 return S;
7239 else
7240 S := Subprograms_For_Type (S);
7241 end if;
7242 end loop;
7243
7244 return Empty;
7245 end if;
7246 end Invariant_Procedure;
7247
7248 ------------------
7249 -- Is_Base_Type --
7250 ------------------
7251
7252 -- Global flag table allowing rapid computation of this function
7253
7254 Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean :=
7255 (E_Enumeration_Subtype |
7256 E_Incomplete_Type |
7257 E_Signed_Integer_Subtype |
7258 E_Modular_Integer_Subtype |
7259 E_Floating_Point_Subtype |
7260 E_Ordinary_Fixed_Point_Subtype |
7261 E_Decimal_Fixed_Point_Subtype |
7262 E_Array_Subtype |
7263 E_String_Subtype |
7264 E_Record_Subtype |
7265 E_Private_Subtype |
7266 E_Record_Subtype_With_Private |
7267 E_Limited_Private_Subtype |
7268 E_Access_Subtype |
7269 E_Protected_Subtype |
7270 E_Task_Subtype |
7271 E_String_Literal_Subtype |
7272 E_Class_Wide_Subtype => False,
7273 others => True);
7274
7275 function Is_Base_Type (Id : E) return Boolean is
7276 begin
7277 return Entity_Is_Base_Type (Ekind (Id));
7278 end Is_Base_Type;
7279
7280 ---------------------
7281 -- Is_Boolean_Type --
7282 ---------------------
7283
7284 function Is_Boolean_Type (Id : E) return B is
7285 begin
7286 return Root_Type (Id) = Standard_Boolean;
7287 end Is_Boolean_Type;
7288
7289 ------------------------
7290 -- Is_Constant_Object --
7291 ------------------------
7292
7293 function Is_Constant_Object (Id : E) return B is
7294 K : constant Entity_Kind := Ekind (Id);
7295 begin
7296 return
7297 K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;
7298 end Is_Constant_Object;
7299
7300 --------------------
7301 -- Is_Discriminal --
7302 --------------------
7303
7304 function Is_Discriminal (Id : E) return B is
7305 begin
7306 return (Ekind_In (Id, E_Constant, E_In_Parameter)
7307 and then Present (Discriminal_Link (Id)));
7308 end Is_Discriminal;
7309
7310 ----------------------
7311 -- Is_Dynamic_Scope --
7312 ----------------------
7313
7314 function Is_Dynamic_Scope (Id : E) return B is
7315 begin
7316 return
7317 Ekind (Id) = E_Block
7318 or else
7319 Ekind (Id) = E_Function
7320 or else
7321 Ekind (Id) = E_Procedure
7322 or else
7323 Ekind (Id) = E_Subprogram_Body
7324 or else
7325 Ekind (Id) = E_Task_Type
7326 or else
7327 (Ekind (Id) = E_Limited_Private_Type
7328 and then Present (Full_View (Id))
7329 and then Ekind (Full_View (Id)) = E_Task_Type)
7330 or else
7331 Ekind (Id) = E_Entry
7332 or else
7333 Ekind (Id) = E_Entry_Family
7334 or else
7335 Ekind (Id) = E_Return_Statement;
7336 end Is_Dynamic_Scope;
7337
7338 --------------------
7339 -- Is_Entity_Name --
7340 --------------------
7341
7342 function Is_Entity_Name (N : Node_Id) return Boolean is
7343 Kind : constant Node_Kind := Nkind (N);
7344
7345 begin
7346 -- Identifiers, operator symbols, expanded names are entity names
7347
7348 return Kind = N_Identifier
7349 or else Kind = N_Operator_Symbol
7350 or else Kind = N_Expanded_Name
7351
7352 -- Attribute references are entity names if they refer to an entity.
7353 -- Note that we don't do this by testing for the presence of the
7354 -- Entity field in the N_Attribute_Reference node, since it may not
7355 -- have been set yet.
7356
7357 or else (Kind = N_Attribute_Reference
7358 and then Is_Entity_Attribute_Name (Attribute_Name (N)));
7359 end Is_Entity_Name;
7360
7361 -----------------------
7362 -- Is_External_State --
7363 -----------------------
7364
7365 function Is_External_State (Id : E) return B is
7366 begin
7367 return
7368 Ekind (Id) = E_Abstract_State and then Has_Option (Id, Name_External);
7369 end Is_External_State;
7370
7371 ------------------
7372 -- Is_Finalizer --
7373 ------------------
7374
7375 function Is_Finalizer (Id : E) return B is
7376 begin
7377 return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer;
7378 end Is_Finalizer;
7379
7380 -------------------
7381 -- Is_Null_State --
7382 -------------------
7383
7384 function Is_Null_State (Id : E) return B is
7385 begin
7386 return
7387 Ekind (Id) = E_Abstract_State and then Nkind (Parent (Id)) = N_Null;
7388 end Is_Null_State;
7389
7390 ---------------------
7391 -- Is_Packed_Array --
7392 ---------------------
7393
7394 function Is_Packed_Array (Id : E) return B is
7395 begin
7396 return Is_Array_Type (Id) and then Is_Packed (Id);
7397 end Is_Packed_Array;
7398
7399 -----------------------------------
7400 -- Is_Package_Or_Generic_Package --
7401 -----------------------------------
7402
7403 function Is_Package_Or_Generic_Package (Id : E) return B is
7404 begin
7405 return Ekind_In (Id, E_Generic_Package, E_Package);
7406 end Is_Package_Or_Generic_Package;
7407
7408 ---------------
7409 -- Is_Prival --
7410 ---------------
7411
7412 function Is_Prival (Id : E) return B is
7413 begin
7414 return (Ekind_In (Id, E_Constant, E_Variable)
7415 and then Present (Prival_Link (Id)));
7416 end Is_Prival;
7417
7418 ----------------------------
7419 -- Is_Protected_Component --
7420 ----------------------------
7421
7422 function Is_Protected_Component (Id : E) return B is
7423 begin
7424 return Ekind (Id) = E_Component and then Is_Protected_Type (Scope (Id));
7425 end Is_Protected_Component;
7426
7427 ----------------------------
7428 -- Is_Protected_Interface --
7429 ----------------------------
7430
7431 function Is_Protected_Interface (Id : E) return B is
7432 Typ : constant Entity_Id := Base_Type (Id);
7433 begin
7434 if not Is_Interface (Typ) then
7435 return False;
7436 elsif Is_Class_Wide_Type (Typ) then
7437 return Is_Protected_Interface (Etype (Typ));
7438 else
7439 return Protected_Present (Type_Definition (Parent (Typ)));
7440 end if;
7441 end Is_Protected_Interface;
7442
7443 ------------------------------
7444 -- Is_Protected_Record_Type --
7445 ------------------------------
7446
7447 function Is_Protected_Record_Type (Id : E) return B is
7448 begin
7449 return
7450 Is_Concurrent_Record_Type (Id)
7451 and then Is_Protected_Type (Corresponding_Concurrent_Type (Id));
7452 end Is_Protected_Record_Type;
7453
7454 --------------------------------
7455 -- Is_Standard_Character_Type --
7456 --------------------------------
7457
7458 function Is_Standard_Character_Type (Id : E) return B is
7459 begin
7460 if Is_Type (Id) then
7461 declare
7462 R : constant Entity_Id := Root_Type (Id);
7463 begin
7464 return
7465 R = Standard_Character
7466 or else
7467 R = Standard_Wide_Character
7468 or else
7469 R = Standard_Wide_Wide_Character;
7470 end;
7471
7472 else
7473 return False;
7474 end if;
7475 end Is_Standard_Character_Type;
7476
7477 -----------------------------
7478 -- Is_Standard_String_Type --
7479 -----------------------------
7480
7481 function Is_Standard_String_Type (Id : E) return B is
7482 begin
7483 if Is_Type (Id) then
7484 declare
7485 R : constant Entity_Id := Root_Type (Id);
7486 begin
7487 return
7488 R = Standard_String
7489 or else
7490 R = Standard_Wide_String
7491 or else
7492 R = Standard_Wide_Wide_String;
7493 end;
7494
7495 else
7496 return False;
7497 end if;
7498 end Is_Standard_String_Type;
7499
7500 --------------------
7501 -- Is_String_Type --
7502 --------------------
7503
7504 function Is_String_Type (Id : E) return B is
7505 begin
7506 return Is_Array_Type (Id)
7507 and then Id /= Any_Composite
7508 and then Number_Dimensions (Id) = 1
7509 and then Is_Character_Type (Component_Type (Id));
7510 end Is_String_Type;
7511
7512 -------------------------------
7513 -- Is_Synchronized_Interface --
7514 -------------------------------
7515
7516 function Is_Synchronized_Interface (Id : E) return B is
7517 Typ : constant Entity_Id := Base_Type (Id);
7518
7519 begin
7520 if not Is_Interface (Typ) then
7521 return False;
7522
7523 elsif Is_Class_Wide_Type (Typ) then
7524 return Is_Synchronized_Interface (Etype (Typ));
7525
7526 else
7527 return Protected_Present (Type_Definition (Parent (Typ)))
7528 or else Synchronized_Present (Type_Definition (Parent (Typ)))
7529 or else Task_Present (Type_Definition (Parent (Typ)));
7530 end if;
7531 end Is_Synchronized_Interface;
7532
7533 -----------------------
7534 -- Is_Task_Interface --
7535 -----------------------
7536
7537 function Is_Task_Interface (Id : E) return B is
7538 Typ : constant Entity_Id := Base_Type (Id);
7539 begin
7540 if not Is_Interface (Typ) then
7541 return False;
7542 elsif Is_Class_Wide_Type (Typ) then
7543 return Is_Task_Interface (Etype (Typ));
7544 else
7545 return Task_Present (Type_Definition (Parent (Typ)));
7546 end if;
7547 end Is_Task_Interface;
7548
7549 -------------------------
7550 -- Is_Task_Record_Type --
7551 -------------------------
7552
7553 function Is_Task_Record_Type (Id : E) return B is
7554 begin
7555 return
7556 Is_Concurrent_Record_Type (Id)
7557 and then Is_Task_Type (Corresponding_Concurrent_Type (Id));
7558 end Is_Task_Record_Type;
7559
7560 ------------------------
7561 -- Is_Wrapper_Package --
7562 ------------------------
7563
7564 function Is_Wrapper_Package (Id : E) return B is
7565 begin
7566 return (Ekind (Id) = E_Package and then Present (Related_Instance (Id)));
7567 end Is_Wrapper_Package;
7568
7569 -----------------
7570 -- Last_Formal --
7571 -----------------
7572
7573 function Last_Formal (Id : E) return E is
7574 Formal : E;
7575 NForm : E;
7576 begin
7577 pragma Assert
7578 (Is_Overloadable (Id)
7579 or else Ekind_In (Id, E_Entry_Family,
7580 E_Subprogram_Body,
7581 E_Subprogram_Type));
7582
7583 if Ekind (Id) = E_Enumeration_Literal then
7584 return Empty;
7585
7586 else
7587 Formal := First_Formal (Id);
7588
7589 if Present (Formal) then
7590 loop
7591 NForm := Next_Formal (Formal);
7592 exit when No (NForm) or else Is_ARECnF_Entity (NForm);
7593 Formal := NForm;
7594 end loop;
7595 end if;
7596
7597 return Formal;
7598 end if;
7599 end Last_Formal;
7600
7601 function Model_Emin_Value (Id : E) return Uint is
7602 begin
7603 return Machine_Emin_Value (Id);
7604 end Model_Emin_Value;
7605
7606 -------------------------
7607 -- Model_Epsilon_Value --
7608 -------------------------
7609
7610 function Model_Epsilon_Value (Id : E) return Ureal is
7611 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
7612 begin
7613 return Radix ** (1 - Model_Mantissa_Value (Id));
7614 end Model_Epsilon_Value;
7615
7616 --------------------------
7617 -- Model_Mantissa_Value --
7618 --------------------------
7619
7620 function Model_Mantissa_Value (Id : E) return Uint is
7621 begin
7622 return Machine_Mantissa_Value (Id);
7623 end Model_Mantissa_Value;
7624
7625 -----------------------
7626 -- Model_Small_Value --
7627 -----------------------
7628
7629 function Model_Small_Value (Id : E) return Ureal is
7630 Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
7631 begin
7632 return Radix ** (Model_Emin_Value (Id) - 1);
7633 end Model_Small_Value;
7634
7635 ------------------------
7636 -- Machine_Emax_Value --
7637 ------------------------
7638
7639 function Machine_Emax_Value (Id : E) return Uint is
7640 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
7641
7642 begin
7643 case Float_Rep (Id) is
7644 when IEEE_Binary =>
7645 case Digs is
7646 when 1 .. 6 => return Uint_128;
7647 when 7 .. 15 => return 2**10;
7648 when 16 .. 33 => return 2**14;
7649 when others => return No_Uint;
7650 end case;
7651
7652 when AAMP =>
7653 return Uint_2 ** Uint_7 - Uint_1;
7654 end case;
7655 end Machine_Emax_Value;
7656
7657 ------------------------
7658 -- Machine_Emin_Value --
7659 ------------------------
7660
7661 function Machine_Emin_Value (Id : E) return Uint is
7662 begin
7663 case Float_Rep (Id) is
7664 when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id);
7665 when AAMP => return -Machine_Emax_Value (Id);
7666 end case;
7667 end Machine_Emin_Value;
7668
7669 ----------------------------
7670 -- Machine_Mantissa_Value --
7671 ----------------------------
7672
7673 function Machine_Mantissa_Value (Id : E) return Uint is
7674 Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
7675
7676 begin
7677 case Float_Rep (Id) is
7678 when IEEE_Binary =>
7679 case Digs is
7680 when 1 .. 6 => return Uint_24;
7681 when 7 .. 15 => return UI_From_Int (53);
7682 when 16 .. 18 => return Uint_64;
7683 when 19 .. 33 => return UI_From_Int (113);
7684 when others => return No_Uint;
7685 end case;
7686
7687 when AAMP =>
7688 case Digs is
7689 when 1 .. 6 => return Uint_24;
7690 when 7 .. 9 => return UI_From_Int (40);
7691 when others => return No_Uint;
7692 end case;
7693 end case;
7694 end Machine_Mantissa_Value;
7695
7696 -------------------------
7697 -- Machine_Radix_Value --
7698 -------------------------
7699
7700 function Machine_Radix_Value (Id : E) return U is
7701 begin
7702 case Float_Rep (Id) is
7703 when IEEE_Binary | AAMP =>
7704 return Uint_2;
7705 end case;
7706 end Machine_Radix_Value;
7707
7708 --------------------
7709 -- Next_Component --
7710 --------------------
7711
7712 function Next_Component (Id : E) return E is
7713 Comp_Id : E;
7714
7715 begin
7716 Comp_Id := Next_Entity (Id);
7717 while Present (Comp_Id) loop
7718 exit when Ekind (Comp_Id) = E_Component;
7719 Comp_Id := Next_Entity (Comp_Id);
7720 end loop;
7721
7722 return Comp_Id;
7723 end Next_Component;
7724
7725 ------------------------------------
7726 -- Next_Component_Or_Discriminant --
7727 ------------------------------------
7728
7729 function Next_Component_Or_Discriminant (Id : E) return E is
7730 Comp_Id : E;
7731
7732 begin
7733 Comp_Id := Next_Entity (Id);
7734 while Present (Comp_Id) loop
7735 exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
7736 Comp_Id := Next_Entity (Comp_Id);
7737 end loop;
7738
7739 return Comp_Id;
7740 end Next_Component_Or_Discriminant;
7741
7742 -----------------------
7743 -- Next_Discriminant --
7744 -----------------------
7745
7746 -- This function actually implements both Next_Discriminant and
7747 -- Next_Stored_Discriminant by making sure that the Discriminant
7748 -- returned is of the same variety as Id.
7749
7750 function Next_Discriminant (Id : E) return E is
7751
7752 -- Derived Tagged types with private extensions look like this...
7753
7754 -- E_Discriminant d1
7755 -- E_Discriminant d2
7756 -- E_Component _tag
7757 -- E_Discriminant d1
7758 -- E_Discriminant d2
7759 -- ...
7760
7761 -- so it is critical not to go past the leading discriminants
7762
7763 D : E := Id;
7764
7765 begin
7766 pragma Assert (Ekind (Id) = E_Discriminant);
7767
7768 loop
7769 D := Next_Entity (D);
7770 if No (D)
7771 or else (Ekind (D) /= E_Discriminant
7772 and then not Is_Itype (D))
7773 then
7774 return Empty;
7775 end if;
7776
7777 exit when Ekind (D) = E_Discriminant
7778 and then (Is_Completely_Hidden (D) = Is_Completely_Hidden (Id));
7779 end loop;
7780
7781 return D;
7782 end Next_Discriminant;
7783
7784 -----------------
7785 -- Next_Formal --
7786 -----------------
7787
7788 function Next_Formal (Id : E) return E is
7789 P : E;
7790
7791 begin
7792 -- Follow the chain of declared entities as long as the kind of the
7793 -- entity corresponds to a formal parameter. Skip internal entities
7794 -- that may have been created for implicit subtypes, in the process
7795 -- of analyzing default expressions.
7796
7797 P := Id;
7798 loop
7799 Next_Entity (P);
7800
7801 -- Return Empty if no next entity, or its an ARECnF entity (since
7802 -- the latter is the last extra formal, not to be returned here).
7803
7804 if No (P) or else Is_ARECnF_Entity (P) then
7805 return Empty;
7806
7807 -- If next entity is a formal, return it
7808
7809 elsif Is_Formal (P) then
7810 return P;
7811
7812 -- Else one, unless we have an internal entity, which we skip
7813
7814 elsif not Is_Internal (P) then
7815 return Empty;
7816 end if;
7817 end loop;
7818 end Next_Formal;
7819
7820 -----------------------------
7821 -- Next_Formal_With_Extras --
7822 -----------------------------
7823
7824 function Next_Formal_With_Extras (Id : E) return E is
7825 NForm : Entity_Id;
7826 Next : Entity_Id;
7827
7828 begin
7829 if Present (Extra_Formal (Id)) then
7830 return Extra_Formal (Id);
7831
7832 else
7833 NForm := Next_Formal (Id);
7834
7835 if Present (NForm) then
7836 return NForm;
7837
7838 -- Deal with ARECnF entity as last extra formal
7839
7840 else
7841 Next := Next_Entity (Id);
7842
7843 if Present (Next) and then Is_ARECnF_Entity (Next) then
7844 return Next;
7845 else
7846 return Empty;
7847 end if;
7848 end if;
7849 end if;
7850 end Next_Formal_With_Extras;
7851
7852 ----------------
7853 -- Next_Index --
7854 ----------------
7855
7856 function Next_Index (Id : Node_Id) return Node_Id is
7857 begin
7858 return Next (Id);
7859 end Next_Index;
7860
7861 ------------------
7862 -- Next_Literal --
7863 ------------------
7864
7865 function Next_Literal (Id : E) return E is
7866 begin
7867 pragma Assert (Nkind (Id) in N_Entity);
7868 return Next (Id);
7869 end Next_Literal;
7870
7871 ------------------------------
7872 -- Next_Stored_Discriminant --
7873 ------------------------------
7874
7875 function Next_Stored_Discriminant (Id : E) return E is
7876 begin
7877 -- See comment in Next_Discriminant
7878
7879 return Next_Discriminant (Id);
7880 end Next_Stored_Discriminant;
7881
7882 -----------------------
7883 -- Number_Dimensions --
7884 -----------------------
7885
7886 function Number_Dimensions (Id : E) return Pos is
7887 N : Int;
7888 T : Node_Id;
7889
7890 begin
7891 if Ekind (Id) = E_String_Literal_Subtype then
7892 return 1;
7893
7894 else
7895 N := 0;
7896 T := First_Index (Id);
7897 while Present (T) loop
7898 N := N + 1;
7899 Next_Index (T);
7900 end loop;
7901
7902 return N;
7903 end if;
7904 end Number_Dimensions;
7905
7906 --------------------
7907 -- Number_Entries --
7908 --------------------
7909
7910 function Number_Entries (Id : E) return Nat is
7911 N : Int;
7912 Ent : Entity_Id;
7913
7914 begin
7915 pragma Assert (Is_Concurrent_Type (Id));
7916
7917 N := 0;
7918 Ent := First_Entity (Id);
7919 while Present (Ent) loop
7920 if Is_Entry (Ent) then
7921 N := N + 1;
7922 end if;
7923
7924 Ent := Next_Entity (Ent);
7925 end loop;
7926
7927 return N;
7928 end Number_Entries;
7929
7930 --------------------
7931 -- Number_Formals --
7932 --------------------
7933
7934 function Number_Formals (Id : E) return Pos is
7935 N : Int;
7936 Formal : Entity_Id;
7937
7938 begin
7939 N := 0;
7940 Formal := First_Formal (Id);
7941 while Present (Formal) loop
7942 N := N + 1;
7943 Formal := Next_Formal (Formal);
7944 end loop;
7945
7946 return N;
7947 end Number_Formals;
7948
7949 --------------------
7950 -- Parameter_Mode --
7951 --------------------
7952
7953 function Parameter_Mode (Id : E) return Formal_Kind is
7954 begin
7955 return Ekind (Id);
7956 end Parameter_Mode;
7957
7958 ------------------------
7959 -- Predicate_Function --
7960 ------------------------
7961
7962 function Predicate_Function (Id : E) return E is
7963 S : Entity_Id;
7964 T : Entity_Id;
7965
7966 begin
7967 pragma Assert (Is_Type (Id));
7968
7969 -- If type is private and has a completion, predicate may be defined
7970 -- on the full view.
7971
7972 if Is_Private_Type (Id) and then Present (Full_View (Id)) then
7973 T := Full_View (Id);
7974 else
7975 T := Id;
7976 end if;
7977
7978 if No (Subprograms_For_Type (T)) then
7979 return Empty;
7980
7981 else
7982 S := Subprograms_For_Type (T);
7983 while Present (S) loop
7984 if Is_Predicate_Function (S) then
7985 return S;
7986 else
7987 S := Subprograms_For_Type (S);
7988 end if;
7989 end loop;
7990
7991 return Empty;
7992 end if;
7993 end Predicate_Function;
7994
7995 --------------------------
7996 -- Predicate_Function_M --
7997 --------------------------
7998
7999 function Predicate_Function_M (Id : E) return E is
8000 S : Entity_Id;
8001 T : Entity_Id;
8002
8003 begin
8004 pragma Assert (Is_Type (Id));
8005
8006 -- If type is private and has a completion, predicate may be defined
8007 -- on the full view.
8008
8009 if Is_Private_Type (Id) and then Present (Full_View (Id)) then
8010 T := Full_View (Id);
8011 else
8012 T := Id;
8013 end if;
8014
8015 if No (Subprograms_For_Type (T)) then
8016 return Empty;
8017
8018 else
8019 S := Subprograms_For_Type (T);
8020 while Present (S) loop
8021 if Is_Predicate_Function_M (S) then
8022 return S;
8023 else
8024 S := Subprograms_For_Type (S);
8025 end if;
8026 end loop;
8027
8028 return Empty;
8029 end if;
8030 end Predicate_Function_M;
8031
8032 -------------------------
8033 -- Present_In_Rep_Item --
8034 -------------------------
8035
8036 function Present_In_Rep_Item (E : Entity_Id; N : Node_Id) return Boolean is
8037 Ritem : Node_Id;
8038
8039 begin
8040 Ritem := First_Rep_Item (E);
8041
8042 while Present (Ritem) loop
8043 if Ritem = N then
8044 return True;
8045 end if;
8046
8047 Next_Rep_Item (Ritem);
8048 end loop;
8049
8050 return False;
8051 end Present_In_Rep_Item;
8052
8053 --------------------------
8054 -- Primitive_Operations --
8055 --------------------------
8056
8057 function Primitive_Operations (Id : E) return L is
8058 begin
8059 if Is_Concurrent_Type (Id) then
8060 if Present (Corresponding_Record_Type (Id)) then
8061 return Direct_Primitive_Operations
8062 (Corresponding_Record_Type (Id));
8063
8064 -- If expansion is disabled the corresponding record type is absent,
8065 -- but if the type has ancestors it may have primitive operations.
8066
8067 elsif Is_Tagged_Type (Id) then
8068 return Direct_Primitive_Operations (Id);
8069
8070 else
8071 return No_Elist;
8072 end if;
8073 else
8074 return Direct_Primitive_Operations (Id);
8075 end if;
8076 end Primitive_Operations;
8077
8078 ---------------------
8079 -- Record_Rep_Item --
8080 ---------------------
8081
8082 procedure Record_Rep_Item (E : Entity_Id; N : Node_Id) is
8083 begin
8084 Set_Next_Rep_Item (N, First_Rep_Item (E));
8085 Set_First_Rep_Item (E, N);
8086 end Record_Rep_Item;
8087
8088 ---------------
8089 -- Root_Type --
8090 ---------------
8091
8092 function Root_Type (Id : E) return E is
8093 T, Etyp : E;
8094
8095 begin
8096 pragma Assert (Nkind (Id) in N_Entity);
8097
8098 T := Base_Type (Id);
8099
8100 if Ekind (T) = E_Class_Wide_Type then
8101 return Etype (T);
8102
8103 -- Other cases
8104
8105 else
8106 loop
8107 Etyp := Etype (T);
8108
8109 if T = Etyp then
8110 return T;
8111
8112 -- Following test catches some error cases resulting from
8113 -- previous errors.
8114
8115 elsif No (Etyp) then
8116 Check_Error_Detected;
8117 return T;
8118
8119 elsif Is_Private_Type (T) and then Etyp = Full_View (T) then
8120 return T;
8121
8122 elsif Is_Private_Type (Etyp) and then Full_View (Etyp) = T then
8123 return T;
8124 end if;
8125
8126 T := Etyp;
8127
8128 -- Return if there is a circularity in the inheritance chain. This
8129 -- happens in some error situations and we do not want to get
8130 -- stuck in this loop.
8131
8132 if T = Base_Type (Id) then
8133 return T;
8134 end if;
8135 end loop;
8136 end if;
8137 end Root_Type;
8138
8139 ---------------------
8140 -- Safe_Emax_Value --
8141 ---------------------
8142
8143 function Safe_Emax_Value (Id : E) return Uint is
8144 begin
8145 return Machine_Emax_Value (Id);
8146 end Safe_Emax_Value;
8147
8148 ----------------------
8149 -- Safe_First_Value --
8150 ----------------------
8151
8152 function Safe_First_Value (Id : E) return Ureal is
8153 begin
8154 return -Safe_Last_Value (Id);
8155 end Safe_First_Value;
8156
8157 ---------------------
8158 -- Safe_Last_Value --
8159 ---------------------
8160
8161 function Safe_Last_Value (Id : E) return Ureal is
8162 Radix : constant Uint := Machine_Radix_Value (Id);
8163 Mantissa : constant Uint := Machine_Mantissa_Value (Id);
8164 Emax : constant Uint := Safe_Emax_Value (Id);
8165 Significand : constant Uint := Radix ** Mantissa - 1;
8166 Exponent : constant Uint := Emax - Mantissa;
8167
8168 begin
8169 if Radix = 2 then
8170 return
8171 UR_From_Components
8172 (Num => Significand * 2 ** (Exponent mod 4),
8173 Den => -Exponent / 4,
8174 Rbase => 16);
8175 else
8176 return
8177 UR_From_Components
8178 (Num => Significand,
8179 Den => -Exponent,
8180 Rbase => 16);
8181 end if;
8182 end Safe_Last_Value;
8183
8184 -----------------
8185 -- Scope_Depth --
8186 -----------------
8187
8188 function Scope_Depth (Id : E) return Uint is
8189 Scop : Entity_Id;
8190
8191 begin
8192 Scop := Id;
8193 while Is_Record_Type (Scop) loop
8194 Scop := Scope (Scop);
8195 end loop;
8196
8197 return Scope_Depth_Value (Scop);
8198 end Scope_Depth;
8199
8200 ---------------------
8201 -- Scope_Depth_Set --
8202 ---------------------
8203
8204 function Scope_Depth_Set (Id : E) return B is
8205 begin
8206 return not Is_Record_Type (Id)
8207 and then Field22 (Id) /= Union_Id (Empty);
8208 end Scope_Depth_Set;
8209
8210 -----------------------------
8211 -- Set_Component_Alignment --
8212 -----------------------------
8213
8214 -- Component Alignment is encoded using two flags, Flag128/129 as
8215 -- follows. Note that both flags False = Align_Default, so that the
8216 -- default initialization of flags to False initializes component
8217 -- alignment to the default value as required.
8218
8219 -- Flag128 Flag129 Value
8220 -- ------- ------- -----
8221 -- False False Calign_Default
8222 -- False True Calign_Component_Size
8223 -- True False Calign_Component_Size_4
8224 -- True True Calign_Storage_Unit
8225
8226 procedure Set_Component_Alignment (Id : E; V : C) is
8227 begin
8228 pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id))
8229 and then Is_Base_Type (Id));
8230
8231 case V is
8232 when Calign_Default =>
8233 Set_Flag128 (Id, False);
8234 Set_Flag129 (Id, False);
8235
8236 when Calign_Component_Size =>
8237 Set_Flag128 (Id, False);
8238 Set_Flag129 (Id, True);
8239
8240 when Calign_Component_Size_4 =>
8241 Set_Flag128 (Id, True);
8242 Set_Flag129 (Id, False);
8243
8244 when Calign_Storage_Unit =>
8245 Set_Flag128 (Id, True);
8246 Set_Flag129 (Id, True);
8247 end case;
8248 end Set_Component_Alignment;
8249
8250 -------------------------------------
8251 -- Set_Default_Init_Cond_Procedure --
8252 -------------------------------------
8253
8254 procedure Set_Default_Init_Cond_Procedure (Id : E; V : E) is
8255 S : Entity_Id;
8256
8257 begin
8258 pragma Assert
8259 (Is_Type (Id) and then (Has_Default_Init_Cond (Id)
8260 or
8261 Has_Inherited_Default_Init_Cond (Id)));
8262
8263 S := Subprograms_For_Type (Id);
8264 Set_Subprograms_For_Type (Id, V);
8265 Set_Subprograms_For_Type (V, S);
8266
8267 -- Check for a duplicate procedure
8268
8269 while Present (S) loop
8270 if Is_Default_Init_Cond_Procedure (S) then
8271 raise Program_Error;
8272 end if;
8273
8274 S := Subprograms_For_Type (S);
8275 end loop;
8276 end Set_Default_Init_Cond_Procedure;
8277
8278 -----------------------------
8279 -- Set_Invariant_Procedure --
8280 -----------------------------
8281
8282 procedure Set_Invariant_Procedure (Id : E; V : E) is
8283 S : Entity_Id;
8284
8285 begin
8286 pragma Assert (Is_Type (Id) and then Has_Invariants (Id));
8287
8288 S := Subprograms_For_Type (Id);
8289 Set_Subprograms_For_Type (Id, V);
8290 Set_Subprograms_For_Type (V, S);
8291
8292 -- Check for duplicate entry
8293
8294 while Present (S) loop
8295 if Is_Invariant_Procedure (S) then
8296 raise Program_Error;
8297 else
8298 S := Subprograms_For_Type (S);
8299 end if;
8300 end loop;
8301 end Set_Invariant_Procedure;
8302
8303 ----------------------------
8304 -- Set_Predicate_Function --
8305 ----------------------------
8306
8307 procedure Set_Predicate_Function (Id : E; V : E) is
8308 S : Entity_Id;
8309
8310 begin
8311 pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
8312
8313 S := Subprograms_For_Type (Id);
8314 Set_Subprograms_For_Type (Id, V);
8315 Set_Subprograms_For_Type (V, S);
8316
8317 while Present (S) loop
8318 if Is_Predicate_Function (S) then
8319 raise Program_Error;
8320 else
8321 S := Subprograms_For_Type (S);
8322 end if;
8323 end loop;
8324 end Set_Predicate_Function;
8325
8326 ------------------------------
8327 -- Set_Predicate_Function_M --
8328 ------------------------------
8329
8330 procedure Set_Predicate_Function_M (Id : E; V : E) is
8331 S : Entity_Id;
8332
8333 begin
8334 pragma Assert (Is_Type (Id) and then Has_Predicates (Id));
8335
8336 S := Subprograms_For_Type (Id);
8337 Set_Subprograms_For_Type (Id, V);
8338 Set_Subprograms_For_Type (V, S);
8339
8340 -- Check for duplicates
8341
8342 while Present (S) loop
8343 if Is_Predicate_Function_M (S) then
8344 raise Program_Error;
8345 else
8346 S := Subprograms_For_Type (S);
8347 end if;
8348 end loop;
8349 end Set_Predicate_Function_M;
8350
8351 -----------------
8352 -- Size_Clause --
8353 -----------------
8354
8355 function Size_Clause (Id : E) return N is
8356 begin
8357 return Get_Attribute_Definition_Clause (Id, Attribute_Size);
8358 end Size_Clause;
8359
8360 ------------------------
8361 -- Stream_Size_Clause --
8362 ------------------------
8363
8364 function Stream_Size_Clause (Id : E) return N is
8365 begin
8366 return Get_Attribute_Definition_Clause (Id, Attribute_Stream_Size);
8367 end Stream_Size_Clause;
8368
8369 ------------------
8370 -- Subtype_Kind --
8371 ------------------
8372
8373 function Subtype_Kind (K : Entity_Kind) return Entity_Kind is
8374 Kind : Entity_Kind;
8375
8376 begin
8377 case K is
8378 when Access_Kind =>
8379 Kind := E_Access_Subtype;
8380
8381 when E_Array_Type |
8382 E_Array_Subtype =>
8383 Kind := E_Array_Subtype;
8384
8385 when E_Class_Wide_Type |
8386 E_Class_Wide_Subtype =>
8387 Kind := E_Class_Wide_Subtype;
8388
8389 when E_Decimal_Fixed_Point_Type |
8390 E_Decimal_Fixed_Point_Subtype =>
8391 Kind := E_Decimal_Fixed_Point_Subtype;
8392
8393 when E_Ordinary_Fixed_Point_Type |
8394 E_Ordinary_Fixed_Point_Subtype =>
8395 Kind := E_Ordinary_Fixed_Point_Subtype;
8396
8397 when E_Private_Type |
8398 E_Private_Subtype =>
8399 Kind := E_Private_Subtype;
8400
8401 when E_Limited_Private_Type |
8402 E_Limited_Private_Subtype =>
8403 Kind := E_Limited_Private_Subtype;
8404
8405 when E_Record_Type_With_Private |
8406 E_Record_Subtype_With_Private =>
8407 Kind := E_Record_Subtype_With_Private;
8408
8409 when E_Record_Type |
8410 E_Record_Subtype =>
8411 Kind := E_Record_Subtype;
8412
8413 when Enumeration_Kind =>
8414 Kind := E_Enumeration_Subtype;
8415
8416 when Float_Kind =>
8417 Kind := E_Floating_Point_Subtype;
8418
8419 when Signed_Integer_Kind =>
8420 Kind := E_Signed_Integer_Subtype;
8421
8422 when Modular_Integer_Kind =>
8423 Kind := E_Modular_Integer_Subtype;
8424
8425 when Protected_Kind =>
8426 Kind := E_Protected_Subtype;
8427
8428 when Task_Kind =>
8429 Kind := E_Task_Subtype;
8430
8431 when others =>
8432 Kind := E_Void;
8433 raise Program_Error;
8434 end case;
8435
8436 return Kind;
8437 end Subtype_Kind;
8438
8439 ---------------------
8440 -- Type_High_Bound --
8441 ---------------------
8442
8443 function Type_High_Bound (Id : E) return Node_Id is
8444 Rng : constant Node_Id := Scalar_Range (Id);
8445 begin
8446 if Nkind (Rng) = N_Subtype_Indication then
8447 return High_Bound (Range_Expression (Constraint (Rng)));
8448 else
8449 return High_Bound (Rng);
8450 end if;
8451 end Type_High_Bound;
8452
8453 --------------------
8454 -- Type_Low_Bound --
8455 --------------------
8456
8457 function Type_Low_Bound (Id : E) return Node_Id is
8458 Rng : constant Node_Id := Scalar_Range (Id);
8459 begin
8460 if Nkind (Rng) = N_Subtype_Indication then
8461 return Low_Bound (Range_Expression (Constraint (Rng)));
8462 else
8463 return Low_Bound (Rng);
8464 end if;
8465 end Type_Low_Bound;
8466
8467 ---------------------
8468 -- Underlying_Type --
8469 ---------------------
8470
8471 function Underlying_Type (Id : E) return E is
8472 begin
8473 -- For record_with_private the underlying type is always the direct
8474 -- full view. Never try to take the full view of the parent it
8475 -- doesn't make sense.
8476
8477 if Ekind (Id) = E_Record_Type_With_Private then
8478 return Full_View (Id);
8479
8480 elsif Ekind (Id) in Incomplete_Or_Private_Kind then
8481
8482 -- If we have an incomplete or private type with a full view,
8483 -- then we return the Underlying_Type of this full view.
8484
8485 if Present (Full_View (Id)) then
8486 if Id = Full_View (Id) then
8487
8488 -- Previous error in declaration
8489
8490 return Empty;
8491
8492 else
8493 return Underlying_Type (Full_View (Id));
8494 end if;
8495
8496 -- If we have a private type with an underlying full view, then we
8497 -- return the Underlying_Type of this underlying full view.
8498
8499 elsif Ekind (Id) in Private_Kind
8500 and then Present (Underlying_Full_View (Id))
8501 then
8502 return Underlying_Type (Underlying_Full_View (Id));
8503
8504 -- If we have an incomplete entity that comes from the limited
8505 -- view then we return the Underlying_Type of its non-limited
8506 -- view.
8507
8508 elsif From_Limited_With (Id)
8509 and then Present (Non_Limited_View (Id))
8510 then
8511 return Underlying_Type (Non_Limited_View (Id));
8512
8513 -- Otherwise check for the case where we have a derived type or
8514 -- subtype, and if so get the Underlying_Type of the parent type.
8515
8516 elsif Etype (Id) /= Id then
8517 return Underlying_Type (Etype (Id));
8518
8519 -- Otherwise we have an incomplete or private type that has
8520 -- no full view, which means that we have not encountered the
8521 -- completion, so return Empty to indicate the underlying type
8522 -- is not yet known.
8523
8524 else
8525 return Empty;
8526 end if;
8527
8528 -- For non-incomplete, non-private types, return the type itself Also
8529 -- for entities that are not types at all return the entity itself.
8530
8531 else
8532 return Id;
8533 end if;
8534 end Underlying_Type;
8535
8536 ------------------------
8537 -- Write_Entity_Flags --
8538 ------------------------
8539
8540 procedure Write_Entity_Flags (Id : Entity_Id; Prefix : String) is
8541
8542 procedure W (Flag_Name : String; Flag : Boolean);
8543 -- Write out given flag if it is set
8544
8545 -------
8546 -- W --
8547 -------
8548
8549 procedure W (Flag_Name : String; Flag : Boolean) is
8550 begin
8551 if Flag then
8552 Write_Str (Prefix);
8553 Write_Str (Flag_Name);
8554 Write_Str (" = True");
8555 Write_Eol;
8556 end if;
8557 end W;
8558
8559 -- Start of processing for Write_Entity_Flags
8560
8561 begin
8562 if (Is_Array_Type (Id) or else Is_Record_Type (Id))
8563 and then Is_Base_Type (Id)
8564 then
8565 Write_Str (Prefix);
8566 Write_Str ("Component_Alignment = ");
8567
8568 case Component_Alignment (Id) is
8569 when Calign_Default =>
8570 Write_Str ("Calign_Default");
8571
8572 when Calign_Component_Size =>
8573 Write_Str ("Calign_Component_Size");
8574
8575 when Calign_Component_Size_4 =>
8576 Write_Str ("Calign_Component_Size_4");
8577
8578 when Calign_Storage_Unit =>
8579 Write_Str ("Calign_Storage_Unit");
8580 end case;
8581
8582 Write_Eol;
8583 end if;
8584
8585 W ("Address_Taken", Flag104 (Id));
8586 W ("Body_Needed_For_SAL", Flag40 (Id));
8587 W ("C_Pass_By_Copy", Flag125 (Id));
8588 W ("Can_Never_Be_Null", Flag38 (Id));
8589 W ("Checks_May_Be_Suppressed", Flag31 (Id));
8590 W ("Contains_Ignored_Ghost_Code", Flag279 (Id));
8591 W ("Debug_Info_Off", Flag166 (Id));
8592 W ("Default_Expressions_Processed", Flag108 (Id));
8593 W ("Delay_Cleanups", Flag114 (Id));
8594 W ("Delay_Subprogram_Descriptors", Flag50 (Id));
8595 W ("Depends_On_Private", Flag14 (Id));
8596 W ("Discard_Names", Flag88 (Id));
8597 W ("Elaboration_Entity_Required", Flag174 (Id));
8598 W ("Elaborate_Body_Desirable", Flag210 (Id));
8599 W ("Entry_Accepted", Flag152 (Id));
8600 W ("Can_Use_Internal_Rep", Flag229 (Id));
8601 W ("Finalize_Storage_Only", Flag158 (Id));
8602 W ("From_Limited_With", Flag159 (Id));
8603 W ("Has_Aliased_Components", Flag135 (Id));
8604 W ("Has_Alignment_Clause", Flag46 (Id));
8605 W ("Has_All_Calls_Remote", Flag79 (Id));
8606 W ("Has_Anonymous_Master", Flag253 (Id));
8607 W ("Has_Atomic_Components", Flag86 (Id));
8608 W ("Has_Biased_Representation", Flag139 (Id));
8609 W ("Has_Completion", Flag26 (Id));
8610 W ("Has_Completion_In_Body", Flag71 (Id));
8611 W ("Has_Complex_Representation", Flag140 (Id));
8612 W ("Has_Component_Size_Clause", Flag68 (Id));
8613 W ("Has_Contiguous_Rep", Flag181 (Id));
8614 W ("Has_Controlled_Component", Flag43 (Id));
8615 W ("Has_Controlling_Result", Flag98 (Id));
8616 W ("Has_Convention_Pragma", Flag119 (Id));
8617 W ("Has_Default_Aspect", Flag39 (Id));
8618 W ("Has_Default_Init_Cond", Flag3 (Id));
8619 W ("Has_Delayed_Aspects", Flag200 (Id));
8620 W ("Has_Delayed_Freeze", Flag18 (Id));
8621 W ("Has_Delayed_Rep_Aspects", Flag261 (Id));
8622 W ("Has_Discriminants", Flag5 (Id));
8623 W ("Has_Dispatch_Table", Flag220 (Id));
8624 W ("Has_Dynamic_Predicate_Aspect", Flag258 (Id));
8625 W ("Has_Enumeration_Rep_Clause", Flag66 (Id));
8626 W ("Has_Exit", Flag47 (Id));
8627 W ("Has_Expanded_Contract", Flag240 (Id));
8628 W ("Has_Forward_Instantiation", Flag175 (Id));
8629 W ("Has_Fully_Qualified_Name", Flag173 (Id));
8630 W ("Has_Gigi_Rep_Item", Flag82 (Id));
8631 W ("Has_Homonym", Flag56 (Id));
8632 W ("Has_Implicit_Dereference", Flag251 (Id));
8633 W ("Has_Independent_Components", Flag34 (Id));
8634 W ("Has_Inheritable_Invariants", Flag248 (Id));
8635 W ("Has_Inherited_Default_Init_Cond", Flag133 (Id));
8636 W ("Has_Initial_Value", Flag219 (Id));
8637 W ("Has_Invariants", Flag232 (Id));
8638 W ("Has_Loop_Entry_Attributes", Flag260 (Id));
8639 W ("Has_Machine_Radix_Clause", Flag83 (Id));
8640 W ("Has_Master_Entity", Flag21 (Id));
8641 W ("Has_Missing_Return", Flag142 (Id));
8642 W ("Has_Nested_Block_With_Handler", Flag101 (Id));
8643 W ("Has_Nested_Subprogram", Flag282 (Id));
8644 W ("Has_Non_Standard_Rep", Flag75 (Id));
8645 W ("Has_Out_Or_In_Out_Parameter", Flag110 (Id));
8646 W ("Has_Object_Size_Clause", Flag172 (Id));
8647 W ("Has_Per_Object_Constraint", Flag154 (Id));
8648 W ("Has_Pragma_Controlled", Flag27 (Id));
8649 W ("Has_Pragma_Elaborate_Body", Flag150 (Id));
8650 W ("Has_Pragma_Inline", Flag157 (Id));
8651 W ("Has_Pragma_Inline_Always", Flag230 (Id));
8652 W ("Has_Pragma_No_Inline", Flag201 (Id));
8653 W ("Has_Pragma_Ordered", Flag198 (Id));
8654 W ("Has_Pragma_Pack", Flag121 (Id));
8655 W ("Has_Pragma_Preelab_Init", Flag221 (Id));
8656 W ("Has_Pragma_Pure", Flag203 (Id));
8657 W ("Has_Pragma_Pure_Function", Flag179 (Id));
8658 W ("Has_Pragma_Thread_Local_Storage", Flag169 (Id));
8659 W ("Has_Pragma_Unmodified", Flag233 (Id));
8660 W ("Has_Pragma_Unreferenced", Flag180 (Id));
8661 W ("Has_Pragma_Unreferenced_Objects", Flag212 (Id));
8662 W ("Has_Predicates", Flag250 (Id));
8663 W ("Has_Primitive_Operations", Flag120 (Id));
8664 W ("Has_Private_Ancestor", Flag151 (Id));
8665 W ("Has_Private_Declaration", Flag155 (Id));
8666 W ("Has_Protected", Flag271 (Id));
8667 W ("Has_Qualified_Name", Flag161 (Id));
8668 W ("Has_RACW", Flag214 (Id));
8669 W ("Has_Record_Rep_Clause", Flag65 (Id));
8670 W ("Has_Recursive_Call", Flag143 (Id));
8671 W ("Has_Shift_Operator", Flag267 (Id));
8672 W ("Has_Size_Clause", Flag29 (Id));
8673 W ("Has_Small_Clause", Flag67 (Id));
8674 W ("Has_Specified_Layout", Flag100 (Id));
8675 W ("Has_Specified_Stream_Input", Flag190 (Id));
8676 W ("Has_Specified_Stream_Output", Flag191 (Id));
8677 W ("Has_Specified_Stream_Read", Flag192 (Id));
8678 W ("Has_Specified_Stream_Write", Flag193 (Id));
8679 W ("Has_Static_Discriminants", Flag211 (Id));
8680 W ("Has_Static_Predicate", Flag269 (Id));
8681 W ("Has_Static_Predicate_Aspect", Flag259 (Id));
8682 W ("Has_Storage_Size_Clause", Flag23 (Id));
8683 W ("Has_Stream_Size_Clause", Flag184 (Id));
8684 W ("Has_Task", Flag30 (Id));
8685 W ("Has_Thunks", Flag228 (Id));
8686 W ("Has_Unchecked_Union", Flag123 (Id));
8687 W ("Has_Unknown_Discriminants", Flag72 (Id));
8688 W ("Has_Uplevel_Reference", Flag215 (Id));
8689 W ("Has_Visible_Refinement", Flag263 (Id));
8690 W ("Has_Volatile_Components", Flag87 (Id));
8691 W ("Has_Xref_Entry", Flag182 (Id));
8692 W ("In_Package_Body", Flag48 (Id));
8693 W ("In_Private_Part", Flag45 (Id));
8694 W ("In_Use", Flag8 (Id));
8695 W ("Is_Abstract_Subprogram", Flag19 (Id));
8696 W ("Is_Abstract_Type", Flag146 (Id));
8697 W ("Is_ARECnF_Entity", Flag284 (Id));
8698 W ("Is_Access_Constant", Flag69 (Id));
8699 W ("Is_Ada_2005_Only", Flag185 (Id));
8700 W ("Is_Ada_2012_Only", Flag199 (Id));
8701 W ("Is_Aliased", Flag15 (Id));
8702 W ("Is_Asynchronous", Flag81 (Id));
8703 W ("Is_Atomic", Flag85 (Id));
8704 W ("Is_Bit_Packed_Array", Flag122 (Id));
8705 W ("Is_CPP_Class", Flag74 (Id));
8706 W ("Is_Called", Flag102 (Id));
8707 W ("Is_Character_Type", Flag63 (Id));
8708 W ("Is_Checked_Ghost_Entity", Flag277 (Id));
8709 W ("Is_Child_Unit", Flag73 (Id));
8710 W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id));
8711 W ("Is_Compilation_Unit", Flag149 (Id));
8712 W ("Is_Completely_Hidden", Flag103 (Id));
8713 W ("Is_Concurrent_Record_Type", Flag20 (Id));
8714 W ("Is_Constr_Subt_For_UN_Aliased", Flag141 (Id));
8715 W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
8716 W ("Is_Constrained", Flag12 (Id));
8717 W ("Is_Constructor", Flag76 (Id));
8718 W ("Is_Controlled", Flag42 (Id));
8719 W ("Is_Controlling_Formal", Flag97 (Id));
8720 W ("Is_Default_Init_Cond_Procedure", Flag132 (Id));
8721 W ("Is_Descendent_Of_Address", Flag223 (Id));
8722 W ("Is_Discrim_SO_Function", Flag176 (Id));
8723 W ("Is_Discriminant_Check_Function", Flag264 (Id));
8724 W ("Is_Dispatch_Table_Entity", Flag234 (Id));
8725 W ("Is_Dispatching_Operation", Flag6 (Id));
8726 W ("Is_Eliminated", Flag124 (Id));
8727 W ("Is_Entry_Formal", Flag52 (Id));
8728 W ("Is_Exported", Flag99 (Id));
8729 W ("Is_First_Subtype", Flag70 (Id));
8730 W ("Is_For_Access_Subtype", Flag118 (Id));
8731 W ("Is_Formal_Subprogram", Flag111 (Id));
8732 W ("Is_Frozen", Flag4 (Id));
8733 W ("Is_Generic_Actual_Subprogram", Flag274 (Id));
8734 W ("Is_Generic_Actual_Type", Flag94 (Id));
8735 W ("Is_Generic_Instance", Flag130 (Id));
8736 W ("Is_Generic_Type", Flag13 (Id));
8737 W ("Is_Hidden", Flag57 (Id));
8738 W ("Is_Hidden_Non_Overridden_Subpgm", Flag2 (Id));
8739 W ("Is_Hidden_Open_Scope", Flag171 (Id));
8740 W ("Is_Ignored_Ghost_Entity", Flag278 (Id));
8741 W ("Is_Immediately_Visible", Flag7 (Id));
8742 W ("Is_Implementation_Defined", Flag254 (Id));
8743 W ("Is_Imported", Flag24 (Id));
8744 W ("Is_Independent", Flag268 (Id));
8745 W ("Is_Inlined", Flag11 (Id));
8746 W ("Is_Inlined_Always", Flag1 (Id));
8747 W ("Is_Instantiated", Flag126 (Id));
8748 W ("Is_Interface", Flag186 (Id));
8749 W ("Is_Internal", Flag17 (Id));
8750 W ("Is_Interrupt_Handler", Flag89 (Id));
8751 W ("Is_Intrinsic_Subprogram", Flag64 (Id));
8752 W ("Is_Invariant_Procedure", Flag257 (Id));
8753 W ("Is_Itype", Flag91 (Id));
8754 W ("Is_Known_Non_Null", Flag37 (Id));
8755 W ("Is_Known_Null", Flag204 (Id));
8756 W ("Is_Known_Valid", Flag170 (Id));
8757 W ("Is_Limited_Composite", Flag106 (Id));
8758 W ("Is_Limited_Interface", Flag197 (Id));
8759 W ("Is_Limited_Record", Flag25 (Id));
8760 W ("Is_Local_Anonymous_Access", Flag194 (Id));
8761 W ("Is_Machine_Code_Subprogram", Flag137 (Id));
8762 W ("Is_Non_Static_Subtype", Flag109 (Id));
8763 W ("Is_Null_Init_Proc", Flag178 (Id));
8764 W ("Is_Obsolescent", Flag153 (Id));
8765 W ("Is_Only_Out_Parameter", Flag226 (Id));
8766 W ("Is_Package_Body_Entity", Flag160 (Id));
8767 W ("Is_Packed", Flag51 (Id));
8768 W ("Is_Packed_Array_Impl_Type", Flag138 (Id));
8769 W ("Is_Potentially_Use_Visible", Flag9 (Id));
8770 W ("Is_Predicate_Function", Flag255 (Id));
8771 W ("Is_Predicate_Function_M", Flag256 (Id));
8772 W ("Is_Preelaborated", Flag59 (Id));
8773 W ("Is_Primitive", Flag218 (Id));
8774 W ("Is_Primitive_Wrapper", Flag195 (Id));
8775 W ("Is_Private_Composite", Flag107 (Id));
8776 W ("Is_Private_Descendant", Flag53 (Id));
8777 W ("Is_Private_Primitive", Flag245 (Id));
8778 W ("Is_Processed_Transient", Flag252 (Id));
8779 W ("Is_Public", Flag10 (Id));
8780 W ("Is_Pure", Flag44 (Id));
8781 W ("Is_Pure_Unit_Access_Type", Flag189 (Id));
8782 W ("Is_RACW_Stub_Type", Flag244 (Id));
8783 W ("Is_Raised", Flag224 (Id));
8784 W ("Is_Remote_Call_Interface", Flag62 (Id));
8785 W ("Is_Remote_Types", Flag61 (Id));
8786 W ("Is_Renaming_Of_Object", Flag112 (Id));
8787 W ("Is_Return_Object", Flag209 (Id));
8788 W ("Is_Safe_To_Reevaluate", Flag249 (Id));
8789 W ("Is_Shared_Passive", Flag60 (Id));
8790 W ("Is_Static_Type", Flag281 (Id));
8791 W ("Is_Statically_Allocated", Flag28 (Id));
8792 W ("Is_Tag", Flag78 (Id));
8793 W ("Is_Tagged_Type", Flag55 (Id));
8794 W ("Is_Thunk", Flag225 (Id));
8795 W ("Is_Trivial_Subprogram", Flag235 (Id));
8796 W ("Is_True_Constant", Flag163 (Id));
8797 W ("Is_Unchecked_Union", Flag117 (Id));
8798 W ("Is_Underlying_Record_View", Flag246 (Id));
8799 W ("Is_Unsigned_Type", Flag144 (Id));
8800 W ("Is_Valued_Procedure", Flag127 (Id));
8801 W ("Is_Visible_Formal", Flag206 (Id));
8802 W ("Is_Visible_Lib_Unit", Flag116 (Id));
8803 W ("Is_Volatile", Flag16 (Id));
8804 W ("Itype_Printed", Flag202 (Id));
8805 W ("Kill_Elaboration_Checks", Flag32 (Id));
8806 W ("Kill_Range_Checks", Flag33 (Id));
8807 W ("Known_To_Have_Preelab_Init", Flag207 (Id));
8808 W ("Low_Bound_Tested", Flag205 (Id));
8809 W ("Machine_Radix_10", Flag84 (Id));
8810 W ("Materialize_Entity", Flag168 (Id));
8811 W ("May_Inherit_Delayed_Rep_Aspects", Flag262 (Id));
8812 W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
8813 W ("Must_Have_Preelab_Init", Flag208 (Id));
8814 W ("Needs_Debug_Info", Flag147 (Id));
8815 W ("Needs_No_Actuals", Flag22 (Id));
8816 W ("Never_Set_In_Source", Flag115 (Id));
8817 W ("No_Dynamic_Predicate_On_actual", Flag276 (Id));
8818 W ("No_Pool_Assigned", Flag131 (Id));
8819 W ("No_Predicate_On_actual", Flag275 (Id));
8820 W ("No_Return", Flag113 (Id));
8821 W ("No_Strict_Aliasing", Flag136 (Id));
8822 W ("Non_Binary_Modulus", Flag58 (Id));
8823 W ("Nonzero_Is_True", Flag162 (Id));
8824 W ("OK_To_Rename", Flag247 (Id));
8825 W ("OK_To_Reorder_Components", Flag239 (Id));
8826 W ("Optimize_Alignment_Space", Flag241 (Id));
8827 W ("Optimize_Alignment_Time", Flag242 (Id));
8828 W ("Overlays_Constant", Flag243 (Id));
8829 W ("Partial_View_Has_Unknown_Discr", Flag280 (Id));
8830 W ("Reachable", Flag49 (Id));
8831 W ("Referenced", Flag156 (Id));
8832 W ("Referenced_As_LHS", Flag36 (Id));
8833 W ("Referenced_As_Out_Parameter", Flag227 (Id));
8834 W ("Renamed_In_Spec", Flag231 (Id));
8835 W ("Requires_Overriding", Flag213 (Id));
8836 W ("Return_Present", Flag54 (Id));
8837 W ("Returns_By_Ref", Flag90 (Id));
8838 W ("Returns_Limited_View", Flag134 (Id));
8839 W ("Reverse_Bit_Order", Flag164 (Id));
8840 W ("Reverse_Storage_Order", Flag93 (Id));
8841 W ("Sec_Stack_Needed_For_Return", Flag167 (Id));
8842 W ("Size_Depends_On_Discriminant", Flag177 (Id));
8843 W ("Size_Known_At_Compile_Time", Flag92 (Id));
8844 W ("SPARK_Aux_Pragma_Inherited", Flag266 (Id));
8845 W ("SPARK_Pragma_Inherited", Flag265 (Id));
8846 W ("SSO_Set_High_By_Default", Flag273 (Id));
8847 W ("SSO_Set_Low_By_Default", Flag272 (Id));
8848 W ("Static_Elaboration_Desired", Flag77 (Id));
8849 W ("Stores_Attribute_Old_Prefix", Flag270 (Id));
8850 W ("Strict_Alignment", Flag145 (Id));
8851 W ("Suppress_Elaboration_Warnings", Flag148 (Id));
8852 W ("Suppress_Initialization", Flag105 (Id));
8853 W ("Suppress_Style_Checks", Flag165 (Id));
8854 W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
8855 W ("Treat_As_Volatile", Flag41 (Id));
8856 W ("Universal_Aliasing", Flag216 (Id));
8857 W ("Uplevel_Reference_Noted", Flag283 (Id));
8858 W ("Used_As_Generic_Actual", Flag222 (Id));
8859 W ("Uses_Sec_Stack", Flag95 (Id));
8860 W ("Warnings_Off", Flag96 (Id));
8861 W ("Warnings_Off_Used", Flag236 (Id));
8862 W ("Warnings_Off_Used_Unmodified", Flag237 (Id));
8863 W ("Warnings_Off_Used_Unreferenced", Flag238 (Id));
8864 W ("Was_Hidden", Flag196 (Id));
8865 end Write_Entity_Flags;
8866
8867 -----------------------
8868 -- Write_Entity_Info --
8869 -----------------------
8870
8871 procedure Write_Entity_Info (Id : Entity_Id; Prefix : String) is
8872
8873 procedure Write_Attribute (Which : String; Nam : E);
8874 -- Write attribute value with given string name
8875
8876 procedure Write_Kind (Id : Entity_Id);
8877 -- Write Ekind field of entity
8878
8879 ---------------------
8880 -- Write_Attribute --
8881 ---------------------
8882
8883 procedure Write_Attribute (Which : String; Nam : E) is
8884 begin
8885 Write_Str (Prefix);
8886 Write_Str (Which);
8887 Write_Int (Int (Nam));
8888 Write_Str (" ");
8889 Write_Name (Chars (Nam));
8890 Write_Str (" ");
8891 end Write_Attribute;
8892
8893 ----------------
8894 -- Write_Kind --
8895 ----------------
8896
8897 procedure Write_Kind (Id : Entity_Id) is
8898 K : constant String := Entity_Kind'Image (Ekind (Id));
8899
8900 begin
8901 Write_Str (Prefix);
8902 Write_Str (" Kind ");
8903
8904 if Is_Type (Id) and then Is_Tagged_Type (Id) then
8905 Write_Str ("TAGGED ");
8906 end if;
8907
8908 Write_Str (K (3 .. K'Length));
8909 Write_Str (" ");
8910
8911 if Is_Type (Id) and then Depends_On_Private (Id) then
8912 Write_Str ("Depends_On_Private ");
8913 end if;
8914 end Write_Kind;
8915
8916 -- Start of processing for Write_Entity_Info
8917
8918 begin
8919 Write_Eol;
8920 Write_Attribute ("Name ", Id);
8921 Write_Int (Int (Id));
8922 Write_Eol;
8923 Write_Kind (Id);
8924 Write_Eol;
8925 Write_Attribute (" Type ", Etype (Id));
8926 Write_Eol;
8927 Write_Attribute (" Scope ", Scope (Id));
8928 Write_Eol;
8929
8930 case Ekind (Id) is
8931
8932 when Discrete_Kind =>
8933 Write_Str ("Bounds: Id = ");
8934
8935 if Present (Scalar_Range (Id)) then
8936 Write_Int (Int (Type_Low_Bound (Id)));
8937 Write_Str (" .. Id = ");
8938 Write_Int (Int (Type_High_Bound (Id)));
8939 else
8940 Write_Str ("Empty");
8941 end if;
8942
8943 Write_Eol;
8944
8945 when Array_Kind =>
8946 declare
8947 Index : E;
8948
8949 begin
8950 Write_Attribute
8951 (" Component Type ", Component_Type (Id));
8952 Write_Eol;
8953 Write_Str (Prefix);
8954 Write_Str (" Indexes ");
8955
8956 Index := First_Index (Id);
8957 while Present (Index) loop
8958 Write_Attribute (" ", Etype (Index));
8959 Index := Next_Index (Index);
8960 end loop;
8961
8962 Write_Eol;
8963 end;
8964
8965 when Access_Kind =>
8966 Write_Attribute
8967 (" Directly Designated Type ",
8968 Directly_Designated_Type (Id));
8969 Write_Eol;
8970
8971 when Overloadable_Kind =>
8972 if Present (Homonym (Id)) then
8973 Write_Str (" Homonym ");
8974 Write_Name (Chars (Homonym (Id)));
8975 Write_Str (" ");
8976 Write_Int (Int (Homonym (Id)));
8977 Write_Eol;
8978 end if;
8979
8980 Write_Eol;
8981
8982 when E_Component =>
8983 if Ekind (Scope (Id)) in Record_Kind then
8984 Write_Attribute (
8985 " Original_Record_Component ",
8986 Original_Record_Component (Id));
8987 Write_Int (Int (Original_Record_Component (Id)));
8988 Write_Eol;
8989 end if;
8990
8991 when others => null;
8992 end case;
8993 end Write_Entity_Info;
8994
8995 -----------------------
8996 -- Write_Field6_Name --
8997 -----------------------
8998
8999 procedure Write_Field6_Name (Id : Entity_Id) is
9000 pragma Warnings (Off, Id);
9001 begin
9002 Write_Str ("First_Rep_Item");
9003 end Write_Field6_Name;
9004
9005 -----------------------
9006 -- Write_Field7_Name --
9007 -----------------------
9008
9009 procedure Write_Field7_Name (Id : Entity_Id) is
9010 pragma Warnings (Off, Id);
9011 begin
9012 Write_Str ("Freeze_Node");
9013 end Write_Field7_Name;
9014
9015 -----------------------
9016 -- Write_Field8_Name --
9017 -----------------------
9018
9019 procedure Write_Field8_Name (Id : Entity_Id) is
9020 begin
9021 case Ekind (Id) is
9022 when Type_Kind =>
9023 Write_Str ("Associated_Node_For_Itype");
9024
9025 when E_Package =>
9026 Write_Str ("Dependent_Instances");
9027
9028 when E_Loop =>
9029 Write_Str ("First_Exit_Statement");
9030
9031 when E_Variable =>
9032 Write_Str ("Hiding_Loop_Variable");
9033
9034 when Formal_Kind |
9035 E_Function |
9036 E_Subprogram_Body =>
9037 Write_Str ("Mechanism");
9038
9039 when E_Component |
9040 E_Discriminant =>
9041 Write_Str ("Normalized_First_Bit");
9042
9043 when E_Abstract_State =>
9044 Write_Str ("Refinement_Constituents");
9045
9046 when E_Return_Statement =>
9047 Write_Str ("Return_Applies_To");
9048
9049 when others =>
9050 Write_Str ("Field8??");
9051 end case;
9052 end Write_Field8_Name;
9053
9054 -----------------------
9055 -- Write_Field9_Name --
9056 -----------------------
9057
9058 procedure Write_Field9_Name (Id : Entity_Id) is
9059 begin
9060 case Ekind (Id) is
9061 when Type_Kind =>
9062 Write_Str ("Class_Wide_Type");
9063
9064 when Object_Kind =>
9065 Write_Str ("Current_Value");
9066
9067 when E_Abstract_State =>
9068 Write_Str ("Part_Of_Constituents");
9069
9070 when E_Function |
9071 E_Generic_Function |
9072 E_Generic_Package |
9073 E_Generic_Procedure |
9074 E_Package |
9075 E_Procedure =>
9076 Write_Str ("Renaming_Map");
9077
9078 when others =>
9079 Write_Str ("Field9??");
9080 end case;
9081 end Write_Field9_Name;
9082
9083 ------------------------
9084 -- Write_Field10_Name --
9085 ------------------------
9086
9087 procedure Write_Field10_Name (Id : Entity_Id) is
9088 begin
9089 case Ekind (Id) is
9090 when E_Abstract_State |
9091 E_Variable =>
9092 Write_Str ("Encapsulating_State");
9093
9094 when Class_Wide_Kind |
9095 Incomplete_Kind |
9096 E_Record_Type |
9097 E_Record_Subtype |
9098 Private_Kind |
9099 Concurrent_Kind =>
9100 Write_Str ("Direct_Primitive_Operations");
9101
9102 when Float_Kind =>
9103 Write_Str ("Float_Rep");
9104
9105 when E_In_Parameter |
9106 E_Constant =>
9107 Write_Str ("Discriminal_Link");
9108
9109 when E_Function |
9110 E_Package |
9111 E_Package_Body |
9112 E_Procedure =>
9113 Write_Str ("Handler_Records");
9114
9115 when E_Component |
9116 E_Discriminant =>
9117 Write_Str ("Normalized_Position_Max");
9118
9119 when others =>
9120 Write_Str ("Field10??");
9121 end case;
9122 end Write_Field10_Name;
9123
9124 ------------------------
9125 -- Write_Field11_Name --
9126 ------------------------
9127
9128 procedure Write_Field11_Name (Id : Entity_Id) is
9129 begin
9130 case Ekind (Id) is
9131 when E_Block =>
9132 Write_Str ("Block_Node");
9133
9134 when E_Component |
9135 E_Discriminant =>
9136 Write_Str ("Component_Bit_Offset");
9137
9138 when Formal_Kind =>
9139 Write_Str ("Entry_Component");
9140
9141 when E_Enumeration_Literal =>
9142 Write_Str ("Enumeration_Pos");
9143
9144 when Type_Kind |
9145 E_Constant =>
9146 Write_Str ("Full_View");
9147
9148 when E_Generic_Package =>
9149 Write_Str ("Generic_Homonym");
9150
9151 when E_Function |
9152 E_Procedure |
9153 E_Entry |
9154 E_Entry_Family =>
9155 Write_Str ("Protected_Body_Subprogram");
9156
9157 when others =>
9158 Write_Str ("Field11??");
9159 end case;
9160 end Write_Field11_Name;
9161
9162 ------------------------
9163 -- Write_Field12_Name --
9164 ------------------------
9165
9166 procedure Write_Field12_Name (Id : Entity_Id) is
9167 begin
9168 case Ekind (Id) is
9169 when E_Package =>
9170 Write_Str ("Associated_Formal_Package");
9171
9172 when Entry_Kind =>
9173 Write_Str ("Barrier_Function");
9174
9175 when E_Enumeration_Literal =>
9176 Write_Str ("Enumeration_Rep");
9177
9178 when Type_Kind |
9179 E_Component |
9180 E_Constant |
9181 E_Discriminant |
9182 E_Exception |
9183 E_In_Parameter |
9184 E_In_Out_Parameter |
9185 E_Out_Parameter |
9186 E_Loop_Parameter |
9187 E_Variable =>
9188 Write_Str ("Esize");
9189
9190 when E_Function |
9191 E_Procedure =>
9192 Write_Str ("Next_Inlined_Subprogram");
9193
9194 when others =>
9195 Write_Str ("Field12??");
9196 end case;
9197 end Write_Field12_Name;
9198
9199 ------------------------
9200 -- Write_Field13_Name --
9201 ------------------------
9202
9203 procedure Write_Field13_Name (Id : Entity_Id) is
9204 begin
9205 case Ekind (Id) is
9206 when E_Component |
9207 E_Discriminant =>
9208 Write_Str ("Component_Clause");
9209
9210 when E_Function =>
9211 Write_Str ("Elaboration_Entity");
9212
9213 when E_Procedure |
9214 E_Package |
9215 Generic_Unit_Kind =>
9216 Write_Str ("Elaboration_Entity");
9217
9218 when Formal_Kind |
9219 E_Variable =>
9220 Write_Str ("Extra_Accessibility");
9221
9222 when Type_Kind =>
9223 Write_Str ("RM_Size");
9224
9225 when others =>
9226 Write_Str ("Field13??");
9227 end case;
9228 end Write_Field13_Name;
9229
9230 -----------------------
9231 -- Write_Field14_Name --
9232 -----------------------
9233
9234 procedure Write_Field14_Name (Id : Entity_Id) is
9235 begin
9236 case Ekind (Id) is
9237 when Type_Kind |
9238 Formal_Kind |
9239 E_Constant |
9240 E_Exception |
9241 E_Loop_Parameter |
9242 E_Variable =>
9243 Write_Str ("Alignment");
9244
9245 when E_Component |
9246 E_Discriminant =>
9247 Write_Str ("Normalized_Position");
9248
9249 when E_Entry |
9250 E_Entry_Family |
9251 E_Function |
9252 E_Procedure =>
9253 Write_Str ("Postconditions_Proc");
9254
9255 when E_Generic_Package |
9256 E_Package =>
9257 Write_Str ("Shadow_Entities");
9258
9259 when others =>
9260 Write_Str ("Field14??");
9261 end case;
9262 end Write_Field14_Name;
9263
9264 ------------------------
9265 -- Write_Field15_Name --
9266 ------------------------
9267
9268 procedure Write_Field15_Name (Id : Entity_Id) is
9269 begin
9270 case Ekind (Id) is
9271 when E_Discriminant =>
9272 Write_Str ("Discriminant_Number");
9273
9274 when E_Component =>
9275 Write_Str ("DT_Entry_Count");
9276
9277 when E_Function |
9278 E_Procedure =>
9279 Write_Str ("DT_Position");
9280
9281 when Entry_Kind =>
9282 Write_Str ("Entry_Parameters_Type");
9283
9284 when Formal_Kind =>
9285 Write_Str ("Extra_Formal");
9286
9287 when Type_Kind =>
9288 Write_Str ("Pending_Access_Types");
9289
9290 when E_Package |
9291 E_Package_Body =>
9292 Write_Str ("Related_Instance");
9293
9294 when E_Constant |
9295 E_Variable =>
9296 Write_Str ("Status_Flag_Or_Transient_Decl");
9297
9298 when others =>
9299 Write_Str ("Field15??");
9300 end case;
9301 end Write_Field15_Name;
9302
9303 ------------------------
9304 -- Write_Field16_Name --
9305 ------------------------
9306
9307 procedure Write_Field16_Name (Id : Entity_Id) is
9308 begin
9309 case Ekind (Id) is
9310 when E_Record_Type |
9311 E_Record_Type_With_Private =>
9312 Write_Str ("Access_Disp_Table");
9313
9314 when E_Abstract_State =>
9315 Write_Str ("Body_References");
9316
9317 when E_Record_Subtype |
9318 E_Class_Wide_Subtype =>
9319 Write_Str ("Cloned_Subtype");
9320
9321 when E_Function |
9322 E_Procedure =>
9323 Write_Str ("DTC_Entity");
9324
9325 when E_Component =>
9326 Write_Str ("Entry_Formal");
9327
9328 when E_Package |
9329 E_Generic_Package |
9330 Concurrent_Kind =>
9331 Write_Str ("First_Private_Entity");
9332
9333 when Enumeration_Kind =>
9334 Write_Str ("Lit_Strings");
9335
9336 when Decimal_Fixed_Point_Kind =>
9337 Write_Str ("Scale_Value");
9338
9339 when E_String_Literal_Subtype =>
9340 Write_Str ("String_Literal_Length");
9341
9342 when E_Variable |
9343 E_Out_Parameter =>
9344 Write_Str ("Unset_Reference");
9345
9346 when others =>
9347 Write_Str ("Field16??");
9348 end case;
9349 end Write_Field16_Name;
9350
9351 ------------------------
9352 -- Write_Field17_Name --
9353 ------------------------
9354
9355 procedure Write_Field17_Name (Id : Entity_Id) is
9356 begin
9357 case Ekind (Id) is
9358 when Formal_Kind |
9359 E_Constant |
9360 E_Generic_In_Out_Parameter |
9361 E_Variable =>
9362 Write_Str ("Actual_Subtype");
9363
9364 when Digits_Kind =>
9365 Write_Str ("Digits_Value");
9366
9367 when E_Discriminant =>
9368 Write_Str ("Discriminal");
9369
9370 when E_Block |
9371 Class_Wide_Kind |
9372 Concurrent_Kind |
9373 Private_Kind |
9374 E_Entry |
9375 E_Entry_Family |
9376 E_Function |
9377 E_Generic_Function |
9378 E_Generic_Package |
9379 E_Generic_Procedure |
9380 E_Loop |
9381 E_Operator |
9382 E_Package |
9383 E_Package_Body |
9384 E_Procedure |
9385 E_Record_Type |
9386 E_Record_Subtype |
9387 E_Return_Statement |
9388 E_Subprogram_Body |
9389 E_Subprogram_Type =>
9390 Write_Str ("First_Entity");
9391
9392 when Array_Kind =>
9393 Write_Str ("First_Index");
9394
9395 when Enumeration_Kind =>
9396 Write_Str ("First_Literal");
9397
9398 when Access_Kind =>
9399 Write_Str ("Master_Id");
9400
9401 when Modular_Integer_Kind =>
9402 Write_Str ("Modulus");
9403
9404 when E_Abstract_State |
9405 E_Incomplete_Type =>
9406 Write_Str ("Non_Limited_View");
9407
9408 when E_Incomplete_Subtype =>
9409 if From_Limited_With (Id) then
9410 Write_Str ("Non_Limited_View");
9411 end if;
9412
9413 when E_Component =>
9414 Write_Str ("Prival");
9415
9416 when others =>
9417 Write_Str ("Field17??");
9418 end case;
9419 end Write_Field17_Name;
9420
9421 ------------------------
9422 -- Write_Field18_Name --
9423 ------------------------
9424
9425 procedure Write_Field18_Name (Id : Entity_Id) is
9426 begin
9427 case Ekind (Id) is
9428 when E_Enumeration_Literal |
9429 E_Function |
9430 E_Operator |
9431 E_Procedure =>
9432 Write_Str ("Alias");
9433
9434 when E_Record_Type =>
9435 Write_Str ("Corresponding_Concurrent_Type");
9436
9437 when E_Subprogram_Body =>
9438 Write_Str ("Corresponding_Protected_Entry");
9439
9440 when Concurrent_Kind =>
9441 Write_Str ("Corresponding_Record_Type");
9442
9443 when E_Label |
9444 E_Loop |
9445 E_Block =>
9446 Write_Str ("Enclosing_Scope");
9447
9448 when E_Entry_Index_Parameter =>
9449 Write_Str ("Entry_Index_Constant");
9450
9451 when E_Class_Wide_Subtype |
9452 E_Access_Protected_Subprogram_Type |
9453 E_Anonymous_Access_Protected_Subprogram_Type |
9454 E_Access_Subprogram_Type |
9455 E_Exception_Type =>
9456 Write_Str ("Equivalent_Type");
9457
9458 when Fixed_Point_Kind =>
9459 Write_Str ("Delta_Value");
9460
9461 when Enumeration_Kind =>
9462 Write_Str ("Lit_Indexes");
9463
9464 when Incomplete_Or_Private_Kind |
9465 E_Record_Subtype =>
9466 Write_Str ("Private_Dependents");
9467
9468 when Object_Kind =>
9469 Write_Str ("Renamed_Object");
9470
9471 when E_Exception |
9472 E_Package |
9473 E_Generic_Function |
9474 E_Generic_Procedure |
9475 E_Generic_Package =>
9476 Write_Str ("Renamed_Entity");
9477
9478 when E_String_Literal_Subtype =>
9479 Write_Str ("String_Literal_Low_Bound");
9480
9481 when others =>
9482 Write_Str ("Field18??");
9483 end case;
9484 end Write_Field18_Name;
9485
9486 -----------------------
9487 -- Write_Field19_Name --
9488 -----------------------
9489
9490 procedure Write_Field19_Name (Id : Entity_Id) is
9491 begin
9492 case Ekind (Id) is
9493 when E_Package |
9494 E_Generic_Package =>
9495 Write_Str ("Body_Entity");
9496
9497 when E_Discriminant =>
9498 Write_Str ("Corresponding_Discriminant");
9499
9500 when Scalar_Kind =>
9501 Write_Str ("Default_Aspect_Value");
9502
9503 when E_Array_Type =>
9504 Write_Str ("Default_Component_Value");
9505
9506 when E_Protected_Type =>
9507 Write_Str ("Entry_Bodies_Array");
9508
9509 when E_Function |
9510 E_Operator |
9511 E_Subprogram_Type =>
9512 Write_Str ("Extra_Accessibility_Of_Result");
9513
9514 when E_Record_Type =>
9515 Write_Str ("Parent_Subtype");
9516
9517 when E_Constant |
9518 E_Variable =>
9519 Write_Str ("Size_Check_Code");
9520
9521 when E_Package_Body |
9522 Formal_Kind =>
9523 Write_Str ("Spec_Entity");
9524
9525 when Private_Kind =>
9526 Write_Str ("Underlying_Full_View");
9527
9528 when others =>
9529 Write_Str ("Field19??");
9530 end case;
9531 end Write_Field19_Name;
9532
9533 -----------------------
9534 -- Write_Field20_Name --
9535 -----------------------
9536
9537 procedure Write_Field20_Name (Id : Entity_Id) is
9538 begin
9539 case Ekind (Id) is
9540 when Array_Kind =>
9541 Write_Str ("Component_Type");
9542
9543 when E_In_Parameter |
9544 E_Generic_In_Parameter =>
9545 Write_Str ("Default_Value");
9546
9547 when Access_Kind =>
9548 Write_Str ("Directly_Designated_Type");
9549
9550 when E_Component =>
9551 Write_Str ("Discriminant_Checking_Func");
9552
9553 when E_Discriminant =>
9554 Write_Str ("Discriminant_Default_Value");
9555
9556 when E_Block |
9557 Class_Wide_Kind |
9558 Concurrent_Kind |
9559 Private_Kind |
9560 E_Entry |
9561 E_Entry_Family |
9562 E_Function |
9563 E_Generic_Function |
9564 E_Generic_Package |
9565 E_Generic_Procedure |
9566 E_Loop |
9567 E_Operator |
9568 E_Package |
9569 E_Package_Body |
9570 E_Procedure |
9571 E_Record_Type |
9572 E_Record_Subtype |
9573 E_Return_Statement |
9574 E_Subprogram_Body |
9575 E_Subprogram_Type =>
9576 Write_Str ("Last_Entity");
9577
9578 when E_Constant |
9579 E_Variable =>
9580 Write_Str ("Prival_Link");
9581
9582 when Scalar_Kind =>
9583 Write_Str ("Scalar_Range");
9584
9585 when E_Exception =>
9586 Write_Str ("Register_Exception_Call");
9587
9588 when others =>
9589 Write_Str ("Field20??");
9590 end case;
9591 end Write_Field20_Name;
9592
9593 -----------------------
9594 -- Write_Field21_Name --
9595 -----------------------
9596
9597 procedure Write_Field21_Name (Id : Entity_Id) is
9598 begin
9599 case Ekind (Id) is
9600 when Entry_Kind =>
9601 Write_Str ("Accept_Address");
9602
9603 when E_In_Parameter =>
9604 Write_Str ("Default_Expr_Function");
9605
9606 when Concurrent_Kind |
9607 Incomplete_Or_Private_Kind |
9608 Class_Wide_Kind |
9609 E_Record_Type |
9610 E_Record_Subtype =>
9611 Write_Str ("Discriminant_Constraint");
9612
9613 when E_Constant |
9614 E_Exception |
9615 E_Function |
9616 E_Generic_Function |
9617 E_Procedure |
9618 E_Generic_Procedure |
9619 E_Variable =>
9620 Write_Str ("Interface_Name");
9621
9622 when Array_Kind |
9623 Modular_Integer_Kind =>
9624 Write_Str ("Original_Array_Type");
9625
9626 when Fixed_Point_Kind =>
9627 Write_Str ("Small_Value");
9628
9629 when others =>
9630 Write_Str ("Field21??");
9631 end case;
9632 end Write_Field21_Name;
9633
9634 -----------------------
9635 -- Write_Field22_Name --
9636 -----------------------
9637
9638 procedure Write_Field22_Name (Id : Entity_Id) is
9639 begin
9640 case Ekind (Id) is
9641 when Access_Kind =>
9642 Write_Str ("Associated_Storage_Pool");
9643
9644 when Array_Kind =>
9645 Write_Str ("Component_Size");
9646
9647 when E_Record_Type =>
9648 Write_Str ("Corresponding_Remote_Type");
9649
9650 when E_Component |
9651 E_Discriminant =>
9652 Write_Str ("Original_Record_Component");
9653
9654 when E_Enumeration_Literal =>
9655 Write_Str ("Enumeration_Rep_Expr");
9656
9657 when E_Record_Type_With_Private |
9658 E_Record_Subtype_With_Private |
9659 E_Private_Type |
9660 E_Private_Subtype |
9661 E_Limited_Private_Type |
9662 E_Limited_Private_Subtype =>
9663 Write_Str ("Private_View");
9664
9665 when Formal_Kind =>
9666 Write_Str ("Protected_Formal");
9667
9668 when E_Block |
9669 E_Entry |
9670 E_Entry_Family |
9671 E_Function |
9672 E_Loop |
9673 E_Package |
9674 E_Package_Body |
9675 E_Generic_Package |
9676 E_Generic_Function |
9677 E_Generic_Procedure |
9678 E_Procedure |
9679 E_Protected_Type |
9680 E_Return_Statement |
9681 E_Subprogram_Body |
9682 E_Task_Type =>
9683 Write_Str ("Scope_Depth_Value");
9684
9685 when E_Variable =>
9686 Write_Str ("Shared_Var_Procs_Instance");
9687
9688 when others =>
9689 Write_Str ("Field22??");
9690 end case;
9691 end Write_Field22_Name;
9692
9693 ------------------------
9694 -- Write_Field23_Name --
9695 ------------------------
9696
9697 procedure Write_Field23_Name (Id : Entity_Id) is
9698 begin
9699 case Ekind (Id) is
9700 when E_Discriminant =>
9701 Write_Str ("CR_Discriminant");
9702
9703 when E_Block =>
9704 Write_Str ("Entry_Cancel_Parameter");
9705
9706 when E_Enumeration_Type =>
9707 Write_Str ("Enum_Pos_To_Rep");
9708
9709 when Formal_Kind |
9710 E_Variable =>
9711 Write_Str ("Extra_Constrained");
9712
9713 when Access_Kind =>
9714 Write_Str ("Finalization_Master");
9715
9716 when E_Generic_Function |
9717 E_Generic_Package |
9718 E_Generic_Procedure =>
9719 Write_Str ("Inner_Instances");
9720
9721 when Array_Kind =>
9722 Write_Str ("Packed_Array_Impl_Type");
9723
9724 when Entry_Kind =>
9725 Write_Str ("Protection_Object");
9726
9727 when Concurrent_Kind |
9728 Incomplete_Or_Private_Kind |
9729 Class_Wide_Kind |
9730 E_Record_Type |
9731 E_Record_Subtype =>
9732 Write_Str ("Stored_Constraint");
9733
9734 when E_Function |
9735 E_Procedure =>
9736 if Present (Scope (Id))
9737 and then Is_Protected_Type (Scope (Id))
9738 then
9739 Write_Str ("Protection_Object");
9740 else
9741 Write_Str ("Generic_Renamings");
9742 end if;
9743
9744 when E_Package =>
9745 if Is_Generic_Instance (Id) then
9746 Write_Str ("Generic_Renamings");
9747 else
9748 Write_Str ("Limited_View");
9749 end if;
9750
9751 when others =>
9752 Write_Str ("Field23??");
9753 end case;
9754 end Write_Field23_Name;
9755
9756 ------------------------
9757 -- Write_Field24_Name --
9758 ------------------------
9759
9760 procedure Write_Field24_Name (Id : Entity_Id) is
9761 begin
9762 case Ekind (Id) is
9763 when E_Constant |
9764 E_Variable |
9765 Type_Kind =>
9766 Write_Str ("Related_Expression");
9767
9768 when E_Function |
9769 E_Operator |
9770 E_Procedure =>
9771 if Field24 (Id) in Uint_Range then
9772 Write_Str ("Subps_Index");
9773 else
9774 Write_Str ("Uplevel_References");
9775 end if;
9776
9777 when others =>
9778 Write_Str ("Field24???");
9779 end case;
9780 end Write_Field24_Name;
9781
9782 ------------------------
9783 -- Write_Field25_Name --
9784 ------------------------
9785
9786 procedure Write_Field25_Name (Id : Entity_Id) is
9787 begin
9788 case Ekind (Id) is
9789 when E_Generic_Package |
9790 E_Package =>
9791 Write_Str ("Abstract_States");
9792
9793 when E_Variable =>
9794 Write_Str ("Debug_Renaming_Link");
9795
9796 when E_Component =>
9797 Write_Str ("DT_Offset_To_Top_Func");
9798
9799 when E_Procedure |
9800 E_Function =>
9801 Write_Str ("Interface_Alias");
9802
9803 when E_Record_Type |
9804 E_Record_Subtype |
9805 E_Record_Type_With_Private |
9806 E_Record_Subtype_With_Private =>
9807 Write_Str ("Interfaces");
9808
9809 when E_Array_Type |
9810 E_Array_Subtype =>
9811 Write_Str ("Related_Array_Object");
9812
9813 when Task_Kind =>
9814 Write_Str ("Task_Body_Procedure");
9815
9816 when E_Entry |
9817 E_Entry_Family =>
9818 Write_Str ("PPC_Wrapper");
9819
9820 when Discrete_Kind =>
9821 Write_Str ("Static_Discrete_Predicate");
9822
9823 when Real_Kind =>
9824 Write_Str ("Static_Real_Or_String_Predicate");
9825
9826 when others =>
9827 Write_Str ("Field25??");
9828 end case;
9829 end Write_Field25_Name;
9830
9831 ------------------------
9832 -- Write_Field26_Name --
9833 ------------------------
9834
9835 procedure Write_Field26_Name (Id : Entity_Id) is
9836 begin
9837 case Ekind (Id) is
9838 when E_Record_Type |
9839 E_Record_Type_With_Private =>
9840 Write_Str ("Dispatch_Table_Wrappers");
9841
9842 when E_In_Out_Parameter |
9843 E_Out_Parameter |
9844 E_Variable =>
9845 Write_Str ("Last_Assignment");
9846
9847 when E_Procedure |
9848 E_Function =>
9849 Write_Str ("Overridden_Operation");
9850
9851 when E_Generic_Package |
9852 E_Package =>
9853 Write_Str ("Package_Instantiation");
9854
9855 when E_Component |
9856 E_Constant =>
9857 Write_Str ("Related_Type");
9858
9859 when Access_Kind |
9860 Task_Kind =>
9861 Write_Str ("Storage_Size_Variable");
9862
9863 when others =>
9864 Write_Str ("Field26??");
9865 end case;
9866 end Write_Field26_Name;
9867
9868 ------------------------
9869 -- Write_Field27_Name --
9870 ------------------------
9871
9872 procedure Write_Field27_Name (Id : Entity_Id) is
9873 begin
9874 case Ekind (Id) is
9875 when E_Package |
9876 Type_Kind =>
9877 Write_Str ("Current_Use_Clause");
9878
9879 when E_Component |
9880 E_Constant |
9881 E_Variable =>
9882 Write_Str ("Related_Type");
9883
9884 when E_Procedure |
9885 E_Function =>
9886 Write_Str ("Wrapped_Entity");
9887
9888 when others =>
9889 Write_Str ("Field27??");
9890 end case;
9891 end Write_Field27_Name;
9892
9893 ------------------------
9894 -- Write_Field28_Name --
9895 ------------------------
9896
9897 procedure Write_Field28_Name (Id : Entity_Id) is
9898 begin
9899 case Ekind (Id) is
9900 when E_Entry |
9901 E_Entry_Family |
9902 E_Function |
9903 E_Procedure |
9904 E_Subprogram_Body |
9905 E_Subprogram_Type =>
9906 Write_Str ("Extra_Formals");
9907
9908 when E_Package |
9909 E_Package_Body =>
9910 Write_Str ("Finalizer");
9911
9912 when E_Constant |
9913 E_Variable =>
9914 Write_Str ("Initialization_Statements");
9915
9916 when E_Access_Subprogram_Type =>
9917 Write_Str ("Original_Access_Type");
9918
9919 when Task_Kind =>
9920 Write_Str ("Relative_Deadline_Variable");
9921
9922 when E_Record_Type =>
9923 Write_Str ("Underlying_Record_View");
9924
9925 when others =>
9926 Write_Str ("Field28??");
9927 end case;
9928 end Write_Field28_Name;
9929
9930 ------------------------
9931 -- Write_Field29_Name --
9932 ------------------------
9933
9934 procedure Write_Field29_Name (Id : Entity_Id) is
9935 begin
9936 case Ekind (Id) is
9937 when E_Constant |
9938 E_Variable =>
9939 Write_Str ("BIP_Initialization_Call");
9940
9941 when Type_Kind =>
9942 Write_Str ("Subprograms_For_Type");
9943
9944 when others =>
9945 Write_Str ("Field29??");
9946 end case;
9947 end Write_Field29_Name;
9948
9949 ------------------------
9950 -- Write_Field30_Name --
9951 ------------------------
9952
9953 procedure Write_Field30_Name (Id : Entity_Id) is
9954 begin
9955 case Ekind (Id) is
9956 when E_Function =>
9957 Write_Str ("Corresponding_Equality");
9958
9959 when E_Constant |
9960 E_Variable =>
9961 Write_Str ("Last_Aggregate_Assignment");
9962
9963 when E_Procedure =>
9964 Write_Str ("Static_Initialization");
9965
9966 when others =>
9967 Write_Str ("Field30??");
9968 end case;
9969 end Write_Field30_Name;
9970
9971 ------------------------
9972 -- Write_Field31_Name --
9973 ------------------------
9974
9975 procedure Write_Field31_Name (Id : Entity_Id) is
9976 begin
9977 case Ekind (Id) is
9978 when E_Procedure |
9979 E_Function =>
9980 Write_Str ("Thunk_Entity");
9981
9982 when Type_Kind =>
9983 Write_Str ("Derived_Type_Link");
9984
9985 when E_Constant |
9986 E_In_Parameter |
9987 E_In_Out_Parameter |
9988 E_Loop_Parameter |
9989 E_Out_Parameter |
9990 E_Variable =>
9991 Write_Str ("Activation_Record_Component");
9992
9993 when others =>
9994 Write_Str ("Field31??");
9995 end case;
9996 end Write_Field31_Name;
9997
9998 ------------------------
9999 -- Write_Field32_Name --
10000 ------------------------
10001
10002 procedure Write_Field32_Name (Id : Entity_Id) is
10003 begin
10004 case Ekind (Id) is
10005 when E_Function |
10006 E_Generic_Function |
10007 E_Generic_Package |
10008 E_Generic_Procedure |
10009 E_Package |
10010 E_Package_Body |
10011 E_Procedure |
10012 E_Subprogram_Body =>
10013 Write_Str ("SPARK_Pragma");
10014
10015 when Type_Kind =>
10016 Write_Str ("No_Tagged_Streams_Pragma");
10017
10018 when others =>
10019 Write_Str ("Field32??");
10020 end case;
10021 end Write_Field32_Name;
10022
10023 ------------------------
10024 -- Write_Field33_Name --
10025 ------------------------
10026
10027 procedure Write_Field33_Name (Id : Entity_Id) is
10028 begin
10029 case Ekind (Id) is
10030 when E_Generic_Package |
10031 E_Package |
10032 E_Package_Body =>
10033 Write_Str ("SPARK_Aux_Pragma");
10034
10035 when E_Constant |
10036 E_Variable |
10037 Subprogram_Kind |
10038 Type_Kind =>
10039 Write_Str ("Linker_Section_Pragma");
10040
10041 when others =>
10042 Write_Str ("Field33??");
10043 end case;
10044 end Write_Field33_Name;
10045
10046 ------------------------
10047 -- Write_Field34_Name --
10048 ------------------------
10049
10050 procedure Write_Field34_Name (Id : Entity_Id) is
10051 begin
10052 case Ekind (Id) is
10053 when E_Entry |
10054 E_Entry_Family |
10055 E_Generic_Package |
10056 E_Package |
10057 E_Package_Body |
10058 E_Subprogram_Body |
10059 E_Variable |
10060 Generic_Subprogram_Kind |
10061 Subprogram_Kind =>
10062 Write_Str ("Contract");
10063
10064 when others =>
10065 Write_Str ("Field34??");
10066 end case;
10067 end Write_Field34_Name;
10068
10069 ------------------------
10070 -- Write_Field35_Name --
10071 ------------------------
10072
10073 procedure Write_Field35_Name (Id : Entity_Id) is
10074 begin
10075 case Ekind (Id) is
10076 when Subprogram_Kind =>
10077 Write_Str ("Import_Pragma");
10078
10079 when others =>
10080 Write_Str ("Field35??");
10081 end case;
10082 end Write_Field35_Name;
10083
10084 -------------------------
10085 -- Iterator Procedures --
10086 -------------------------
10087
10088 procedure Proc_Next_Component (N : in out Node_Id) is
10089 begin
10090 N := Next_Component (N);
10091 end Proc_Next_Component;
10092
10093 procedure Proc_Next_Component_Or_Discriminant (N : in out Node_Id) is
10094 begin
10095 N := Next_Entity (N);
10096 while Present (N) loop
10097 exit when Ekind_In (N, E_Component, E_Discriminant);
10098 N := Next_Entity (N);
10099 end loop;
10100 end Proc_Next_Component_Or_Discriminant;
10101
10102 procedure Proc_Next_Discriminant (N : in out Node_Id) is
10103 begin
10104 N := Next_Discriminant (N);
10105 end Proc_Next_Discriminant;
10106
10107 procedure Proc_Next_Formal (N : in out Node_Id) is
10108 begin
10109 N := Next_Formal (N);
10110 end Proc_Next_Formal;
10111
10112 procedure Proc_Next_Formal_With_Extras (N : in out Node_Id) is
10113 begin
10114 N := Next_Formal_With_Extras (N);
10115 end Proc_Next_Formal_With_Extras;
10116
10117 procedure Proc_Next_Index (N : in out Node_Id) is
10118 begin
10119 N := Next_Index (N);
10120 end Proc_Next_Index;
10121
10122 procedure Proc_Next_Inlined_Subprogram (N : in out Node_Id) is
10123 begin
10124 N := Next_Inlined_Subprogram (N);
10125 end Proc_Next_Inlined_Subprogram;
10126
10127 procedure Proc_Next_Literal (N : in out Node_Id) is
10128 begin
10129 N := Next_Literal (N);
10130 end Proc_Next_Literal;
10131
10132 procedure Proc_Next_Stored_Discriminant (N : in out Node_Id) is
10133 begin
10134 N := Next_Stored_Discriminant (N);
10135 end Proc_Next_Stored_Discriminant;
10136
10137 end Einfo;